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

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
Category:Алгоритмы
Category:Математика