Метод Ньютона
01.01.2007
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;
(*fonction de la puissance*)
function pow(x:real;n:integer):real;
begin
p:=1;
for i := 1 to abs(n) do begin
if n < 0 then p:=p/10
else p:=p*x;
end;
pow:=p;
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;
(*fonction qui lit la chaine de caractSre*)
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 qui affiche la formule *)
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('l"‚quation est: [ ', 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;
(*foction qui calcule 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;
{*fonction qui calcule la 1er deriv‚*}
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;
{*fonction qui calcule la 2eme deriv‚*}
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;
{*programme principale*}
begin
rep:='n'; b1:=2;
while rep<>'o' do
begin
writeln('PROGRAMME DE LA SOLUTION D"UNE FONCTION NON LINEAIRE PAR LA METHODE DE NEWTON');writeln(' ');
writeln('* * * * * * * * * PRESENTE PAR BACHIR ET SAMIA * * * * * * * ');writeln;
if b1<>2 then readln;
writeln(' POUR CALCULER LA RACINE DE LA FONCTION: ');writeln('');
write(' donner f[x]=');readln(ch);
case ch[1] of
'1'..'9','+','-','x':begin gen:=4; tri(ch); end;
end;
begin
readln;
write('donner la valeur a=');readln(a);
write('donner la valeur b=');readln(b);
write('donner l"erreur ep=');readln(ep);writeln(''); k:=0;
if f(a)=0 then begin writeln(' SOLUTION x=',a);
writeln(' f[',a,']=',f(a));
writeln('ET LE NOMBRE D"ETERATION EST i=0');
end
else if f(b)=0 then begin writeln(' SOLUTION x=',b);
writeln(' f[',b,']=',f(b));
writeln('ET NOMBRE D"ETERATION EST i=0');
end
else
if f(a)*f(b)>0 then begin
writeln(' ***************REMARQUE*************** ');
writeln('ERREUR!!! LA FONCTION NE ADMET AUCUN ZERO...');end
else begin
if f(a)*df2(a)>0 then x0:=a
else x0:=b;
if f(x0)=0 then begin r:=x0;
writeln(' SOLUTION x=',r);
writeln(' f[',r,']=',f(r));
writeln(' ET LE NOMBRE D"ITERATION EST i=',k); end
else begin
if df(x0)=0 then begin
writeln(' ***************REMARQUE*************** ');
writeln('ERREUR!!! la derive est NULLE 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(' SOLUTION x=',r);
writeln(' ');
writeln(' f[',r,']=',f(r) );
writeln(' ');
writeln(' ET ');
writeln(' ');
writeln(' LE NOMBRE D"ITERATUION EST N=',k);
writeln(' '); end;end;end;
write('voulez vous quiter O/N?'); read(rep);
writeln(' ');
writeln(' ');
writeln(' ');
writeln(' ');
end;end;
end.