PROGRAM fracrac;

{
Epreuve informatique de l'Ecole Polytechnique           92.011
--------------------------------------------------------------

     Connaissant une suite ak  de réels, on cherche à
     définir la suite de fonctions réelles :

      f1(x)=x/sqrt(a1)
      f2(x)=x/sqrt(a1+x/sqrt(a2))
      ...
      fn(x)=x/sqrt(a1+x/sqrt(a2+x/sqrt(a3...an-1+x/sqrt(an)...)))




1/   Que peut-on dire, avant tout calcul, des fonctions fn(x) ?
     Ecrire un programme Pascal permettant de calculer,
     lorsque n tend vers l'infini la limite de fn(x) que l'on notera f(x)

     Remarquer que cette définition peut avoir un sens pour
     une valeur donnée de x, même si fn(x) n'est pas
     défini pour certaines valeurs de n.
     On admettra dans la suite du problème que la suite ak
     a été "suffisamment bien choisie" pour que f(x) ait un
     domaine de définition non vide.

2/   Ecrire un programme Pascal capable de tracer le graphe de f(x).
     L'appliquer au cas où ak=1.

3/   En admettant que cette fonction  peut s'écrire sous
     la forme :
                r
         f(x)= x  - h + eps(x)

           avec    lim(eps(x))=0 quand x tend vers l'infini

     écrire un programme capable de calculer les deux constan-
     tes r et h et constater par exemple que celles-ci sont
     des fractions rationnelles simples lorsque ak=k0+k
     où  k0 est une constante entière.

4/   Aurait-on pu prévoir ces résultats par un raisonnement
     mathématique ? Vérifier sur d'autres exemples.

5/   On suppose à nouveau que ak=k0+k mais maintenant k0 est
     un réel quelconque. Etudier comment varie, en fonction
     de k0, la borne inférieure du domaine de définition de f(x) .

                            -=-=-=-
 }


uses
  crt, modubase, entrees, foncteur;

VAR
   x,y,f1,f2,eps:Real;
   k,n,n0,p,m0,i :integer;
   k0,k1,y0   : real;
{   ak         : FonctionReelle1; }
   fak        : fonction;
   ok         : boolean;
   question   : char;
   g          : array[0..100] of real;

const
     xmin=-10 ;
     xmax= 100;
     ymin=-30;
     ymax= 30;


Function ak(k:integer):real;
var
   r:real;
begin
     if k=0 then
        ak:=0
     else
         ak:= Evalue1(fak,k);
end;


Procedure affiche(s:string);
begin
     if gr_CurrSw=1 then Ecris(s) else write(s);
end;

Function rac(x:double):extended;
var
   y:extended;
   i:integer;
const
     eps=1E-15;
begin
     y:=sqrt(x);
     i:=0;
     while (abs(y*y-x)>eps) or (i>10 )do
           begin
                i:=i+1;
                if i>10 then
                 begin
                 {   write(' ecart=',y*y-x);   pause; }
                 end;
            y:=0.5*(y+x/y);
           end;
      {    write(' ecart final=',y*y-x);pause;   }
     rac:=y;

end;


Function fn(x:Real;n:integer;var existe:boolean):extended;
VAR
   y:extended;
   m : integer;
begin
      existe := true;
      m:=n;
      i:=n;
      y:=0;
      g[m]:=y;
      m0:=0;
      while (m>0) and existe do
      begin
          y:=y+ak(m);
          existe:=(y>0);
          if existe then
              y:=x/rac(y)
          else
              m0:=m;
          g[m]:=y;
          m:=m-1;
      end;

      if existe then
         fn:=y
      else
          fn:=0;
end ;


function f(x:real;var existe:boolean):extended;
const
     pas = 3;
var
   f1,f2:extended;
   n : integer;
   converge : Boolean;
begin
     n:=10;
     f1:=0;
     n0:=1;
     repeat
     begin
          f2:=f1;
          f1:=fn(x,n,existe);
          if not existe then
             n0:=n+1;
          converge :=existe and (abs(f1-f2)<eps);
          n:=n+1;
     end
     until (n>20) or converge;

     if converge then
          f:=f1
     else
         begin
          ok:=false;
          f:=0;
        end;
end ;


Procedure Trace_f(s:string;xmin,xmax,ymin,ymax:real);
var
   i : integer;
   x,pas : real;
begin
      ModeGraphique;
      Couleur(Rouge);
      Fenetre(xmin,xmax,ymin,ymax);
      X_Axe(0,0,1) ;
      Y_Axe(0,0,1);
      pas := (xmax-xmin)/500;
      x := xmin;
      couleur(-Brillant);
      Deplace(xmin,ymax/2);
      Affiche(s);
      While x<xmax do
      begin
           Point(x,f(x,ok));
           x:=x + pas;
      end ;
end;

Function Borne(x1,x2:real):real;
var
   x:real;
begin
     while (x2-x1)>eps do
     begin
          x:=(x1+x2)/2;
          y:=f(x,ok);
          if ok then
             begin
                  y0:=y;
                  x2:=x;
             end
          else
              begin
                   x1:=x;

              end;
     end;
     Borne := x2;
end;

Procedure Entre_ak;
begin
     Write('Entrez la formule suite a(k) =');
     Entre_Fonction('k',fak);
end;

Procedure borne_inf(s:string;x1,x2:real);
begin
     Definis_Fonction('k',s,fak);
     Write('< Définition de ak(k)=');
     Affiche_Expression(fak);
     write('>');
     Write(' ---->>  f(x) définie pour x>');
     writeln(borne(x1,x2):12:8);
end;



Procedure Question1;
var
   x,y: real;
   existe:boolean;
   n:integer;
begin
     Entre_ak;
     repeat
     begin
          Write(' x=');readln(x);
          write(' n=');readln(n);
          write('f(',x:9:5,')=');
          y:=fn(x,n,existe);
          if existe then
               writeln(y:9:5)
          else
               writeln('<non défini>');
     end
     until false;
end;

{
Procedure Cherche_borne_inf;
var
   x1,x2: real;
   s:string;
begin
     x1:=-100;
     x2:= 1000;
     eps:=1E-04;
     Writeln('recherche de la borne inférieure dans [',x1:7:1,',',x2:7:1,']');
     borne_inf('1',x1,x2);
     k0:= 10;
     while not KeyPressed do
     begin
          str(trunc(k0),s);
          borne_inf(s+'+k',x1,x2);
          k0:=k0-1;
     end;
     question := ReadKey;
end;
}
Procedure Question2;
var
   x1,x2: real;
   s:string;
begin
     eps:=1E-03;
     Entre_ak;
     Trace_f('Question n°2 : Graphe de f(x) pour a(k)='+fak.chaine,
             -3,10,-10,10);
end;


Procedure Question3;
var
   h1,h2,x:real;
   s:string
begin
     WriteLN('La théorie montre que r=2/3 et que h=2/9+k/3');
     WriteLN('');
     eps:=1E-5;
     k0:= 10;
     while not KeyPressed do
     begin
          str(trunc(k0),s);
          definis_fonction('k',s+'+k',fak);
          Write('< Pour a(k)=');
          Affiche_Expression(fak);
          Write(' ---->>  h=');
          x:= 10;
          h1:= 0;
          repeat
          begin
               h2:=h1;
               h1:=puissreal(abs(x),2/3)-f(x,ok);
               x:=x*2
          end
          until (abs(h1-h2)<eps) or (not ok);
          writeln(h1:12:8);
          k0:=k0-1;
     end;
     question := ReadKey;
end;




Procedure Question4;
begin

     WriteLN('+--------------------------------------------------------+');
     WriteLN('¦    Lorsque x tend vers l''infini, f(x) est équivalent à ¦');
     WriteLN('¦                 2/3                                    ¦');
     WriteLN('¦     f(x)  ¸   x   + h                                  ¦');
     WriteLN('¦                                                        ¦');
     WriteLN('¦                a     a              a                  ¦');
     WriteLN('¦                 2     3          k   k                 ¦');
     WriteLN('¦   où  h = (a - --- + --- -...+(-1) ------ + .... )/2   ¦');
     WriteLN('¦            1    2     4              k-1               ¦');
     WriteLN('¦                                     2                  ¦');
     WriteLN('¦                                                        ¦');
     WriteLN('¦ qui converge dès que a  /  k-1  tend vers zéro         ¦');
     WriteLN('¦                       k   2                            ¦');
     WriteLN('¦                                                        ¦');
     WriteLN('¦  ce qui est la condition même d''existence d''un         ¦');
     WriteLN('¦  domaine de définition non vide de f(x).               ¦');
     WriteLN('+--------------------------------------------------------+');
end;

Procedure Question5;
const
     kmin= -12;
     kmax=   2;
     ymax=   -0.7*kmin;
     ymin=   -1.5*kmax;

var
   x0,y1,pas,k1,x1 :real;
   s:string;
begin
     eps:=1E-4;
  {   k0:=10;
     repeat
     begin
          str(trunc(k0),s);definis_fonction('k',s+'+k',fak);
          Write('Si a(k)=');
          Affiche_Expression(fak);
          Write('  --->  Borne inférieure x>');
          x0:=Borne(-25,30);
          Writeln(x0:12:7);
          k0:=k0-1;
     end;
     until KeyPressed;
     question :=ReadKey;  }
      k0:=kmin;
      ModeGraphique;
      Couleur(Rouge);
      Fenetre(kmin,kmax,ymin,ymax);
      X_Axe(0,0,1) ;
      Y_Axe(0,0,1);
      pas := (kmax-kmin)/500;
      eps := 1E-3;
      couleur(Brillant);
      Deplace(kmin,ymin/2);
      Ecris('Coupure de f(x) pour ak=k+k0   eps=');
      EcrisReel(eps);
      k1:=k0;
      str(k0,s);definis_fonction('k',s+'+k',fak);
      x1:=Borne(-100,100);
      while k0<kmax do
      begin
          k0:=k0+pas;
          str(k0,s);definis_fonction('k',s+'+k',fak);
          Deplace(kmin,ymin);
          Ecris('                                  ');
          Deplace(kmin,ymin);
          Ecris('k0=');
          EcrisReel(k0);
          x0:=Borne(-100,100);
          Ecris('          x0=');
          EcrisReel(x0);
          Ecris('              ');
            Deplace(k1,x1);
            couleur(Brillant);
            Trace(k0,x0);
            k1:=k0;
            x1:=x0;
     end;
end;

Procedure Question6;
var
   s:string;
   x1,x2,pas:real;
begin
          eps:=1E-6;
          WriteLN('eps=',eps);
          Write('Quelle valeur initiale de k0 ? ');
          Entre_Reel(k0);
          Write('Pas=');
          Entre_Reel(Pas);
        {  str(k0,s);definis_fonction('k',s+'+k',fak);
          Write('Si a(k)=');
          Affiche_Expression(fak); }
        repeat
        begin
          x1:=  0;
          x2:= 10;
          while (x2-x1)>eps do
               begin
                    x:=(x1+x2)/2;
                    y:=f(x,ok);
                    if ok then
                         x2:=x
                    else
                         x1:=x;
               end;
          x:=x2;
          y:=f(x,ok);
          Write('k0=',k0:11:8,' x0=',x:10:8,' f(x0)=',y:10:5,' ');
          i:=2;
          repeat
          begin
               y:=g[i];
               write('>',y:9:7);
               i:=i-1;
          end
          until i<=0;
          writeln('');
          k0:=k0+pas;
     end
     until keypressed;



end;

Procedure Presentation;
begin
    ModeTexte;
    Efface;
    WriteLN('Fraction racine continue               ');
    WriteLN('                                       ');
    WriteLN(' (1)  Calcul de fn(n,x)                ');
    WriteLN(' (2)  Tracé du graphe pour ak=1        ');
    WriteLN(' (3)  Calcul de h                      ');
    WriteLN(' (4)  Démonstration mathématique       ');
    WriteLN(' (5)  Calcul de la borne inférieure    ');
    WriteLN(' (6)  Calcul de x0,n0,f(x0) pour k0    ');
    WriteLN('                                       ');
    eps:=1E-04;
end;



begin

  Initgraphique;
  while true do
  begin
     Presentation;
     write('Question choisie ? ');
     readln(question);
     Efface;
     writeln('======== Question n°',question,'===============');
     writeln('');

     case question of
          '1':  Question1;
          '2':  Question2;
          '3' : Question3;
          '4' : Question4;
          '5' : Question5;
          '6' : Question6;
     end;
     Pause;
  end;

end.