PROGRAM k_geometrie;       {CUBE.PAS}

{


Epreuve informatique de l'Ecole Polytechnique                           93.136



Les arpenteurs d'une planète imaginaire ayant la forme d'un cube essaient
d'adapter nos concepts usuels de géométrie plane pour définir une K-géométrie
adaptée à leurs besoins.

On pourra supposer dans les calculs que l'ensemble K est la réunion de six faces carrées
repérées par :K

                       +------+
                       ¦ y=+1 ¦
                       ¦  f=2 ¦
                +------+------+--------------+
                ¦ x=-1 ¦ z=+1 ¦ x=+1 ¦ z=-1  ¦
                ¦  f=6 ¦  f=3 ¦  f=1 ¦  f=4  ¦
                +------+------+--------------+
                       ¦ y=-1 ¦
                       ¦  f=5 ¦
                       +------+


et utiliser une représentation à plat, sorte de "mappemonde" inspirée de
la technique de construction d'un cube en carton plié :

                x= ±1     y=±1     z=±1

Définitions :
	- Le K-segment AB est le plus court chemin parcouru à la surface
          de K reliant deux points A et B situés à la surface de K.
          On admet qu'il s'agit d'une ligne brisée, dont la longueur totale
          notée ¦AB¦ est appelée K-distance.
	- Le K-triangle  ABC est la ligne polygonale fermée constituée des
          trois K-segments AB, BC et CA. Cette ligne délimite une partition
          de K en deux sous-ensembles connexes, que l'on appelle intérieur
          et extérieur du triangle ABC. Par convention, l'intérieur est
          celui des deux sous-ensembles dont l'aire est la plus petite.
	- Le K-cercle de centre C et de rayon r est le lieu des points de K
          dont la K-distance à C est égale à r.

1° Ecrire un programme Pascal capable de calculer la K-distance entre deux
   points A et B quelconques de K. Dans quels cas cette K-distance est-elle
   maximale ?

2° Même question concernant l'aire, puis le périmètre du K-triangle.
   Rechercher et montrer graphiquement des K-triangles d'aire maximale,
   puis de périmètre maximal.

3° On définit la K-médiatrice d'un K-segment AB comme le lieu des points dont
   les K-distances à  A et B sont identiques. Ecrire un programme Pascal
   qui détermine cette K-médiatrice en fonction des points A et B, et qui
   calcule sa longueur totale.
   Dans quel cas cette longueur est-elle minimale ? maximale ?
                                7
4  Montrer qu'un K-cercle est un contour fermé constitué d'arcs de cercle
   et écrire un programme Pascal qui trace une série de K-cercles
   concentriques de rayon croissant. Quel est le K-cercle de rayon maximal ?

5° La K-distance d'un point M à un segment AB est définie comme la plus
   petite des distances de M à un point du K-segment AB.
   Chercher un point I qui soit K-équidistant aux trois côtés du K-triangle
   ABC et tracer un K-cercle inscrit dans le K-triangle ABC.
   Discuter l'existence d'une notion analogue à celle du cercle exinscrit
   de la géométrie plane usuelle et illustrer graphiquement.

6° Que deviennent les résultats précédents lorsque le cube K est remplacé
   par un paralléllépipède ?

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

                            -=-=-=-
 }



uses
  crt, graph, modubase ;




TYPE

    Points = record
              x:array[1..3] of real;
              t  : string[1]
            end;
    Segment = record
              p1,p2:Points;
            end;
    Chemin = record
                   n:integer;                      { nombre de sommets}
                   p:array[1..5] of Points;          {maximum de 5 sommets }
             end;

    Face = array[1..3] of integer;  {-1,0,1

Var
     Car         : Char ;
     Question    : Char;
     Xmin,Xmax,Ymin,Ymax:real;
     Sommet:array [1..8] of Points;
     Arete:array[1..12] of segment;
     Nessai             :integer;
Const
     Faces:array[1..6] of face=
     ((1,0,0),(0,1,0),(0,0,1),(0,0,-1),(0,-1,0),(-1,0,0));
     eps=1.E-8;

Procedure erreur(err:string);
begin
     Ecris('Erreur '+err);
     Pause;
end;

Procedure Message(mes:string);
begin
     Deplace(xmax/2,ymin*0.9);
     Ecris(mes);
     Delay(1000);
     Deplace(xmax/2,ymin*0.9);
     Ecris('             ');
end;

Procedure Alea_P(VAR p:Points);
Var
   i:integer;
begin
     with p do
          begin
               t:='M';
               for i:=1 to 3 do
                   x[i]:=2*random-1;
               x[1+trunc(random(3))]:=2*trunc(random(2))-1;
          end;
end;


Procedure NewPoint(var p:Points;x,y,z:real;t:string);
begin
     p.x[1]:=x;
     p.x[2]:=y;
     p.x[3]:=z;
     p.t:=t;
end;

Procedure NewSegment(var s:segment;p1,p2:Points);
begin
     s.p1:=p1;
     s.p2:=p2;
end;




{
                       +------+
                       ¦ y=+1 ¦
                       ¦  f=2 ¦
                +------+------+--------------+
                ¦ x=-1 ¦ z=+1 ¦ x=+1 ¦ z=-1  ¦
                ¦  f=6 ¦  f=3 ¦  f=1 ¦  f=4  ¦
                +------+------+--------------+
                       ¦ y=-1 ¦
                       ¦  f=5 ¦
                       +------+
 }
Function cube(p:Points):Boolean;
begin
 with p do
    begin
     cube:=(abs(x[1])<1+eps)and(abs(x[2])<1+eps)and(abs(x[3])<1+eps)
    end; { with p}
end;




Function deplie(var p:Points):Boolean;
var
   ok:boolean;
begin  { ordre des faces : x=+1 y=+1 z=+1 z=-1 y=-1 x=-1  }
 with p do
    begin
     ok:=cube(p);
     if ok then
      begin
           if x[1]>1-eps then x[1]:=2-x[3]      else
           if x[2]>1-eps then x[2]:=2-x[3]      else
           if x[3]<eps-1 then x[1]:=4-x[1]      else
           if x[2]<eps-1 then x[2]:=x[3]-2      else
           if x[1]<eps-1 then x[1]:=x[3]-2;
       end;
       deplie:=ok;
    end; { with p}
end;

Procedure Trace_Croix(p:Points);
begin
     if Deplie(p) then
        begin
             Croix(p.x[1],p.x[2]);Ecris(p.t);
        end;

end;

Function Trace_Point(p:Points):Boolean;
Var
   Ok:Boolean;
begin
     ok:= deplie(p);
     if ok then
          Point(p.x[1],p.x[2]);
     Trace_Point:=Ok;
end;

Function Distance(p1,p2:Points):real;
VAR
   d:real;
   i:integer;
begin
     d:=0;
     for i:=1 to 3 do
         d:=d+sqr(p1.x[i]-p2.x[i]);
     distance:=sqrt(d);
end;


Procedure Joindre(p1,p2:Points);
begin
     if Trace_Point(p1) and Trace_Point(p2) then
     begin
     if (p1.x[1]>1-eps) and (p2.x[1]>1-eps) then
        begin
             p1.x[1]:=2-p1.x[3];p2.x[1]:=2-p2.x[3];
        end
     else
     if (p1.x[2]>1-eps) and (p2.x[2]>1-eps) then
        begin
             p1.x[2]:=2-p1.x[3];p2.x[2]:=2-p2.x[3];
        end
     else
     if (p1.x[3]<eps-1) and (p2.x[3]<eps-1) then
        begin
             p1.x[1]:=4-p1.x[1];p2.x[1]:=4-p2.x[1];
        end
     else
     if (p1.x[2]<eps-1) and (p2.x[2]<eps-1) then
        begin
             p1.x[2]:=p1.x[3]-2;p2.x[2]:=p2.x[3]-2;
        end
     else
     if (p1.x[1]<eps-1) and (p2.x[1]<eps-1) then
        begin
             p1.x[1]:=p1.x[3]-2;p2.x[1]:=p2.x[3]-2;
        end;
     Deplace(p1.x[1],p1.x[2]);
     Trace(p2.x[1],p2.x[2]);
     end;
end;

Function Longueur(c:chemin):real;
VAR
   d:real;
   i:integer;
begin
     with c do
          begin
               d:=0;
               for i:=1 to n-1 do
                        d:=d+distance(p[i],p[i+1]);
               Longueur:=d;
          end;
end;


{
                       +------+
                       ¦ y=+1 ¦
                       ¦  f=2 ¦
                +------+------+-------------+
                ¦ x=-1 ¦ z=+1 ¦ x=+1 ¦ z=-1 ¦
                ¦  f=6 ¦  f=3 ¦  f=1 ¦  f=4 ¦
                +------+------+-------------+
                       ¦ y=-1 ¦
                       ¦  f=5 ¦
                       +------+    }

Procedure Trace_chemin(c:chemin);
Var
   i:integer;
begin
     with c do
          begin
               Deplace(xmax*0.30,ymin*0.6);
               Ecris('n=');
               Ecrisentier(n);
               for i:=1 to n-1 do
                   begin
                        Deplace(xmax*0.60,ymin*0.6);
                        Ecris('i=');
                        Ecrisentier(i);
                        Joindre(p[i],p[i+1]);
                   end;
          end;
end;



Function Kdistance(A,B:Points;VAR c:chemin):real;
Var
   c3,c4,c5:chemin;
   dis:real;
   u:boolean;
   d1,d2,w1,w2:real;
   m:integer;
   i,j,k : integer;
   si,sj,sk,di,dj,dk:integer;  {sj=0 => dj=-1   &   sj=1 => dj=+1
                                sk=0 => dk=-1   &   sk=1 => dk=+1  }

Procedure tester_dis(celui_ci:chemin);
var
   w:real;
begin
     Inc(Nessai);
     w:=longueur(celui_ci);
     if w<dis then
        begin
             dis:=w;
             c:=celui_ci;
        end;
{     Deplace(xmin,-ymin*(0.95-0.05*Nessai));
     Ecris('essai=');
     EcrisReel(w);}

end;

begin  { ordre des faces : x=+1 y=+1 z=+1 z=-1 y=-1 x=-1  }
  with c do
   begin
    Nessai:=0;
    dis:=1000;     { initialisation longueur }
    p[1]:=A;    { Points de départ = A}
    i:=0;
    repeat
          Inc(i);
          u:=(abs(A.x[i])>1-eps) and (abs(B.x[i])>1-eps);
    until u or (i=3);
    if u then
       begin  {A et B sont soit sur la même face}
            if A.x[i]*B.x[i]>0 then
               begin
                    n:=2;
                    p[2]:=B;
                    dis:=longueur(c);
               end
            else   {A et B soit sur des faces opposées}
                begin
                    di:=round(A.x[i]);
                    for j:=1 to 3 do
   {deux directions j}   if i<>j then   {passage par 1 face latérale j}
                            begin
                                k:=6-i-j;
                                for sj:=0 to 1 do
                                 begin
                                      dj:=2*sj-1;
                                      n:=4;
                                      p[2].x[i]:=di;
                                      p[3].x[i]:=-di;
                                      p[4]:=B;
                                      c4:=c;
                                      c4.p[2].x[j]:=dj;
                                      c4.p[3].x[j]:=dj;
                                      d1:=abs(A.x[j]-dj);
                                      d2:=abs(B.x[j]-dj);
                                      c4.p[2].x[k]:=(A.x[k]*(2+d2)+B.x[k]*d1)
                                                /(2+d1+d2);
                                      c4.p[3].x[k]:=(A.x[k]*d2+B.x[k]*(2+d1))
                                                /(2+d1+d2) ;
                                      Tester_dis(c4);
  {choisir le meilleur chemin parmi 4 possibles}
  {mais il faut aussi tester le passage par 2 faces latérales j et k : dk=1
                                                              j et -k: dk=-1}
                                      n:=5;
                                      p[5]:=B;
                                      c5:=c;
                                      c5.p[2].x[i]:=di;
                                      c5.p[4].x[i]:=-di;
                                      c5.p[2].x[j]:=dj;
                                      c5.p[3].x[j]:=dj;
                         for sk:=0 to 1 do
                          begin
                           dk:=2*sk-1;
                           c5.p[3].x[k]:=dk;
                           c5.p[4].x[k]:=dk;
                           d1:=abs(dj-A.x[j]);
                           d2:=abs(dk-B.x[k]);
                           c5.p[2].x[k]:=((2+d2)*A.x[k]+
                                          +d1*dk*(1+abs(dj-B.x[j])))
                                                /(2+d1+d2);
                           c5.p[4].x[j]:=((2+d1)*B.x[j]+
                                          +d2*dj*(1+abs(dk-A.x[k])))
                                                /(2+d1+d2);
                           d1:=abs(dk-A.x[k]);
                           d2:=abs(dj-B.x[j]);
                           c5.p[3].x[i]:=di*(d2*(1+abs(dj-A.x[j]))
                                         -d1*(1+abs(dk-B.x[k])))
                                                /(d1+d2) ;
 {test}

                           Tester_dis(c5);
                           for m:=1 to 5 do
                            begin
                             c5.p[m].t:=chr(48+m);
                            end;
                          end; {for sk}
                         end;   {for sj}
                        end;   { if i<>j }
                 end;
      end  {if u}
   else
     begin         { c4 : passage par une 3ème face}
          n:=4;    { c3 passage par l'arête commune}
          p[4]:=B;
          c4:=c;
          n:=3;       {A et B sont donc sur des faces adjacentes}
          p[3]:=B;
          c3:=c;
          for i:=1 to 3 do
           for j:=1 to 3 do
            if i<>j then
             begin        {passage direct}
                  k:=6-i-j;
                  if (abs(A.x[i])>1-eps) and (abs(B.x[j])>1-eps) then
                     begin
                          c3.p[2].x[i]:=A.x[i];
                          c3.p[2].x[j]:=B.x[j];
                          d1:=abs(A.x[j]-B.x[j]);
                          d2:=abs(A.x[i]-B.x[i]);
                          c3.p[2].x[k]:=(A.x[k]*d2+B.x[k]*d1)/(d1+d2);
                          tester_dis(c3);
                          {mais il faut aussi essayer une 3ème face k }
                          for sk:=0 to 1 do
                              begin
                                   dk:=2*sk-1;
                                   c4.p[2].x[k]:=dk;
                                   c4.p[3].x[k]:=dk;
                                   c4.p[2].x[i]:=A.x[i];
                                   c4.p[3].x[j]:=B.x[j];
                                   d1:=abs(A.x[k]-dk);
                                   d2:=abs(A.x[i]-B.x[i]);
                                   c4.p[2].x[j]:=(A.x[j]*d2+B.x[j]*(2-dk*B.x[k])*d1)
                                                /(d1+d2);
                                   d1:=abs(A.x[j]-B.x[j]);
                                   d2:=abs(B.x[k]-dk);
                                   c4.p[3].x[i]:=(A.x[i]*(2-dk*A.x[k])*d2+B.x[i]*d1)
                                                /(d1+d2) ;
                                   tester_dis(c4);
                             end;   {for d}
                     end; {if .. and ..}
             end ;  {if i<>j}
      end;
    P[n]:=B;          {Point d'arrivée}
  end;  {with c}
  Kdistance:=longueur(c);
end;



Function antipode(x,y:real;VAR y1:real):real;

{       on suppose 0<y<x<1     }
 {          d²=4²+(y+y1)²=(4+y-y1)2+4x²

                (2+y)(2-y1)=(2+x)(2-x)}
begin
    y1:=2-(2+x)*(2-x)/(2+y);
    antipode:=sqrt(16+sqr(y-y1));
end;

procedure init(titre:string);
Var
   n,i,j,k:integer;
begin
     Modegraphique;
     Efface;
     Xmin := -3.5;
     Xmax := +5.5;
     Ymin := -3.3;
     IsoFenetre(Xmin,Xmax,Ymin);
     Deplace(Xmin,Ymin*0.9);
     Ecris(Titre);
deplace(xmax/3,-ymin*0.90);Ecris('       +------+');
deplace(xmax/3,-ymin*0.85);Ecris('       ¦ y=+1 ¦');
deplace(xmax/3,-ymin*0.80);Ecris('       ¦  f=2 ¦');
deplace(xmax/3,-ymin*0.75);Ecris('+------+------+-------------+');
deplace(xmax/3,-ymin*0.70);Ecris('¦ x=-1 ¦ z=+1 ¦ x=+1 ¦ z=-1 ¦');
deplace(xmax/3,-ymin*0.65);Ecris('¦  f=6 ¦  f=3 ¦  f=1 ¦  f=4 ¦');
deplace(xmax/3,-ymin*0.60);Ecris('+------+------+-------------+');
deplace(xmax/3,-ymin*0.55);Ecris('       ¦ y=-1 ¦');
deplace(xmax/3,-ymin*0.50);Ecris('       ¦  f=5 ¦');
deplace(xmax/3,-ymin*0.45);Ecris('       +------+');

     SetBkColor(Blue);
     SetBkColor(Black);

     Couleur(Rouge);
     n:=0;
     For i:=1 to 2 do
         for j:=1 to 2 do
             for k:=1 to 2 do
                 begin
                      Inc(n);
                      NewPoint(Sommet[n],2*i-3,2*j-3,2*k-3,chr(48+n));
                 end;

     for n:=1 to 4 do
         begin
              NewSegment(Arete[n],Sommet[2*n],Sommet[2*n-1]);
              NewSegment(Arete[4+n],Sommet[n],Sommet[n+4]);
              NewSegment(Arete[8+n],Sommet[(3+n)mod 6+1 ],Sommet[(3+n)mod 6+3]);
         end;

     Deplace(-3,-1);
     Trace(-3,+1);
     Trace( 5,1);
     Trace( 5,-1);
     Trace(-3,-1);
     Deplace(-1,-3);
     Trace(-1,+3);
     Trace(+1,+3);
     Trace(+1,-3);
     Trace(-1,-3);
     Deplace(3,-1);
     Trace(3,+1);
     Couleur(-Brillant);
end;                     (* init *)




Procedure Question1;
Var
   s:Segment;
   c:chemin;
   i:integer;
   kd:real;
begin
     repeat
           Init('Mappemonde');
           With s do
             begin
                 repeat
                       Alea_P(p1);
                       Alea_P(p2);
                 until (p1.x[2]=1)and (p2.x[2]=-1);



                 P1.t:='A';
                 P2.t:='B';
                 Couleur(Vert);
                 Deplace(xmin,ymin*0.5);
                 for i:=1 to 4 do
                     c.p[i].t:=Chr(48+i);
                 kd:=kdistance(p1,p2,c);
                 Couleur(Brillant);
                 Trace_chemin(c);
                 Deplace(xmin,ymin/2)
                 Ecris('K-distance=');
                 EcrisReel(kd);
                 Pause;
                              { Trace_point(p1);
                               Trace_point(p2);}
             end ;  {with s}
      until false;
end;

Procedure Question2;
Var
   s:Segment;
   c:chemin;
   i:integer;
   x,y,y1,d:real;
   kd:real;
begin
     Modetexte;
     Writeln('+---------------------- Question n°2 -------------------------------+');
     Writeln('¦                                                                   ¦');
     Writeln('¦    (2+y)(2-y'')=(2+x)(2-x)=4-x²                                   ¦');
     Writeln('¦    si y''=y(n+1)f(yn) est le 7K-antipode                          ¦');
     Writeln('¦    la limite de y'' est yý=x                                      ¦');
     Writeln('+-------------------------------------------------------------------+');
     Pause;



     Modegraphique;

     Efface;
     Xmin := -0.5;
     Xmax := +1.5;
     Ymin := -0.3;
     IsoFenetre(Xmin,Xmax,Ymin);
     Deplace(Xmin,Ymin*0.9);
     Ecris('Antipodes');
     X_Axe(0,0,1/4);
     Y_Axe(0,0,1/4) ;
     Deplace(1,0);Ecris('x=1');
     Deplace(0,1);Ecris('y=1');
     Repeat


     x:=random;
     y:=x*random;
     for i:=1 to 1000 do

         begin
              y:=x*i/1000;
              Couleur(Magenta);
              Point(y,y);
              Couleur(vert);
              d:=antipode(x,y,y1);
              Point(y,y1);
              Couleur(Blanc);
              Point(y,10*(d-4));
         end;
         Delay(1000);
     until false;

end;

Procedure Question3;
Var
   s:Segment;
   c:chemin;
   i:integer;
   kd:real;
   D:Points;
begin
     repeat
           Init('Cercles');
           With s do
             begin
                 alea_P(p1);
                 P1.t:='C';
                 Trace_Croix(P1);
                 D.t:='D';
                 for i:=1 to 3 do
                     D.x[i]:=-P1.x[i];
                 Trace_Croix(D);


                 repeat
                       Alea_P(p2);
                       P1.t:='C';
                       P2.t:='';
                       kd:=kdistance(p1,p2,c);
                       Couleur(trunc(kd*32) mod 8);
                       if Trace_point(p2) then
                          begin
                               Deplace(xmin,ymin/2);
                               EcrisReel(kd);
                          end;
                 until Keypressed;
                 Car:=ReadKey;
             end ;  {with s}
      until false;
end;

Procedure Question4;
Var
   s:Segment;
   c:chemin;
   i:integer;
   kd:real;
   D:Points;
   choix:integer;
begin
    ModeTexte;
    Efface;
    WriteLN('   Cercles particuliers (de centre C)  ');
    WriteLN('                                       ');
    WriteLN('                                       ');
    WriteLN(' (1)  Sommet                           ');
    WriteLN(' (2)  Milieu d''une arête               ');
    WriteLN(' (3)  Milieu d''un côté             ');
    WriteLN('                                       ');
    repeat
          Write(' Choix :');
          Read(choix);
    until choix in [1..3];

    with s do
    begin
         Case choix of
         1:  begin  P1.x[1]:=1; P1.x[2]:=1; P1.x[3]:=1; end;
         2: begin   P1.x[1]:=0; P1.x[2]:=1; P1.x[3]:=1; end;
         3: begin   P1.x[1]:=0; P1.x[2]:=0; P1.x[3]:=1; end;
         end; {esac}
         repeat
           Init('Cercles particuliers');
                 P1.t:='C';
                 if Trace_Point(P1) then
                    begin
                         D.t:='D';
                         for i:=1 to 3 do
                         D.x[i]:=-P1.x[i];
                    end;
                 if Trace_Point(D) then
                 repeat
                       Alea_P(p2);
                       P1.t:='C';
                       P2.t:='';
                       kd:=kdistance(p1,p2,c);
                       if odd(trunc(kd*8)) then
                          begin
                               Couleur(trunc(kd*4));
                               if Trace_point(p2)then
                                  begin
                                       Deplace(xmin,ymin/2);
                                       EcrisReel(kd);
                                  end;
                          end;
                 until Keypressed;
                 Car:=ReadKey;

      until false;
      end ;  {with s}
end;





Procedure Presentation;
begin
    ModeTexte;
    Efface;
    WriteLN('   K-Géométrie dans le Cube           ');
    WriteLN('                                       ');
    WriteLN('                                       ');
    WriteLN(' (1)  Distances                        ');
    WriteLN(' (2)  K-antipodes                      ');
    WriteLN(' (3)  Cercles                          ');
    WriteLN(' (4)  Cercles particuliers             ');
    WriteLN('                                       ');
end;


begin
  Randomize;
  Initgraphique;
  while true do
  begin
     Presentation;
     Repeat
           write('Question choisie ? ');
           readln(question);
     Until true {question in ('1',234')}  ;
     Efface;
     writeln('======== Question n°',question,'===============');
     writeln('');

     case question of
          '1':  Question1;
          '2':  Question2;
          '3' : Question3;
          '4' : Question4;
     end;
     Pause;
  end;

end.