Суть задачи: С заданной точностью eps найти минимум уравнения F(x)=0 с помощью метода дихотомии.
Помогите пожалуйста.
Метод дихотомии в Delphi
-
- Сообщения: 526
- Зарегистрирован: 03 янв 2009, 23:17
- Откуда: Voronezh
- Контактная информация:
Подставь свою функцию, убери процедуру рисования графика, если не нужна. Если не подойдет ищи метод бисекции или половинного деления
Код: Выделить всё
program bisekcia;
uses crt,graph;{podkluchaen moduli}
var a_,b_,eps_,x_:real;
it_,k_,gd,gm:integer;
vybor:char; {obiavliaem peremennye}
Function func (arg:real):real;{procedura-funkcia vychisliaiuschaia znachenia funkcii F(x)}
begin
func:=arg*sqr(arg)-3*arg-2*exp(-arg);{Zdes mozhno zadat liubuiu funkciu}
end;
Function sign(zn:real):integer;
begin
if zn=0 then
begin
sign:=0
end
else
if zn>0 then sign:=1 else sign:=-1;
end;
PROCEDURE BISECT (A,B,EPS :REAL; IT:INTEGER;{procedura nahozhdenia korhney}
VAR X : REAL; VAR K:INTEGER);{a-verniaia granica intervala,}
{b-nizhnaia granica intervala,}
{eps-tochnost}
{it-maksimalnoe kol-vo iteracii,chtoby programma ne zaciklilas,esli interval}
{zadan ne pravilno}
VAR A1, B1: REAL; X1, X2, X3 : INTEGER;{opisanie algoritma v listinge}
BEGIN
K := 0;
X1 := SIGN (FUNC(A));
X2 := SIGN (FUNC(B));
A1 := A;
B1 := B;
REPEAT
INC (K);
X := (A1+B1)*0.5;
X3 := SIGN (FUNC (X));
IF X3=0 THEN EXIT;
IF ABS(B1-A1)<(2*EPS) THEN EXIT;
IF (X1=X2) AND (X2=X3) THEN EXIT;
IF X1=X3 THEN
BEGIN
A1 := X;
X1 := X3;
END
ELSE
BEGIN B1 := X;
X2 := X3;
END;
UNTIL K>IT;
END;
{procedura risovaniia grafika funkcii}
procedure drawgrafik(a,b:real); { a,b - nachalnoe i konechnoe znachenie x }
var x,dx,max,min,koef,h,g:real;
k,x0,y0:integer; { x0,y0 - polozhenie osey koordinat }
begin
h:=a;
g:=b;
clearviewport;
dx:=(b-a)/639; { opredelily shag izmenenia x
(640 tochek na grafike,intervalov 639) }
x:=a; max:=func(a); min:=func(a);
for k:=1 to 640 do { opredeliaem oblast znacheniy f(x) }
begin
if func(x)>max then max:=func(x);
if func(x)<min then min:=func(x);
x:=x+dx;
end;
koef:=479/(max-min); { koefficient po osi y }
x:=a;{ nachalnoe znachenie x }
moveto(0,round(479-koef*(func(a)-min)));{ nachalnoe znachenie ukazatelia }
for k:=1 to 639 do { stroim grafik }
begin
x:=x+dx;
setbkcolor(black);
setcolor(green);
lineto(k,round(479-koef*(func(x)-min)));
end;
x0:=round(639*a/(a-b)); { a/(a-b)=(0-a)/(b-a) }
line(x0,0,x0,479); { os y }
y0:=round(479-479*(min/(min-max)));
line(0,y0,639,y0); { os x }
PutPixel(x0,y0,red);
setcolor(white);
OutTextXY(x0+3,y0+4,'0');{podpis nachala koordinat}
OutTextXY(x0-10,6,'y'); {podpisi po osiam}
OutTextXY(615,y0+3,'x');
end;
{osnovnaia programma}
begin
clrscr;
writeln('_____________________________________________');
writeln('***Programma nahozhdenia kornei uravneniia***');
writeln('F(x)=x*sqr(x)-3*x-2*exp(-x) metodom bisekcii.');
writeln('---------------------------------------------');
write('Zadaite nizhniuu granicu: ');
readln(a_);
write('Zadaite verhniuu granicu: ');
readln(b_);
write('Zadaite maksimalnoe kolichestvo iteracii: ');
readln(it_);
writeln;
write('Hotite zadat druguiuu tochnost (po umolchaniuu 0,001)? [y/n] ');
readln(vybor);
if (vybor='y') or (vybor='Y') then
begin
write('-> ');
readln(eps_);
end
else eps_:=0.001;
bisect(a_,b_,eps_,it_,x_,k_);
clrscr;
writeln('Otrezok [',a_:6:2,' ..',b_:6:2,']');
writeln('Tochnost ',eps_:8:5);
writeln;
writeln('Koren:',x_:8:5);
writeln('Kolichestvo iteracii:',k_:3);
writeln('Znachenie funkcii v etoi tochke:',func(x_):12:5);
writeln;
write('Pokazat graficheski? [y/n] ');
readln(vybor);
if (vybor='y') or (vybor='Y') then
begin
clrscr;
writeln('Rekomenduemyi interval: ',(x_-2.5):8:5,'..',(x_+1):8:5);
write('Zadat drugoi interval? [y/n] ');
readln(vybor);
if (vybor='y') or (vybor='Y') then
begin
writeln;
write('Zadaite nizhniuu granicu: ');
readln(a_);
write('Zadaite verhniuu granicu: ');
readln(b_);
end
else
begin
a_:=x_-2.5;
b_:=x_+1;
end;
gd:=detect; {inicializiruem graficheskii rezhim}
initgraph(gd, gm, '');
if graphresult <> grok then
begin
writeln('Oshibka pri zapuske graficheskogo rezhima!');{vyvodim soobschenie pri oshibke}
readln;
halt;
end
else
begin
DrawGrafik(a_,b_);{risuem grafik}
readln;
closegraph;{zakryvaem graficheskii rezhim}
end;
end
else halt;{esli grafik ne nuzhen vyhodim iz programmy}
end.
Нет религии выше истины
Что за метод? Я знаю методы: бисекций и Ньютона. А что такоя дихотомия?
Вопрос: "Почему вы все сионисты? Нельзя ли писать на чём то другом?".
Ответ: "Писать можно на чём угодно. Но зачем же так себя ограничивать? Пиши на С!".
Ответ: "Писать можно на чём угодно. Но зачем же так себя ограничивать? Пиши на С!".