Помощь - Поиск - Пользователи - Календарь
Полная версия: построение графика функции
Форум «Всё о Паскале» > Delphi, Assembler и другие языки. > Delphi
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.проблема с графиком: я не понимаю, как, с какими данными его начать строить? буду рад помощи
Ozzя
Цитата
с какими данными его начать строить

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

Цитата
как

В Drkb есть тема
Рисуем график функции в Delphi
marwell
а с первым пунктом не можешь помочь?
Ozzя
Цитата
а с первым пунктом не можешь помочь?

Что-то с алгоритмом не так.
У меня выплевывает сразу из цикла
marwell
Цитата(Ozzя @ 19.05.2010 18:26) *

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

Есть функция 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
Цитата(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.


но ведь у меня тот же алгоритм blink.gif
сорри, нашел ошибку
Ozzя
Это я ошибся. Извини.
Численные методы решения уравнений
Сравни со своим

Добавлено через 3 мин.
Нашел ошибку?
marwell
Цитата(Ozzя @ 19.05.2010 18:35) *

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

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

...
until  abs(b0-a0)>=eps;
...
неверное условие поставил
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;

написал, как понял. У кого есть время, посмотрите пожалуйста...
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.