Programmer un sudoku en ada

pascalou34 -  
Bonjour,

je suis depuis cette année à l'IUT de Montpellier et nous utilisons le langage ada pour débuter. Nous devons programmer un sudoku, j'ai presque finis seulement j'ai quelques soucis pour les procédure de fin. je vous laisse mon code pour ceux qui veulent bien y jetter un oeil :-)

la grille se remplie mais plusieurs chiffres aparraissent dans la meme region.

merci par avance !

-- bibliotheques necessaires
with ada.Integer_Text_IO; use ada.Integer_Text_IO;
with ada.Text_IO; use ada.Text_IO;

procedure sudoku is
-- pre requis : aucun
-- action : resoud une grille de sudoku
-- strategie : decoupage en plusieurs procedures et fonctions

type Tcarre is array (1..9,1..9) of integer; -- matrice de jeu

type Tvectpossibles is array (1..9) of boolean;
type Tpossibles is record
vect:Tvectpossibles; -- vecteur des chiffres possibles
nb:integer; -- nombre de chiffres possibles
end record;

type Tcube is array (1..9,1..9) of Tpossibles; -- matrice des possibles

procedure affiche (mat:in Tcarre) is
-- pre requis : aucun
-- action : affiche la matrice sous la forme du jeu de sudoku
-- strategie : parcours total. on affiche une par une les valeurs des cases
begin
for I in 1..9
loop
if I=4 or I=7
then
new_line;
end if;
for J in 1..9
loop
if J=4 or J=7
then
put(" ");
end if;
put(mat(I,J),2);
end loop;
new_line;
end loop;
end affiche;

function plusdecasesnulles (mat:in Tcarre) return boolean is
-- pre requis : la matrice est correctement initialisee
-- resultat : retour vrai si la matrice est remplie, faux sinon (il reste des cases a zero)
-- strategie : parcours partiel. si on trouve un zero on s'arrete, sinon on continue
I:integer:=1; -- indice des lignes
J:integer; -- indice des colonnes
result:boolean:=true; -- vrai si il n'y a pas de cases nulles
begin
while I<=9 and then result
loop
J:=1;
while J<=9 and then result
loop
if mat(I,J)=0
then
result:=false;
end if;
J:=J+1;
end loop;
I:=I+1;
end loop;
return result;
end plusdecasesnulles;

function existedansligne (mat:in Tcarre; lig:in integer; x:in integer) return boolean is
-- pre requis : la matrice est correctement initialisee
-- resultat : retourne vrai si x existe dans la ligne lig, faux sinon
-- strategie : parcours partiel de la ligne lig
I:integer:=1; -- indice des colonnes
begin
while I<=9 and then mat(lig,I)/=x
loop
I:=I+1;
end loop;
return I<=9;
end existedansligne;

function existedanscolonne (mat:in Tcarre; col:in integer; x:in integer) return boolean is
-- pre requis : la matrice est correctement initialisee
-- resultat : retourne vrai si x existe dans la colonne col, faux sinon
-- strategie : parcours partiel de la colonne col
I:integer:=1; -- indice des lignes
begin
while I<=9 and then mat(I,col)/=x
loop
I:=I+1;
end loop;
return I<=9;
end existedanscolonne;

function existedansregion (mat:in Tcarre; lig,col:in integer; x:in integer) return boolean is
-- pre requis : la matrice est correctement initialisee
-- resultat : retourne vrai si x existe dans la region indicees par (lig,col), faux sinon
-- strategie : parcours partiel de la region
I:integer:=lig*3-2; -- indice des lignes
J:integer; -- indice des colonnes
result:boolean:=false; -- faux si le nombre n'existe pas
begin
while I<=lig*3 and then not result
loop
J:=col*3-2;
while J<=col*3 and then not result
loop
if mat (I,J)=x
then
result:=true;
end if;
J:=J+1;
end loop;
I:=I+1;
end loop;
return result;
end existedansregion;

procedure initlespossibles (cube:out Tcube) is
-- pre requis : aucun
-- action : initialise tout le cube a faux
-- strategie : parcours total
begin
for I in 1..9
loop
for J in 1..9
loop
cube(I,J).nb:=0;
for K in 1..9
loop
cube(I,J).vect(K):=false;
end loop;
end loop;
end loop;
end initlespossibles;

procedure valeurspossibles (mat:in Tcarre; cube:in out Tcube) is
-- pre requis : la matrice et le cube sont correctement initialises
-- action : calcule les valeurs possibles de chaque nombre
-- strategie : parcours total de la matrice
begin
for I in 1..9
loop
for J in 1..9
loop
if mat(I,J)=0
then
for K in 1..9
loop
if not existedansligne (mat,I,K) and not existedanscolonne (mat,J,K) and not existedansregion (mat,((I-1)/3)+1,((J-1)/3)+1,K)
then
cube(I,J).vect(K):=true;
cube(I,J).nb:=cube(I,J).nb+1;
end if;
end loop;
end if;
end loop;
end loop;
end valeurspossibles;

function seulpossibledansligne (mat:in Tcarre; cube:in Tcube; lig,x:in integer) return boolean is
-- pre requis : la matrice est correctement initialisee
-- resultat : retourne vrai si x est le seul possible dans la ligne, faux sinon
-- strategie : parcours partiel de la ligne lig
cpt:integer:=0; -- compteur de l'occurence du nombre
I:integer:=1; -- indice de ligne
begin
while I<=9 and then cpt<=1
loop
if mat(lig,I)=0
then
if cube(lig,I).vect(x)
then
cpt:=cpt+1;
end if;
end if;
I:=I+1;
end loop;
return cpt=1;
end seulpossibledansligne;

function seulpossibledanscolonne (mat:in Tcarre; cube:in Tcube; col,x:in integer) return boolean is
-- pre requis : la matrice est correctement initialisee
-- resultat : retourne vrai si x est le seul possible dans la colonne, faux sinon
-- strategie : parcours partiel de la colonne col
cpt:integer:=0; -- compteur de l'occurence du nombre
I:integer:=1; -- indice de colonne
begin
while I<=9 and then cpt<=1
loop
if mat(I,col)=0
then
if cube(I,col).vect(x)
then
cpt:=cpt+1;
end if;
end if;
I:=I+1;
end loop;
return cpt=1;
end seulpossibledanscolonne;

function seulpossibledansregion (mat:in Tcarre; cube:in Tcube; lig,col,x:in integer) return boolean is
-- pre requis : la matrice est correctement initialisee
-- resultat : retourne vrai si x est le seul possible dans la region, faux sinon
-- strategie : parcours partiel de la region
cpt:integer:=0; -- compteur de l'occurence du nombre
I:integer:=lig*3-2; -- indice de ligne
J:integer; -- indice de colonne
begin
while I<=lig*3 and then cpt<=1
loop
J:=col*3-2;
while J<=col*3 and then cpt<=1
loop
if mat(I,J)=0
then
if cube(I,J).vect(x)
then
cpt:=cpt+1;
end if;
end if;
J:=J+1;
end loop;
I:=I+1;
end loop;
return cpt=1;
end seulpossibledansregion;

function candidatunique (mat:in Tcarre; cube:in Tcube; lig,col,x:in integer) return boolean is
-- pre requis : la matrice et le cube sont correctement initialises
-- resultat : retourne vrai si x est le seul possible pour une case donnee, faux sinon
-- strategie : si le chiffre est le seul possible dans la ligne ou la colonne ou la region,
-- alors la valeur est verifiee
begin
if (seulpossibledansligne (mat,cube,lig,x) or seulpossibledanscolonne (mat,cube,col,x)
or seulpossibledansregion (mat,cube,((lig-1)/3)+1,((col-1)/3)+1,x))
then
return true;
else
return false;
end if;
end candidatunique;

procedure transform_coord (I:in integer; k1,k2:out integer) is
-- pre requis : aucun
-- action : donne les coordonnees des 2 autres lignes ou
-- colonnes a partir d'un numero de ligne ou colonne
-- strategie : utilisation du modulo
begin
if I mod 3=1
then
k1:=1; k2:=2;
elsif I mod 3=2
then
k1:=-1; k2:=1;
else
k1:=-1; k2:=-2;
end if;
end transform_coord;

function positionunique (mat:in Tcarre; I,J,x:in integer) return boolean is
-- pre requis : la matrice est correctement initialisee
-- resultat : retourne vrai si la position du chiffre est unique, faux sinon
-- strategie : on regardes si les autres cases sont occupees
l1,l2:integer; -- lignes
c1,c2:integer; -- colonnes
begin
transform_coord (I,l1,l2); transform_coord (J,c1,c2);
if ((existedansligne (mat,I+l1,x) and existedansligne (mat,I+l2,x) and existedanscolonne (mat,J+c1,x) and existedanscolonne (mat,J+c2,x))
or (existedansligne (mat,I+l1,x) and existedansligne (mat,I+l2,x) and mat(I+l1,J)/=0 and mat(I+l2,J)/=0)
or (existedanscolonne (mat,J+c1,x) and existedanscolonne (mat,J+c2,x) and mat(I,J+c1)/=0 and mat(I,J+c2)/=0))
then
return true;
else
return false;
end if;
end positionunique;

procedure jeu (mat:in out Tcarre; cube:in out Tcube) is
begin
initlespossibles (cube);
valeurspossibles (mat,cube);
while not plusdecasesnulles (mat)
loop
for I in 1..9
loop
for J in 1..9
loop
if mat(I,J)=0
then
for K in 1..9
loop
if candidatunique (mat,cube,I,J,K) or positionunique (mat,I,J,K)
then
mat(I,J):=K;
cube(I,J).vect(K):=false;
cube(I,J).nb:=cube(I,J).nb-1;
valeurspossibles (mat,cube);
end if;
end loop;
end if;
end loop;
end loop;
end loop;
end jeu;

cube:Tcube;
mat:Tcarre:=((1,3,7,0,2,8,0,6,5),(0,0,5,0,7,0,4,3,0),(0,0,6,1,3,0,2,0,0),
(5,8,0,7,0,0,3,0,2),(0,0,4,3,0,2,1,0,0),(2,0,3,0,0,1,0,8,6),
(0,0,8,0,1,4,6,0,0),(0,1,2,0,6,0,5,0,0),(4,6,0,2,5,0,8,1,7));
begin
affiche (mat); new_line;
jeu (mat,cube);
put("--------------------");
new_line;
affiche (mat);
end sudoku;
Configuration: Windows XP
Firefox 2.0.0.12

4 réponses

  • Votes
  • Date
  • Date décroissante
  1. sauliwx
    Celle-ci marche mais pas totalement, voici la version qui marche à tout les coup (et qui un peu plus jolie niveau prog)
    Les commentaires dans la procédure Jeu permettent l'affichage de chaque étape de remplissage.
    Par contre il n'y a pas les prérequis et la procédure Affiche est un peu custom. 

    with Ada.Text_IO;         use Ada.Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;

procedure Main is

   --------------------------------------------------

   type TCarre is array (1 .. 9, 1 .. 9) of Integer;
   type TPossibles is array (1 .. 9) of Boolean;
   type TVectPossibles is record
      nb   : Integer;
      vect : TPossibles;
   end record;
   type TCube is array (1 .. 9, 1 .. 9) of TVectPossibles;
   type TVectCarre is array (1 .. 40) of TCarre;
   type TVectCoord is array (1 .. 40, 1 .. 4) of Integer;

   --------------------------------------------------

   procedure Affiche (Sud : in TCarre) is
   begin
      Put (" =========================================");
      New_Line;
      for I in 1 .. 9 loop
         for J in 1 .. 9 loop
            if J mod 3 = 1 then
               Put (" || ");
               if Sud (I,J) = 0 then
                  put (" ");
               else
                  Put (Sud (I, J), 1);
               end if;
            else
               Put (" | ");
               if Sud (I,J) = 0 then
                  put (" ");
               else
                  Put (Sud (I, J), 1);
               end if;
            end if;
         end loop;
         Put (" || ");
         if I mod 3 = 0 then
            New_Line;
            Put (" =========================================");
            New_Line;
         else
            New_Line;
            Put (" -----------------------------------------");
            New_Line;
         end if;
      end loop;
   end Affiche;

   --------------------------------------------------

   procedure Recopie (Sud : in TCarre; Sud_bis : out TCarre) is
   begin
      Sud_bis := Sud;
   end Recopie;

   --------------------------------------------------

   function PlusDeCasesNulles (Sud : TCarre) return Boolean is
      cpt : Integer := 0;
   begin
      for I in 1 .. 9 loop
         for J in 1 .. 9 loop
            if Sud (I, J) = 0 then
               cpt := cpt + 1;
            end if;
         end loop;
      end loop;
      return cpt = 0;
   end PlusDeCasesNulles;

   --------------------------------------------------

   function ExisteDansLigne
     (Sud    : TCarre;
      Lig    : Integer;
      Valeur : Integer)
      return   Boolean
   is
      cpt : Integer := 0;
      I   : Integer := 1;
   begin
      for I in 1 .. 9 loop
         if Sud (Lig, I) = Valeur then
            cpt := cpt + 1;
         end if;
      end loop;
      return cpt /= 0;
   end ExisteDansLigne;

   --------------------------------------------------

   function ExisteDansColonne
     (Sud    : TCarre;
      Col    : Integer;
      Valeur : Integer)
      return   Boolean
   is
      cpt : Integer := 0;
      I   : Integer := 1;
   begin
      for I in 1 .. 9 loop
         if Sud (I, Col) = Valeur then
            cpt := cpt + 1;
         end if;
      end loop;
      return cpt /= 0;
   end ExisteDansColonne;

   --------------------------------------------------

   function ExisteDansRegion
     (Sud    : TCarre;
      lig    : Integer;
      col    : Integer;
      Valeur : Integer)
      return   Boolean
   is
      X     : Integer := ((lig - 1) / 3) * 3 + 1;
      Y     : Integer := ((col - 1) / 3) * 3 + 1;
      X_bis : Integer := X + 2;
      Y_bis : Integer := Y + 2;
      cpt   : Integer := 0;
   begin
      for I in X .. X_bis loop
         for J in Y .. Y_bis loop
            if Sud (I, J) = Valeur then
               cpt := cpt + 1;
            end if;
         end loop;
      end loop;
      return cpt /= 0;
   end ExisteDansRegion;

   --------------------------------------------------

   procedure InitLesPossibles (VectPoss : out TVectPossibles) is
   begin
      VectPoss.nb := 0;
      for I in 1 .. 9 loop
         VectPoss.vect (I) := False;
      end loop;
   end InitLesPossibles;

   --------------------------------------------------

   procedure InitCube (Cub : out TCube) is
   begin
      for I in 1 .. 9 loop
         for J in 1 .. 9 loop
            InitLesPossibles (Cub (I, J));
         end loop;
      end loop;
   end InitCube;

   --------------------------------------------------

   procedure ValeursPossiblesJeu (Sud : in TCarre; Cub : out TCube) is
   begin
      for I in 1 .. 9 loop
         for J in 1 .. 9 loop
            if Sud (I, J) = 0 then
               for K in 1 .. 9 loop
                  if not ExisteDansLigne (Sud, I, K) and
                     not ExisteDansColonne (Sud, J, K) and
                     not ExisteDansRegion (Sud, I, J, K)
                  then
                     Cub (I, J).vect (K) := True;
                     Cub (I, J).nb       := Cub (I, J).nb + 1;
                  end if;
               end loop;
            end if;
         end loop;
      end loop;
   end ValeursPossiblesJeu;

   --------------------------------------------------

   function SeulPossibleDansLigne
     (Cub    : TCube;
      Lig    : Integer;
      valeur : Integer)
      return   Boolean
   is
      cpt : Integer := 0;
   begin
      for I in 1 .. 9 loop
         if Cub (Lig, I).vect (valeur) then
            cpt := cpt + 1;
         end if;
      end loop;
      return cpt = 1;
   end SeulPossibleDansLigne;

   --------------------------------------------------

   function SeulPossibleDansColonne
     (Cub    : TCube;
      Col    : Integer;
      valeur : Integer)
      return   Boolean
   is
      cpt : Integer := 0;
   begin
      for I in 1 .. 9 loop
         if Cub (I, Col).vect (valeur) then
            cpt := cpt + 1;
         end if;
      end loop;
      return cpt = 1;
   end SeulPossibleDansColonne;

   --------------------------------------------------

   function SeulPossibleDansRegion
     (Cub    : TCube;
      lig    : Integer;
      col    : Integer;
      valeur : Integer)
      return   Boolean
   is
      Cpt   : Integer := 0;
      X     : Integer := ((lig - 1) / 3) * 3 + 1;
      Y     : Integer := ((col - 1) / 3) * 3 + 1;
      X_bis : Integer := X + 2;
      Y_bis : Integer := Y + 2;
   begin
      for I in X .. X_bis loop
         for J in Y .. Y_bis loop
            if Cub (I, J).vect (valeur) then
               Cpt := Cpt + 1;
            end if;
         end loop;
      end loop;
      return Cpt = 1;
   end SeulPossibleDansRegion;

   --------------------------------------------------

   function CandidatUnique
     (Cub    : TCube;
      lig    : Integer;
      col    : Integer;
      valeur : Integer)
      return   Boolean
   is
   begin
      if Cub (lig, col).nb = 1 or
         SeulPossibleDansLigne (Cub, lig, valeur) or
         SeulPossibleDansColonne (Cub, col, valeur) or
         SeulPossibleDansRegion (Cub, lig, col, valeur)
      then
         return True;
      else
         return False;
      end if;
   end CandidatUnique;

   --------------------------------------------------

   procedure VARIATION_COORD (num : in Integer; k1, k2 : out Integer) is
   -- pré-requis : num est compris entre 1 et 9
   -- action : cf TP
   begin
      if num mod 3 = 1 then
         k1 := num + 1;
         k2 := num + 2;
      elsif num mod 3 = 2 then
         k1 := num - 1;
         k2 := num + 1;
      else
         k1 := num - 1;
         k2 := num - 2;
      end if;
   end VARIATION_COORD;

   --------------------------------------------------

   function PositionUnique
     (Sud    : TCarre;
      Cub    : TCube;
      Lig    : Integer;
      Col    : Integer;
      Valeur : Integer)
      return   Boolean
   is
      Lig1 : Integer;
      Lig2 : Integer;
      Col1 : Integer;
      Col2 : Integer;
   begin
      VARIATION_COORD (Lig, Lig1, Lig2);
      VARIATION_COORD (Col, Col1, Col2);
      if (ExisteDansLigne (Sud, Lig1, Valeur) and
          ExisteDansLigne (Sud, Lig2, Valeur) and
          ExisteDansColonne (Sud, Col1, Valeur) and
          ExisteDansColonne (Sud, Col2, Valeur)) or
         (ExisteDansLigne (Sud, Lig1, Valeur) and
          ExisteDansLigne (Sud, Lig2, Valeur) and
          Sud (Lig, Col1) /= 0 and
          Sud (Lig, Col2) /= 0) or
         (ExisteDansColonne (Sud, Col1, Valeur) and
          ExisteDansColonne (Sud, Col2, Valeur) and
          Sud (Lig1, Col) /= 0 and
          Sud (Lig2, Col) /= 0)
      then
         return True;
      else
         return False;
      end if;
   end PositionUnique;

   --------------------------------------------------

   procedure Jeu (Sud : in TCarre; Sud2 : out TCarre) is
      Cub : TCube;
   begin
      Recopie (Sud, Sud2);
      InitCube (Cub);
      ValeursPossiblesJeu (Sud2, Cub);
      while not PlusDeCasesNulles (Sud2) loop
         for I in 1 .. 9 loop
            for J in 1 .. 9 loop
               for K in 1 .. 9 loop
                  if Cub (I, J).vect (K) and
                     (CandidatUnique (Cub, I, J, K) or
                      PositionUnique (Sud2, Cub, I, J, K))
                  then
                     Sud2 (I, J) := K;
                     InitCube (Cub);
                     ValeursPossiblesJeu (Sud2, Cub);
                     --New_Line (9);
                     --Affiche (Sud2);
                  end if;
               end loop;
            end loop;
         end loop;
      end loop;
   end Jeu;

   --------------------------------------------------

   procedure Init (Sud : out TCarre) is
   begin
      for I in 1 .. 9 loop
         for J in 1 .. 9 loop
            Sud (I, J) := 0;
         end loop;
      end loop;
   end Init;

   --------------------------------------------------

   L    : Integer;
   C    : Integer;
   Nbr  : Integer;
   Sud  : TCarre;
   Sud2 : TCarre;
begin
   Init (Sud);
   Put(
"Entrez les coordonées du chiffre voulu suivit du chiffre lui même et terminez par 000"
);
   Get (L);
   Get (C);
   Get (Nbr);
   while L /= 0 loop
      Sud (L, C) := Nbr;
      Get (L);
      Get (C);
      Get (Nbr);
   end loop;
   Affiche (Sud);
   Jeu (Sud, Sud2);
   New_line (3);
   Affiche (Sud2);
end Main;
    1.  gaara_40
      Pour ceux qui essayerait de s'inspirer de ce code, je vous conseille plutôt de partir sur une matrice 9*9 mais dans chaque case, au lieu de mettre directement un chiffre entre 0 et 9, mettez plutôt un tableau comprenant tous les chiffres de 1 à 9 et vous les remplacez petit à petit par des zéros, et quand il ne vous restera plus que des 0 et un seul chiffre ce sera CE chiffre ;o). J'ai fait programme de résolution de grille avec ce principe et il s'en sort pas mal jusqu'au niveau moyen mais après il kiffe pas XD.

      Désolé pascalou34 de pas te donner la solution à ton problème, j'ai compilé ton code rapidement et j'ai vu en effet qu'il y avait les mêmes chiffres sur la même ligne cependant j'ai pas cherché plus loin, j'avais un peu la flegme. De toute façon, je pense que tu as du trouver la solution depuis longtemps XP, ça fait quand même 2 ans que t'as posté ce message.
      1. Falindir
        le dernier programme me semble bon à part peut être la procédure affiche qui semble bizarre. Mais en fait le programme n'est pas finit car il manque la partit 2 avec les procédures qui résous toute les difficulté du sudoku.
        1. tom
          Pour les futur génération d'élève de l'iut informatique de montpellier j'ai le bonheur de vous annoncer que vous n'aurais plus a travailler. Non non c juste une aide alors bonne chance. A.T! génération 2011-2012.

          WITH Ada.Integer_Text_IO;
          USE Ada.Integer_Text_IO;
          WITH Ada.Text_IO;
          USE Ada.Text_IO;

          PROCEDURE Sudoku IS
          -- pre requis : aucun
          -- action : resoud une grille de sudoku
          -- strategie : decoupage en plusieurs procedures et fonctions

          TYPE TCarre IS ARRAY (1 .. 9, 1 .. 9) OF Integer;
          TYPE TPossible IS ARRAY (1 .. 9) OF Boolean;
          TYPE TVectPossibles IS
          RECORD
          NB : Integer;
          Vect : TPossible;
          END RECORD;
          TYPE TCube IS ARRAY (1 .. 9, 1 .. 9) OF TVectPossibles;

          -------------------------------------------------------------------------------------------

          PROCEDURE Transform_Coord (
          I : IN Integer;
          K1,
          K2 : OUT Integer;
          A : Integer) IS

          -- pre requis : aucun
          -- action : donne les coordonnees des 2 autres lignes ou
          -- colonnes a partir d'un numero de ligne ou colonne
          -- strategie : utilisation du modulo

          BEGIN

          IF I mod 3=1 THEN
          IF A = 1 THEN
          K1:= I+1;
          K2:= I+2;
          ELSIF A = 2 THEN
          K1 := I;
          K2 := I+2;
          END IF;
          ELSIF I mod 3=2 THEN
          K1:= I-1;
          K2:= I+1;
          ELSIF I mod 3 = 0 THEN
          IF A = 1 THEN
          K1:= I-1;
          K2:= I-2;
          ELSIF A = 2 THEN
          K1 := I-2;
          K2 := I;
          END IF;
          END IF;

          END Transform_Coord;

          -------------------------------------------------------------------------------------------

          PROCEDURE Affiche (
          Mat : IN TCarre) IS

          -- pre requis : aucun
          -- action : affiche la matrice sous la forme du jeu de sudoku
          -- strategie : parcours total. on affiche une par une les valeurs des cases

          BEGIN

          New_Line(2);

          FOR I IN 1..9 LOOP
          IF I=4 OR I=7 THEN
          New_Line;
          END IF;
          FOR J IN 1..9 LOOP
          IF J=4 OR J=7 THEN
          Put(" ");
          END IF;
          IF Mat(I,J) = 0 THEN
          Put (" ");
          ELSE
          Put(Mat(I,J),2);
          END IF;
          END LOOP;
          New_Line;
          END LOOP;

          END Affiche;

          -------------------------------------------------------------------------------------------

          PROCEDURE Recopie (
          Mat : TCarre) IS

          -- pre requis : aucun
          -- resultat : duplique la matrice initiale

          Copie : TCarre;

          BEGIN

          Copie := Mat;

          END Recopie;

          -------------------------------------------------------------------------------------------

          FUNCTION PlusDeCasesNulles (
          Mat : IN Tcarre)
          RETURN Boolean IS

          -- pre requis : la matrice est correctement initialisee
          -- resultat : retour vrai si la matrice est remplie, faux sinon (il reste des cases a zero)
          -- strategie : parcours partiel. si on trouve un zero on s'arrete, sinon on continue

          BEGIN

          FOR I IN 1..9 LOOP
          FOR J IN 1..9 LOOP
          IF Mat (I,J) = 0 THEN
          RETURN (False);
          END IF;
          END LOOP;
          END LOOP;
          RETURN (True);

          END PlusDeCasesNulles;

          -------------------------------------------------------------------------------------------

          FUNCTION ExisteDansLigne (
          Mat : IN Tcarre;
          Ligne : IN Integer;
          X : IN Integer)
          RETURN Boolean IS

          -- pre requis : la matrice est correctement initialisee
          -- resultat : retourne vrai si x existe dans la ligne lig, faux sinon
          -- strategie : parcours partiel de la ligne lig

          BEGIN

          FOR I IN 1..9 LOOP
          IF Mat (Ligne, I) = X THEN
          RETURN (True);
          END IF;
          END LOOP;
          RETURN False;

          END ExisteDansLigne;

          -------------------------------------------------------------------------------------------

          FUNCTION ExisteDansColonne (
          Mat : IN Tcarre;
          Colonne : IN Integer;
          X : IN Integer)
          RETURN Boolean IS

          -- pre requis : la matrice est correctement initialisee
          -- resultat : retourne vrai si x existe dans la colonne col, faux sinon
          -- strategie : parcours partiel de la colonne col

          BEGIN

          FOR I IN 1..9 LOOP
          IF Mat (I, Colonne) = X THEN
          RETURN (True);
          END IF;
          END LOOP;
          RETURN (False);

          END ExisteDansColonne;

          -------------------------------------------------------------------------------------------

          FUNCTION ExisteDansRegion (
          Mat : IN Tcarre;
          I,
          J : IN Integer;
          X : IN Integer)
          RETURN Boolean IS

          -- pre requis : la matrice est correctement initialisee
          -- resultat : retourne vrai si x existe dans la region indicees par (lig,col), faux sinon
          -- strategie : parcours partiel de la region

          L1,
          L2 : Integer; -- lignes
          C1,
          C2 : Integer; -- colonnes

          BEGIN

          Transform_Coord (I, L1, L2, 2);
          Transform_Coord (J, C1, C2, 2);

          FOR I IN L1..L2 LOOP
          FOR J IN C1..C2 LOOP
          IF Mat (I, J) = X THEN
          RETURN (True);
          END IF;
          END LOOP;
          END LOOP;
          RETURN (False);

          END ExisteDansRegion;

          -------------------------------------------------------------------------------------------

          PROCEDURE InitLesPossibles (
          Possibles : OUT TVectPossibles) IS

          -- pre requis : aucun
          -- action : initialise les deux champ de TVectPossible
          -- strategie : parcours total

          BEGIN

          FOR I IN 1..9 LOOP
          Possibles.Vect (I) := False;
          END LOOP;
          Possibles.Nb :=0;

          END InitLesPossibles;

          -------------------------------------------------------------------------------------------

          PROCEDURE InitCube (
          Cube : OUT TCube) IS

          -- pre requis : aucun
          -- action : initialise tout le cube a faux
          -- strategie : parcours total

          BEGIN

          FOR I IN 1..9 LOOP
          FOR J IN 1..9 LOOP
          Cube(I,J).Nb := 0;
          FOR K IN 1..9 LOOP
          Cube(I,J).Vect(K) := False;
          END LOOP;
          END LOOP;
          END LOOP;

          END InitCube;

          -------------------------------------------------------------------------------------------

          PROCEDURE ValeursPossiblesJeu (
          Mat : IN Tcarre;
          Cube : IN OUT Tcube) IS

          -- pre requis : la matrice et le cube sont correctement initialises
          -- action : calcule les valeurs possibles de chaque nombre
          -- strategie : parcours total de la matrice

          BEGIN

          FOR I IN 1..9 LOOP
          FOR J IN 1..9 LOOP
          IF Mat(I,J)=0 THEN
          FOR K IN 1..9 LOOP
          IF NOT Existedansligne (Mat,I,K) AND NOT Existedanscolonne (Mat,J,K) AND NOT Existedansregion (Mat,I,J,K) THEN
          Cube(I,J).Vect(K):=True;
          Cube(I,J).Nb:=Cube(I,J).Nb+1;
          END IF;
          END LOOP;
          END IF;
          END LOOP;
          END LOOP;

          END ValeursPossiblesJeu;

          -------------------------------------------------------------------------------------------

          FUNCTION SeulPossibleDansLigne (
          Cube : TCube;
          Lig : Integer;
          X : Integer)
          RETURN Boolean IS

          -- pre requis : la matrice est correctement initialisee
          -- resultat : retourne vrai si x est le seul possible dans la ligne, faux sinon
          -- strategie : parcours partiel de la ligne lig

          Cpt : Integer := 0;

          BEGIN

          FOR I IN 1..9 LOOP
          IF Cube ( Lig, I ).Vect(X) THEN
          Cpt := Cpt + 1;
          END IF;
          END LOOP;
          RETURN (Cpt=1);

          END SeulPossibleDansLigne;

          -------------------------------------------------------------------------------------------

          FUNCTION SeulPossibleDansColonne (
          Cube : TCube;
          Col : Integer;
          X : Integer)
          RETURN Boolean IS

          -- pre requis : la matrice est correctement initialisee
          -- resultat : retourne vrai si x est le seul possible dans la colonne, faux sinon
          -- strategie : parcours integrel de la colonne col
          Cpt : Integer := 0;

          BEGIN

          FOR I IN 1..9 LOOP
          IF Cube ( Col, I ).Vect(X) THEN
          Cpt := Cpt + 1;
          END IF;
          END LOOP;
          RETURN (Cpt=1);

          END SeulPossibleDansColonne;

          -------------------------------------------------------------------------------------------

          FUNCTION SeulPossibleDansRegion (
          Cube : TCube;
          Lig : Integer;
          Col : Integer;
          X : Integer)
          RETURN Boolean IS

          -- pre requis : la matrice est correctement initialisee
          -- resultat : retourne vrai si x est le seul possible dans la region, faux sinon
          -- strategie : parcours integrel

          Cpt : Integer := 0;
          L1,
          L2 : Integer; -- lignes
          C1,
          C2 : Integer; -- colonnes

          BEGIN

          Transform_Coord (Lig, L1, L2, 2);
          Transform_Coord (Col, C1, C2, 2);

          FOR I IN L1..L2 LOOP
          FOR J IN C1..C2 LOOP
          IF Cube ( I, J ).Vect(X) THEN
          Cpt := Cpt + 1;
          END IF;
          END LOOP;
          END LOOP;
          RETURN (Cpt=1);

          END SeulPossibleDansRegion;

          -------------------------------------------------------------------------------------------

          FUNCTION CandidatUnique (
          Cube : IN Tcube;
          Mat : IN TCarre;
          Lig,
          Col,
          X : IN Integer)
          RETURN Boolean IS

          -- pre requis : la matrice et le cube sont correctement initialises
          -- resultat : retourne vrai si x est le seul possible pour une case donnee, faux sinon
          -- strategie : si le chiffre est le seul possible dans la ligne ou la colonne ou la region,
          -- alors la valeur est verifiee

          BEGIN

          IF (SeulPossibleDansLigne (Cube, Lig, X ) OR SeulPossibleDansColonne (Cube, Col, X) OR SeulPossibleDansRegion ( Cube, Lig, Col, X ))THEN

          RETURN ( True );
          ELSE
          RETURN ( False );
          END IF;

          END CandidatUnique;

          -------------------------------------------------------------------------------------------

          FUNCTION PositionUnique (
          Mat : IN TCarre;
          I,
          J,
          X : IN Integer)
          RETURN Boolean IS

          -- pre requis : la matrice est correctement initialisee
          -- resultat : retourne vrai si la position du chiffre est unique, faux sinon
          -- strategie : on regardes si les autres cases sont occupees

          Cpt,
          Cpt1 : Integer := 0;
          L1,
          L2 : Integer; -- lignes
          C1,
          C2 : Integer; -- colonnes

          BEGIN

          Transform_Coord (I,L1,L2,1);
          Transform_Coord (J,C1,C2,1);

          FOR Z IN L1..L2 LOOP
          IF Mat ( I, Z ) = 0 THEN
          Cpt := Cpt + 1;
          END IF;
          END LOOP;

          FOR E IN C1..C2 LOOP
          IF Mat ( E, J ) = 0 THEN
          Cpt1 := Cpt1 + 1;
          END IF;
          END LOOP;

          IF ((ExisteDansLigne (Mat, L1, X) AND ExisteDansLigne (Mat, L2, X) AND ExisteDansColonne (Mat, C1, X) AND ExisteDansColonne (Mat, C2, X) )
          OR (ExisteDansLigne (Mat, L1, X) AND ExisteDansLigne (Mat, L2, X) AND Cpt1 = 1)
          OR (ExisteDansColonne (Mat, C1, X) AND ExisteDansColonne (Mat, C2, X) AND Cpt = 1)) THEN

          RETURN ( True );
          ELSE
          RETURN ( False );
          END IF;

          END PositionUnique;

          -------------------------------------------------------------------------------------------

          PROCEDURE Jeu (
          Mat : IN OUT TCarre;
          Cube : IN OUT TCube;
          Possibles : IN OUT TVectPossibles) IS

          BEGIN

          InitCube ( Cube );
          InitLesPossibles ( Possibles );
          ValeursPossiblesJeu ( Mat, Cube );

          WHILE NOT PlusDeCasesNulles (Mat) LOOP
          FOR I IN 1..9 LOOP
          FOR J IN 1..9 LOOP
          IF Mat(I,J)=0 THEN
          FOR K IN 1..9 LOOP

          IF (PositionUnique (Mat,I,J,K)
          OR CandidatUnique (Cube,Mat,I,J,K))
          AND NOT Existedansligne (Mat, I, K)
          AND NOT Existedanscolonne (Mat, J, K)
          AND NOT Existedansregion (Mat, I, J, K)THEN
          IF Cube (I,J).Vect (K) THEN
          Mat(I,J):=K;
          FOR Z IN 1..9 LOOP
          Cube(I,J).Vect(Z):=False;
          END LOOP;
          Cube(I,J).Nb:=Cube(I,J).Nb-1;
          ValeursPossiblesJeu ( Mat, Cube );
          END IF;
          END IF;

          END LOOP;
          END IF;
          END LOOP;
          END LOOP;
          END LOOP;

          END Jeu;

          Possibles : TVectPossibles;
          Cube : Tcube;
          Mat : Tcarre := (
          (1, 3, 7, 0, 2, 8, 0, 6, 5),
          (0, 0, 5, 0, 7, 0, 4, 3, 0),
          (0, 0, 6, 1, 3, 0, 2, 0, 0),
          (5, 8, 0, 7, 0, 0, 3, 0, 2),
          (0, 0, 4, 3, 0, 2, 1, 0, 0),
          (2, 0, 3, 0, 0, 1, 0, 8, 6),
          (0, 0, 8, 0, 1, 4, 6, 0, 0),
          (0, 1, 2, 0, 6, 0, 5, 0, 0),
          (4, 6, 0, 2, 5, 0, 8, 1, 7)
          );

          BEGIN

          Affiche (Mat);
          New_Line;
          Jeu (Mat,Cube, Possibles);
          Put("--------------------");
          New_Line;
          Affiche (Mat);

          END Sudoku;

          Discussions similaires

          Mise en veille de téléviseur tcl
          Othmane

          17 réponses
          Fonctionnement de télécommande fpe/ref:80019
          Chris44_5823

          6 réponses
          enregistrer avec FREEBOX POP
          BIGA26

          2 réponses
          Télécommande universel grundig pas de code
          Zaboux

          1 réponse
          Enregistrement sur TV LG 6300
          01armagedon

          3 réponses