Метод дихотомии в Delphi

Ответить
gerik_a
Сообщения: 1
Зарегистрирован: 30 май 2009, 22:13

Суть задачи: С заданной точностью eps найти минимум уравнения F(x)=0 с помощью метода дихотомии.
Помогите пожалуйста.
dr.Jekill
Сообщения: 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.
Нет религии выше истины
atavin-ta
Сообщения: 585
Зарегистрирован: 30 янв 2009, 06:38

Что за метод? Я знаю методы: бисекций и Ньютона. А что такоя дихотомия?
Вопрос: "Почему вы все сионисты? Нельзя ли писать на чём то другом?".
Ответ: "Писать можно на чём угодно. Но зачем же так себя ограничивать? Пиши на С!".
dr.Jekill
Сообщения: 526
Зарегистрирован: 03 янв 2009, 23:17
Откуда: Voronezh
Контактная информация:

atavin-ta писал(а):Я знаю методы: бисекций и Ньютона. А что такоя дихотомия?
Это то же самое, что и метод бисекции или половинного деления.
Нет религии выше истины
Ответить