METHODE DE NEWTON

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 caractŠre*)
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.