Метод Ньютона

Материал из DRKB



program newton;

type
  vect1 = array [1..15] of Real;
  vect2 = array [1..15] of Char;
  vect3 = array [1..15] of Integer;
var
  coef, ncoef: vect1;
  cha: vect2;
  bol: Boolean;
  pui: vect3;
  b1, n, i, deg, l, nbr, ln, gen, k: Integer;
  s, p, c, x, y, z, r, d, ep, fd, x0, a, b: Real;
  co, rep: Char;
  op, op1: set of Char;
  ch: string;
  ca: Char;

  (* возведение в степень *)
  function pow(x: Real; n: Integer): Real;
  begin
    Result := 1;
    for i := 1 to abs(n) do
    begin
      if n < 0 then
        Result := Result / 10
      else
        Result := Result * x;
    end;
  end;

  (****************)
  function chifi(chifr: Char): Integer;
  begin
    case chifr of
      '1': chifi := 1;
      '2': chifi := 2;
      '3': chifi := 3;
      '4': chifi := 4;
      '5': chifi := 5;
      '6': chifi := 6;
      '7': chifi := 7;
      '8': chifi := 8;
      '9': chifi := 9;
      '0': chifi := 0;
    end;
  end;

  (* чтение строки *)
  function cach(chaine: string): Real;
  var
    res: Real;
    point, j: Integer;
  begin
    b1 := 0;
    for i := 1 to Length(chaine) do
      if chaine[i] = '.' then
        b1 := 1;
    if b1 = 0 then
      chaine := chaine + '.';
    if (chaine[1] <> '+') and (chaine[1] <> '-') then
      chaine := '+' + chaine;
    point := Length(chaine) + 1;
    j := 1;
    for i := 2 to Length(chaine) do
    begin
      if chaine[i] = '.' then
        point := i
      else
      begin
        cha[j] := chaine[i];
        j := j + 1;
      end;
    end;
    for i := 1 to Length(chaine) - 2 do
    begin
      case cha[i] of
        '1': ncoef[i] := 1;
        '2': ncoef[i] := 2;
        '3': ncoef[i] := 3;
        '4': ncoef[i] := 4;
        '5': ncoef[i] := 5;
        '6': ncoef[i] := 6;
        '7': ncoef[i] := 7;
        '8': ncoef[i] := 8;
        '9': ncoef[i] := 9;
        '0': ncoef[i] := 0;
      end;
    end;
    res := 0;
    j := 0;
    for l := point - 2 downto 1 do
    begin
      res := res + ncoef[l] * pow(10, j);
      j := j + 1;
    end;
    j := 1;
    for l := point - 1 to Length(chaine) - 2 do
    begin
      res := res + ncoef[l] * pow(10, -j);
      j := j + 1;
    end;
    case chaine[1] of
      '+': res := +1 * res;
      '-': res := -1 * res;
    end;
    cach := res;
  end;

  (* отображение формулы *)
  procedure tri(st: string);
  var
    l, di: Integer;
    mot, mots, chifre: string;
  begin
    op1 := ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9'];
    ln := 1;
    op := ['+', '-', '='];
    st := st + '=' + '0';
    if st[1] in op then
    else
      st := '+' + st;
    for l := 1 to Length(st) do
    begin
      if l = 1 then
        mot := st[l]
      else
        mot := mot + st[l];
      if (st[l] in op) and (st[l + 1] = 'x') then
        mot := mot + '1';
      if (st[l + 1] in op) and (st[l] = 'x') then
        mot := mot + '1';
    end;
    mots := mot[1];
    for l := 2 to Length(mot) - 2 do
      mots := mots + mot[l];
    st := mot;
    WriteLn('уравнение:   [ ', mots, '=0 ]');
    l := 1;
    while st[l] <> '=' do
    begin
      chifre := st[l];
      while (st[l + 1] <> 'x') and (st[l + 1] <> '=') do
      begin
        l := l + 1;
        chifre := chifre + st[l];
      end;
      coef[ln] := cach(chifre);
      ln := ln + 1;
      case st[l + 1] of
        '=': l := l + 1;
        'x':
        begin
          pui[ln - 1] := chifi(st[l + 2]);
          l := l + 3;
        end;
      end;
    end;
  end;

  (* вычисление f(x) *)
  function f(r: Real): Real;
  begin
    c := 0;
    case gen of
      4: for l := 1 to ln - 1 do
          c := c + coef[l] * pow(r, (pui[l]));
    end;
    f := c;
  end;

  {* вычисление 1-й производной *}
  function df(var x: Real): Real;
  begin
    c := 0;
    case gen of
      4: for l := 1 to ln - 2 do
          c := c + pui[l] * coef[l] * pow(x, (pui[l] - 1));
    end;
    df := c;
  end;

  {* вычисление 2-й производной *}
  function df2(var x: Real): Real;
  begin
    c := 0;
    case gen of
      4: for l := 1 to ln - 3 do
          c := c + pui[l] * (pui[l] - 1) * coef[l] * pow(x, (pui[l] - 2));
    end;
    df2 := c;
  end;

  {* основная программа *}
begin
  rep := 'n';
  b1 := 2;
  while rep <> 'y' do
  begin
    WriteLn('ПРОГРАММА РЕШЕНИЯ НЕЛИНЕЙНОЙ ФУНКЦИИ МЕТОДОМ НЬЮТОНА');
    WriteLn('       ');
    WriteLn('* * * * * * * * * PRESENTE PAR BACHIR ET SAMIA * * * * * * * ');
    WriteLn;
    if b1 <> 2 then
      ReadLn;
    WriteLn('        ДЛЯ РАСЧЕТА КОРНЯ ФУНКЦИИ: ');
    WriteLn('');
    Write('        введите f[x]=');
    ReadLn(ch);
    case ch[1] of
      '1'..'9', '+', '-', 'x':
      begin
        gen := 4;
        tri(ch);
      end;
    end;
    begin
      ReadLn;
      Write('введите значение a=');
      ReadLn(a);
      Write('введите значение b=');
      ReadLn(b);
      Write('введите погрешность ep=');
      ReadLn(ep);
      WriteLn('');
      k := 0;
      if f(a) = 0 then
      begin
        WriteLn(' РЕШЕНИЕ x=', a);
        WriteLn('  f[', a, ']=', f(a));
        WriteLn('ЧИСЛО ИТЕРАЦИЙ i=0');
      end
      else if f(b) = 0 then
      begin
        WriteLn(' РЕШЕНИЕ x=', b);
        WriteLn('  f[', b, ']=', f(b));
        WriteLn('ЧИСЛО ИТЕРАЦИЙ i=0');
      end
      else
      if f(a) * f(b) > 0 then
      begin
        WriteLn('      ***************ЗАМЕЧАНИЕ***************        ');
        WriteLn('ОШИБКА!!! ФУНКЦИЯ НЕ ДОПУСКАЕТ НОЛЬ...');
      end
      else
      begin
        if f(a) * df2(a) > 0 then
          x0 := a
        else
          x0 := b;
        if f(x0) = 0 then
        begin
          r := x0;
          WriteLn('     РЕШЕНИЕ x=', r);
          WriteLn('  f[', r, ']=', f(r));
          WriteLn(' ЧИСЛО ИТЕРАЦИЙ i=', k);
        end
        else
        begin
          if df(x0) = 0 then
          begin
            WriteLn(
              '      ***************ЗАМЕЧАНИЕ***************        ');
            WriteLn('ОШИБКА!!! Отклонение равно нулю df(x)=0...');
          end
          else
          begin
            repeat
              d := -f(x0) / df(x0);
              x0 := x0 + d;
              k := k + 1;
            until abs(d) < abs(ep * x0);
            r := x0;
            WriteLn('                                          ');
            WriteLn('                 РЕШЕНИЕ x=', r);
            WriteLn('                                          ');
            WriteLn('             f[', r, ']=', f(r));
            WriteLn('                                          ');
            WriteLn('                          И                  ');
            WriteLn('                                         ');
            WriteLn('                  ЧИСЛО ИТЕРАЦИЙ N=', k);
            WriteLn('                                          ');
          end;
        end;
      end;
      Write('Y - завершить; N - продолжить');
      Read(rep);
      WriteLn('                                         ');
      WriteLn('                                          ');
      WriteLn('                                          ');
      WriteLn('                                 ');
    end;
  end;
end.


ID: 04246