Метод Ньютона
Материал из 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