Guest User

Untitled

a guest
May 5th, 2018
107
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Ada 15.05 KB | None | 0 0
  1. WITH Ada.Text_IO, Ada.Integer_Text_IO;
  2. USE Ada.Text_IO, Ada.Integer_Text_IO;
  3.  
  4. PROCEDURE Sudoku IS
  5.  
  6.    --------------------------- ETAPE 1 : DECLARATION DES TYPES ---------------------------
  7.  
  8.    TYPE TCarre IS ARRAY (Integer RANGE 1 .. 9, Integer RANGE 1 .. 9) OF Integer;
  9.    TYPE TPossibles IS ARRAY (Integer RANGE 1 .. 9) OF Boolean;
  10.    TYPE TVectPossibles IS
  11.       RECORD
  12.          Nb   : Integer;
  13.          Vect : Tpossibles;
  14.       END RECORD;
  15.    TYPE TCube IS ARRAY (Integer RANGE 1 .. 9, Integer RANGE 1 .. 9) OF TVectPossibles;
  16.    TYPE TVectCarre IS ARRAY (1 .. 40) OF Tcarre;
  17.    TYPE TVectCoord IS ARRAY (1 .. 40, 1 .. 4) OF Integer;
  18.  
  19.  
  20.    --------------------------- DECLARATION DES VARIABLES ---------------------------
  21.  
  22.    Sudoku  : TvectPossibles;
  23.    Grille,
  24.    Grille2 : TCarre;
  25.    Cube    : TCube;
  26.    H,
  27.    X,
  28.    Y,
  29.    Z       : Integer;
  30.    Rep,Rep2     : String (1 .. 3);
  31.    change : integer := 1;
  32.  
  33.  
  34.  
  35.    --------------------------- ETAPE 2 : Procédures et fonctions de base de la grille de jeu ---------------------------
  36.    PROCEDURE Affiche (
  37.          Mat : IN     TCarre) IS
  38.       X : Integer := 0;
  39.    BEGIN
  40.       FOR I IN 1..9 LOOP
  41.          FOR J IN 1..9 LOOP
  42.             X := Mat(I,J);
  43.             IF (X = 0) THEN
  44.                Put("x");
  45.             ELSE
  46.  
  47.                Put(X,0);
  48.             END IF;
  49.             Put("  ");
  50.             IF (J = 3) OR (J = 6) THEN
  51.                Put("|");
  52.                Put("  ");
  53.             END IF;
  54.  
  55.          END LOOP;
  56.          New_Line(2);
  57.          IF (I = 3) OR (I = 6) THEN
  58.             Put("--------------------------------");
  59.             New_Line(2);
  60.          END IF;
  61.  
  62.       END LOOP;
  63.    END Affiche;
  64.  
  65.    PROCEDURE Recopie (
  66.          Mat  : IN     TCarre;
  67.          Mat2 :    OUT TCarre) IS
  68.    BEGIN
  69.       FOR I IN 1..9 LOOP
  70.          FOR J IN 1..9 LOOP
  71.             Mat2(I,J) := Mat(I,J);
  72.          END LOOP;
  73.       END LOOP;
  74.    END Recopie;
  75.  
  76.    FUNCTION PlusDeCasesNulles (
  77.          Mat : IN     TCarre)
  78.      RETURN Boolean IS
  79.       Flag : Boolean := True;
  80.    BEGIN
  81.       FOR I IN 1..9 LOOP
  82.          FOR J IN 1..9 LOOP
  83.             IF (Mat(I,J) = 0) THEN
  84.                Flag := False;
  85.             END IF;
  86.          END LOOP;
  87.       END LOOP;
  88.       RETURN (Flag);
  89.    END PlusDeCasesNulles;
  90.  
  91.    --------------------------- ETAPE 3 : Existence d'une valeur dans une unité ---------------------------
  92.  
  93.    FUNCTION ExisteDansLigne (
  94.          Mat    : IN     TCarre;
  95.          NumLig : IN     Integer;
  96.          X      : IN     Integer)
  97.      RETURN Boolean IS
  98.       Flag : Boolean := False;
  99.    BEGIN
  100.       FOR I IN 1..9 LOOP
  101.          IF (Mat(NumLig,I) = X) THEN
  102.             Flag := True;
  103.          END IF;
  104.       END LOOP;
  105.       RETURN (Flag);
  106.    END ExisteDansLigne;
  107.  
  108.    FUNCTION ExisteDansColonne (
  109.          Mat    : IN     TCarre;
  110.          NumCol : IN     Integer;
  111.          X      : IN     Integer)
  112.      RETURN Boolean IS
  113.       Flag : Boolean := False;
  114.    BEGIN
  115.       FOR I IN 1..9 LOOP
  116.          IF (Mat(I,NumCol) = X) THEN
  117.             Flag := True;
  118.          END IF;
  119.       END LOOP;
  120.       RETURN (Flag);
  121.    END ExisteDansColonne;
  122.  
  123.    FUNCTION ExisteDansRegion (
  124.          Mat : IN     TCarre;
  125.          K   : IN     Integer;
  126.          L   : IN     Integer;
  127.          X   : IN     Integer)
  128.      RETURN Boolean IS
  129.       Flag : Boolean := False;
  130.  
  131.    BEGIN
  132.  
  133.       FOR I IN K..K+2 LOOP
  134.          FOR J IN L..L+2 LOOP
  135.             IF Grille(I,J) = X THEN
  136.                Flag := True;
  137.             END IF;
  138.          END LOOP;
  139.       END LOOP;
  140.       RETURN Flag;
  141.    END ExisteDansRegion;
  142.  
  143.    --------------------------- ETAPE 4 : Gestion des possibles ---------------------------
  144.  
  145.    PROCEDURE InitLesPossibles (
  146.          T : IN OUT TVectPossibles) IS
  147.    BEGIN
  148.       FOR I IN 1..9 LOOP
  149.          T.Vect(I) := False;
  150.       END LOOP;
  151.       T.Nb := 0;
  152.    END InitLesPossibles;
  153.  
  154.    PROCEDURE InitCube (
  155.          Cube : IN     TCube) IS
  156.       X : TVectPossibles;
  157.    BEGIN
  158.       FOR I IN 1..9 LOOP
  159.          FOR J IN 1..9 LOOP
  160.             X := Cube(I,J);
  161.             InitLesPossibles(X);
  162.          END LOOP;
  163.       END LOOP;
  164.    END InitCube;
  165.  
  166.    PROCEDURE ValeursPossiblesDansRegion (
  167.          Grille : IN     TCarre;
  168.          K,
  169.          L      : IN     Integer;
  170.          Cub    : IN OUT TCube) IS
  171.       -- Pré-requis : K et L doivent être égaux à 1, 4 ou 7
  172.       N : Integer := 0;
  173.    BEGIN
  174.       FOR I IN K..K+2 LOOP
  175.          FOR J IN L..L+2 LOOP
  176.             N := 0;
  177.             InitLesPossibles(Cub(I,J));
  178.             IF Grille(I,J) = 0 THEN
  179.                FOR X IN 1..9 LOOP
  180.                   IF ExisteDansLigne(Grille, I, X) = False THEN
  181.                      IF ExisteDansColonne(Grille, J, X) = False THEN
  182.                         IF ExisteDansRegion(Grille, K, L, X) = False THEN
  183.                            Cub(I,J).Vect(X) := True;
  184.                            Cub(I,J).Nb := N + 1;
  185.                         END IF;
  186.                      END IF;
  187.                   END IF;
  188.                END LOOP;
  189.             END IF;
  190.          END LOOP;
  191.       END LOOP;
  192.    END ValeursPossiblesDansRegion;
  193.  
  194.    PROCEDURE ValeursPossiblesJeu (
  195.          Grille : IN     TCarre;
  196.          Cube   : IN OUT TCube) IS
  197.       I,
  198.       J : Integer := 1;
  199.    BEGIN
  200.       WHILE I < 8 LOOP
  201.          WHILE J < 8 LOOP
  202.             ValeursPossiblesDansRegion(Grille,I,J,Cube);
  203.             J := J + 3;
  204.          END LOOP;
  205.          I := I + 3;
  206.       END LOOP;
  207.    END ValeursPossiblesJeu;
  208.  
  209.    FUNCTION SeulPossibleDansLigne (
  210.          Cub    : IN     TCube;
  211.          Lig,
  212.          Valeur : IN     Integer)
  213.      RETURN Boolean IS
  214.       Stock : Integer := 0;
  215.    BEGIN
  216.       FOR I IN 1..9 LOOP
  217.          IF (Cub(Lig,I).Vect(Valeur)) THEN
  218.             Stock := Stock + 1;
  219.          END IF;
  220.       END LOOP;
  221.       RETURN(Stock = 1);
  222.    END SeulPossibleDansLigne;
  223.  
  224.    FUNCTION SeulPossibleDansColonne (
  225.          Cub    : IN     TCube;
  226.          Col,
  227.          Valeur : IN     Integer)
  228.      RETURN Boolean IS
  229.       Stock : Integer := 0;
  230.    BEGIN
  231.       FOR I IN 1..9 LOOP
  232.          IF (Cub(I,Col).Vect(Valeur)) THEN
  233.             Stock := Stock + 1;
  234.          END IF;
  235.       END LOOP;
  236.       RETURN(Stock = 1);
  237.    END SeulPossibleDansColonne;
  238.  
  239.    FUNCTION SeulPossibleDansRegion (
  240.          Cub    : IN     TCube;
  241.          Lig,
  242.          Col,
  243.          Valeur : IN     Integer)
  244.      RETURN Boolean IS
  245.       L     : Integer := Lig;
  246.       K     : Integer := Col;
  247.       Stock : Integer := 0;
  248.  
  249.    BEGIN
  250.       L := (Lig-1)/3 * 3 ;
  251.       K := (Col-1)/3 * 3 ;
  252.       FOR I IN 1+Lig .. 3+Lig LOOP
  253.          FOR J IN 1+Col .. 3+Col LOOP
  254.             IF (Cub(I,J).Vect(Valeur)) THEN
  255.                Stock := Stock + 1;
  256.             END IF;
  257.          END LOOP;
  258.       END LOOP;
  259.       RETURN (Stock = 1);
  260.    END SeulPossibleDansRegion;
  261.  
  262.    --------------------------- ETAPE 5 : Jeu ---------------------------
  263.  
  264.    FUNCTION CandidatUnique (
  265.          Lig,
  266.          Col,
  267.          Valeur : Integer;
  268.          Cub    : TCube)
  269.      RETURN Boolean IS
  270.    BEGIN
  271.       IF SeulPossibleDansLigne(Cub,Lig,Valeur) OR SeulPossibleDansColonne(
  272.             Cub,Col,Valeur) OR SeulPossibleDansRegion(Cub,Lig,Col,Valeur) THEN
  273.          RETURN(True);
  274.       ELSE
  275.          RETURN(False);
  276.       END IF;
  277.    END CandidatUnique;
  278.  
  279.    PROCEDURE VARIATION_COORD (
  280.          Num : IN     Integer;
  281.          K1,
  282.          K2  :    OUT Integer) IS
  283.    BEGIN
  284.       IF (Num mod 3 = 1) THEN
  285.          K1 := 1;
  286.          K2 := 2;
  287.       ELSIF (Num mod 3 = 2) THEN
  288.          K1 := -1;
  289.          K2 := 1;
  290.       ELSE
  291.          K1 := -1;
  292.          K2 := -2;
  293.       END IF;
  294.    END VARIATION_COORD;
  295.  
  296.    FUNCTION PositionUnique (
  297.          Mat_Carre : IN     TCarre;
  298.          Lig,
  299.          Col,
  300.          Val       : IN     Integer)
  301.      RETURN Boolean IS
  302.       X1,
  303.       X2,
  304.       Lig1,
  305.       Lig2,
  306.       Col1,
  307.       Col2 : Integer;
  308.    BEGIN
  309.       Variation_Coord(Lig,X1,X2);
  310.       Lig1 := Lig + X1;
  311.       Lig2 := Lig + X2;
  312.  
  313.       Variation_Coord(Col,X1,X2);
  314.       Col1 := Col + X1;
  315.       Col2 := Col + X2;
  316.  
  317.       RETURN ((ExisteDansLigne(Mat_Carre, Lig1, Val) AND ExisteDansLigne(
  318.                Mat_Carre, Lig2, Val) AND ExisteDansColonne(Mat_Carre, Col1,
  319.                Val) AND ExisteDansColonne(Mat_Carre, Col2, Val))
  320.          OR  (ExisteDansLigne(Mat_Carre, Lig1, Val) AND ExisteDansLigne(
  321.                Mat_Carre, Lig2, Val) AND Mat_Carre(Lig,Col1) /= 0 AND
  322.             Mat_Carre(Lig,Col2) /= 0 )
  323.          OR  (ExisteDansColonne(Mat_Carre, Col1, Val) AND
  324.             ExisteDansColonne(Mat_Carre, Col2, Val) AND Mat_Carre(Lig1,
  325.                Col ) /= 0 AND  Mat_Carre(Lig2,Col) /=0 ));
  326.    END;
  327.  
  328.    --------------------------- PARTIE II Etape 2 ------------------------------
  329.    PROCEDURE PROPOSE (
  330.          C     : IN OUT TCarre;
  331.          Cub   : IN     TCube;
  332.          Lig,
  333.          Col,
  334.          Val   :    OUT Integer;
  335.          Stop1 : IN OUT Boolean) IS
  336.       I,
  337.       J,
  338.       K     : Integer := 1;
  339.       Flag,
  340.       Flag2 : Boolean := False;
  341.    BEGIN
  342.       WHILE Flag=False AND (I/=10) LOOP
  343.          IF C(I,J)=0 THEN
  344.             Lig:=I;
  345.             Col:=J;
  346.             Flag:=True;
  347.             WHILE Flag2=False LOOP
  348.                IF Cub(I,J).Vect(K) THEN
  349.                   Val:=K;
  350.                   Flag2:=True;
  351.                ELSE
  352.                   K:=K+1;
  353.                END IF;
  354.             END LOOP;
  355.             Stop1:=True;
  356.             C(I,J):=Val;
  357.          ELSE
  358.             J:=J+1;
  359.             IF J=10 THEN
  360.                I:=I+1;
  361.                J:=1;
  362.             END IF;
  363.          END IF;
  364.       END LOOP;
  365.    END PROPOSE;
  366.  
  367.    PROCEDURE PROPOSE2 (
  368.          C   : IN OUT TCarre;
  369.          Cub : IN     TCube;
  370.          Lig,
  371.          Col : IN     Integer;
  372.          Val : IN OUT Integer) IS
  373.       Flag : Boolean := False;
  374.       K    : Integer := Val + 1;
  375.    BEGIN
  376.       WHILE Flag=False OR K<10 LOOP
  377.          IF Cub(Lig,Col).Vect(K) THEN
  378.             Val:=K;
  379.             Flag:=True;
  380.          END IF;
  381.          K:=K+1;
  382.       END LOOP;
  383.    END PROPOSE2;
  384.  
  385.  
  386.    FUNCTION IL_EXISTE_CASE_SANS_CANDIDAT (
  387.          C    : IN     TCarre;
  388.          Cube : IN     TCube)
  389.      RETURN Boolean IS
  390.       I,
  391.       J    : Integer := 1;
  392.       Flag : Boolean := False;
  393.    BEGIN
  394.       WHILE (I >= 9) OR (Flag = False) LOOP
  395.          WHILE (J >= 9) OR (Flag = False) LOOP
  396.             IF (C(I,J) = 0) THEN
  397.                Flag := True;
  398.             END IF;
  399.             J := J+1;
  400.          END LOOP;
  401.          I := I+1;
  402.       END LOOP;
  403.       RETURN(Cube(I,J).Nb = 0);
  404.    END IL_EXISTE_CASE_SANS_CANDIDAT;
  405.  
  406.    --------------------------- PARTIE II Etape 3 ------------------------------
  407.  
  408.  
  409.    --------------------------- Procedure bonus de saisie de Soduku par l'utilisateur ------------------------------
  410.  
  411.  
  412.    FUNCTION SaisieSudoku RETURN TCarre IS
  413.       -- Pré-requis : 0 <= N <= 9 avec 0 symbolisant une valeur absente.
  414.       -- Résultat : Permet de saisir, case par case (ligne par ligne) une grille de Sudoku.
  415.       -- Statégie: Utilise une double boucle pour, pour entrer les différentes valeurs dans la variable Grille (Parcours total).
  416.       -- Variables :
  417.  
  418.       Grille : TCarre;
  419.  
  420.    BEGIN
  421.  
  422.       Put("Saisissez ligne par ligne les valeurs de votre grille de Sudoku.");
  423.       New_Line;
  424.       Put("Saisissez un 0 pour une case vide.");
  425.       New_Line;
  426.  
  427.       FOR I IN 1..9 LOOP
  428.          FOR J IN 1..9 LOOP
  429.             Get(Grille(I, J));
  430.          END LOOP;
  431.       END LOOP;
  432.  
  433.       RETURN Grille;
  434.    END SaisieSudoku;
  435.  
  436.  
  437.    --------------------------- PROCEDURE PRINCIPALE ---------------------------
  438.  
  439.  
  440. BEGIN
  441.  
  442.  
  443.    Put("Bienvenue au Sudoku !");
  444.    New_Line;
  445.    WHILE (Rep2 /= "Non") OR (Rep2 /= "non") LOOP
  446.       Put("Voulez-vous votre propre grille (1) ou une grille preremplie (2) ?");
  447.       New_Line(2);
  448.       Get(H);
  449.       IF (H = 1) THEN
  450.          Grille := SaisieSudoku;
  451.       ELSE
  452.          -- Initialisation matrice
  453.          IF (Change = 1) THEN
  454.  
  455.                            Grille := ((0,0,4,0,6,1,5,7,8),(5,6,3,8,0,7,0,0,9),(1,0,8,2,0,9,0,0,6),
  456.                (0,1,2,9,8,0,0,5,0),(8,3,7,0,2,0,9,4,1),(0,9,0,0,7,3,8,6,0),
  457.                (7,0,0,4,0,2,3,0,5),(2,0,0,7,0,8,6,9,4),(3,4,9,5,1,0,2,0,0));
  458.          ELSIF (Change = 2) THEN
  459.             Grille := ((0,0,0,0,4,0,5,0,0),(0,5,0,0,0,0,6,0,3),(6,0,1,5,0,0,0,0,0),
  460.                (0,0,0,1,9,0,0,6,0),(0,7,0,0,0,0,0,4,0),(0,8,0,0,6,2,0,0,0),
  461.                (0,0,0,0,0,8,4,0,9),(4,0,7,0,0,0,0,8,0),(0,0,3,0,2,0,0,0,0));
  462.  
  463.             -- EXEMPLES DE GRILLES:
  464.          ELSIF (Change = 3) THEN
  465.             Grille := ((6,5,3,1,0,9,2,0,0),(0,7,0,4,6,3,1,0,9),(1,0,0,0,5,0,6,8,3),
  466.                (0,9,5,6,0,4,0,0,2),(3,2,4,0,7,0,8,6,1),(7,0,0,3,0,8,4,9,0),
  467.                (5,3,1,0,4,0,0,0,8),(4,0,2,5,9,7,0,1,0),(0,0,7,8,0,1,5,2,4));
  468.          ELSIF (Change = 4) THEN
  469.             Grille := ((0,0,0,0,4,0,5,0,0),(0,5,0,0,0,0,6,0,3),(6,0,1,5,0,0,0,0,0),
  470.                (0,0,0,1,9,0,0,6,0),(0,7,0,0,0,0,0,4,0),(0,8,0,0,6,2,0,0,0),
  471.                (0,0,0,0,0,8,4,0,9),(4,0,7,0,0,0,0,8,0),(0,0,3,0,2,0,0,0,0));
  472.          END IF;
  473.       END IF;
  474.       New_Line(2);
  475.       Affiche(Grille);
  476.       Recopie(Grille,Grille2);
  477.       InitCube(Cube);
  478.       WHILE(NOT(Plusdecasesnulles(Grille))) LOOP
  479.          ValeursPossiblesJeu(Grille,Cube);
  480.          Put ("Ligne ?");
  481.          Get(X);
  482.          Put ("Colonne ?");
  483.          Get(Y);
  484.          IF X<0 OR X>9 OR Y<0 OR Y>9 THEN
  485.             Put ("Case invalide");
  486.             New_Line;
  487.          ELSE
  488.             Put ("Chiffre ?");
  489.             Get(Z);
  490.             New_Line(3);
  491.             IF Z<0 OR Z>9 THEN
  492.                Put("Chiffre invalide");
  493.                New_Line;
  494.             ELSIF ((ExisteDansLigne(Grille,X,Z)) OR (ExisteDansColonne(Grille,Y,Z)) OR (ExisteDansRegion(Grille,X,Y,Z))) THEN
  495.                IF (ExisteDansLigne(Grille,X,Z)) THEN
  496.                   Put("Valeur impossible car est present dans la ligne");
  497.                   New_Line;
  498.                END IF;
  499.                IF (ExisteDansColonne(Grille,Y,Z)) THEN
  500.                   Put("Valeur impossible car est present dans la colonne");
  501.                   New_Line;
  502.                END IF;
  503.                IF (ExisteDansRegion(Grille,X,Y,Z)) THEN
  504.                   Put("Valeur impossible car est present dans la region");
  505.                   New_Line;
  506.                END IF;
  507.                Put("Souhaitez-vous une aide pour completer cette case ?");
  508.                Get(Rep);
  509.                IF(Rep = "Oui") OR (Rep = "oui") THEN
  510.                   Put("Essayez avec ces chiffres :");
  511.                   New_Line;
  512.                   FOR I IN 1..9 LOOP
  513.                      IF Cube(X,Y).Vect(I) THEN
  514.                         Put (I,0);
  515.                         Put(" ");
  516.                      END IF;
  517.                   END LOOP;
  518.                ELSE
  519.                   Put("Tant pis !");
  520.                END IF;
  521.  
  522.             ELSE
  523.                Grille(X,Y):=Z;
  524.                Affiche(Grille);
  525.             END IF;
  526.          END IF;
  527.          New_Line(2);
  528.       END LOOP;
  529.       Put("Voulez-vous rejouer ?");
  530.       Get(Rep2);
  531.       Change := Change + 1;
  532.      
  533.    END LOOP;
  534.    
  535.    END Sudoku;
Add Comment
Please, Sign In to add comment