Версия для печати темы

Автор: marwell 19.05.2010 21:54

Составить программу для решения нелинейного уравнения f(x)=0 методом половинного деления. В качестве f(x) взять функцию, указанную ниже. На выбранном интервале [a, b] корень должен быть единственным (отделенным). В качестве исходных данных, задаваемых в начале программы или вводимых из файла или с экрана, следует взять:
1) Границы интервала [a, b], на котором ищется корень;
2) Точность вычислений еps;
В качестве результатов работы программы представить:
1) Корень уравнения;
2) Значение функции в корне;
3) Количество реально проведенных итераций;
4) График функции f(x).

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Image1: TImage;
    Button1: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Edit3: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;


var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
function f(x:real):real;
  begin
  f:=x*x*x*x+x-1;
  end;
var a0,b0,eps,fa,fb,x:real;
    schet:integer;
begin
schet:=0;
a0:=StrToFloat(Edit1.Text);
b0:=StrToFloat(Edit2.Text);
eps:=StrToFloat(Edit3.Text);
if a0>b0 then begin MessageDlg('Неверные данные', mtError, [mbOK],0);
Edit1.Text:=' ';
Edit2.Text:=' ';
end;
fa:=f(a0); fb:=f(b0);
repeat
x:=(a0+b0)/2;
if fa*f(x)>0 then a0:=x  else b0:=x;
schet:=schet+1;
until  abs(b0-a0)>=eps;
Label1.Caption:=FloatToStr(x);
Label2.Caption:=FloatToStr(f(x));
Label3.Caption:=FloatToStr(schet);
With Image1.Canvas do
begin
 Pen.Color:=clBlack;
 Brush.Color:=clWhite;
 FillRect(Image1.ClientRect);
 MoveTo(0,Image1.Height div 2);
 LineTo(Image1.Width, Image1.Height div 2);
 MoveTo(Image1.Width div 2, 0);
 LineTo(Image1.Width div 2, Image1.Height);
.....
end;
end.

Автор: Ozzя 19.05.2010 22:00

Автор: marwell 19.05.2010 22:13

а с первым пунктом не можешь помочь?

Автор: Ozzя 19.05.2010 22:26

Автор: marwell 19.05.2010 22:28

Цитата(Ozzя @ 19.05.2010 18:26)

Автор: Ozzя 19.05.2010 22:30

uses sysutils;
var a0,b0,eps,fa,fb,x:real;
    schet:integer;
function f(x:real):real;
  begin
  f:=x*x*x*x+x-1;
  end;

begin
schet:=0;
a0:=0;
b0:=2;
eps:=0.00001;
fa:=f(a0); fb:=f(b0);
repeat
  x:=(a0+b0)/2;
  if fa*f(x)>0 then b0:=x  else a0:=x;
  schet:=schet+1;
until  abs(b0-a0)<=eps;
writeln(schet);
end.

Автор: marwell 19.05.2010 22:32

Цитата(Ozzя @ 19.05.2010 18:30)

uses sysutils;
var a0,b0,eps,fa,fb,x:real;
    schet:integer;
function f(x:real):real;
  begin
  f:=x*x*x*x+x-1;
  end;

begin
schet:=0;
a0:=0;
b0:=2;
eps:=0.00001;
fa:=f(a0); fb:=f(b0);
repeat
  x:=(a0+b0)/2;
  if fa*f(x)>0 then b0:=x  else a0:=x;
  schet:=schet+1;
until  abs(b0-a0)<=eps;
writeln(schet);
end.

Автор: Ozzя 19.05.2010 22:35

Это я ошибся. Извини.
http://forum.pascal.net.ru/index.php?s=&showtopic=3789&view=findpost&p=17091
Сравни со своим

Добавлено через 3 мин.
Нашел ошибку?

Автор: marwell 19.05.2010 22:42

Цитата(Ozzя @ 19.05.2010 18:35)

...
until  abs(b0-a0)>=eps;
...

Автор: TarasBer 20.05.2010 13:50

> неверное условие поставил

Не только.
fa не меняется.
Метод по ссылке считает значение функции по два раза внутри цикла. А можно обойтись одним.

function FindRoot(v: extended; r1, r2: extended): extended; // для функции f ищем корень уравнения f(x)=v
// на отрезке от r1 до r2
var
  r: extended;
  f1, f2: extended;
begin
  f1 := f(r1);
  repeat
    r := r1 + (r2 - r1) * 0.5;
    if (r = r1) or (r = r2) then break;
    f2 := f ( r ) ; 
    if (f1 > v) xor (f2 > v) then r2 := r  // если корень левее середины
    else begin  // если корень правее середины
      r1 := r;
      f1 := f2;
    end;
  until false;
  FindRoot := r1;
end;

Автор: marwell 20.05.2010 17:15

With Image1.Canvas do
begin
 Pen.Color:=clBlack;
 Brush.Color:=clWhite;
 FillRect(Image1.ClientRect);
 MoveTo(0,Image1.Height div 2);
 LineTo(Image1.Width, Image1.Height div 2);
 MoveTo(Image1.Width div 2, 0);
 LineTo(Image1.Width div 2, Image1.Height);
 MoveTo(0,0);
 px:=-100;
 while px<=Image1.Width do begin
  LineTo(image1.Width div 2 + px,Image1.Height div 2 - trunc(f(px)));
 Application.ProcessMessages;
 inc(px);
 end;
 end;