Program ep96_415;

{
     Ecole Polytechnique  ...........................   95.415

On considre l'ensemble des matrices M, carres d'ordre n, dont tous les lments
sont des entiers naturels.

Exemple pour n=7 : 


4, 49, 37, 93, 97, 32, 62
79, 64, 52, 97, 66, 23, 59
19, 87, 22, 50, 14, 56, 77
42, 23, 63, 24, 11, 63, 49
24, 87, 42, 94, 52, 7, 67
53, 79, 30, 86, 25, 59, 29
39, 13, 32, 22, 49, 89, 16



1/ Que peut-on dire a priori du dterminant D de M ?
Ecrire un programme Pascal capable de savoir si D est un entier
pair ou impair.

2/ Est-il possible d'lever cette matrice  une puissance entire
positive p de sorte que le rsultat (une matrice de mme dimension note Mp)
ne contienne que des entiers pairs partout,
sauf dans la diagonale principale o les entiers seront impairs ? 

3/ Ecrire un programme en Pascal permettant de calculer, quand il existe,
le nombre p dfini  la question prcdente.

4/ Gnraliser  une matrice d'entiers (ngatifs, nuls ou positifs) carre
quelconque. 
Que peut-on dire de ce nombre p : existence ? maximum ?

5/ Comment peut-on amliorer les programmes Pascal raliss lors des questions
prcdentes de manire  pouvoir traiter des matrices de grande taille ?
Jusqu' quelle valeur de n est-il possible de travailler avec les moyens de
calcul dont vous disposez ?
Comment varie le temps moyen de calcul en fonction de n ?
Dans le cas par exemple d'une matrice de dimension 100 sur 100, quel serait
e temps moyen mis par votre programme pour calculer la valeur de p, sachant
que si celle-ci existe, elle est ncessairement infrieure  2100 ?

. . . . .

Attention, au del d'une certaine limite, les nombres ne sont plus codables 
exactement sur votre ordinateur... Mais les mathmatiques restent valables
(il n'est pas interdit d'tre astucieux).



:--------------------------------------------------------------:
:    Imprimer tous les rsultats                               :
:     en indiquant chaque fois  quoi ils correspondent        :
:--------------------------------------------------------------:
                            -=-=-=-
 }

uses
    crt, modubase;

const
     size=20;
type
     { Myreal=double;}
    Myreal=real;

    mat = array [1..7,1..7] of integer;
    bmat = array [1..size,1..size] of boolean;

var
   ch:char;
   n:integer;
     Car         : Char ;
     Question    : Char;



const
     exemple : mat=

 ((  4, 49, 37, 93, 97, 32, 62),
  ( 79, 64, 52, 97, 66, 23, 59),
  ( 19, 87, 22, 50, 14, 56, 77),
  ( 42, 23, 63, 24, 11, 63, 49),
  ( 24, 87, 42, 94, 52,  7, 67),
  ( 53, 79, 30, 86, 25, 59, 29),
  ( 39, 13, 32, 22, 49, 89, 16));


function parity(x:integer):Boolean;
begin
     parity:=odd(x);
end;

function showb(x:boolean):integer;
begin
     if x then showb:=1 else showb:=0;
end;


procedure showmat(m:mat);
var
   i,j:integer;
begin
     for i:= 1 to n do
      begin
         for j:= 1 to n do
             write(showb(parity(m[i,j])),' ');
         Writeln;
      end;
end;

procedure showbmat(m:bmat);
var
   i,j:integer;
begin
     for i:= 1 to n do
      begin
         for j:= 1 to n do
             write(showb(m[i,j]),' ');
         Writeln;
      end;
end;

procedure convbool (m:mat;VAR b:bmat);
var
   i,j:integer;
begin
     for i:= 1 to n do
         for j:= 1 to n do
             b[i,j]:=parity(m[i,j]);
end;

Procedure bmat1(VAR a:bMat);
Var
   i,j:integer;
begin
     for i:=1 to n do
         for j:=1 to n do
           a[i,j]:=(i=j);
end;

Procedure alea_mat(VAR a:bMat);
Var
   i,j:integer;
begin
     for i:=1 to n do
         for j:=1 to n do
           a[i,j]:=(random>0.5);
end;

Procedure prod_mat(a,b:bmat;VAR c:bmat);
Var
   z : Boolean;
   i,j,k:integer;
begin
     for i:=1 to n do
         for j:=1 to n do
          begin
               z:=False;
               for k:=1 to n do
                   z:=z xor (a[i,k] and b[k,j]);
               c[i,j]:=z;
          end;
end;

Procedure Sous_mat(a:bmat;VAR b:bmat;i,j,m:integer);
var
   u,v,u1,v1:integer;
begin
     u1:=0;
     for u:=1 to m do
       if u<>i then
         begin
              Inc(u1);
              v1:=0;
              for v:=1 to m do
                  if v<>j then
                     begin
                          Inc(v1);
                          b[u1,v1]:=a[u,v];
                     end;
         end;
end;


Function Determinant(a:bmat;m:integer):Boolean;
var
   u,v,i1,j1,cth,ctv,ctmax:integer;
   d:Boolean;
   b:bmat;
begin
     if m=1 then
        Determinant:=a[1,1]
     else
         begin
              d:=False;
              { chercher la ligne i1 ou la colonne j1
               o le nombre de 1 est minimal }
              ctmax:=m+1;
              u:=0;
              repeat
                    Inc(u);
                    cth:=0;
                    ctv:=0;
                    for v:=1 to m do
                        begin
                           if a[u,v] then
                              Inc(cth);
                           if a[v,u] then
                              Inc(ctv);
                        end;
                       if cth<ctmax then
                          begin
                               i1:=u;j1:=0;
                               ctmax:=cth;
                          end;
                       if ctv<ctmax then
                          begin
                               i1:=0;j1:=u;
                               ctmax:=ctv;
                          end;
              until (ctmax=0) or (u=m);
{              WriteLN('m=',m,' ctmax=',ctmax,' i1=',i1,' j1=',j1);}

              if ctmax>0 then
                 begin
                  if j1>0 then
                   begin
                      for i1:=1 to m do
                          if a[i1,j1] then
                             begin
{                                  WriteLN('Pour i1=',i1,' Sous_mat(a,b,i1,j1,m)=',i1,j1,m);}
                                  Sous_mat(a,b,i1,j1,m);
                                  d:=d xor determinant(b,m-1);
                             end
                    end
                  else
                      for j1:=1 to m do
                          if a[i1,j1] then
                             begin
{                                 WriteLN('Pour j1=',j1,' Sous_mat(a,b,i1,j1,m)=',i1,j1,m);  }
                                  Sous_mat(a,b,i1,j1,m);
                                  d:=d xor determinant(b,m-1);
                             end;
                 end;
              Determinant:=d;
         end;
end;

Procedure ident_mat(VAR a:bmat);
Var
   i,j:integer;
begin
     for i:=1 to n do
         for j:=1 to n do
           a[i,j]:=(i=j);
end;

Function equal_mat(a,b:bmat):Boolean;
Var
   i,j:integer;
   e:boolean;
begin
     e:=true;
     for i:=1 to n do
         for j:=1 to n do
           e:=e and (a[i,j]=b[i,j]);
         equal_mat:=e;
end;

Procedure transforme (VAR a,b,c:bmat);
begin
     Prod_mat(c,a,a);
     Prod_mat(c,b,b);
     {  illustre(a,b,c);  }
end;


Procedure echange(VAR a,b:bmat;i,j:integer);
var
   k:integer;
   c:bmat;
begin
   {  WriteLN('<<Echange ',i,' et ',j,'>>');Pause; }
     Ident_mat(c);
     c[i,i]:=false;
     c[j,j]:=false;
     c[i,j]:=true;
     c[j,i]:=true;
     Transforme(a,b,c);
end;


Procedure combine(VAR a,b:bmat;i,j:integer);
var
   k:integer;
   c:bmat;
begin
    { WriteLN('<<Combine ',i,' et ',j,'>>');Pause;   }
     Ident_mat(c);
     c[i,j]:=true;
     Transforme(a,b,c);
end;

Procedure inv_bool(a:bmat;VAR b:bmat;VAR inversible:Boolean);
var
   i,j:integer;
begin
     inversible:=true;
     ident_mat(b);
     j:=0;
     repeat
      i:=j;
      j:=j+1;
      repeat
         i:=i+1;
      until a[i,j] or (i>n);
      if i>n then
         inversible:=false
      else
         begin
           echange(a,b,i,j);
           for i:=1 to n do
               if (i<>j) and a[i,j] then
                  combine(a,b,i,j);
         end;
     until (j=n) or not inversible
end;


procedure Presentation;
begin;
      Efface;
      WriteLN(' ====== EP96.415 - Parit de matrice ===================');
      WriteLN('                                  ');
      WriteLN('                                                  ');
      WriteLN(' (1) Parit de la matrice exemple                          ');
      WriteLN(' (2) Parit de matrice quelconque                  ');
      WriteLN('                              ');
      Write('   Tapez votre Choix  :  ');
end;


procedure Question1;
var
   e,e1,e2:bmat;
   inversible:Boolean;
   count:integer;
   A,ex,i:bmat;

begin
     Efface;
     Writeln('ษออออออออออออออออออออออ Question n๘1 อออออออออออออออออออออออออออออออป');
     Writeln('บ                                                                   บ');
     Writeln('บ   Parit de la matrice exemple                                    บ');
     Writeln('บ                                                                   บ');
     Writeln('ศอออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออผ');

     n:=7;
     Showmat(exemple);
     ConvBool(exemple,ex);
     count:=0;
     Bmat1(I);
     A:=I;
     repeat
           Inc(count);
           Prod_Mat(A,ex,A);
           Showbmat(A);
           WriteLN('count=',count,' determinant=',determinant(A,7));
           if equal_mat(A,I) then
              begin
                   writeLN('A^',count,'=I');
                   Pause;
              end;
     until false;

     repeat
     n:=3;
     efface;
     repeat
           Alea_mat(e);
           Inv_bool(e,e1,inversible);
     until inversible;
     Showbmat(e);
     WriteLN('Son inverse est = ');
             Showbmat(e1);
            WriteLN('Le produit des deux matrices est = ');
            Prod_mat(e,e1,e2);
             Showbmat(e2);
            Inv_bool(e1,e2,inversible);
            WriteLN('L''inverse de l''inverse est = ');
             Showbmat(e2);

     PAuse;
     until false;
end;

procedure Question2;
var
   e,e1,e2:bmat;
   inversible:Boolean;
   count:integer;
   A,ex,i:bmat;

begin
     Efface;
     Writeln('ษออออออออออออออออออออออ Question n๘2 อออออออออออออออออออออออออออออออป');
     Writeln('บ                                                                   บ');
     Writeln('บ   Parit de la matrice quelconque                                 บ');
     Writeln('บ                                                                   บ');
     Writeln('ศอออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออออผ');

           Write('dimension de la matrice n=');
           ReadLN(n);
           Write('p=');
     repeat
           repeat
                 Alea_mat(ex);
           until determinant(ex,n);
           count:=0;
           Bmat1(I);
           A:=I;
           repeat
                 Inc(count);
                 Prod_Mat(A,ex,A);
           until equal_mat(A,I);
           write(count,' ');
     until false;
end;


begin
  while true do
  begin
    Presentation;

     write('Question choisie ? ');
     readln(question);
     case question of
          '1':  Question1;
          '2':  Question2;

     end;
     Pause;
  end;
end.