построение графика функции Опции

[marwell]

Составить программу для решения нелинейного уравнения 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.

Корень находит, проблема вот в чем:
1.Неверно считает количество итераций, всегда выдает равным единице.
2.проблема с графиком: я не понимаю, как, с какими данными его начать строить? буду рад помощи

Сообщение отредактировано: marwell - 21.05.2010 10:51

[Ozzя]

с какими данными его начать строить

Границы интервала [a, b],

как

В Drkb есть тема
Рисуем график функции в Delphi

[marwell]

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

[Ozzя]

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

Что-то с алгоритмом не так.
У меня выплевывает сразу из цикла

[marwell]

Что-то с алгоритмом не так.
У меня выплевывает сразу из цикла

Есть функция f(x), есть интервал [a,b], есть условие, что на концах промежутка функция имеет разный знак: f(a)*f(b)<0. Требуется найти с заданной точностью eps корень этой функции. Поступаем так: выбираем середину отрезка [a,b]. Если в середине функция имеет тот же знак что и слева, то принимаем середину за новую левую границу, в противном случае - за правую. Повторяем до тех пор, пока отрезок не станет меньше eps. Правильно?

[Ozzя]

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]

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 18:36

[Ozzя]

Это я ошибся. Извини.
Численные методы решения уравнений
Сравни со своим

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

[marwell]

Это я ошибся. Извини.
Численные методы решения уравнений
Сравни со своим

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

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

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

Сообщение отредактировано: marwell - 19.05.2010 18:44

[TarasBer]

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

Не только.
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]

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;

написал, как понял. У кого есть время, посмотрите пожалуйста...