PROGRAM fractale;

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


1/ A toute fonction h: R -> R, et tout entier n, on associe une série de
   fonctions f : R -> R définies par récurrence  :
              n
                        +----------------------------------------+
 +-------------+        ¦                       n                ¦
 ¦             ¦        ¦                    h(2 .x)             ¦
 ¦ f (x) = h(x)¦  et    ¦ f (x) =   f   (x) + ------    pour n>0 ¦
 ¦  0          ¦        ¦  n         n-1         n               ¦
 +-------------+        ¦                       2                ¦
                        +----------------------------------------+


   Lorsqu'elle existe, on définit la fonction f : R -> R :

                       f(x) = lim         f (x
                             n->infini     n

   Que peut-on dire des propriétés de f en fonction de celles de h :
   continue ? croissante ? bornée ? paire ou impaire ? périodique ?
   dérivable ? intégrable ?


2/ Ecrire un programme Pascal capable de représenter et de comparer
   les graphes des fonctions h et f, dont on calculera les extrema.
   L'appliquer au cas  h(x)=sin(x) et h(x)=cos(x).

3/ On suppose mainte^atPqUe la fonction h(x) est périodique
   de période 1 et définie sur l'intervalle [a,a+1] par
   nterpolation linéaire entre les valeurs suivantes :

h(a)=0   h(a+p)=p    h(a+1-p)=-p    h(a+1)=0      0<p<1/2




            p                          p
         -+-                        -+-


a-1     a-1+p     a-p       a       a+p     a+1-p     a+1
-+--------+--------+--------+--------+--------+--------+--> x



                 -+-                        -+-
                     -p                        -p



     Tracer le graphe de f(x) qui s'en déduit et le comparer à
     celui de h(x) pour différentes valeurs des constantes a
     et p.

4/   Après avoir observé les variations de f (x) pour
                                            n
     différentes valeurs de n, de p et de a, écrire un
     programme Pascal qui recherche les solutions de f (x)=0.
                                                      n

     Appliquer ce programme, pour des valeurs croissantes de n,
     aux cas suivants :

          a) a=0  p=1/3


          b) a=1/4  p=1/4


5/   Que deviennent les résultats qui précèdent

          a) lorsque p tend vers 1/2?
          b) lorsque n tend vers l'infini ?



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

                            -=-=-=-
}



uses
  crt, graph, modubase, foncteur ;




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

VAR
     Xmax, Ymax,x1,x2,y1   : real;
     yv           : real ;
     n,m          : integer ;
     arg,b        : real ;
     forme        : real ;
     h_libre      : FonctionReelle1;
     question     : char ;


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




function h(x:real):real;
var
   z :real ;
begin
   if question='2' then
        h:=h_libre(x)
   else
    begin
     z := x-arg;
     if z>1 then z:=z-trunc(z);
     if z<0 then z:=z+1+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;
     h := z;
    end;
end;




function f(x:real):real;
var
   i   : integer;
   y,m : 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;


Procedure TraceCourbe(a,b:real;racines:Boolean);
var
   x,y,x1,y1,pas : real;
   Xext,Yext : real;
begin
     x1:=a;
     deplace (a,Ymax-0.2); Ecris('n='); EcrisEntier(n);
     if question ='2' then
     begin
          Deplace(a,Ymax-0.3);
          Ecris('h(x)=');
          Affiche_expression1(h_libre);
     end
        else
     begin
          deplace (a,Ymax-0.3); Ecris('a='); EcrisReel(arg);
          deplace (a,Ymax-0.4); Ecris('p='); EcrisReel(forme);

     end;

     pas := (b-a)/600;
     y1 := f(x1);
     Xext := x1; Yext :=y1;
     x:=x1;
      While x<b do
      begin
           y := f(x);
           if (n>0) and (y*y1<0) and racines then
            begin
                 Deplace (a+0.1,Ymax/2);
                 Ecris('Racine : x=');EcrisReel(x);
                 pause;
            end;
          Deplace(x1,y1);
          Trace(x,y);
          x1:=x;
          y1:=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;
     Fenetre(x1,x2,-Ymax,Ymax);
     X_Axe(0,0,1) ;
     Y_Axe(0,0,1);
     Deplace(0,-Ymax+0.1);
     Ecris(Titre);
     SetBkColor(Blue);
     Couleur(Rouge);
end;


procedure Question1;
begin
end;

procedure Question2;
var
   m:integer;
begin
     Write('Entrez h(x)='); Entre_Fonction1('x',h_libre);
     while true do
     begin
          x1:=-4;
          x2:= 4;
          ymax :=3;
          ModeGraphique;
          for m:=1 to 25 do
          begin
               Efface;
               Init('fractale linéaire');
               Couleur(Rouge);
               n:=0;
               TraceCourbe(x1,x2,FALSE);
               n:=m;
               Couleur(Brillant);
               TraceCourbe(x1,x2,FALSE);
               Pause;
          end;
     end;
end;

procedure question3;
var
   m :integer;
begin
     Write('p = '); Entre_Reel(forme);
     Write('a = '); Entre_Reel(arg);
     Write('n = '); Entre_Entier(m);
     ModeGraphique;
      Efface;
      x1:=-1;
      x2:=1;
      ymax:=1;
      Init('fractale linéaire');
      Couleur(Rouge);
      n:=0;
      TraceCourbe(x1,x2,FALSE);
      n:=m;
      Couleur(-Brillant);
      TraceCourbe(x1,x2,FALSE) ;
      Pause;
end; {question 3 }


procedure Question4;
var
   m:integer;
begin
     Write('Entrez h(x)='); Entre_Fonction1('x',h_libre);
     while true do
     begin
          x1:=-2;
          x2:= 2;
          ymax :=1.5;
          ModeGraphique;
          for m:=1 to 25 do
          begin
               Efface;
               Init('fractale linéaire');
               Couleur(Rouge);
               n:=0;
               TraceCourbe(x1,x2,FALSE);
               n:=m;
               Couleur(Brillant);
               TraceCourbe(x1,x2,TRUE);
               Pause;
          end;
     end;
end;



Procedure Presentation;
begin
    ModeTexte;
    Efface;
       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('             ');
       writeln('             ');
       gotoxy(1,13);
       writeln('            (2) fonction quelconque');
       writeln('            (3) h(x)= 1-2p-abs(x-p)+abs(x+p-1)');
       writeln('                                             ');
end;



begin

  Initgraphique;
  while true do
  begin
     Presentation;
     write('Question choisie ? ');
     readln(question);
     Efface;
     writeln('======== Question n°',question,'===============');
     writeln('');

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

end.