Метод Дихотомии

Материал из 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