IPB
ЛогинПароль:

> ВНИМАНИЕ!

Прежде чем задать вопрос, смотрите FAQ.
Рекомендуем загрузить DRKB.

Наладить общение поможет, если вы подпишитесь по почте на новые темы в этом форуме.

 
 Ответить  Открыть новую тему 
> построение графика функции
сообщение
Сообщение #1


Бывалый
***

Группа: Пользователи
Сообщений: 198
Пол: Мужской

Репутация: -  1  +


Составить программу для решения нелинейного уравнения 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 -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гуру
*****

Группа: Пользователи
Сообщений: 1 220
Пол: Мужской

Репутация: -  16  +


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

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

Цитата
как

В Drkb есть тема
Рисуем график функции в Delphi
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Бывалый
***

Группа: Пользователи
Сообщений: 198
Пол: Мужской

Репутация: -  1  +


а с первым пунктом не можешь помочь?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Гуру
*****

Группа: Пользователи
Сообщений: 1 220
Пол: Мужской

Репутация: -  16  +


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

Что-то с алгоритмом не так.
У меня выплевывает сразу из цикла
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Бывалый
***

Группа: Пользователи
Сообщений: 198
Пол: Мужской

Репутация: -  1  +


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

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

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


Гуру
*****

Группа: Пользователи
Сообщений: 1 220
Пол: Мужской

Репутация: -  16  +


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.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Бывалый
***

Группа: Пользователи
Сообщений: 198
Пол: Мужской

Репутация: -  1  +


Цитата(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
сорри, нашел ошибку

Сообщение отредактировано: marwell -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Гуру
*****

Группа: Пользователи
Сообщений: 1 220
Пол: Мужской

Репутация: -  16  +


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

Добавлено через 3 мин.
Нашел ошибку?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Бывалый
***

Группа: Пользователи
Сообщений: 198
Пол: Мужской

Репутация: -  1  +


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

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

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

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

Сообщение отредактировано: marwell -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10


Злостный любитель
*****

Группа: Пользователи
Сообщений: 1 755
Пол: Мужской

Репутация: -  62  +


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

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



--------------------
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #11


Бывалый
***

Группа: Пользователи
Сообщений: 198
Пол: Мужской

Репутация: -  1  +


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;

написал, как понял. У кого есть время, посмотрите пожалуйста...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 27.10.2020 22:54
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name