PROGRAM Riemann;
{

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



     Soit E l'ensemble des points situés à la surface d'une
     sphère S de rayon 1  et de centre O  dans un repère ortho-
     normé Oxyz.


1/   Il est possible de repérer un point M, soit par deux
     angles theta et phi, soit par ses coordonnées (x,y,z) : x2+y2+z2=1
     Ecrire un programme permettant de passer d'un repère dans
     l'autre et réciproquement.

2/   On cherche à transposer dans E, en les notant en itali-
     ques pour les distinguer, les notions habituelles de la
     géométrie plane :

     -    le segment AB est le lieu des points constituant le
          plus court chemin entre les points A et B ;
          (c'est un arc de cercle de centre O)

     -    la distance AB entre les points A et B  est égale à
          la longueur curviligne du segment  ;

     -    la droite AB est l'intersection de E et du plan OAB
           (c'est un grand cercle de la sphère)

     -    le triangle ABC est la plus petite des deux parties
          de l'espace E délimitées par le contour fermé cons-
          titué des trois segments curvilignes AB, BC et CA

     -    l'angle de deux droites est l'angle formé par leurs
          tangentes en leur point d'intersection.

     Ecrire un programme Pascal qui permet de calculer (en
     traitant les cas particuliers) :
          - la distance de deux points AB
          - l'intersection de deux droites AB et CD
          - l'angle de deux droites AB et AC


3/   Que peut-on dire de la somme des trois angles d'un trian-
     gle ?

     Peut-on transposer les notions de médiatrice, de hauteur,
     de bissectrice et de médiane d'un triangle ABC  ?

     Chacun de ces quatre triplets de droites possède-il comme
     en géométrie plane, une intersection unique ? Si oui, la
     calculer.


4/   On admettra sans avoir à le démontrer que l'aire d'un
     triangle ABC est comprise entre les deux grandeurs sui-
     vantes :
          -    l'aire du triangle plan ABC  ;
          -    l'aire du triangle plan A'B'C' obtenu par pro-
               jection centrale de  sur un plan tangent à
               la sphère .

     Calculer cet encadrement et évaluer l'erreur relative que
     l'on commet en l'utilisant pour calculer l'aire d'un
     triangle équilatéral. Illustrer par un graphe en faisant
     varier la longueur d'un côté.


5/   En joignant deux à deux les milieux respectifs C', A', B'
     des côtés AB, BC, CA du triangle ABC, on partage celui-
     ci en quatre triangles dont les aires additionnées sont
     égales à celle de . En partageant ensuite de la même
     manière chacun des quatre triangles obtenus en quatre
     triangles plus petits, on en obtient 16, et ainsi de sui-
     te.
     Donner une estimation de l'erreur que l'on commet en
     calculant l'aire du triangle  de cette manière.
     Montrer de quelle façon elle tend vers zéro lorsqu'on
     répète indéfiniment le partage.

     Ecrire un programme Pascal effectuant ce calcul pour un
     triangle quelconque, et l'appliquer à deux familles par-
     ticulières : les triangles équilatéraux, et les triangles
     rectangles.

     Montrer dans chacun de ces deux cas par un graphe comment
     varie l'aire du triangle en fonction de la longueur d'un
     côté et confirmer par un calcul mathématique les maxima
     obtenus.

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

                             -=-=-
}

uses
  printer, crt, graph, modubase, entrees;

const
     Maxx=400;
     Maxy=400;

TYPE
    Points = record
              x,y,z :real
            end;

    Vecteur = record
              x,y,z :real
            end


VAR
     Ch         : Char ;
     i,j,k      : integer;
     u,v,w      : Vecteur;

     A,B,C,O,M,M1 : Points;
     A1,B1,C1  : Points;


Procedure Vectorise(VAR A:Vecteur;P1,P2:Points);
BEGIN

     With A DO
          BEGIN
               x:=P2.x-P1.x;
               y:=P2.y-P1.y;
               z:=P2.z-P1.z;
          END;
END;


Function Module(v:Vecteur):Real;
BEGIN
     With V do
          Module := SQRT(SQR(x)+SQR(y)+SQR(z));

END;

Function Distance(A,B:Points):Real;
VAR
   v:vecteur;
BEGIN
     Vectorise(V,A,B);
     Distance := Module(v);

END;


PROCEDURE Normalise(VAR p:Points);
VAR
   Module : Real;
BEGIN
     With p DO
          BEGIN
               Module := SQRT(SQR(x)+SQR(y)+SQR(z));
               if module<>0 then
                 begin
                      x := x/Module;
                      y := y/Module;
                      z := z/Module;
                 end;
          END;
END;

PROCEDURE TirePoint(VAR p:points);
BEGIN
     WITH p DO
     BEGIN
          x:=1;y:=1;z:=1;
          WHILE SQR(x)+SQR(y)+SQR(z)>1 DO
                BEGIN
                     x := 2*Random-1;
                     y := 2*Random-1;
                     z := 2*Random-1;
                END;
          Normalise(p);
     END;
END;

Function Fx(p:points):real;
begin
     Fx:=p.x*150;
end;

Function Fy(p:points):real;
begin
     Fy:=p.y*100
end;

PROCEDURE TracePoint(p:Points);
BEGIN
     Point(Fx(p),Fy(p));
END ;

Procedure TraceTrait(p1,p2:Points);
BEGIN
    Deplace(Fx(p1),Fy(p1));
    Trace  (Fx(p2),fy(p2));
END;

PROCEDURE Centre(VAR p:Points);
BEGIN
     With p DO
          BEGIN
               x := 0;
               y := 0;
               z := 0;
          END;
END;

PROCEDURE Vectoriel(VAR U:Vecteur;V,W:Vecteur);
BEGIN
     With U Do
          BEGIN
               x := V.y*W.z-V.z*W.y;
               y := V.z*W.x-V.x*W.z;
               z := V.x*W.y-V.y*W.x;
          END;
END;

Function Scalaire(u,v:Vecteur):Real;
BEGIN
     Scalaire := u.x*v.x+u.y*v.y+u.z*v.z;
END;



Procedure Homothetie(VAR A:Vecteur;B:Vecteur;k:REAL);
BEGIN
     With A DO
          BEGIN
               x:=B.x*k;
               y:=B.y*k;
               z:=B.z*k
          END;
END;

Procedure Translate(VAR p:Points;origine:Points;v:Vecteur);
BEGIN
     With p DO
          BEGIN
               x:=Origine.x+v.x;
               y:=Origine.y+v.y;
               z:=Origine.z+v.z;
          END;
END;

Function Distcurv(A,B:Points):Real;
VAR
   u,v :vecteur;
   y : real;
BEGIN
     Vectorise(u,O,A);
     Vectorise(v,O,B);
     y:=scalaire(u,v);
     if y=0 then
        Distcurv:=pi/2
     else
         if y<0 then
                Distcurv := pi+Arctan(sqrt(1-sqr(y))/y)
         else
                Distcurv := Arctan(sqrt(1-sqr(y))/y);

END;


Procedure TraceArc(A,B:Points);
VAR
   u,v,w:Vecteur;
   k:Real;
BEGIN
     TraceTrait(O,A);
     TraceTrait(O,B);
     Vectorise(v,O,A);
     Vectorise(w,O,B);
     Vectoriel(u,v,w);
     k:=0.01/module(u);
     Homothetie(u,u,k);
     While Distance(A,B)>0.02 d
           BEGIN
               Vectorise(v,O,A);
               Vectoriel(w,u,v);
               Translate(A,A,w);
               Normalise(A);
               TracePoint(A);
           END;
END;



FUNCTION SensTetraedre (P1,P2,P3,P4:Points):Integer;
VAR
   Det : Real;
   A,B,C,u : Vecteur;

BEGIN
     Vectorise(A,P4,P1);
     Vectorise(B,P4,P2);
     Vectorise(C,P4,P3);
     Vectoriel(u,A,B);
     Det := Scalaire(u,C);
     If Det>0  then
        SensTetraedre:= 1
     ELSE
        SensTetraedre := -1;
END ;

Procedure GrandCercle(u:vecteur);
VAR
   M:Points;
   v:Vecteur;
   alpha:real;
const
     pas=0.1;
BEGIN
     TirePoint(M);
     Vectorise(v,O,M);
     Vectoriel(v,v,u);
     Translate(M,O,v);
     Homothetie(u,u,pas/module(u));
     alpha:=0;
     While alpha<2*pi do
     begin
          vectorise(v,O,M);
          vectoriel(v,u,v);
          translate(M,M,v);
          Normalise(M);
          TracePoint(M);
          alpha:=alpha+pas;
     end;
END;


Function Interieur(A,B,C,M:Points):Boolean;
BEGIN
     Interieur:=False;
     IF SensTetraedre(O,A,B,M)=SensTetraedre(O,B,C,M) then
                  If SensTetraedre(O,B,C,M)=SensTetraedre(O,C,A,M) then
                       Interieur:= SensTetraedre (A,B,C,M)<>SensTetraedre(A,B,C,O);
END;






Procedure Presentation;
begin;
      Modetexte;
      Efface
      WriteLN(' ====== Géométrie de Riemann ===========');
      WriteLN('                                        ');
      WriteLN('                                        ');
      WriteLN('                              ');
      WriteLN('   (1) Segment AB             ');
      WriteLN('   (2) distance AB            ');
      WriteLN('   (3) Droites remarquables   ');
      WriteLN('   (4) Question 4             ');
      WriteLN('                              ');
      WriteLN('   Tapez votre choix          ');
      WriteLN('                              ');
      WriteLN('                              ');
end;




procedure Question1;
const
     xmax=250;
     ymax=200;
begin
     ModeGraphique;
     Repeat
     begin
          Efface;
          fenetre(-xmax,xmax,-ymax,ymax);

          TirePoint (A);
          TirePoint (B);
          Centre(O)

          TracePoint(A);
          TracePoint(B);
          TraceArc(A,B);

          deplace(-xmax,ymax/2+10);
          ecris ('Distance AB=');ecrisreel(distance(A,B));
          Ch:=readKey;
      end
      until Ch=#27;
end;


Procedure Question2;
var
   y,ym  : real;
   n : longint;
   A,B,C,D : points;
begin

     WriteLN('=========== Longueur d''un segment AB ==========');
     Centre(O);
     ym:=0;
     n:=0;
     Repeat
     begin
          TirePoint (A);
          TirePoint (B);
          y:=distcurv(A,B);
          n:=n+1;
          if y>ym then
              begin
                  ym:=y;
                  WriteLN('Plus grande longueur trouvée=',ym:10:7,
                  '  pour n=',n);
              end;
      end
      until KeyPressed;

     WriteLN('=========== Intersection AB, CD ==========');
     Centre(O);
     ym:=0;
     n:=0;
     Repeat
     begin
          TirePoint (A);
          TirePoint (B);
          TirePoint (C);
          TirePoint (D);
      end
      until KeyPressed;





end;


Procedure Question3;

      Procedure Question3_1;
      begin
           WriteLN(' ====== Géométrie de Riemann - Question 3-1  ===========');
           WriteLN('                                        ');
           WriteLN('   (1) Médiatrice             ');
           WriteLN('                              ');
           WriteLN('   Correspond à la  médiatrice ABC par projection           ');
           WriteLN('   centrale. On trace le cercle circonscrit à ABC.           ');
           WriteLN('   On pose u = AB /\ AC vecteur normal au plan ABC           ');
           WriteLN('   Ce vecteur coupe la sphère au point cherché               ');
           WriteLN('                              ');
           Vectorise(v,A,B);
           Vectorise(w,A,C);
           Vectoriel(u,v,w);
           Translate(O,M,u);
           Normalise(M);
           TracePoint(M);
           Homothetie(u,u,-1);
           Translate(O,M1,u);
           Normalise(M1);
           TracePoint(M1);
      end;

      Procedure Question3_2;
      begin
           WriteLN(' ====== Géométrie de Riemann - Question 3-2  ===========');
           WriteLN('                                        ');
           WriteLN('   (2) Hauteur                ');
           WriteLN('                              ');
           WriteLN('   On cherche OM=x0A+yOB+zOC     tel que                 ');
           WriteLN('        AM.BC=BM.CA=CM.AB=0                              ');
           WriteLN('   D''où un système lié :                                 ');
           WriteLN('     (xOA+yOB+zOC).BC= OA.BC                                                    ');
           WriteLN('     (xOA+yOB+zOC).CA= OB.CA                                                    ');
           WriteLN('     (xOA+yOB+zOC).AB= OC.AB                                                    ');
           WriteLN('                              ');


      end;
      Procedure Question3_3;
      begin
           WriteLN(' ====== Géométrie de Riemann - Question 3-3  ===========');
           WriteLN('                                        ');
           WriteLN('   (3) Bissectrices           ');
           WriteLN('                              ');
           WriteLN('   Les plans OAB, OBC et OCA ont comme vecteurs directeurs ');
           WriteLN('   u = OA /\ AB                   ');
           WriteLN('   v = OB /\ BC                   ');
           WriteLN('   w = OC /\ CA                   ');
           WriteLN('   Les bissectrices sont alors contenues dans les plans ');
           WriteLN('     u-v     v-w   et w-u    qui sont liés.        ');
           WriteLN('   La droite comune à ces trois plans coupe la sphère en M');
end;

    Procedure Question3_4;
    begin
           WriteLN(' ====== Géométrie de Riemann - Question 3-4  ===========');
           WriteLN('                                        ');
           WriteLN('   (4) Médiane                          ');
           WriteLN('                                        ');
           WriteLN('   OM = (OA+OB+OC)                      ');
           WriteLN('   donne la direction.                   ');
           WriteLN('   Le point M est à l''intersection avec     ');
           WriteLN('   la surface de la sphère               ');
           WriteLN('                              ');
    end;


begin

      Modetexte;
      Efface;
      WriteLN(' ====== Géométrie de Riemann - Question 3 ===========');
      WriteLN('                                        ');
      WriteLN('                                        ');
      WriteLN('                              ');

      WriteLN('   (1) Médiatrice             ');
      WriteLN('   (2) Hauteur                ');
      WriteLN('   (3) Bissectrice            ');
      WriteLN('   (4) Médiane                ');
      WriteLN('                              ');
      WriteLN('   Tapez votre choix          ');
      WriteLN('                              ');


     Ch:= ReadKey;
     case ch of
     '1':  Question3_1;
     '2':  Question3_2;
     '3' : Question3_3;
     '4' : Question3_4;
     end;
     Pause;
end;

Procedure Question4;
begin
end;
Procedure Question5
begin
end;

begin
  InitGraphique;
  while true do
  begin
     Presentation;

     While not Keypressed do
     begin
     end;
     Ch:= ReadKey;
     case ch of

     '1':  Question1;
     '2':  Question2;
     '3' : Question3;
     '4' : Question4;
     '5' : Question5;
     end;
     Pause;
  end;

end.