PROGRAM Matrices_de_Hadamard;
{
Epreuve informatique de l'Ecole Polytechnique           94.248
--------------------------------------------------------------

                             -=-=-}

uses
  printer,crt, modubase;


Const
     maxn = 32;
     ymin=-1;
     print=true;
type
    element = real;
    matrice = array [1..maxn,1..maxn] of element;
    vecteur = array[1..maxn*maxn] of element;
Var
   Ch : char;

Function Hadamard(i,j:Longint):shortint;
var
   m,n:Longint;
begin
      n:=1;
      repeat
            m:=n;
            n:=n*2
      until (j<=n) and (i<=n);

      if n=2 then
        begin
             if (i=2) and (j=2) then
                Hadamard:=-1
             else
                Hadamard:=1;
        end
     else
         begin
              if (i>m) and (j>m) then
                 Hadamard:=-Hadamard(i-m,j-m)
              else
                  begin
                       if i>m then i:=i-m;
                       if j>m then j:=j-m;
                       Hadamard:=Hadamard(i,j);
                  end;
         end;
end;

Procedure Hadamard_vec(VAR w:vecteur;v :vecteur;n:integer;graphique:Boolean);
var
   s:real;
   i,j:integer;
begin
     If Graphique then
        POint(0,0);
     for i:=1 to n do
         begin
              s:=0;
              for j:=1 to n do
                  s:=s+Hadamard(i,j)*v[j];
              s:=s/n;
           {   w[i]:=s; }
              if graphique then
               begin
                 Trace(i,s);
            {    if abs(s)>0.001 then  }
                        WriteLN(lst,'i=',i:4,'  s=',s:10:5);
                Deplace(i,ymin);
                Ecris(' i=');EcrisEntier(i);
                Ecris(' -> s=');EcrisReel(s);
                Deplace(i,s);
               end;
         end;
end;

Procedure reshape(VAr m:matrice;n,i:integer);
var
   j,u,v:integer;
begin
     u:=1;
     v:=0;
     for j:=1 to n*n do
      begin
           Inc(v);
           m[u,v]:=HAdamard(i,j);
         {  Write('<',i,',',j,'>');}
           if v=n then
             begin
              v:=0;
              Inc(u);
             end;
      end;
end;

Procedure reshape_vec(VAr m:matrice;v:vecteur;n:integer);
var
   i,j,k:integer;
begin
     i:=1;
     j:=1;
     for k:=1 to n*n do
      begin
           m[i,j]:=v[k];
           Inc(j);
           if j>n then
             begin
              j:=1;
              Inc(i);
             end;
      end;
end;

Procedure Montre_vecteur(v:vecteur;n:integer);
var
   i:integer;
begin
     Write('(');
      for i:=1 to n do
             Point(i,v[i]);
      WriteLN(' .... )');

end;

Procedure Montre_mat(m:matrice;n,d:integer);
var
   i,j:integer;
begin
      for i:=1 to n do
         begin
              for j:=1 to n do
                  Write(m[i,j]:6:d);
              WriteLN;
         end;
end;

Procedure Produit_mat(var a:matrice;b,c:matrice;n:integer);
var
   i,j,k:integer;
   s:element;
begin
      for i:=1 to n do
              for j:=1 to n do
                  begin
                       s:=0;
                       for k:=1 to n do
                         s:=s+b[i,k]*c[k,j];
                       a[i,j]:=s;

                  end;
end;

Procedure Presentation;
begin;
      Modetexte;
      Efface;
      WriteLN(' ====== Matrices de Hadamard  ============');
      WriteLN('                                        ');
      WriteLN('                                        ');
      WriteLN('   (1) Enumération des premières matrices  ');
      WriteLN('   (2) Carré de Hadamard   ');
      WriteLN('   (3) Produit H.v                       ');
      WriteLN('   (4) h(...111111,...222222)');
      WriteLN('   (5) Période de i ');
      WriteLN('   (6) M32*xt*M32');
      WriteLN('   (7) % de termes négatifs ');
      WriteLN('   (8) Premier terme non nul de Hv si vk=cos(2pik/n) ');

      WriteLN('                              ');
      Write('   Tapez votre Choix  :  ');
end;





procedure Question1;
var
   i,j,n:integer;
   m:matrice;
begin
     n:=1;
     repeat
     WriteLN('=========== HAdamard ',n,' ==============');
      for i:=1 to n do
          for j:=1 to n do
              m[i,j]:=Hadamard(i,j);
      Montre_mat(m,n,0);
      Produit_mat(m,m,m,n);
      WriteLN('m.m=');
      Pause;
      Montre_mat(m,n,0);
      Pause;
      n:=n*2;
     until false;
end;

procedure Question2;
var
   i:integer;
   m:matrice;
   n:integer;
begin
     n:=1;
     repeat
     n:=n*2;
      for i:=1 to n*n do
        begin
             Reshape(m,n,i);
             WriteLN('=========== HAdamard carrée i=',i,' ==============');
             Montre_mat(m,n,0);
             Pause;
             Produit_mat(m,m,m,n);
             Montre_mat(m,n,0);
             Pause;
        end;
      until n=32;

end;


Procedure Question3;
var
   k,n:integer;
   v,w:vecteur;
   a:real;
begin
     n:=16;
     n:=n*n;
     a:=1/n;
     for k:=1 to n do
       v[k]:=sin(2*a*k*pi);
     WriteLN('======== v ====');
     Modegraphique;
     Fenetre(-1,n,-9,9);
     X_axe(0,0,10);
     Y_axe(0,0,1);
     Couleur(jaune);
     Montre_vecteur(v,n);
     Couleur(-Brillant);
     Fenetre(-1,n,ymin,-ymin);
     Hadamard_vec(v,v,n,True);
     PAuse;
end;

Procedure Question4;
var
   i,j:longint;
begin
     i:=1;
     j:=2;
     repeat
           WriteLN('Hadamard(',i,',',j,')=',Hadamard(i,j));
           i:=i*10+1;
           j:=j*10+2;
           PAuse;
     until false;
end;


Procedure Question5;
var
   i,j,k:longint;
   n:longint;
Function Periode(i:Longint):longint;
var
   n:longint;
begin
     n:=1;
     While n<i do
           n:=n*2;
    Periode:=n;
end;
begin
     WriteLN('La période de la ligne i est 2^n tel que 2^(n-1)<i<=2^n');
     i:=1;
     Repeat
           Write('P[',i,']=');
           for j:=1 to Periode(i) do
                    Write(Round((HAdamard(i,j)+1)/2));
           Writeln;

           Inc(i);
           CH:=REadKey;
     until ch=#27;


end;

Procedure Question6;
var
   h,xt,yt:matrice;
   v:vecteur;
   i,j,k:longint;
   n,m:longint;
   a:real;
begin
     Write('Entrez la valeur de n=');
     ReadLN(n);
     m:=n;
     n:=n*n;

     a:=3/n;
     a:=random;
     for k:=1 to n do

       v[k]:=sin(2*a*k*pi);
     REshape_vec(xt,v,m);

     WriteLN('xt=');
     Montre_mat(xt,m,2);
     PAuse;
     for i:=1 to m do
         for j:=1 to m do
             h[i,j]:=Hadamard(i,j);

     WriteLN('Hadamard=');
     Montre_mat(h,m,2);

Pause; Produit_mat(yt,xt,h,m);

     Produit_mat(yt,h,yt,m);
     WriteLN('1ère méthode : yt=');
     Montre_mat(yt,m,2);
     PAuse;
     Hadamard_vec(v,v,n,false);
     REshape_vec(yt,v,m);
     WriteLN('2ème méthode : yt=');
     Montre_mat(yt,m,2);
           Pause;
end;

procedure Question7;
var
   i,j,n:integer;
   s:real;
   h:integer;
begin
     ClrScr;
     WriteLN('Le nombre de termes négatifs est égal à n(n-1)/2 :');
     n:=1;
     repeat
      s:=0;
      for i:=1 to n do
          for j:=1 to n do
              if Hadamard(i,j)<0 then
                     s:=s+1;
      WriteLN('Pour n=',n:8,' il y a',s:8:0,' termes négatifs sur',sqr(n):14:0);
      n:=n*2;
     until false;
end;

Procedure Question8;
var
   u:integer;
   i,j,k,n,q:Longint;
   x:double;

Function v(k:Longint):real;
begin
     v:=sin(2*k*pi/n);
end;

Function w(i:Longint):double;
var
   j:longint;
   s:double;
begin
     s:=0;
     for j:=1 to n do
         s:=s+v(j)*hadamard(i,j);
     w:=s;
end;
begin
     WriteLN('================ v(k)=sin(2*k*pi/n)   &   w=Hv ===========');
     WriteLN('    pour k=n/2+1 ,   k =n*3/4+1   k=n*7/8+1    k=n*15/16+1 ');
           if print then

     WriteLN(lst,'================ v(k)=sin(2*k*pi/n)   &   w=Hv ===========');
           if print then
     WriteLN(lst,'    pour k=n/2+1 ,   k =n*3/4+1   k=n*7/8+1    k=n*15/16+1 ');

     n:=64;
     repeat
           WriteLN('n=',n:10);
           if print then
           WriteLN(lst,'n=',n:10);

           q:=n;
           for u:=1 to 6 do
            begin
                 q:=q shr 1;
                 x:=w(n-q+1);
                 if odd(u) then
                  begin
                  WriteLN('      k=n*',((n div q)-1),'/',n div q,'+1   -------->yk/n=',x/n:14:10,'     ',
                  x/n*puiss(2,u):14:10);
                  end
                 else
                  WriteLN('      k=n*',((n div q)-1),'/',n div q,'+1   -------->yk=',
                  x:14:10,'      ',x*puiss(4,u):14:10);
           if print then
                 WriteLN(lst,'      k=n*',((n div q)-1),'/',n div q,'   -------->',x:14:10);

            end;

           n:=n*2;
     until false;
end;





begin
     InitGraphique;
     Efface;
     WriteLN(' ====== Hadamard ============');
     Randomize;
     repeat
          Presentation;
              Read(Ch);
          case ch of
               '1':  Question1;
               '2':  Question2;
               '3' : Question3;
               '4' : Question4;
               '5' : Question5;
               '6' : Question6;
               '7' : Question7;
               '8' : Question8;
               '0' : Halt
          end;
    until false;
end.