PROGRAM fractri;

{
Epreuve informatique de l'Ecole Polytechnique           92.019
--------------------------------------------------------------


1/   Soient A, B et C trois points fixes non colinéaires dans
     un plan E. On considère toutes les fonctions continues
     H : E -> R  qui vérifient les conditions suivantes :

     (C1)     MM'= AB  ==>   H(M) = H(M')
     (C2)     MM'= AC  ==>   H(M) = H(M')
     (C3)     MB + MC = 0 ==>  H(M) + H(M') = 0

     Montrer que cet ensemble de propriétés est invariant en
     cas de permutation des points A, B et C.
     Interpréter géométriquement.



2/   Pour la commodité des calculs, on associe à chaque point M
     ses coordonnées barycentriques (u,v,w) , telles que :

     OM = u.OA  + v.OB  + w.OC     et         u+v+w=1

     Montrer que l'on peut calculer H(u,v,w) en tout point de E
     si on connaît sa restriction H = H \ ABC :
                                   °

     H (u,v,w) = H(u,v,w)   0<=u<=1  0<=v<=1  0<=w<=1
      °

     Ecrire le programme Pascal correspondant. Dans la suite
     du problème, on étudiera les exemples suivants :

 (1) H (u,v,w)= uvw
      °
 (2) H (u,v,w) = sin (Òu).sin (Òv).sin (Òw)
      °
 (3) H (u,v,w) = min (u,v,w)       (minimum des trois valeurs)
      °
 (4) Un autre exemple non trivial de votre choix



3/   Etudier les variations de la fonction H(M) lorsque M
     décrit une droite dans E. Déterminer les extrema. Illus-
     trer par un graphe. Montrer les cas particuliers.



4)   Ecrire un programme Pascal pour calculer :

                  Intégrale sur ABC de H(M)dS

     où dS est l'élément d'aire du triangle ABC


5)   Soit T l'application particulière qui à tout
     point M de coordonnées barycentriques (u,v,w) fait cor-
     respondre le point M' de coordonnées barycentriques (u',v',w')
      telles que :

      u'=1-2u   v'=1-2v   w'=1-2w
       n
      T  désignera l'application T itérée n fois.

     A chaque application H on associe une suite de fonctions
     transformées F  définies par récurrence :
                   n
                                                n
                                             H(T (M))
      F (M)= H(M)    et    F (M) = F   (M)+ ------------   pour n>0
       0                    n       n-1          n
                                                2

     Cette suite converge-t-elle ?
     Ecrire un programme Pascal pour calculer :


                 F(M) = lim   F (M)
                        n->oo  n


6/   Ecrire un programme Pascal pour comparer les extrema de
     H  et de sa transformée F, ainsi que leurs intégrales res-
     pectives sur la surface du triangle ABC :


     Appliquer ce programme à différentes fonctions H.
     Montrer qu'il existe entre ces différentes grandeurs des
     relations que l'on pouvait prévoir par un raisonnement
     mathématique.


7/   Dans les exemples cités, la fonction M -> H(M)  est-elle
     partout dérivable ? Lorsque ce n'est pas le cas, repré-
     senter graphiquement l'ensemble des points du plan E où
     H n'est pas dérivable.


                            -=-=-=-
 }


uses
  crt, graph, modubase, foncteur ;




TYPE
    Point = record
              u,v,w :real;
              t  : string[2]
            end;

VAR
     Xmax, Ymax   : real;
     yv           : real ;
     n            : integer ;
     a,b,c,w,w1   : point;
     a1,b1,c1     : point;
     ax,bx,cx     : real ;
     ay,by,cy     : real ;
     forme        : real ;


Procedure NewPoint(VAR p:point;u,v,w:real;t:string);
var
   module:real;
begin
     module := u+v+w ;
     p.u := u/module;
     p.v := v/module;
     p.w := w/module;
     p.t := t;
end;

Procedure Verifie(t:string;v:real);
begin
     yv:=yv-0.13;
     Deplace(Xmax/4,yv);
     Ecris (t);
     EcrisReel(v);
end;


Function ProjX(p:point):real;
begin
     ProjX := ax*p.u +bx*p.v + cx*p.w
end;

Function ProjY(p:point):real;
begin
     ProjY := ay*p.u +by*p.v + cy*p.w
end;


Procedure TraceSegment(p,q:point);
begin
     deplace(ProjX(p),ProjY(p)) ;
     trace  (ProjX(q),ProjY(q)) ;
end;

Procedure Tracetriangle(p,q,r:point);
begin
     TraceSegment(p,q);
     TraceSegment(q,r);
     TraceSegment(r,p);
end;

Procedure EtoileCentre(p,q,r:point);
var
   c : point;
begin
     Newpoint(c,p.u+q.u+r.u,p.v+q.v+r.v,p.w+q.w+r.w,'W');
     TraceSegment(c,p);
     TraceSegment(c,q);
     TraceSegment(c,r);
end;







function h(x:real):real;
var
   z :real ;
begin
     z := abs(x);
     z := z-trunc(z);    {modulo 1}

     if z>forme then
     begin
          if z>1-forme then
             z :=z-1
          else
              z := (1-2*z)/(1/forme-2)
     end;
{    if z>1/3 then
     begin
         if z>2/3 then
            z := z-1
         else
            z := 1-2*z;
     end; }
     if x<0 then
        h := -z
     else
        h := z;
end;




function f(x:real):real;
var
   i,m : integer;
   y : real;
begin
     y := 0;
     m :=1;
     for i:=0 to n do
     begin
             y:= y + h(x*m)/m;
             m:= m*2;
     end;
     f := y;
end;

function hh(p:point):real;

begin
     with p do
          hh := h(u)+h(v)+h(w) ;
end;

procedure TransPoint(VAR m1:point;p:point);
begin
     with p do
         NewPoint(m1,1-2*u,1-2*v,1-2*w,'w');
end;



function ff(p:point):real;
var
   i,m : integer;
   pi  : point;
   y   : real;
begin
     y := 0;
     m :=1;
     for i:=0 to n do
     begin
             y:= y + hh(p)/m;
             m:= m*2;
             Transpoint(pi,p);
             p:=pi;
     end;
     ff := y;
end;

Procedure TracePoint(p:point);
VAR
   x,y : real
begin
     x := ProjX(p);
     y := ProjY(p);
     croix(x,y);
     Ecris(p.t);

end ;

Procedure presentation;
begi
  ModeTexte;
  efface;
  gotoxy(1,3);
  writeln('             Ce programme dessine une fractale');
  writeln('             à partir d''une fonction de base');
  writeln('             qui doit être continue et s''annuler');
  writeln('             pour x=0 et x=1');
  writeln('             ');
  gotoxy(1,13);
  Writeln('h(x)=     fonction en dent de scie');
  Write('forme = '); Entre_Reel(forme);
  gotoxy(1,23);
  Pause;
end;

Procedure TraceCourbe;
var
   x,y,a,b,pas : real;
   Xext,Yext : real;
begin
     a := -Xmax;
     b := Xmax;
     deplace (-Xmax/2,Ymax-0.2);
     Ecris('n=');
     EcrisEntier(n);

     pas := (b-a)/600;
     x := a; y := f(x);
     Xext := x; Yext :=y;
     Deplace(x,y);
      While x<b do
      begi
           y := f(x);
          Trace(x,y);
          if (x>0) and (x<1) then
           if y>yExt then
           begin
               yExt:=y;
               xext:=x;
           end;
          x:=x + pas;
      end ;
      Croix(Xext,Yext);
      Deplace (a+0.1,-Ymax+0.05);
      Ecris('Maximum=');EcrisReel(Yext);
      Ecris('  pour x=');Ecrisreel(Xext);
end ;


procedure init(titre:string);
begin
     Efface;
     Xmax := 2;
     Ymax := 1.5;
     Fenetre(-Xmax,Xmax,-Ymax,Ymax);
     X_Axe(0,0,1) ;
     Y_Axe(0,0,1);
     Deplace(0,-Ymax+0.1);
     Ecris(Titre);
     SetBkColor(Blue);
     Couleur(Rouge);

end;

Function fp(x:real):real;
var
   y:real;
   p:point;
begin
     y := 1-x;
     NewPoint(p,A1.u*x+A.u*y,
                A1.v*x+A.v*y,
                A1.w*x+A.w*y,'w') ;
     fp := ff(p);
end;

Procedure Check(p:point);
begin
      Verifie('F('+p.t+')=',ff(p));
end;


Procedure TraceCourbe2;
var
   x,y,xa,xb,pas : real;
   Xext,Yext : real;
begin
     yv := Ymax-0.05;
          Check(A);
          Check(B);
          Check(C);
          Check(A1);
          Check(B1);
          Check(C1);
          Check(W);
          Check(W1);
     xa := -Xmax;
     xb := Xmax;
     deplace (Xmax/2,Ymax-0.2);
     Ecris('n=');
     EcrisEntier(n);

     pas := (xb-xa)/600;
     x := xa; y := fp(x);
     Xext := x; Yext :=y;
     Deplace(x,y);
      While x<xb do
      begin
           y := fp(x);
          Trace(x,y);
          if (x>0) and (x<1) then
           if y>yExt then
           begin
               yExt:=y;
               xext:=x;
           end;
          x:=x + pas;
      end ;
      Croix(Xext,Yext);
      Deplace (xa+0.1,-Ymax+0.05);
      Ecris('Maximum=');EcrisReel(Yext);
      Ecris('  pour x=');Ecrisreel(Xext);

end;


procedure question2;
begin
     ModeGraphique;
     Efface;
     Init('fractale linéaire');
     Couleur(Rouge);
     n:=0;
     TraceCourbe;
     n:=10;
     Couleur(-Brillant);
     TraceCourbe ;
     Pause;
end; {question 2 }

procedure trace;
var
   xj,yj,ypas:real;
begin
     ypas :=-12;
     xj := ProjX(W1);
     yj := ProjY(W1);
     Deplace(xj,yj); Ecris('H(W1)=');EcrisReel(hh(W1));
     with W1 do
     begin
      yj:=yj+ypas;
      Deplace(xj,yj);Ecris ('u,h(u)=');EcrisReel(u);EcrisReel(h(u));
      yj:=yj+ypas;
      Deplace(xj,yj);Ecris ('v,h(v)=');EcrisReel(v);EcrisReel(h(v));
      yj:=yj+ypas;
      Deplace(xj,yj);Ecris ('w,h(w)=');EcrisReel(w);EcrisReel(h(w));
     end;



end;




procedure question4;
begin
     Init('fractale triangulaire');
     ModeGraphique;
     Efface;
     Xmax := 600;
     Ymax := 500;
     Fenetre(0,Xmax,0,Ymax);

     ax := 200 ;   ay := 120 ;
     bx := 230  ;  by := 300;
     cx := 400 ;   cy := 250 ;

     yv := Ymax;
     Couleur(Rouge);
     NewPoint(A,1,0,0,'A'); TracePoint(A);
     NewPoint(B,0,1,0,'B'); TracePoint(B);
     NewPoint(C,0,0,1,'C'); TracePoint(C);
     TraceTriangle(A,B,C);

     NewPoint(A1,-1,1,1,'A1'); TracePoint(A1);
     NewPoint(B1,1,-1,1,'B1'); TracePoint(B1);
     NewPoint(C1,1,1,-1,'C1'); TracePoint(C1);
     TraceTriangle(A1,B1,C1);

     Couleur(Brillant);
     NewPoint(W,1/3,1/3,1/3,'W'); TracePoint(W);
     NewPoint(W1,A.u+W.u,A.v+W.v,A.w+W.w,'W1'); TracePoint(W1);
     EtoileCentre(A,B,C);
     EtoileCentre(A1,B,C);
     EtoileCentre(A,B1,C);
     EtoileCentre(A,B,C1);
     n:=0;
     Trace;


     Pause;
end; {question 3 }


Procedure Question5;
begin
     Init('Fractale   de A vers A1');
     n:=0;
     Couleur(Rouge);
     TraceCourbe2;
     Pause;
     for n:=1 to 10 do
     begin
          Couleur(-Brillant);




          TraceCourbe2;
          Pause;
          TraceCourbe2;
     end;
end;


begin
     InitGraphique;
     Presentation;
     Question2;
     Question4 ;
     Question5;