PROGRAM Rdansr2;

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



1/   A tout nombre z=0,z1z2z3z4.....z2nz2n+1....en binaire, on
     associe le couple (x,y) de R2 tel que :

               x=0,z1z3z5......z2n+1...
               y=0,z2z4z6...z2n......

   L'appplication de [0,1[ dans [O,1[² est-elle surjective ?


   si z est une fraction rationnelle pz/qz, montrer que x et y
   le sont aussi; cacul de px/qx et de py/qy.


2/   Application inverse?



3/ Graphe de x  et y tels que z<z0 ?




+------------------------------------------------------------+
¦              Imprimer tous les résultats                   ¦
¦     en indiquant chaque fois à quoi ils correspondent      ¦
+------------------------------------------------------------+

                             -=-=-}

uses
  crt, modubase;

Const
     Escape=#27;
     maxn  = 16;


Var
    Ch         : Char ;

Type
    Myreal = {real }
            extended
            { record
             x:Array[1..maxn] of Boolean;
         end };


    Sequence= array[1..maxn]      of Boolean;
    Fraction =record
                   num,den :Longint;
              end;
    Point=record
                x,y,z:MyReal;
                t:string;
          end;

Var
   x,y,z,zero  : Sequence;
   n      : integer;
   W:Point;      {Origine}
Const
     Reduction=0.8;
     Coef_y=0.5;
     Coef_z=0.2;


Function ProjX(p:point):real;
begin
     ProjX := (p.x-p.y*Coef_y)*reduction;
end;

Function ProjY(p:point):real;
begin
     ProjY := (p.z+p.y*Coef_z)*reduction;
end;

Procedure Relie(VAR p1,p2:Point);
begin
     Deplace(ProjX(p1),ProjY(p1));
     Trace(ProjX(p2),ProjY(p2));
     p1:=p2;
end;

Function min(a,b:Longint):Longint;
begin
   if a<b then
      min:=a
   else
      min:=b;
end;

Function symbool(b:Boolean):char;
begin
   if b then
      symbool:='1'
   else
      symbool:='0';
end;

Function Bin_pattern(p:Myreal):string;
var
   i:integer;
   s:string;
begin
     s:='0,';
     while (p<>0) and (length(s)<15) do
           begin
                p:=p*2;
                if p>1 then
                   begin
                        p:=p-1;
                        s:=s+'1';
                   end
                else
                    s:=s+'0';
           end;
     Bin_pattern:=s;
end;

Function f(x:Myreal):Myreal;
Var
   u,y:Myreal;
Const
     eps=1.0E-10;
begin
     u:=1;
     y:=0;
     While u>eps do
           begin
                x:=x*2;
                u:=u/4;
                if x>1 then
                   begin
                        x:=x-1;
                        y:=y+u;
                   end;
           end;

{     Write('<f(x)=',Bin_pattern(y),'>');Pause;}
     f:=y;
end;

Procedure NewPoint(VAR p:point;x,y,z:Myreal;t:string);
begin
     p.x := x;
     p.y := y;
     p.z := z;
     p.t := t;
end;



Procedure TracePoint(p:point);
VAR
   x,y : real;
begin
     x := ProjX(p);
     y := ProjY(p);
     croix(x,y);
     Ecris(p.t);
end ;




Function divise(a,b:Longint):Boolean;
var
   i:Longint;
begin
     write('[',a,' / ',b,'? ->');

     i:=b div a;

     divise:=((i*a)=b);
     write(((i*a)=b),']');


end;



Function Merge(x,y:Myreal):MyReal;
begin
     Merge:=2*f(x)+f(y);
end;


Function String_fraction(f:fraction):string;
var
   s1,s2:string;
begin
     with f do
          begin
               str(num,s1);
               str(den,s2);
               String_fraction:=s1+'/'+s2;
          end;
end;

Procedure New_fraction(VAR f:fraction;p,q:Longint);
begin
     f.num:=p;
     f.den:=q;
end;

Procedure simplifie_fraction(VAR f:Fraction);
Var
   i:longint;
begin
     with f do
          begin
               { write(string_fraction(f),' simplifié en '); }
               i:=min(num,den);
               if i>0 then
                  begin
                       repeat
                             if divise(i,num) and divise(i,den) then
                                begin
                                     num:=num div i;
                                     den:=den div i;
                                     i:=  min(num,den);
                                end
                             else
                                 i:=i-1;
                       until i=1;
                  end;
          end;
end;

Function Contracte(n:Longint):Longint;
{ compacte  SOMME(ai*4^i) en SOMME(ai*2^i)  }
VAR
   j:integer;
   c:longint;
begin
     j:=0;
     c:=0;
     while n>0 do
           begin
              c:=c+ ((n and 1) shl j);
              inc(j);
              n:=n shr 2;
           end;
     Contracte:=c;

end;

Procedure Extrait_paire(n:Longint;var p,q:Longint)
Const
     mask=$55555555;
begin
     p:=contracte(n and mask);
     q:=contracte((n shr 1) and mask);
     WriteLN('<<',n,'==>',p,' & ',q,'>>');
     Pause;

end;


Procedure Conjugue(VAR x,y:fraction;f1:fraction);
var
   i:longint;
   u:longint;
   f2:fraction;


   {Méthode : on va essayer de construire une fraction f2 égale à f1,
   et dont le dénominateur est de la forme (4^j)*(4^k-1),
   où j et k sont entier}


begin
     Simplifie_fraction(f1);
     u:=1;
     i:=0;


     {chercher si le dénominateur est de la forme 2^i  }

     while not odd(f1.den) do
           begin
                f1.den:=f1.den shr 1;
                u:=u shl 1;
                i:=i+1;
           end;
     if odd(i) then
        {Factoriser tout terme dénominateur de la forme 4^j}
        begin
             f1.num:=f1.num shl 1;
             u:=u shl 1;
             Write('<u=',u,'>');Pause;
        end;
        write('<   z=',string_fraction(f1),'--> dénominateur ',u,'>');Pause;


     if f1.den=1 then
        Extrait_paire(f1.num,x.num,y.num)
     else
         begin
              i:=4;
              while not divise(f1.den,i-1) do
                    i:=i shl 2;
              u:=u*(i-1);
              New_fraction(f2,f1.num*((i-1) div f1.den),u);
         end;
         WriteLN('<On trouve u=',u,' et f2=',string_fraction(f2),'>');
         Pause;



     x.den:=u;
     y.den:=u;
     Extrait_paire(f2.num,x.num,y.num);
     Simplifie_fraction(x);
     Simplifie_fraction(y);
        write('<   x=',string_fraction(x),
              '<   y=',string_fraction(y),'>');
                      Pause;

end;




Procedure Presentation;
Begin
     InitGraphique;
     ModeTexte;
      Efface;
      n:=8;

      WriteLN(' ========== Application de R dans R² ===============');
      WriteLN('                                        ');
      WriteLN('                                        ');
      WriteLN('   (1) Première question : pz/qz -->  px/qx & py/qy     ');
      WriteLN('   (2) Deuxième question : px/qx & py/qy --> pz/qz      ');
      WriteLN('   (3) Troisième question : Courbes z=Merge(x,y)=Cte  ');
      WriteLN('   (4) Quatrième question : Graphe tridimensionnel z=Merge(x,y))               ');
      WriteLN('                              ');
      Write('   Tapez votre Choix  :  ');
end;

Procedure Question1;
Var
   x,y,z:fraction;


begin
     Efface;
     WriteLN('======= Question n°1 =============');
     repeat
     WriteLN(' Recherche des deux fractions  x et y  ');
     WriteLN('  extraites de z                      ');
     WriteLN;
           Write ('Entrez le numérateur   de z =');ReadLN(z.num);
           Write ('Entrez le dénominateur de z =');ReadLN(z.den);
           Conjugue(x,y,z);



     until z.den=0;



end;

procedure Question2;
const
     xmin=-0.1;
     xmax=1.1;
     ymin=-0.1;
     ymax=1.1;
Var
   i:integer;
   x1,y1: real;
   z:real;
   tot:longint;
   p1,p2:point;
begin
     Efface;
     WriteLN('======= Question n°2 =============');
      ModeGraphique;
      Couleur(Jaune);
      Fenetre(xmin,xmax,ymin,ymax);
      Deplace(xmax/2,ymax-0.1);
      Ecris('tracé de f(x)');
      Couleur(Vert);
      X_Axe(0,0,1) ;
      Y_Axe(0,0,1);
      Couleur(Brillant);

     n:=8;
     z:=0;
     tot:=0;
     Modetexte;
end;

Procedure Trace_Axe(x,y,z:real;t:string);
Var
   p : point;
begin
     NewPoint(p,x,y,z,t);
     Croix(ProjX(p),ProjY(p));
     Ecris(t);
     Relie(p,W);

end;



procedure Question3;
Var
   x,y,z:MyReal;
const
     xmin=-0.5;
     xmax= 1.1;
     ymin=-0.1;
     ymax= 1.1;
     eps=1.E-13;
     pasx=0.01;
     pasy=0.01;
     pasz=0.01;
var
   p1,p2:point;
begin
     Randomize;

     Efface;
     WriteLN('======= Question n°3 =============');
     WriteLN;
     WriteLN('Courbes   (x,y)<z             ');
     WriteLN;


     Pause;

      ModeGraphique;
      Couleur(Jaune);

    randomize;
    repeat
          z:=random;
     Efface;
     IsoFenetre(Xmin,Xmax,Ymin);

     Couleur(Jaune);
     Deplace(0,0);
     Trace(0,1);
     Trace(1,1);
     Trace(1,0);
     Trace(0,0);
          Deplace(0,-0.1);
          Ecris('Graphe de Merge(x,y) pour z='+Bin_pattern(z));
          Couleur(Brillant);
          x:=0;
          y:=1;
          Deplace(x,y);
          repeat
                while (merge(x,y)>z)and (y>0) do
                      y:=y-pasy;
                Trace(x,y);
                while (merge(x,y)<z) and (x<1) do
                      x:=x+pasx;
                Trace(x,y);
          until (x>=1) or (y<=0);
       Pause;

    until false;
    Pause;
end;

procedure Question4;
VAr
   x,y:MyReal;
const
     xmin=-0.5;
     xmax= 1.1;
     ymin=-0.1;
     ymax= 1.1;
     eps=1.E-13;
     pasx=0.05;
     pasy=0.05;
var
   p1,p2:point;
begin
     Randomize;

     Efface;
     WriteLN('======= Question n°4 =============');
     WriteLN;
     WriteLN('Représentation perspective de z=Merge(x,y)');
     WriteLN;
     WriteLN('   en fait Merge(x,y)=2*f(x)+f(y)      ');


     Pause;

      ModeGraphique;
      Couleur(Jaune);
     Efface;
     IsoFenetre(Xmin,Xmax,Ymin);

     Couleur(Jaune);

     NewPoint(W,0,0,0,'W');
     TracePoint(W);
     Trace_Axe(1,0,0,'x');
     Trace_Axe(0,1,0,'y');
     Trace_Axe(0,0,1,'z');
     Couleur(-Brillant);

     p2.y:=0;
      repeat

            Deplace(0,ymin/2);
            Ecris('Graphe de Merge(x,y) pour y='+Bin_pattern(p2.y));
            Couleur(Brillant);
            p2.x:=0;
            p2.z:=0;
            p1:=p2;
            repeat
                  p2.z:=Merge(p2.x,p2.y);
                  Relie(p1,p2);
                  p2.x:=p2.x+pasx;
            until p2.x>1;
            p2.y:=p2.y+pasy;
      until p2.y>1;

     p2.x:=0;
      repeat
            Deplace(0,ymin/2);
            Ecris('Graphe de Merge(x,y) pour x='+Bin_pattern(p2.x));
            Couleur(Brillant);
            p2.y:=0;
            p2.z:=0;
            p1:=p2;
            repeat
                  p2.z:=Merge(p2.x,p2.y);
                  Relie(p1,p2);
                  p2.y:=p2.y+pasy;
            until p2.y>1;
            p2.x:=p2.x+pasx;
      until p2.x>1;

      Pause;
         Modetexte;
end;

Begin
     while true do
     begin
          Presentation;
          Repeat
              Read(Ch)
          until Ch in ['0'..'4'];
          case ch of
               '1':  Question1;
               '2':  Question2;
               '3' : Question3;
               '4' : Question4;
               '0' : Halt
          end;
     Pause;
  end;
end.