Метод Дихотомии
Материал из DRKB
program dicotomie;
var
y: Integer;
function f(var x: Real): Real;
begin
if y = 1 then
f := sin(x) - 1 / 2
else
begin
if y = 2 then
f := exp(x) - 2
else
begin
if y = 3 then
f := sqr(x) - 2;
end;
end;
end;
procedure verif;
var
a, b, m, ep, va: Real;
i, n: Integer;
r, c: Char;
begin
repeat
WriteLn('Выберите одну функцию из трёх:');
WriteLn('f[x]=sin(x)-1/2.....[1]');
WriteLn('f[x]=exp(x)-2.......[2] ');
WriteLn('f[x]=x(puiss)2-2....[3] ');
Write('введите номер [i] из 1..3 i=');
ReadLn(y);
WriteLn('Чтобы расчитать корень функции f[x] введите интервал [a,b]');
Write('введите a=');
ReadLn(a);
Write('введите b=');
ReadLn(b);
begin
if a > b then
repeat
WriteLn('*****************ЗАМЕЧАНИЕ**************');
WriteLn(' *** должно быть a < b *** ');
Write('Пожалуйста, введите другой интервал или поменяйте местами значения a=');
ReadLn(a);
Write(' b=');
ReadLn(b);
until a < b;
begin
if f(a) * f(b) > 0 then
repeat
WriteLn('*******************ЗАМЕЧАНИЕ************************');
WriteLn(' *** функция не допускает нулей в своем интервале *** ');
WriteLn(' ');
Write('Пожалуйста, введите другой интервал a=');
ReadLn(a);
Write(' b=');
ReadLn(b);
until f(a) * f(b) <= 0;
WriteLn('функция f допускает хотя бы один нуль в [', a, ';', b, ']');
Write(' ');
Write('введите количество итераций n=');
ReadLn(n);
m := (a + b) / 2;
if f(m) = 0 then
ep := m
else
begin
for i := 1 to n - 1 do
begin
if f(m) * f(a) > 0 then
begin
a := m;
m := (b + m) / 2;
end
else
m := (a + m) / 2;
b := 2 * m - a;
end;
end;
i := i + 1;
ep := m;
WriteLn(' КОРЕНЬ для "итерации ', n,' - это эпсилон=', ep);
Write('Вычислить[', ep, '] Y/N?');
ReadLn(c);
if c = 'Y' then
WriteLn('f[', ep, ']=', f(ep));
Write('Продолжить Y/N? ');
ReadLn(r);
end;
end;
until r = 'N';
end;
begin
WriteLn(' Метод дихотомии');
WriteLn('');
WriteLn('');
verif;
end.
ID: 04247