PROGRAM Polygone_inscrit;
{
Epreuve informatique de l'Ecole Polytechnique           94.282
--------------------------------------------------------------

1°


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


     }



uses crt, modubase;


Const
     nbmax=30;

Type
    distances=real;
    aires    =real;
    angles   =real ; { en radian}
    Points = record
              x,y:real;
             end;
    Vecteurs = record
              x,y:real;
             end;

    Polaire = record
             Rho       : Real;
             Theta     : Real;
             end;


    Polygone = record
             nb : integer;
             Som : array [1..nbmax] of Points;
             end;


    Liste_cotes = record
             nb : integer;
             cote : array [1..nbmax] of distances;
             end;



VAR
   Ch        : char;


Function arcsin(x:real):real;
var
   cos2:real;
begin
     cos2:=1-sqr(x);
     if cos2<1E-07 then
        arcsin:=pi/2
     else
         arcsin:=arctan(x/sqrt(cos2));
end;

Procedure Relie_points(P1,P2:Points);
begin
     With P1 do Deplace(x,y);
     With P2 do Trace  (x,y);
end;

function distance(P1,P2:Points):distances;
begin
     distance:=sqrt(sqr(p1.x-p2.x))+sqr(p1.y-p2.y);
end;

Procedure Construit_polaire(var P:points;R:distances;theta:angles;y0:distances);
begin
     with P do
          begin
               x:=R*cos(theta);
               y:=y0+R*sin(theta);
          end;

end;


procedure Afficher_cotes(lc:liste_cotes);
var
   n:integer;
begin

     with lc do
      begin
           WriteLN('Polygone de ',nb,' côtés :');
           For n:=1 to nb do
               Write(n,':',cote[n]:8:3,' ');
           WriteLN;
      end;
end;



Procedure Trace_corde(R,y0:distances;theta1,theta2:angles);
var
   P1,P2:points;
begin
     Construit_polaire(P1,R,theta1,y0);
     Construit_polaire(P2,R,theta2,y0);
     Relie_points(P1,P2);
end;

procedure Alea_polygone(n:integer;VAR lc:liste_cotes);
var
   i:integer;
begin
     with lc do
          begin
               nb:=n;
               for i:=1 to nb do
                   cote[i]:=random;
          end;
end;

procedure  Affiche_polygone(lc:liste_cotes);
var
   i:integer;
begin
     with lc do
          begin
               WriteLN('Polygone à ',nb,' cotes : ');
               for i:=1 to nb do
                   write(' cote[',i,']=',cote[i]:8:4);
               WriteLN;
          end;
end;


procedure Trace_polygone(poly:polygone);
var
   n:integer;
begin
     with poly do
           for n:=1 to nb do
               Relie_Points(SOm[n],Som[n+1]);
end;

Procedure permuter(var x,y:real);
var
   z:real;
begin
     z:=x;x:=y;y:=z;
end;


Function classer_polygone(var lc:liste_cotes):boolean;
var              {placer le plus grand côté en dernier}
   i,im:integer;
   cote_max:distances;
   x:real;
   lc1:liste_cotes;
begin
     lc1:=lc;
     with lc do
      begin
           cote_max:=0;
           for i:=1 to nb do
               if cote[i]>cote_max then
                  begin
                       cote_max:=cote[i];
                       im:=i;
                  end;
           for i:=1 to nb do
               cote[i]:=lc1.cote[1+((i+im-1) mod nb)];
           x:=cote_max;
           for i:=1 to nb-1 do
               x:=x-Cote[i];
       end;
      Classer_polygone :=(x<=0);
end;


function aire_polygone(r:distances;lc:liste_cotes):aires;
var
   s:aires;
   i:integer;
   theta:angles;
begin
     if classer_polygone(lc) then
      begin
           s:=0;
           theta:=0;
           with lc do
           for i:=1 to nb-1 do
               begin
                    theta:=theta+arcsin(cote[i]/(2*R));
                    s:=s+cote[i]*sqrt(sqr(r)-sqr(cote[i]/2))/2;
               end;
           aire_polygone:=s-r*r*sin(theta)*cos(theta);
      end;
end;


Procedure Inscrire_polygone(r:distances;lc:liste_cotes);
var
   theta,t:angles;
   i:integer;
   xmin,xmax,ymin:distances;
begin
     Efface;
     Couleur(Vert);
     ymin :=-r*1.1;
     xmax:=r*1.5;
     xmin:=-xmax;
     Isofenetre(xmin,xmax,ymin);
     x_axe(0,0,1);
     y_axe(0,0,1);
     Cercle(0,0,r);
     couleur(-Brillant);
     Deplace(xmin,r*1.10);Ecris('Inscription d''un polygone dans un cercle');
     with lc do
       for i:=1 to nb do
         begin
              Deplace(xmin,r*(1.10-0.05*i));
              Ecris('Côté[');EcrisEntier(i);
              Ecris(']=');    EcrisReel(cote[i]);
         end;

     if classer_polygone(lc) then
      With lc do
         begin
              theta:=0;
              deplace(r,0);
              for i:=1 to nb-1 do
                begin
                 theta:=theta+2*arcsin(0.5*cote[i]/R);;
                 trace(r*cos(theta),r*sin(theta));
                end;
              trace(r,0);
              deplace(r*0.8,r);
              Ecris('aire=');ecrisreel(aire_polygone(r,lc));
         end
      else
          begin
              deplace(r*0.8,r);
              Ecris('Polygone impossible');;
          end;

end;


                    
function Completer_cotes(r:distances;lc:liste_cotes):Distances;
var
   i:integer;
   p0,p:points;
   theta : angles;

begin {function Completer_cotes(r:distances;lc:liste_cotes):real;}
      with lc do
          begin
               Theta:=0;
               for i:=1 to nb-1 do
                         theta:=theta+arcsin(cote[i]/(2*R));
               Completer_cotes:= abs(2*R*sin(theta));
          end;
end;

Procedure Quadrilatere(a,b,c,d:Distances);
var
   lc:liste_cotes;
   h,h1,h2:distances;
   reste,reste1,reste2:angles;
   ok:boolean;
   xmin,xmax,ymin:real;
   s:aires;
begin
     ModeTexte;
     with lc do
          begin
               nb:=4;
               cote[1]:=a;
               cote[2]:=b;
               cote[3]:=c;
               cote[4]:=d;
          end;
     Afficher_cotes(lc);
     WriteLN('============== classement .............');
     ok:=Classer_polygone(lc);

     Afficher_cotes(lc);
     with lc do
          h1:=cote[nb]/2;
     reste1:=pi/10;

     if ok then
      begin
           Modegraphique;
           Couleur(Vert);
           with lc do
                xmax:=2*Cote[nb];
           xmin:=-xmax;
           ymin:=xmin/10;
           Isofenetre(xmin,xmax,ymin);
           x_axe(0,0,1);
           y_axe(0,0,1);

           repeat
                 reste2:=reste1;
                 Inscrire_polygone(h1,lc);
                 Delay(500);
                 Inscrire_polygone(h1,lc);
                 h:=abs((h1*reste2-h2*reste1)/(reste2-reste1));
                 h2:=h1;
                 h1:=h;
          until abs(reste1)<1E-4;
     Inscrire_polygone(h1,lc);
    end
else
    WriteLN('====== Polygone impossible =========');
end;



Function Aire_triangle(a,b,c:Distances):real;
var
   a2,b2,c2:real;
   s:real;
begin
     a2:=sqr(a);
     b2:=sqr(b);
     c2:=sqr(c);
     s:=2*(a2*b2+b2*c2+c2*a2)-(sqr(a2)+sqr(b2)+sqr(c2));
     if s<0 then
        Aire_triangle:=-1
     else
         Aire_triangle:=sqrt(s)/4;
end;

function Aire_maxi_quadrilatere(a,b,c,d:distances):aires;
{ le quadrilatère est possible si la diagonale est possible :
     Triangle (a, b, e)  avec e1<e<e2
     Triangle (c, d, e)  avec e3<e<e4
       il faut que  max(e1,e2)<e<min(e2,e4) }

var
   e,e1,e2,e3,e4,
   e_inf,e_sup,e_max:distances;
   aire,aire_maxi:aires;
   i:integer;
const
    imax=1000;

procedure bornes(a,b:distances;var e1,e2:distances);
begin
     e1:=abs(a-b);
     e2:=a+b;
end;




begin
     bornes(a,b,e1,e2);
     bornes(c,d,e3,e4);
     e_inf:=max(e1,e3);
     e_sup:=min(e2,e4);
     if e_inf>e_sup then
       begin
        writeLN('quadrilatère impossible à construire');
        Aire_maxi_quadrilatere:=-1;
       end
     else
         begin
              Aire_maxi:=0;
              for i:=0 to imax do
                begin
                     e:=e_inf+(e_sup-e_inf)*i/imax;
                     aire:=Aire_triangle(a,b,e)+Aire_triangle(c,d,e);
                     if aire>aire_maxi then
                      begin
                        e_max:=e;
                        Aire_maxi:=aire;
                      end;
                end;
                Write(Aire_triangle(a,b,e_max):8:4,'+',Aire_triangle(c,d,e_max):8:4,' = ');
              Aire_maxi_quadrilatere:=aire_maxi;
         end;
end;

Procedure Inscrire_triangle(a,b,c:Distances);
var
   r,reste:distances;
   xmin,xmax,ymin:real;
   s:aires;
   lc:liste_cotes;

begin     {   Procedure Inscrire_triangle(a,b,c:Distances)  }
           s:=aire_triangle(a,b,c);
           R:=a*b*c/(4*s);
           if r<0 then
              r:=1;
           with lc do
                begin
                     nb:=3;
                     cote[1]:=a;
                     cote[2]:=b;
                     cote[3]:=c;
                     Inscrire_polygone(r,lc);
                end;
end;



function rayon_polygone(lc:liste_cotes):distances;
var
   i:integer;
   perimetre,cote_max,cote_estime,
   r1,r2,r:distances;
   s:aires;
begin
     with lc do
      begin
           affiche_polygone(lc);
           if classer_polygone(lc) then
              begin
                   perimetre:=0;
                   cote_max:=0;
                   for i:=1 to nb do
                       begin
                            perimetre:=perimetre+cote[i];
                            
                            cote_max:=max(cote[i],cote_max);
                       end;
                   WriteLN('Périmètre=',perimetre:8:5);
                   r1:=(cote_max/2);
                   r2:=1E+5;
                   WriteLN('Si r=',r1:15:4,' le plus grand côté vaudrait ',completer_cotes(r1,lc):8:4);
                   WriteLN('Si r=',r2:15:4,' le plus grand côté vaudrait ',completer_cotes(r2,lc):8:4);
                   repeat
                         r:=(r1+r2)/2;
                         cote_estime:=completer_cotes(r,lc);
                         if cote_estime>cote_max then
                            r2:=r
                         else
                             r1:=r;
                   until abs(cote_estime-cote_max)<1E-3;
                   WriteLN('rayon trouvé =',r:8:4,' aire=',aire_polygone(r,lc):8:4);
                   Rayon_polygone:=r;
              end
           else
               begin
                    WriteLN('POLYGONE IMPOSSIBLE');
                    r:=0;
               end;
      end;
end;


procedure Inscrire_quadrilatere(a,b,c,d:distances);
var
   lc:liste_cotes;
   i:integer;
   perimetre,cote_max,cote_estime,
   r1,r2,r:distances;
   s:aires;
begin
     with lc do
      begin
           nb:=4;
           cote[1]:=a;
           cote[2]:=b;
           cote[3]:=c;
           cote[4]:=d;
           affiche_polygone(lc);
           r:=rayon_polygone(lc);
           WriteLN('rayon trouvé =',r:8:4,' aire=',aire_polygone(r,lc):8:4);
           WriteLN('Aire maximale (abcd) : ',
           Aire_maxi_quadrilatere(cote[1],cote[2],cote[3],cote[4]):8:4);
           WriteLN('Aire maximale (bcda) : ',
           Aire_maxi_quadrilatere(cote[2],cote[3],cote[4],cote[1]):8:4);
           PAuse;
           Inscrire_polygone(r,lc);
       end
end;

Procedure Presentation;
begin;
      ModeTexte;
      Efface;
      WriteLN(' ======= Polygone inscrit dans un cercle =====');
      WriteLN('                                               ');
      WriteLN('                                               ');
      WriteLN('                                               ');
      WriteLN('   (1) Inscrire un triangle a,b,c              ');
      WriteLN('   (2) Maximiser l''aire d''un quadrilatère     ');
      WriteLN('   (3) Inscrire un quadrilatère dans un cercle ');
      WriteLN('   (4) Inscrire un polygone quelconque            ');
      WriteLN('                                               ');
      WriteLN('   Tapez votre choix                           ');
      WriteLN('                                               ');
      WriteLN('                                               ');
end;

Procedure Question1;
Const
     Xmin=-10;
     Xmax= 10;
     Ymin=-6;
     Ymax= 6;
     Size=20;
Var
   lc:liste_cotes;
begin
     Efface;
     Writeln('+---------------------- Question n°1 -------------------------------+');
     Writeln('¦                                                                   ¦');
     Writeln('¦                                                                   ¦');
     Writeln('+-------------------------------------------------------------------+');
      ModeGraphique;


      Inscrire_triangle(3,3,3);
      Pause;
      Inscrire_triangle(3,4,5);
      Pause;
            Inscrire_triangle(3,4,6);
        Pause;
        Repeat
            Inscrire_triangle(4*random,4*random,4*random);
            Pause;
        until false;



end;


Procedure Question2;
var
   lc:liste_cotes;
begin
     Efface;
     Writeln('+---------------------- Question n°2 -------------------------------+');
     Writeln('¦                                                                   ¦');
     Writeln('¦      Maximiser l''aire d''un quadrilatère                           ¦');
     Writeln('¦                                                                   ¦');
     Writeln('+-------------------------------------------------------------------+');
     repeat
           Alea_polygone(4,lc);
           Affiche_polygone(lc);
           if classer_polygone(lc) then
            with lc do
               WriteLN('Aire maximale=',
               Aire_maxi_quadrilatere(cote[1],cote[2],cote[3],cote[4]):8:4);
     until false;
end;




Procedure Question3;
var
   perimetre,cote_max,r_min:distances;
   lc:liste_cotes;
   i:integer;
   r,r1,r2:distances;
   cote_estime:distances;
   s:aires;
begin
     ClrScr;
     Writeln('+---------------------- Question n°3 -------------------------------+');
     Writeln('¦                                                                   ¦');
     Writeln('¦      Inscrire un quadrilatère                                     ¦');
     Writeln('¦                                                                   ¦');
     Writeln('+-------------------------------------------------------------------+');
     inscrire_quadrilatere(1,1,1,1);
     repeat
           Alea_polygone(4,lc);
           with lc do
                Inscrire_quadrilatere(cote[1],cote[2],cote[3],cote[4]);
     until false;
end;


Procedure Question4;
var
   lc:liste_cotes;
   i:integer;
   r:distances;

begin
     Efface;
     Writeln('+---------------------- Question n°4 -------------------------------+');
     Writeln('¦                                                                   ¦');
     Writeln('¦      Cas d''un polygone quelconque à inscrire                      ¦');
     Writeln('¦                                                                   ¦');
     Writeln('¦      On se donne la suite des côtés.                              ¦');
     Writeln('¦      On enlève le plus grand, on vérifie qu''il n''est pas plus    ¦');
     Writeln('¦      grand que la somme de ceux qui restent, car alors il n''y    ¦');
     Writeln('¦      aurait pas de solution.                                      ¦');
     Writeln('¦      On cherche ensuite par tâtonnement quelle est la valeur du   ¦');
     Writeln('¦      rayon qui redonne au côté manquant la valeur qu''il avait.   ¦');
     Writeln('¦                                                                   ¦');
     Writeln('¦                                                                   ¦');
     Writeln('+-------------------------------------------------------------------+');
     PAuse;
     repeat
           with lc do
                begin
                     nb:=trunc(5*random)+3;
                     for i:=1 to nb do
                         cote[i]:=random;
                     r:=rayon_polygone(lc);
                     pause;
                     modegraphique;
                     inscrire_polygone(r,lc);

                     pause;
                     modetexte;
                end;

     until false;
end;

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