Program ep95_311_pas;

{
Epreuve informatique d'admission à l'Ecole Polytechnique      95.311
---------------------------------------------------------------------


1°/   On désigne habituellement en mathématiques par  C(n,p) le nombre de
combinaisons de p éléments choisis parmi n, que l'on rencontre en développant
l'expression des puissances du binôme :

  (a+b)^n=C(n,0)a^n+C(n,1)a^(n-1)b+ ... +C(n,n-1)qb^(n-1)+C(n,n)b^n

Ecrire un programme Pascal capable de répondre à la simple question suivante :
connaissant les entiers p et q, le nombre C(p+q,p) est-il pair ou impair ?
 (choisir un mode de calcul permettant de traiter des valeurs de p et q
 les plus grandes possibles).


2°/ A tout entier n, on associe une matrice S, carrée d'ordre n dont
l'élément situé en ligne i et en colonne j, noté s(i, j) est tel que
s(i,j)=0 si C(i+j-2,i-1) est pair et  s(i, j)=1 si  C(i+j-2,i-1) est impair.
Ecrire un programme Pascal capable de calculer et d'afficher cette matrice.
Citez plusieurs propriétés remarquables de cette matrice,
valables pour tout n.


3°/ A tout entier n, on associe une matrice Gn, carrée d'ordre n obtenue de
la façon suivante :
	- on cherche un entier k tel que     2^k>=n
	- on considère la matrice S d'ordre 2k dont le terme général s(i,j)
correspond à la définition précédente, on lui enlève les (2^k-n) colonnes
les plus à gauche et les (2^k-n) lignes les plus en bas.
On obtient ainsi une matrice carrée dont le terme général est


                     g(i,j)=s(i,j+2^k,-n)

Après avoir remarqué que chacune des matrices Gn est égale au bloc de même
taille situé dans la partie supérieure droite des matrices suivantes, écrire
un programme Pascal qui calcule les termes de cette matrice.


4°/ On appelle valeur propre de la matrice Gn  un nombre réel lambda qui annule
le déterminant de la matrice  Gn-lambda.I, où I désigne la matrice diagonale
unité.
Ecrire un programme Pascal pour calculer les valeurs propres de Gn.
Quels résultats obtient-on pour les premières valeurs de n ?


5°/ Remarquer expérimentalement que toutes ces valeurs propres sont,
au signe près, des puissances entières (nulles, positives ou négatives)
d'un même nombre F dont on explicitera la valeur exacte.
En admettant sans chercher à la démontrer que cette propriété est vraie
pour toute valeur de n, quelles améliorations peut-on apporter au programme
Pascal précédent pour accélérer la recherche des valeurs propres de Gn  ?


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

uses
    modubase, crt;

const
     maxn=10;
type
  Myreal=real;
  Myint=Longint;
  Element=record
     t:MyInt;
     lambda:boolean;
  end;
  matrice=array[1..maxn,1..maxn] of Element;
  matriceReal=array[1..maxn,1..maxn] of Myreal;


  Polynome=record
      degre:integer;
      terme:array[0..maxn] of MyInt;
  end;

var
   ch:char;
   n:integer;



procedure AddMatrice(a,b:matrice;VAR c:matrice);
var
   i,j:integer;
begin
   for i:=1 to n do for j:=1 to n do c[i,j].t:=a[i,j].t+b[i,j].t;
end;

procedure MulMatrice(a,b:matrice;VAR c:matrice);
var
   i,j,k:integer;
   x:MyInt;
begin
   for i:=1 to n do
      for j:=1 to n do
          begin
               x:=0;
               for k:=1 to n do
                   x:=x+a[i,k].t*b[k,j].t;
               c[i,j].t:=x;
          end;
end;




procedure AfficheMatrice(a:matrice);
var
   i,j:integer;
begin
   for i:=1 to n do
     begin
          for j:=1 to n do write(' a[',i,',',j,']=',a[i,j].t:3);
          WriteLN;
     end;
end;


function Sierpinski(i,j:MyInt):boolean;
var
 h,k:Myint;
   procedure exchange(VAR i,j:Myint);
   var
      h,k:Myint;
   begin
     k:=i;i:=j;j:=k
   end;
begin
     if i<j then
        exchange(i,j);
     if i<3 then
        Sierpinski:=(i=1)or(j=1)
     else
       begin
            h:=1;
            while h<i do
                  begin
                       k:=h;
                       h:=k*2;
                  end;
            if j>k then
               Sierpinski:=false
            else
                Sierpinski:=Sierpinski(i-k,j);
       end;
end;

procedure Geniton(VAR m:matrice);
var
   h,k,i,j:integer;
begin
     k:=0;
     h:=1;
     while h<n do
           begin
                Inc(k);
                h:=h*2;
           end;
     for i:=1 to n do
         for j:=1 to n do
             m[i,j].t:=integer(Sierpinski(i,j+h-n));
end;

function determinant(m:matriceReal;n:integer):MyReal;
var
   d:real;
   m1:matriceReal;
   i,v:integer;
   procedure Supprime(m:matriceReal;VAR m1:matriceReal;i,n:integer);
   var
      j:integer;
   begin
        m1:=m;
        while i<n do
         begin
           for j:=1 to n-1 do
               m1[i,j]:=m[i+1,j];
           Inc(i);
         end;
   end;
begin
     if n=1 then
        determinant:=m[1,1]
     else
        begin
          d:=0;
          if odd(n) then v:=1 else v:=-1;
          for i:=1 to n do
              begin
                   Supprime (m,m1,i,n);
                   d:=d+v*m[i,n]*Determinant(m1,n-1);
                   v:=-v;
              end;
          determinant:=d;
        end;
end;

procedure NewPolynome(VAR p:Polynome;d:integer);
var
   i:integer;
begin
     with p do
       begin
            degre:=d;
            for i:=0 to d do terme [i]:=0;
       end;

end;


procedure AffichePolynome(p:polynome);
var
   i:integer;
begin
     with p do
       begin
            for i:=0 to degre do
             begin
              Write(terme[i],'*x',i,' ');
             end;
       end;

end;


procedure ZeroPolynome(VAR p:Polynome);
begin
     NewPolynome(p,0);
     p.terme[0]:=0;
end;

procedure NormalisePolynome(VAR p:Polynome);
begin
   with p do
     While (degre>0) and (terme[degre]=0) do
           Dec(degre);
end;

procedure ScalairePolynome(VAR p:Polynome;s:integer);
var
   i:integer;
begin
  if s=0 then
   NewPolynome(p,0)
  else
     with p do
       for i:=0 to degre do terme [i]:=terme[i]*s;

end;


procedure AddPolynome(p,q:Polynome;VAR r:Polynome);
var
   i:integer;
   Function max(i,j:MyInt):MyInt;
   begin
        if i>j then max:=i else max:=j;
   end;
begin
  NewPolynome(r,max(p.degre,q.degre));
  with r do
  for i:=0 to degre do
        if i>p.degre then
          terme[i]:=q.terme[i]
      else
        if i>q.degre then
          terme[i]:=p.terme[i]
      else
             terme[i]:=p.terme[i]+q.terme[i];
end;

procedure SubPolynome(p,q:Polynome;VAR r:Polynome);
var
   i:integer;
   Function max(i,j:MyInt):MyInt;
   begin
        if i>j then max:=i else max:=j;
   end;
begin
  NewPolynome(r,max(p.degre,q.degre));
  with r do
  for i:=0 to degre do
        if i>p.degre then
          terme[i]:=-q.terme[i] 
      else
        if i>q.degre then
          terme[i]:=p.terme[i]
      else
             terme[i]:=p.terme[i]-q.terme[i];
end;

procedure MulPolynome(p,q:Polynome; VAR r:Polynome);
var
   i,j:integer;
begin
     NewPolynome(r,p.degre+q.degre);
     for i:=0 to p.degre do
      for j:=0 to q.degre do
         r.terme[i+j]:=r.terme[i+j]+p.terme[i]*q.terme[j];
end


procedure DivEuclidienne(u,v:Polynome;var q,r:polynome);
var
    w:polynome;
begin
      {on va construire progressivement q en commencant par le
       terme de degre le plus eleve, qui est le quotient
        entre les termes de degré le plus eleve de u et de v.
       On recommence jusqu'à ce que le reste r=u-vq ait un degre
       inferieur a celui de v}
   ZeroPolynome(q);
   repeat
            MulPolynome(v,q,w);
            SubPolynome(u,w,r);
            q.terme[u.degre-w.degre]:=w.terme[w.degre] div q.terme[q.degre];
    until r.degre<v.degre
end;

procedure Polynomedeterminant(m:matrice;n:integer;VAR resultat:polynome);
var
   u,d:Polynome;
   m1:matrice;
   w:polynome;
   i,v:integer;
   procedure Supprime(m:matrice;VAR m1:matrice;i,n:integer);
   var
      j:integer;
   begin
        m1:=m;
        while i<n do
              begin
                   for j:=1 to n-1 do
                       m1[i,j]:=m1[i+1,j];
                   Inc(i);
              end
   end;
begin
     NewPolynome(w,1);   {  -lambda }
     w.Terme[1]:=-1;
     if n=1 then
        begin
           NewPolynome(resultat,1);
           resultat.terme[0]:=m[1,1].t;
           if m[1,1].lambda then
               AddPolynome(resultat,w,resultat);
        end
     else
        begin
          NewPolynome(resultat,0);
          if odd(n) then v:=1 else v:=-1;
          for i:=1 to n do
              begin
                   Supprime (m,m1,i,n);
                   PolynomeDeterminant(m1,n-1,d);
                   NewPolynome(u,0);
                   u.terme[0]:=m[i,n].t;
                   if m[i,n].lambda then
                         AddPolynome(u,w,u);
                   ScalairePolynome(u,v);
                   MulPolynome(u,d,d);
                   AddPolynome(resultat,d,resultat);
                   v:=-v;
              end;
        end;
end;


procedure affiche;
var
   m,n:integer;
const
     maille=200;
begin
     Efface;

     ModeGraphique;
     Couleur(vert);
     Isofenetre(-2,2,-1.5);
     x_axe(0,0,1);
     y_axe(0,0,1);
     Couleur(-Jaune);
     Ecris('Mandelbrot');
     Couleur(Jaune);
     for m:=-maille to maille do
         for n:=0 to maille do
             begin

             end;
     Pause;
end;





procedure Question_1;
var
   a,b,c:matrice;
   i,j,n:integer;
begin
     n:=1;
     repeat
          Efface;
          WriteLN('n=',n);
          for i:=1 to n do
            begin
              for j:=1 to n do
                 if Sierpinski(i,j) then
                    write('1 ')
                 else
                     write('0 ');
              WriteLN;
            end;

           Pause;
           n:=n*2;
     until n=16;
end;


procedure Question_2;
var
   m:matrice;
   i,j:integer;
begin
     for n:=1 to 10 do;
     begin
          Geniton(m);
          for i:=1 to n do
            begin
              for j:=1 to n do
                     begin
                        write(m[i,j].t:3);
                     end;
              WriteLN;
            end;
          Pause;

     end;
end;


procedure Question_3;
var
   m,m1:matrice;
   x:Myreal;

const
     pas=0.01;
     calx=3;
     function detlambda(m:matrice;x:MyReal):MyReal;
     var
        i,j:integer;
        m1:matricereal;
     begin
          for i:=1 to n do
           for j:=1 to n do
             if i=j then
                m1[i,j]:=m[i,j].t-x
             else
                m1[i,j]:=m[i,j].t;
          detlambda:=determinant(m1,n);
     end;

begin
     begin
          Efface;
          ModeGraphique;
          Couleur(vert);
          Fenetre(-calx,calx,-11,11);
          x_axe(0,0,1);
          y_axe(0,0,1);
          Couleur(-Jaune);

          Ecris('Transformation a=');
          Couleur(Jaune);
          for n:=2 to 8 do
           begin
                Geniton(m);
                x:=-calx;
                Deplace(x,detlambda(m,x));
                repeat
                      x:=x+pas;
                      Trace(x,detlambda(m,x));
                      m1:=m;
                until x>calx;
                Pause;
           end;
     end;
     repeat
     until false;
end;


procedure Question_4;
var
   m,m1:matrice;
   x:Myreal;
   p:polynome;

const
     pas=0.01;
     calx=3;
     procedure detlambda(m:matrice;var p:polynome);
     var
        i,j:integer;
     begin
          for i:=1 to n do
           for j:=1 to n do
              m[i,j].lambda:=(i=j);

          Polynomedeterminant(m,n,p);
          AffichePolynome(p);
          Pause;
     end;

begin
     begin
          for n:=1 to 8 do
           begin
                WriteLN;
                WriteLN('n=',n);
                Geniton(m);
                AfficheMatrice(m);
                DetLambda(m,p);
                Pause;
           end;
     end;
     repeat
     until false;
end;

procedure Presentation;
begin;
      Efface;
      WriteLN(' ====== Le nombre d''or  ============');
      WriteLN('                                        ');
      WriteLN('                                        ');
      WriteLN('   (1) Calcul de Sierpinski ');
      WriteLN('   (2) Calcul des Génitons ');
      WriteLN('   (3) Recherche des valeurs propres ');
      WriteLN('   (4) Polynome caractéristique');
      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;
               '4':  Question_4;
               '0' : Halt
          end;
    until false;
end.