PROGRAM Boucles;
{
Epreuve informatique de l'Ecole Polytechnique           93.153
--------------------------------------------------------------


1/                          -=-=-
     }


uses crt, modubase;

Const
     pas=0.1;
     zoom=4;
     maxd=19;


Type
    Points = record
              x,y:real;
             end;
    Vecteur = record
              x,y:real;
             end;
    Polynome = record
              degre:integer;
              a:array[0..maxd] of real;
             end;

    Pol3 = record
              a:array[0..3] of real;
             end;



VAR
   t0,t         : real;
   Ch           : char;
   n            :integer;
   cas          :integer;
   P1,P2,Q1,Q2 :Polynome;
   t1,t2,t3,z1,z2:real;
   xmin,xmax,ymin,ymax:real;

Procedure Alea_P(Var P:polynome;degre:integer);
Var
   i:integer;
begin
     P.degre:=degre;
     for i:=0 to P.degre do
           P.a[i]:=1.1*(random*2-1);

end;

Function Evalue(P:polynome;t:real):real;
Var
   u,z:real;
   i:integer;
begin
     z:=0;
     u:=1;
     for i:=0 to P.degre do
         begin
              z:=z+P.a[i]*u;
              u:=u*t;
         end;
     Evalue:=z;
end;

Procedure Conv3(Var p:polynome;p3:Pol3);
Var
   i:integer;
begin
     P.degre:=3;
     for i:=0 to P.degre do
         p.a[i]:=p3.a[i];
end;

Function Montre_P(P:polynome):string;
Var
   s,v:string;
   i:integer;
begin
          s:='';
          for i:=0 to P.degre do
              if P.a[i]<>0 then
                 begin
                      if (P.a[i]<0) then
                         s:=s+'-'
                      else
                          if s<>'' then
                             s:=s+'+';

                      str(abs(P.a[i]):4:2,v);
                      s:=s+v;
                      if i>0 then
                         begin
                              s:=s+'*t';
                              if i>1 then
                                 s:=s+chr(48+i);
                         end;

                 end;
          Montre_P:=s;
end;


Procedure Lemniscate(VAR M:points;t:real);
var
   t1:real;
begin
     t1:=(1+Puiss(t,4));
     M.x:=t/t1;
     M.y:=Puiss(t,3)/t1;
end;

Procedure RAMIS556(VAR M:points;t:real);
var
   t1:real;
begin
     t1:=(1+t)/(1+sqr(t));
     M.x:=t1*(1-sqr(t));
     M.y:=t1*t*2;
end;

Procedure quotient(VAR M:points;t:real);
var
   t1:real;
begin
     M.x:=Evalue(P1,t)/Evalue(Q1,t);
     M.y:=Evalue(P2,t)/Evalue(Q2,t);
end;

Procedure Vectorise(VAR V:vecteur;M1,M2:points);
begin
     V.x:=M2.x-M1.x;
     V.y:=M2.y-M1.y;
end;

Function Scalaire(V1,V2:Vecteur):Real;
begin
     Scalaire:=V1.x*V2.x+V1.y*V2.y;
end;

Function Module(V:Vecteur):Real;
begin
     Module:=sqrt(scalaire(v,v));
end;




Function Vectoriel(V1,V2:Vecteur):Real;
begin
     Vectoriel:=V1.x*V2.y-V1.y*V2.x;
end;


Procedure Genere(VAR M:points;t:real);
begin
     case cas of
     1:     Lemniscate(M,t);
     2:     RAMIS556(M,t) ;
     3:     Quotient(M,t);
     else
        Lemniscate(M,t);
     end ;    { case}
end;

Procedure Joindre(M1,M2:points);
begin
     with M1 do Deplace(x,y);
     with M2 do Trace  (x,y);
end ;

Function Distance(M1,M2:points):Real;
begin
     Distance:=sqrt(sqr(M1.x-M2.x)+sqr(M1.y-M2.y));
end ;


Function Aire(t1,t2:real):Real;
const
     n=1000;
Var
   i:Longint;
   z:real;
   M0,M1,M2: points;
   pas:Real;
begin
     z:=0;
     t:=t1;
     pas:=(t2-t1)/n;
     Genere(M1,t);
     M0:=M1;
     Couleur(vert);
     for i:=1 to n do
     begin
           M2:=M1;
           t:=t+pas;
           Genere(M1,t);
           Joindre(M1,M0);
           z:=z+M1.x*M2.y-M1.y*M2.x;
     end;
     Aire:=abs(z)/2;
end;


Procedure remplace(VAR t1,t2:real;t3,t4:real);
begin
     t1:=t3;
     t2:=t4
end;

Procedure Point_double(VAR t1,t2:real;t0:real);
Const
     eps=1E-5;
     ini=0.1;
     taux=2;
Var
   M0,M1,M2,M3,M4:Points;
   u1,u2,u12,u24,u13,u34:vecteur;
   t3,t4,t:real;
   dt,v0,v,a,b:real;
   n:integer;

begin
     Genere(M0,t0);
     Couleur(-Brillant);
     n:=0;
     v:=0;
     dt:=0.001;
     repeat             { recherche du "ventre" de la boucle }
          t1:=t0+dt;
          t2:=t0-dt;
          t3:=t0+dt*taux;
          t4:=t0-dt*taux;
           Genere(M1,t1);
           Genere(M2,t2);
           Genere(M3,t3);
           Genere(M4,t4);

          vectorise(u1,M1,M3);
          vectorise(u2,M2,M4);
           Joindre(M0,M1);
           Joindre(M0,M2);
           Delay(100);
           Joindre(M0,M1);
           Joindre(M0,M2);
          v0:=v;
          v:=vectoriel(u1,u2);
          dt:=dt*taux;
     until v*v0<0;
     with M1 do
           croix(x,y);
     with M2 do
           croix(x,y);
     n:=0;
     repeat         {recherche du point de rencontre}
           Inc(n);
           Genere(M1,t1);
           Genere(M2,t2);
           Genere(M3,t3);
           Genere(M4,t4);
           Joindre(M1,M3);
           Joindre(M2,M4);
           Delay(100);
           Joindre(M1,M3);
           Joindre(M2,M4);
           vectorise(u12,M1,M2);
           vectorise(u24,M2,M4);
           vectorise(u13,M1,M3);
           b:=vectoriel(u13,u24);
           if b<>0 then
             begin
                  a:=vectoriel(u12,u24)/b;
                  if a>0.5 then
                     remplace(t1,t3,t1+a*(t3-t1),t3)
                  else
                     remplace(t1,t3,t1,t1+a*(t3-t1));
                  a:=vectoriel(u12,u13)/b;
                  if a>0.5 then
                     remplace(t2,t4,t2+a*(t4-t2),t4)
                  else
                      remplace(t2,t4,t2,t2+a*(t4-t2));
             end;
     until (n>100)or (distance(M1,M2)<eps);
     Couleur(Brillant);
     with M2 do
           croix(x,y);
end;


Procedure TraceCourbe(n:integer;t1,t2:real;nom:string);
Const
     pase=0.2;

Var
   pas : Real;
   M1,M2: points;
   xe,ye,z:real;
   courbure, oldcourbure,cote:real;
   Asymptote,u:vecteur;
begin
     cas:=n;
     xe:=-zoom;
     ye:=-zoom/4;

     deplace(xe,ye);
     Ecris(nom);
     if cas=3 then
        begin
             ye:=ye-pase;deplace(xe,ye);Ecris('P1(t)='+Montre_P(P1));
             ye:=ye-pase;deplace(xe,ye);Ecris('Q1(t)='+Montre_P(Q1));
             ye:=ye-pase;deplace(xe,ye);Ecris('P2(t)='+Montre_P(P2));
             ye:=ye-pase;deplace(xe,ye);Ecris('Q2(t)='+Montre_P(Q2));
        end;

     cas:=n;
     Couleur(vert);
     Genere(M1,10*t1);
     Genere(M2,10*t2);
     Joindre(M1,M2);
     Vectorise(asymptote,M1,M2);
     courbure:=0;
     Couleur(Brillant);
     t:=t1;
     t3:=t1;
     pas:=(t2-t1)/2000;
     Genere(M1,t);
     repeat
           M2:=M1;
           t:=t+pas;
           Genere(M1,t);
           Couleur(Jaune);
           Joindre(M1,M2);
           Vectorise(u,M2,M1);
           oldcourbure:=courbure;
           courbure:=vectoriel(u,asymptote);
           if  courbure*oldcourbure<=0 then
               if scalaire(asymptote,u)<0 then
                  begin
                       Couleur(Brillant);
                       Croix(M1.x,M1.y);
                       t3:=t;
                       cote:=courbure-oldcourbure;   { ± selon côté }
                  end;
     until t>t2;
     if t3>t1 then
        begin

             Point_double(t1,t2,t3);
             Deplace(0,zoom/2);
             Ecris('La Boucle existe');
             Deplace(0,zoom/2-0.2);
             z1:=aire(t1,t2);
             Ecris('Aire=');Ecrisreel(z1);
           {  Deplace(0,zoom/2-0.4);
             z2:=Longueur(t1,t2);
             Ecris('Longueur=');Ecrisreel(z);}
             Pause;
        end
     else
         begin
             Deplace(0,zoom/2);
             Ecris('Pas de boucle...');
             delay(1000);
         end;
end;

Procedure TracePoint(M:Points);
begin
     With M do Croix(x,y);
end;

Procedure Init;
Var
   O:Points;
begi
      Initgraphique;
      xmin:=-zoom;
      xmax:=zoom;
      ymin:=-zoom*0.6;
      ymax:=zoom*0.6;
      Fenetre(xmin,xmax,ymin,ymax);
      Couleur(Bleu);
      Croix(0,0);
      Ecris('o');
      Deplace(0,0);
      Trace(0,1);
      Ecris('y');
      Deplace(0,0);
      Trace(1,0);
      Ecris('x');
end;



Procedure Presentation;
begin;
      Modetexte;
      Efface;
      WriteLN(' ======= Les Boucles ========');
      WriteLN('                              ');
      WriteLN('                              ');
      WriteLN('                              ');
      WriteLN('   (1) Lemniscate de Bernouilli      ');
      WriteLN('   (2) Strophoïde                    ');
      WriteLN('   (3) Ramis V.56                    ');
      WriteLN('   (4) Aleatoire              ');
      WriteLN('                              ');
      WriteLN('   Tapez votre choix          ');
      WriteLN('                              ');
      WriteLN('                              ');
end;

Procedure Question1;
begin
     Efface;
     Writeln('+---------------------- Question n°1 -------------------------------+');
     Writeln('¦                                                                   ¦');
     Writeln('¦   Tracé du Lemniscate de Bernouilli                               ¦');
     Writeln('¦                                                                   ¦');
     Writeln('+-------------------------------------------------------------------+');

              Pause
              Init;
              TraceCourbe(1,-100,100,'Lemniscate de Bernouilli');
              Pause;

end;

Procedure Question2;
begin
     Efface;
     Writeln('+---------------------- Question n°2 -------------------------------+');
     Writeln('¦                                                                   ¦');
     Writeln('¦                                                                   ¦');
     Writeln('+-------------------------------------------------------------------+');

    Init;
    TraceCourbe(2,-100,100,'Ramis V.p56  r=1+tg(Ú/2)');
end;





Procedure Question3;
Const
     Qi:Pol3=(a:(1,0,1,0));
     P1i:Pol3=(a:(1,1,-1,-1));
     P2i:Pol3=(a:(0,1,1,0));


begin
     Efface;
     Writeln('+---------------------- Question n°3 -------------------------------+');
     Writeln('¦                                                                   ¦');
     Writeln('¦   Tracé du Ramis V.56                                             ¦');
     Writeln('¦                                                                   ¦');
     Writeln('¦                                                                   ¦');
     Writeln('+-------------------------------------------------------------------+');
     Randomize;

           Conv3(P1,P1i);
           Conv3(P2,P2i);
           Conv3(Q1,Qi);
           Conv3(Q2,Qi);


           Init;
           TraceCourbe(3,-10,10,'RAMIS Tome V p. 56     r=(1+tg(Ú/2))');


           ModeTexte;
           writeLN('aire=',z1);


           writeLN('longueur=',z2);
           Pause;



end;



Procedure Question4;
Var
   t1,t2:real;
   h,k:real;
   i:integer;

begin
     Efface;
     Writeln('+---------------------- Question n°4 -------------------------------+');
     Writeln('¦                                                                   ¦');
     Writeln('¦     Polynomes aleatoires                                          ¦');
     Writeln('¦         x=P1(t)/(1+t2)     y= P2(t)/(1+t2)                        ¦');
     Writeln('¦                                                                   ¦');
     Writeln('+-------------------------------------------------------------------+');
     Pause;
     Randomize;

     n:=1;
     repeat
           Q1.degre:=2*n;
           for i:=0 to Q1.degre do
              Q1.a[i]:=0;
           Q1.a[0]:=1;
           Q1.a[2*n]:=1;

           Q2:=Q1;

           Alea_P(P1,2*n+1);
           Alea_P(P2,2*n+1);

           Init;
           TraceCourbe(3,-10,10,'x=P1(t)/(1+t^2n)     y= P2(t)/(1+t^2n)');
            Inc(n);
     until false;

end;

Procedure Question5;
begin
     Efface;
     Writeln('+---------------------- Question n°5 -------------------------------+');
     Writeln('¦                                                                   ¦');
     Writeln('+-------------------------------------------------------------------+');
end;

{ Bloc principal }
begin
  Init;
  Repeat
     Presentation;
     Ch:= ReadKey;
     case ch of
          '1':  Question1;
          '2':  Question2;
          '3' : Question3;
          '4' : Question4;
          '5' : Question5;
     end;
     Pause;
  until false;