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

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

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.

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
Проверка
Антиспам проверка
Image CAPTCHA
...