program ep95_315;

{

Epreuve informatique de l'Ecole Polytechnique                95.315
---------------------------------------------------------------------


Soient trois disques coplanaires C1, C2 et C3 de rayons respectifs
r1, r2 et r3 tangents extérieurement deux à deux.

1/ Ecrire un programme Pascal qui trace la figure correspondante connaissant
r1, r2 et r3 a priori quelconques.

[FIGURE]

2/ A l'intérieur du domaine délimité par ces trois disques, on cherche à en
placer un quatrième, dénommé G, qui a la propriété d'être lui même tangent à
chacun des trois premiers.
Est-ce toujours possible ? La solution est-elle unique ?

Ecrire un programme Pascal qui calcule le rayon rho du disque G
en fonction de r1, r2 et r3, et qui trace la figure correspondante.
Tester ce programme sur des cas particuliers simples, puis sur l'exemple
suivant :

                 r1=1, r2=2, r3=3


3/ Ecrire un programme Pascal qui recherche les cas où les mesures des
quatre longueurs r1, r2, r3 et rho prennent toutes des valeurs entières.


:--------------------------------------------------------------:
:    Imprimer tous les résultats                               :
:     en indiquant chaque fois à quoi ils correspondent        :
:--------------------------------------------------------------:
                            -=-=-=-
 }


                }

uses
    modubase, crt, printer;


const
     maxn=10;
type
  Myint=Longint;
  Myreal = real;
  Distances=myreal;
  Distance2=myreal;
  Distance4=myreal;
  Distance6=myreal;
  Distance8=myreal;
  Distance9=myreal;
  Distance10=myreal;

  matrice=array[1..maxn,1..maxn] of real;
  Points =record
      x,y:distances;
      t:string
  end;
var
   ch:char;
   n:integer;

   c1,c2,c3:points;


procedure Comparer(s:string;x,y:Myreal);
var
   ecart:real;
begin
     Write(s,' ',x:8:5,'=',y:8:5);
     ecart:=abs((x-y))/max(abs(x),abs(y));
     if ecart<0.0011 then writeLN(' OK.') else writeLN ('! écart de
',ecart*100:4:1,'%');
end;

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

procedure NewPoint(var p:points;t:string;x,y:distances);
begin
    p.t:=t;
    p.x:=x;
    p.y:=y;
end;

procedure MontrePoint(p:points);
begin
    Croix(p.x,p.y);
    Ecris(p.t);
end;

procedure MontreSegment(p1,p2:points);
begin
     Deplace(p1.x,p1.y);
     Trace(p2.x,p2.y);
end;

procedure MontreCercle(p:points;r:distances);
begin
     Cercle(p.x,p.y,r);
end;




Procedure TraceCercles(r1,r2,r3:distances);
var
   a,b,c:distances;
   x,y:distances;
   procedure exchange(var x,y:distances);
   var z:distances;
   begin z:=x;x:=y;y:=z end;

begin
{  on suppose que r1>r2>r3; }


{     if r2<r3 then exchange(r2,r3);
     if r1<r2 then exchange(r1,r2);
     if r2<r3 then exchange(r2,r3);}
     a:=r2+r3;
     b:=r3+r1;
     c:=r1+r2;
     y:=sqrt((a+b+c)*(a+b-c)*(a-b+c)*(-a+b+c))/(2*c);
     x:=sqrt(b*b-y*y);


     NewPoint(C1,'A',0,0);
     NewPoint(C2,'B',r1+r2,0);
     NewPoint(C3 ,'C',x,y);
     ModeGraphique;
     Isofenetre(-c,2*c,-y);
     x_axe(0,0,1);
     y_axe(0,0,1);
     Ecris('r1=');Ecrisreel(r1);
     Ecris(' r2=');Ecrisreel(r2);
     Ecris(' r3=');Ecrisreel(r3);

     Montrepoint(C1);
     Montrepoint(C2);
     MontrePoint(C3);
     Montresegment(C1,C2);
     Montresegment(C2,C3);
     Montresegment(C3,C1);
     MontreCercle(C1,r1);
     MontreCercle(C2,r2) ;
     MontreCercle(C3,r3)  ;

end;

Procedure calcule(r1,r2,r3:distances);
var
  e:byte;
  nu:distance2;
  Det,h,k,m,n:distance4;
  lambda,mu:myreal;
  alpha,det2:distance8;
  beta,beta1,disc:distance9;
  gamma:distance10;
  u,v:distance2;
  rho1,rho2:distances;
  G1,G2:points;
  a,b,c,x,y:distances;
  u1,u2,u3:myreal;
begin
     a:=r2+r3;
     b:=r3+r1;
     c:=r1+r2;

     y:=sqrt((a+b+c)*(a+b-c)*(a-b+c)*(-a+b+c))/(2*c);
     x:=sqrt(b*b-y*y);


     NewPoint(C1,'A',0,0);
     NewPoint(C2,'B',r1+r2,0);
     NewPoint(C3 ,'C',x,y);


    e:=1;
    WriteLN('r1=',r1:8:5,' r2=',r2:8:5,' r3=',r3:8:5);
    nu:=r1*(r1+r2)+r3*(r1-r2);
    Det:=4*r1*r2*r3*(r1+r2+r3);
    WriteLN('nu=',nu:12:8,' det=',det:12:8);
    h:=r1*r1*(r3-r2)+r3*r3*(r1-r2); m:=r1*r2*r3*(r1+r3);
    k:=r1*r1*(r2-r3)+r2*r2*(r1-r3); n:=r1*r2*r3*(r1+r2);

    u1:=1/r1+1/r2+1/r3;
    u3:=(r1+r2+r3)/(r1*r2*r3);

   rho1:=1/abs((u1+2*sqrt(u3)));
   rho2:=1/abs((u1-2*sqrt(u3)));
    WriteLN('rho1 =',rho1:8:5,' rho2 =',rho2:8:5);
    Pause;


    lambda:=2*(h*rho1+m)/det;
    mu    :=2*(k*rho1+n)/det;
    Newpoint(G1,'G1',lambda*C2.x+mu*C3.x,lambda*C2.y+mu*C3.y);


    Pause;
    TraceCercles(r1,r2,r3);
    MontreCercle(G1,abs(rho1));
    Pause;
    lambda:=2*(h*rho2+m)/det;
    mu    :=2*(k*rho2+n)/det;

    Newpoint(G2,'G2',lambda*C2.x+mu*C3.x,lambda*C2.y+mu*C3.y);
    MontreCercle(G2,abs(rho2));
    Pause;
end;




procedure Question_1;
begin


     Calcule(30,40,4);

     Calcule(5,2,1);
     Calcule(1,1,1);
     Calcule(5,2,1);

     Calcule(4,2,1);
     Calcule(30,20,7);
     Pause;
end;



procedure Question_2;
begin
     Calcule(1,1,1);
     Pause;
end;

procedure Question_3;
var
   i,j,k:integer;
   r1,r2,r3,u1,u2,u3:myreal;
   rho1,rho2:myreal;
const
   eps=0.000001;
begin
     Efface;
     for i:=1 to 1000 do
        begin
          for j:=1 to i do
             for k:=1 to j do
                 begin
                      r1:=i;
                      r2:=j;
                      r3:=k;
                      u1:=1/r1+1/r2+1/r3;
                      u3:=(r1+r2+r3)/(r1*r2*r3);
                      rho1:=1/abs((u1+2*sqrt(u3)));
                      {rho2:=1/abs((u1-2*sqrt(u3)));}
                      if abs(round(rho1)-rho1)<eps then
                         begin
                              rho2:=abs((u1-2*sqrt(u3)));
                              if rho2<>0 then rho2:=1/rho2;
                              Writeln(i:5,j:5,k:5,
                              '  rho1=',rho1:15:8,' rho2=', rho2:15:8);
                              Writeln(lst,i:5,j:5,k:5,
                              '  rho1=',rho1:15:8,' rho2=', rho2:15:8);
                         end;
                 end;

        end;

     Pause;
end;

Procedure Presentation;
begin;
      Efface;
      WriteLN(' ====== Cercles tritangents  ============');
      WriteLN('                                        ');
      WriteLN('                                        ');
      WriteLN('   (1) Tracé pour r1=1, r2=2, r3=3  ');
      WriteLN('   (2) Calcul pour r1=1, r2=1, r3=1  ');
      WriteLN('   (3) Essai de valeurs ');

      WriteLN('                              ');
      Write('   Tapez votre Choix  :  ');
end;


begin
  Randomize;
  InitGraphique;
    repeat
           ModeTexte;
           Presentation;
          Read(Ch);
          case ch of
               '1':  Question_1;
               '2':  Question_2;
               '3':  Question_3;
               '0' : Halt
          end;
    until false;
end.