PROGRAM FracDecalpha;

{
     Ecole Polytechnique  ...........................   95.421

Soit B une base de numration
(B=10 en calcul dcimal, B=2 en calcul binaire, etc ....).
On l'utilise pour exprimer un rel x appartenant  l'intervalle [0,1[
sous la forme :

     x=0,x1x2x3...xn...

o chaque "digit"  est un entier xi  tel que 0<=xi<B

Si x est de la forme               i=n
                                x=SOMME  xi/B^i
                                   i=1

  on lui associe la quantit :

                    1
  y= ------------------------------------------
                     1
      ax1+ ------------------------------------
                       1
             ax2 + ----------------------------
                                1
                 ax3 + ------------------------
                                 ...
                           --------------------
                                       1
                         ax[n-1] + ------------
                                   axn + 1

o a est une constante relle positive.


1/ Utiliser cette expression pour dfinir une application
y=fB(x) de [0,1[ dans R+. 
Etudier les proprits de cette application.
Tracer son graphe dans un repre Oxy dans les cas
 (B=10  a=0.2) et  (B=2  a=0.9).


2/ Quelles sont, en fonction de B et de a, les limites entre lesquelles
varie y lorsque x dcrit l'intervalle [0,1[ ? 

 
3/ Ecrire un programme Pascal qui recherche le maximum et le minimum de
la quantit y=fB(x)  lorsque x appartient  un intervalle donn [u,v[ et
qui visualise graphiquement le rsultat obtenu.

Application au cas (B=2  a=0.25) et
x in [p/k , p/(k-1) [  o k est un entier suprieur  4


(dans cet nonc, les valeurs proposes pour a figurent en notation dcimale
usuelle)

:--------------------------------------------------------------:
:    Imprimer tous les rsultats                               :
:     en indiquant chaque fois  quoi ils correspondent        :
:--------------------------------------------------------------:
                            -=-=-=-

	
}


uses
  crt,modubase;


const
     dimserie=50;
     zero=0;
     infini=1E+12;
   
type
    Digits = set of 0..9;
    MyReal=real;
    MyInt=Longint;
    developpement = record
                  n:integer;
                  c:array[1..dimserie] of MyInt;
                  end;
    Points = record
           x,y:real;
      end;

var
   amort:array[0..dimserie] of MyReal;
   x,y,lambda,alpha:MyReal;
   ch:char;
   base,i:integer;
   Car         : Char ;
   Question    : Char;

Procedure Segment(P,Q:Points);
begin
     Deplace(P.x,P.y);
     Trace(Q.x,Q.y);
end;

Function dim(x:developpement):integer;
var
   n:integer;
   y,u:MyReal;
   ok:boolean;
begin
     with x do
          begin
               n:=dimserie;
               while (n>0) and (c[n]=0) do
                     Dec(n);
               dim:=n;
          end
end;

procedure afficherD(s:developpement);
var
   i,n:integer;
begin
     Write('0.');
     n:=dimserie;
     while (s.c[n]=0) and (n>0) do
           Dec(n);
     if n>0 then
           for i:=1 to n do
               write(s.c[i],'.')
end;

procedure Developper(x:Myreal;VAR s:developpement);
var
   n:integer;
const
     eps=1.E-9;
begin
     for n:=1 to dimserie do
         if x<eps then
            s.c[n]:=0
         else
             begin
                  x:=Base*x;
                  s.c[n]:=Trunc(x);
                  x:=x-s.c[n];
             end;
end;

Function invy(xi:integer;y:myreal):myreal;
begin
     if y=infini then
        invy:=zero
     else
         if (y=zero) and (xi=0) then
            invy:=infini
         else
             invy:=1/(alpha*xi+y)
end;

Function F(x:MyReal):MyReal;
var
   n:integer;
   y,u:MyReal;
   s:developpement;
begin
     Developper(x,s);
     n:=dim(s);
     y:=1;
     repeat
         y:=Invy(s.c[n],y);
         Dec(n);
     until (n=0);
     f:=y
end;

Procedure Presentation;
begin
    Efface;
    WriteLN('Fraction continue decimale          ');
    WriteLN('                                    ');
    WriteLN('                                    ');
    WriteLN(' (1)    Calcul de y=fB(x)           ');
    WriteLN(' (2)    Graphe de fB(x) pour B=2    ');
    WriteLN(' (3)    Graphe de fB(x) pour B=10   ');
    WriteLN(' (4)    Extrema de f(x) sur l''intervalle [u,v[   ');
    WriteLN('                           ');
    WriteLN('                           ');

    InitGraphique;
    ModeTexte;
end;


procedure Question1;
var
   s:developpement;

begin
     Efface;
     Writeln('ษออออออออออออออออออออออ Question n๘1 อออออออออออออออออออออออออออออออป');
     Writeln('บ                                                                   บ');
     Writeln('บ  (1)    Calcul de y=fB(x)                                         บ');
     Writeln('บ                                                                   บ');
     Writeln('ศอออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออผ');

     Write('Choisir la base B =');ReadLN(Base);
     Write('Choisir alpha =');ReadLN(alpha);


     while true do
      begin
           Write('Entrer x=');Read(x);
           Developper(x,s);
           WriteLN('Dveloppement de x : ');
           AfficherD(s);
           WriteLN;
           WriteLN('fB(x)= ',f(x):12:8);


      end;

end;



procedure Question2; 
const
     xmin=-0.1;
     xmax=1.1;
     ymin=-0.1;
     ymax=5.1;
     pas=0.0001/pi;
var
c:integer;
   P,P0,Q,Q0:Points;
   s:developpement;
begin
     Efface;
     Writeln('ษออออออออออออออออออออออ Question n๘2 อออออออออออออออออออออออออออออออป');
     Writeln('บ                                                                   บ');
     Writeln('บ   Graphe de fB(x) pour B=2                                                 บ');
     Writeln('บ                                                                   บ');
     Writeln('ศอออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออผ');

     Base:=2;
     Alpha:=4;

     ModeGraphique;
           efface ;
           Fenetre(xmin,xmax,ymin,ymax);
           Couleur(Vert);
           X_axe(0,0,1);
           Y_axe(0,0,1);
           Deplace(-0.5,xmax*0.9);ECris('x');
           Deplace(xmax*0.9,-0.5);ECris('y');
           Couleur(Brillant);
           Croix(1,1);
     c:=1;
     repeat
         alpha:=alpha/2;
         Inc(c);
         Couleur(c);
         Deplace (xmax/4,ymax*0.8);
         Ecris('Base= ');EcrisEntier(Base);
         Ecris('  alpha= ');EcrisReel(alpha);

         P.x:=0;P.y:=0;
         x:=pas;
         repeat
               y:=f(x);
              Point(x,y);
              x:=x+pas;
         until x>1;
         Deplace(0,0);
         Couleur(Rouge);
    {     Pause;  }
     until false
end;
                                                  


procedure Question3;
const
     xmin=-0.1;
     xmax=1.1;
     ymin=-0.1;
     ymax=5.1;
     pas=0.0001/pi;
var
c:integer;
   P,P0,Q,Q0:Points;
   s:developpement;
begin
     Efface;
     Writeln('ษออออออออออออออออออออออ Question n๘3 อออออออออออออออออออออออออออออออป');
     Writeln('บ                                                                   บ');
     Writeln('บ   Graphe de fB(x) pour B=10                                                 บ');
     Writeln('บ                                                                   บ');
     Writeln('ศอออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออผ');

     Base:=10;
     Alpha:=4;

     ModeGraphique;
           efface ;
           Fenetre(xmin,xmax,ymin,ymax);
           Couleur(Vert);
           X_axe(0,0,1);
           Y_axe(0,0,1);
           Deplace(-0.5,xmax*0.9);ECris('x');
           Deplace(xmax*0.9,-0.5);ECris('y');
           Couleur(Brillant);
           Croix(1,1);
     c:=1;
     repeat
         alpha:=alpha/2;
         Inc(c);
         Couleur(c);
         Deplace (xmax/4,ymax*0.8);
         Ecris('Base= ');EcrisEntier(Base);
         Ecris('  alpha= ');EcrisReel(alpha);

         P.x:=0;P.y:=0;
         x:=pas;
         repeat
               y:=f(x);
              Point(x,y);
              x:=x+pas;
         until x>1;
         Deplace(0,0);
         Couleur(Rouge);
    {     Pause;  }
     until false
end;
                                                  

procedure Question4;
const
     xmin=-0.1;
     xmax=1.1;
     ymin=-0.1;
     ymax=5.1;
     pas=0.001/pi;
var
   u,v:MyReal;
   P,P0,Q,Q0,Pmin,Pmax:Points;
   s:developpement;
   depth:integer;

   Procedure MinMax(u,v:Myreal;Var Pmin,Pmax:Points);
   var
      Q,QM:Points;

      procedure Writetag;
      var
         i:integer;
      begin
           WriteLN;Write('0.');
           for i:=1 to depth do
                   write(s.c[i]);
           write(' ');
      end;


     Procedure Maximum(u,v:MyReal;Var P:Points);forward;

     Procedure Minimum(u,v:MyReal;Var P:Points);
     var
        Popt:Points;
        u1,v1:MyReal;
        x1:integer;
   {cette procedure calcule le min sur [u,v[}
   {Une valeur de x tel que fB(x) soit minimale est de la forme
    x= 0.[B-1]0[B-1]......0[B-1]...     c'est  dire que x=B/(B+1) }
    begin
         Inc(Depth);s.c[depth]:=0;
         Popt.x:=Base/(Base+1);
         Popt.y:=zero;

         if (Popt.x<u) or (Popt.x>=v) then
         begin
           {   Developper(Popt.x,s);
              WriteTag;
              write('Recherche du minimum sur [',u:8:5,v:8:5,']');
              Pause;  }

              Maximum(0,1,Popt);

              for x1:=0 to Base-1 do
                  begin
                       s.c[depth]:=x1;
                       u1:=u*Base-x1;
                       v1:=v*Base-x1;
                       {Writetag;
                       write('[x1=',x1,' u1=',u1:9:5,' v1=',v1:9:5);Pause;}
                       if (u1<1) and (v1>0) then
                          begin
                               if u1<0 then u1:=0;
                               if v1>1 then v1:=1;
                               Maximum(u1,v1,Q);
                               With QM do
                                    begin
                                         x:=(x1+Q.x)/Base;
                                         y:=Invy(x1,Q.y);
                                         {WriteTag;Write('Checking ',y:8:5,' < ',Popt.y:8:5,' : ');Pause;}
                                         if y<=Popt.y then
                                           begin
                                             Popt:=QM;
                                             {Write('..found f(',x:8:5,')=',f(x):8:5);}
                                           end;
                                    end;
                          end;
                      {   write(']');}

                  end;
             
         end;
         P:=Popt;
       {  WriteTag;
         write('Le minimum sur [',u:8:5,v:8:5,'] pour x=',P.x:8:5);Pause; }
         Dec(depth);
    end;

    Procedure Maximum(u,v:MyReal;Var P:Points);
    var
        Popt:Points;
        x1:integer;
        u1,v1:MyReal;
        {cette procedure calcule le max sur [u,v[}

        {Une valeur de x tel que fB(x) soit maximal est de la forme
    x= 0.0[B-1]0[B-1]......0[B-1]...     c'est  dire que x=1/(B+1) }

    begin
         Inc(Depth);s.c[depth]:=0;
         Popt.x:=1/(Base+1);
         Popt.y:=infini;
         if (Popt.x<u) or (Popt.x>=v) then
         begin
              
         {     Developper(Popt.x,s);
              WriteTag;
              write('Recherche du maximum sur [',u:8:5,v:8:5,']');
              Pause;}

              Minimum(0,1,Popt);

              for x1:=0 to Base-1 do
                  begin
                       s.c[depth]:=x1;
                       u1:=u*Base-x1;
                       v1:=v*Base-x1;
                     {   Writetag;
                        write('[x1=',x1,' u1=',u1:9:5,' v1=',v1:9:5);Pause;}
                       if (u1<1) and (v1>0) then
                        begin
                             if u1<0 then u1:=0;
                               if v1>1 then v1:=1;
                               Minimum(u1,v1,Q);
                               With QM do
                                    begin
                                         x:=(x1+Q.x)/Base;
                                         y:=Invy(x1,Q.y);
                                         {WriteTag;Write('Checking ',y:8:5,' > ',Popt.y:8:5,' : ');Pause;}
                                         if y>=Popt.y then
                                           begin
                                             Popt:=QM;
                                           {  Write('..found f(',x:8:5,')=',f(x):8:5);}
                                            end;
                                    end;
                          end;
                        { write(']');}
                  end;
              
         end;
         P:=Popt;
         {WriteTag;
         write('Le maximum sur [',u:8:5,v:8:5,'] pour x=',P.x:8:5);Pause;}
         Dec(Depth);
      
    end;

   begin
        Depth:=0;
        Minimum(u,v,Pmin);
{        Writeln;
        WriteLN('xmin=',Pmin.x:9:5,'    ---fB(x)=',Pmin.y:9:5);
        Writeln('**********');                                 }
        Maximum(u,v,Pmax);
     {   WriteLN('xmax=',Pmax.x:9:5,'    ---fB(x)=',Pmax.y:9:5);}
   end;
   
begin
     Efface;
     Writeln('ษออออออออออออออออออออออ Question n๘4 อออออออออออออออออออออออออออออออป');
     Writeln('บ                                                                   บ');
     Writeln('บ   Extrema de f(x) sur l''intervalle [u,v[                          บ');
     Writeln('บ                                                                   บ');
     Writeln('ศอออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออผ');


{
     Write('Choisir la base B =');ReadLN(Base);
     Write('Choisir alpha =');ReadLN(alpha);
}
        Base:=1+random(9);
        alpha:=random;
           v:=random;u:=v*random;

           Base:=2;alpha:=0.8;u:=0.723;v:=0.75;
           Base:=2;alpha:=0.8;u:=0.75;v:=0.792;
           Base:=2;alpha:=0.8;u:=0.723;v:=0.792;
         

           WriteLN('B=',Base,'  alpha=',alpha:9:5);
           WriteLN('u=',u:9:5);
           WriteLN('v=',v:9:5);
        MinMax(u,v,Pmin,Pmax);
       WriteLN;
        WriteLN('xmin=',Pmin.x:9:5,'    ---fB(x)=',Pmin.y:9:5);
        WriteLN('xmax=',Pmax.x:9:5,'    ---fB(x)=',Pmax.y:9:5) ;
        Pause;
     while true do
      begin
        Base:=2+random(9);
        alpha:=random;
          { Write('Entrer u=');ReadLN(u);
           Write('Entrer v=');ReadLN(v);}
           v:=random;u:=v*(1-0.2*random);

{           Base:=2;alpha:=0.8;u:=0.723;v:=0.792;  }


           ModeGraphique;
           efface ;
           Fenetre(xmin,xmax,ymin,ymax);
           Couleur(Vert);
           X_axe(0,0,1);
           Y_axe(0,0,1);
           Deplace(-0.5,xmax*0.9);Ecris('x');
           Deplace(xmax*0.9,-0.5);Ecris('y');
           Couleur(Brillant);
           Croix(1,1);
           Deplace (xmax/4,ymax*0.8);
           Ecris('Base= ');EcrisEntier(Base);
           Ecris('  alpha= ');EcrisReel(alpha);
           Deplace (xmax/4,ymax*0.7);
           Ecris('u= ');EcrisReel(u);
           Ecris('  v= ');EcrisReel(v);

           Couleur(Blanc);
           
           MinMax(u,v,Pmin,Pmax);

           Deplace(u,Pmin.y);
           Trace(v,Pmin.y);
           Trace(v,Pmax.y);
           Trace(u,Pmax.y);
           Trace(u,Pmin.y);

           Couleur(Brillant);

           With Pmin do Croix(x,y);
           With Pmax do Croix(x,y);


           Couleur(Blanc);
           P.x:=0;P.y:=0;
           x:=pas;
           repeat
               y:=f(x);
              Point(x,y);
              x:=x+pas;
           until x>1;
           Pause;
      end;
end;


begin
  while true do
  begin
    Randomize;
    Presentation;
      Question4;
     write('Question choisie ? ');
     readln(question);
     case question of
          '1':  Question1;
          '2':  Question2;
          '3':  Question3;
          '4':  Question4;
     end;
     Pause;
  end;
end.