Форум: "Основная";
Текущий архив: 2002.04.29;
Скачать: [xml.tar.bz2];
Вниз
Опять ТП7. Найти похожие ветки
← →
Miwa (2002-04-16 13:02) [10]Упс.... Не лезет.... Поднажмем...
{--------------------------------------------------------------}
procedure InputData;
begin
ClrScr;TextColor(7);
Write("F(X)="); Readln(funk);
Write("F""(X)="); ReadLn(fdef);
Write("F""""(X)=");ReadLn(sdef);
Write("Start from: "); ReadLn(a);
Write("Stop in: "); ReadLn(b);
Write("Capasity "); ReadLn(eps);
end;
{--------------------------------------------------------------}
procedure OutputRes;
var i:byte;
begin
i:=0;
GoToXY(5,wherey+1); Write("No");
GoToXY(15, wherey); Write("X");
GoToXY(30, wherey); Write("Y");
GoToXY(50, wherey); Write("Y""");
GoToXY(70, wherey); Write("|X-X|");
repeat
GoToXY(4,wherey+1); Write(i);
GoToXY(10, wherey); Write(x[i]:9:5);
GoToXY(24, wherey); Write(y[i]:9:5);
GoToXY(45, wherey); Write(d[i]:9:5);
GoToXY(65, wherey); Write(r[i]:9:5);
inc(i);
until r[i] < abs(eps);
end;
{--------------------------------------------------------------}
procedure Release(start:real);
var i:byte;
begin
i:=0;
x[i]:=start;
repeat
y[i]:=interp(funk,x[i]);
d[i]:=interp(fdef,x[i]);
x[i+1]:=x[i]-y[i]/d[i];
r[i]:=abs(x[i+1]-x[i]);
inc(i);
until r[i-1] < eps;
OutputRes;
end;
{--------------------------------------------------------------}
var t:real;k:byte;
begin
InputData;
c:=a;k:=0;
repeat
if interp(funk,c)*interp(funk,c+1) <= 0 then
begin
t:=interp(funk,c)*interp(sdef,c);
if t > 0 then release(c) else
if t < 0 then release(c+1) else
if t = 0 then if interp(funk,c)=0 then write("y=",c:8:5)
else write("y=",c+1:8:5);
inc(k);
end;
c:=c+1;
until c > b;
Write("Found ",k," decisions.");
readkey
end.
Финиш...
Страницы: 1 вся ветка
Форум: "Основная";
Текущий архив: 2002.04.29;
Скачать: [xml.tar.bz2];
Память: 0.44 MB
Время: 0.006 c
