examples/apply/backtrac.log

   1 PROGRAM BACKTRACKING ;\r
   2 \r
   3 (*************************************************************************)\r
   4 (* Programme : BACKTRAC.LOG                                              *)\r
   5 (* Date : 04/03/93                                                       *)\r
   6 (* Auteur  : SIMON Philippe           LICENCE INFORMATIQUE  1992/93      *)\r
   7 (*                                                                       *)\r
   8 (*      Ce programme permet d'effectuer des op\82rations de retour arri\8are *)\r
   9 (* de fa\87on intelligente. Pour cela 2 exemples de BACKTRACKING ont \82t\82   *)\r
  10 (* choisi. La Gestion du Planning d'une Semaine et le Probl\8ame des Pions *)\r
  11 (* Noirs et Blancs. Le choix de  ces 2  exemples ce faisant par un  MENU *)\r
  12 (* principal.                                                            *)\r
  13 (*************************************************************************)\r
  14 \r
  15 \r
  16 \r
  17       VAR  choix,touche : integer,\r
  18            r : SEM,\r
  19            pi :pion;\r
  20 \r
  21 (*************************************************************************)\r
  22 (*                         METHODES  USUELLES                            *)\r
  23 (*                                                                       *)\r
  24 (* Cette partie contient des m\82thodes usuelles de travail (BIBLIOTHEQUE) *)\r
  25 (*************************************************************************)\r
  26 \r
  27 \r
  28       UNIT eff : PROCEDURE ;\r
  29        (* envoie un ordre d'\82ffacer l'\82cran *)\r
  30         var i : integer ;\r
  31        BEGIN\r
  32              WRITE( chr(27), "[2J");\r
  33        END ;\r
  34 \r
  35 \r
  36       UNIT GetCar : IIuwgraph FUNCTION : INTEGER;\r
  37       (* attend que l'utilisateur tape une touche et renvoie le code ASCII *)\r
  38          VAR i : INTEGER;\r
  39         BEGIN\r
  40                 i := 0;\r
  41                 WHILE i=0\r
  42                 DO\r
  43                    i := INKEY;\r
  44                    Result := i;\r
  45                 OD;\r
  46         END GetCar;\r
  47 \r
  48 \r
  49       UNIT attendre : PROCEDURE(t : integer);\r
  50       (* Procedure permettant d'attendre pendant 't' seconde(s)  *)\r
  51 \r
  52          VAR j : integer;\r
  53 \r
  54         BEGIN\r
  55            j := TIME;\r
  56            while (ABS(j - TIME) < t) do od;\r
  57         END;\r
  58 \r
  59 \r
  60    (*--------------------------------------------------------------*)\r
  61    (*  PROCEDURE li\82es la gestion du MENU Principal                *)\r
  62    (*--------------------------------------------------------------*)\r
  63 \r
  64        UNIT menu : PROCEDURE ;\r
  65          (* Appelle les m\82thodes correspondantes au choix de l'utilisateur *)\r
  66 \r
  67          VAR    boucle : BOOLEAN;\r
  68 \r
  69          BEGIN\r
  70            boucle := TRUE;\r
  71            WHILE (boucle)\r
  72             DO\r
  73              CALL eff;\r
  74              WRITELN;\r
  75              WRITELN ("     ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿");\r
  76              WRITELN ("     ³                 M E N U                  ³");\r
  77              WRITELN ("     ³                                          ³");\r
  78              WRITELN ("     ³       'BACKTRACKING  INTELLIGENT'        ³");\r
  79              WRITELN ("     ³                                          ³");\r
  80              WRITELN ("     ³                                          ³");\r
  81              WRITELN ("     ³      0.......... QUITTER                 ³");\r
  82              WRITELN ("     ³                                          ³");\r
  83              WRITELN ("     ³                                          ³");\r
  84              WRITELN ("     ³      1 ..... Gestion du planning de la   ³");\r
  85              WRITELN ("     ³              semaine.                    ³");\r
  86              WRITELN ("     ³                                          ³");\r
  87              WRITELN ("     ³      2 ..... Probl\8ame des pions noirs    ³");\r
  88              WRITELN ("     ³              et blancs.                  ³");\r
  89              WRITELN ("     ³                                          ³");\r
  90              WRITELN ("     ³                                          ³");\r
  91              WRITELN ("     ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ");\r
  92              WRITELN;WRITELN;\r
  93              WRITE   ("     Entrez votre choix : ");\r
  94              READLN (choix);\r
  95 \r
  96              CASE choix\r
  97                WHEN 0 : boucle := FALSE;\r
  98 \r
  99                WHEN 1 : CALL eff;\r
 100                         r := NEW SEM;\r
 101 \r
 102                WHEN 2 : CALL eff;\r
 103                         pi := NEW pion;\r
 104             ESAC;\r
 105             choix := 0;\r
 106           OD;\r
 107         END menu;\r
 108 \r
 109 (***************************************************************************)\r
 110 (*             LA  PARTIE GESTION  DU  PLANNING DE LA  SEMAINE             *)\r
 111 (*                                                                         *)\r
 112 (*            il s'agit ici de la DECLARATION de l'objet SEM               *)\r
 113 (*             (utilise la biblioth\8aque Graphique IIugraph)                *)\r
 114 (***************************************************************************)\r
 115 \r
 116 \r
 117    UNIT SEM : IIuwgraph CLASS;\r
 118 \r
 119       VAR   i,cpt,ex,pl,et,arg,retour,val,N,N2,M : integer,\r
 120             exercice,plaisir,argent,etude,interv,interv2,interv3 : integer,\r
 121             MA,ME,JE,res : ARRAYOF integer,\r
 122             L1,L2,V1,V2 : ARRAYOF ARRAYOF integer,\r
 123             solution_possible : boolean;\r
 124 \r
 125       UNIT recurs : PROCEDURE(i : integer, res : ARRAYOF integer);\r
 126       (* recurs est la proc\82dure principale, appel\82e de fa\87on recursive  *)\r
 127       (* afin de cr\82er l'arboresence de tous les cas possibles d'une     *)\r
 128       (* Gestion de Semaine. A l'interieur de cette proc\82dure nous avons *)\r
 129       (* 6 autres sous_proc\82dures li\82es aux 6 premiers jours de la       *)\r
 130       (* semaine (LUNDI MARDI MERCREDI JEUDI VENDREDI). Chacune de ces   *)\r
 131       (* proc\82dures est propre \85 un test, \85 des affectation et \85 des     *)\r
 132       (* retours arri\8ares particuliers.                                  *)\r
 133       (* Chaque solution trouv\82e est rang\82e dans le tableau 'res'.       *)\r
 134 \r
 135 \r
 136 \r
 137         VAR j,w : integer;\r
 138 \r
 139 \r
 140         UNIT lundi : PROCEDURE;\r
 141         (* La proc\82dure lundi correspond en quelque sorte \85 la racine   *)\r
 142         (* de l'arbre de gestion de la semaine. Les affectations        *)\r
 143         (* touchent ici les exercices, le plaisir, et l'argent. De plus *)\r
 144         (* on g\8are, grace \85 la variable retour, les retours arri\8ares    *)\r
 145         (* afin de calculer les branches de l'arbre \85 \82laguer.          *)\r
 146 \r
 147 \r
 148           BEGIN\r
 149              FOR w := 1 TO N\r
 150                DO\r
 151                  FOR j := 1 TO M\r
 152                    DO\r
 153                      (* on initialise les variables de travail li\82es\r
 154                         aux exercices, aux plaisirs, et \85 l'argent   *)\r
 155                      ex := 0; pl := 0; arg := 0; et := 0;\r
 156                      res(i) := L1(2,w);\r
 157                      res(i+1) := L2(2,j);\r
 158                      res(i+2) := L1(1,w) + L2(1,j);\r
 159                      (* On incr\82mente les variables de travail *)\r
 160                      ex := ex + res(i);\r
 161                      pl := pl + res(i+1);\r
 162                      arg := arg + res(i+2);\r
 163 \r
 164                      (* appel de la procedure recurs correspondant au mardi *)\r
 165                      CALL recurs(i+1,res);\r
 166 \r
 167                      (* On decrement les variable de travail  *)\r
 168                      ex := ex - res(i);\r
 169                      pl := pl - res(i+1);\r
 170                      arg := arg - res(i+2);\r
 171 \r
 172                      (* retour = 4 ou 5 correspond au vendredi  *)\r
 173                      IF retour = 4 THEN w := (exercice - val)/interv2;\r
 174                                         j := M;\r
 175                      FI;\r
 176                      IF retour = 5 THEN j := (plaisir - val);\r
 177                      FI;\r
 178                      retour := 0;\r
 179 \r
 180                   OD;\r
 181                OD;\r
 182              solution_possible := FALSE;\r
 183           END lundi;\r
 184 \r
 185         UNIT mardi : PROCEDURE;\r
 186         (* La proc\82dure mardi correspond \85 la seconde tranche de l'arbre*)\r
 187         (* de gestion de la semaine. Les affectations touchent ici les  *)\r
 188         (* \82tudes.                                                      *)\r
 189         (* On g\8are, grace \85 la variable retour, les retours arri\8ares du *)\r
 190         (* mercredi afin de calculer les branches de l'arbre \85 \82laguer. *)\r
 191 \r
 192          BEGIN\r
 193            FOR w := 1 TO N\r
 194             DO\r
 195               res(i+2) := MA(w);\r
 196               et := 0;\r
 197               IF retour = 0 THEN\r
 198                   (* On incremente les variable de travail  *)\r
 199                   et := et + res(i+2);\r
 200 \r
 201                   (* appel de la procedure recurs correspondant au mercredi *)\r
 202                   CALL recurs(i+1,res);\r
 203 \r
 204                   (* On decremente les variable de travail  *)\r
 205                   et := et - res(i+2);\r
 206               FI;\r
 207               (* retour = 2 correspond au mercredi  *)\r
 208               IF retour = 2 THEN w := (etude - val)/interv;\r
 209                                  IF w >= N THEN retour := 1;\r
 210                                        ELSE retour := 0;\r
 211                                  FI;\r
 212               FI;\r
 213             OD;\r
 214           solution_possible := FALSE;\r
 215          END mardi;\r
 216 \r
 217 \r
 218 \r
 219         UNIT mercredi : PROCEDURE;\r
 220         (* La proc\82dure mercredi correspond \85 la troisi\8ame tranche de   *)\r
 221         (* l'arbre de gestion de la semaine. Les affectations touchent  *)\r
 222         (* ici les \82tudes.                                              *)\r
 223         (* On g\8are, grace \85 la variable retour, les retours arri\8ares du *)\r
 224         (* jeudi afin de calculer les branches de l'arbre \85 \82laguer.    *)\r
 225 \r
 226          BEGIN\r
 227            FOR w := 1 TO N\r
 228              DO\r
 229                res(i+2) := ME(w);\r
 230                IF retour = 0 THEN\r
 231                      (* On incremente les variable de travail  *)\r
 232                      et := et + res(i+2);\r
 233 \r
 234                      (* appel de la procedure recurs correspondant au jeudi *)\r
 235                      CALL recurs(i+1,res);\r
 236 \r
 237                      (* On decremente les variable de travail  *)\r
 238                      et := et - res(i+2);\r
 239                FI;\r
 240                (* retour = 3 correspond au jeudi  *)\r
 241                IF retour = 3 THEN w := (etude - val)/interv;\r
 242                                   IF w >= N THEN retour := 2;\r
 243                                                  val := val + ME(N);\r
 244                                        ELSE retour := 0;\r
 245                                   FI;\r
 246                FI;\r
 247              OD;\r
 248            solution_possible := FALSE;\r
 249           END mercredi;\r
 250 \r
 251 \r
 252         UNIT jeudi : PROCEDURE;\r
 253         (* La proc\82dure jeudi correspond \85 la quartri\8ame tranche de     *)\r
 254         (* l'arbre de gestion de la semaine. Les affectations touchent  *)\r
 255         (* ici les \82tudes.                                              *)\r
 256         (* On g\8are, grace \85 la variable retour, les retours arri\8ares du *)\r
 257         (* jeudi au mercredi afin de calculer les branches de l'arbre \85 *)\r
 258         (* \82laguer.                                                     *)\r
 259 \r
 260          BEGIN\r
 261             FOR w := 1 TO N\r
 262               DO\r
 263                res(i+2) := JE(w);\r
 264                IF retour = 0 THEN\r
 265                         (* On incremente les variable de travail  *)\r
 266                         et := et + res(i+2);\r
 267                         IF et < etude THEN\r
 268                               (* si aucun cas n'est trouv\82 on indique un\r
 269                                  retour arri\8are et on calcul grace \85 la\r
 270                                  variable val et a l'indice de boucle w\r
 271                                  les branches \85 \82laguer.              *)\r
 272 \r
 273                               IF w = N THEN retour := 3;\r
 274                                             val := et;\r
 275                                    ELSE w := (etude - et)/interv;\r
 276                                         IF w>=N THEN w := N - 1 FI;\r
 277                               FI;\r
 278                             ELSE\r
 279                               (* appel de la procedure recurs correspondant\r
 280                                  au vendredi       *)\r
 281                                CALL recurs(i+1,res);\r
 282                          FI;\r
 283                          (* On decremente les variable de travail  *)\r
 284                          et := et - res(i+2);\r
 285                FI;\r
 286               OD;\r
 287             solution_possible := FALSE;\r
 288          END jeudi;\r
 289 \r
 290 \r
 291         UNIT vendredi : PROCEDURE;\r
 292         (* La proc\82dure vendredi correspond \85 la cinqui\8ame tranche de   *)\r
 293         (* l'arbre de gestion de la semaine. Les affectations touchent  *)\r
 294         (* ici les exercices, le plaisir, et l'argent.                  *)\r
 295         (* On g\8are, grace \85 la variable retour, les retours arri\8ares du *)\r
 296         (* lundi afin de calculer les branches de l'arbre \85 \82laguer.    *)\r
 297 \r
 298          BEGIN\r
 299             FOR w := 1 TO N\r
 300               DO\r
 301                 FOR j := 1 TO M\r
 302                   DO\r
 303                     res(i+2) := V1(2,w);\r
 304                     res(i+3) := V2(2,j);\r
 305                     res(i+4) := V1(1,w) + V2(1,j);\r
 306                     (* On incremente les variable de travail  *)\r
 307                     ex := ex + res(i+2);\r
 308                     pl := pl + res(i+3);\r
 309                     arg := arg + res(i+4);\r
 310                     IF arg > argent THEN j := M;\r
 311                         ELSE\r
 312                            IF ex < exercice THEN\r
 313                               (* si aucun cas n'est trouv\82 on indique un\r
 314                                  retour arri\8are et on calcul grace \85 la\r
 315                                  variable val et \85 l'indice de boucle w\r
 316                                  les branches \85 \82laguer.              *)\r
 317 \r
 318                                 IF w = N THEN retour := 4;\r
 319                                               val := ex;\r
 320                                               exit;\r
 321                                     ELSE w := ((exercice - ex)/interv2);\r
 322                                          IF w >= N THEN w := N-1 FI;\r
 323                                          j := M;\r
 324                                 FI\r
 325                               ELSE\r
 326                                 IF pl < plaisir THEN\r
 327                                   (* si aucun cas n'est trouv\82 on indique un\r
 328                                       retour arri\8are et on calcul grace \85 la\r
 329                                       variable val et a l'indice de boucle j\r
 330                                       les branches \85 \82laguer.              *)\r
 331 \r
 332                                       IF j = M THEN retour := 5;\r
 333                                                     val := pl;\r
 334                                            ELSE j := (plaisir - pl)/interv3;\r
 335                                       FI;\r
 336                                 (* appel de la procedure recurs correspondant\r
 337                                    \85 une solution trouv\82e             *)\r
 338                                     ELSE  CALL recurs(i+1,res);\r
 339                                 FI\r
 340                            FI\r
 341                     FI;\r
 342                     (* On decremente les variable de travail  *)\r
 343                     ex := ex - res(i+2);\r
 344                     pl := pl - res(i+3);\r
 345                     arg := arg - res(i+4);\r
 346                  OD;\r
 347                OD;\r
 348             solution_possible := FALSE;\r
 349          END vendredi;\r
 350 \r
 351 \r
 352 \r
 353        BEGIN\r
 354 \r
 355           retour := 0;\r
 356           solution_possible := TRUE;\r
 357 \r
 358           CASE i\r
 359 \r
 360              WHEN 1 : CALL lundi;\r
 361 \r
 362              WHEN 2 : CALL mardi;\r
 363 \r
 364              WHEN 3 : CALL mercredi;\r
 365 \r
 366              WHEN 4 : CALL jeudi;\r
 367 \r
 368              WHEN 5 : CALL vendredi;\r
 369 \r
 370           ESAC;\r
 371 \r
 372           (* si une solution est trouv\82e on l'imprime \85 l'\82cran *)\r
 373           IF solution_possible THEN CALL imprim(res)  FI;\r
 374 \r
 375        END recurs;\r
 376 \r
 377 \r
 378    (*------------------------------------------------------------------*)\r
 379    (*  PROCEDURE li\82es la gestion du MENU de la Gestion de la Semaine  *)\r
 380    (*------------------------------------------------------------------*)\r
 381 \r
 382       UNIT menu_ps : PROCEDURE;\r
 383           VAR i : integer;\r
 384 \r
 385         BEGIN\r
 386             WRITELN("     ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ");\r
 387             WRITELN("     ³ PLANNING DE LA SEMAINE AVEC CONTRAINTES ³ ");\r
 388             WRITELN("     ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ ");\r
 389             WRITELN(" Chaque jour implique un choix particulier :");\r
 390             WRITELN;\r
 391             WRITELN("   * LUNDI :");\r
 392             FOR i := 1 TO N  DO\r
 393                WRITE(" $",L1(1,i):2,"   Exercice ",L1(2,i):2);\r
 394                IF i > M THEN WRITELN;\r
 395                  ELSE WRITELN("      $",L2(1,i):2," Plaisir ",L2(2,i));\r
 396                FI;\r
 397             OD;\r
 398             WRITELN;\r
 399             WRITELN("    * MARDI     MERCREDI    JEUDI :");\r
 400             FOR i := 1 TO N DO\r
 401                  WRITELN(" Etude ",MA(i):2,"         ",ME(i):2,"     ",JE(i));\r
 402             OD;\r
 403             WRITELN;\r
 404             WRITELN("    * VENDREDI :");\r
 405             FOR i := 1 TO N  DO\r
 406                WRITE(" $",V1(1,i):2,"   Exercice ",V1(2,i):2);\r
 407                IF i > M THEN WRITELN;\r
 408                  ELSE WRITELN("      $",V2(1,i):2," Plaisir ",V2(2,i));\r
 409                FI;\r
 410             OD;\r
 411             WRITELN;\r
 412             WRITE("  CONTRAINTES : ");\r
 413             WRITE(" Exercice >= ",exercice:2,"   Argent ($) =< ",argent:2);\r
 414             WRITELN("  Etude >= ",etude:2,"   Plaisir >= ",plaisir:2);\r
 415             touche := Getcar;\r
 416         END;\r
 417 \r
 418 \r
 419 \r
 420    (*---------------------------------------------------------------------*)\r
 421    (*  PROCEDURES li\82es la gestion de l'AFFICHAGE \85 l'\82cran des resultats *)\r
 422    (*---------------------------------------------------------------------*)\r
 423 \r
 424 \r
 425       UNIT imprim : PROCEDURE(res : ARRAYOF integer);\r
 426       (* La proc\82dure imprim permet d'afficher toutes les solutions   *)\r
 427       (* possibles (les unes a la suite des autres) pages par pages \85 *)\r
 428       (* l'\82cran, sous forme de tableau de resultat.                  *)\r
 429 \r
 430          VAR j : integer;\r
 431 \r
 432         BEGIN\r
 433           IF cpt = 0 THEN CALL eff;\r
 434                           (* affichage de l'entete \85 l'\82cran  *)\r
 435                           CALL entete;\r
 436           FI;\r
 437           WRITE ("³",res(1):4,"³",res(2):4,"³",res(3):4);\r
 438           WRITE ("³",res(4):6,"  ³",res(5):6,"  ³",res(6):6);\r
 439           WRITE ("  ³",res(7):4,"³",res(8):4,"³",res(9):4);\r
 440           WRITE ("º",ex:4,"³",pl:4,"³",arg:4,"³",et:4,"³");\r
 441           WRITELN;\r
 442           cpt := cpt + 1;\r
 443           IF cpt = 16 THEN WRITELN ("Appuyez sur une touche pour continuer...");\r
 444                            touche := Getcar;\r
 445                            cpt := 0;\r
 446           FI;\r
 447 \r
 448         END imprim;\r
 449 \r
 450 \r
 451      UNIT entete : PROCEDURE;\r
 452      (* Affiche l'entete du tableau de resultat \85 l'\82cran.   *)\r
 453       BEGIN\r
 454          WRITELN("CONTRAINTES : ");\r
 455          WRITE("Exercice >= ",exercice:2,"   Argent ($) =< ",argent:2);\r
 456          WRITELN("  Etude >= ",etude:2,"   Plaisir >= ",plaisir:2);\r
 457          WRITE("ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÂÄÄÄÄÄ");\r
 458          WRITELN("ÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄËÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿");\r
 459          WRITE("³     LUNDI    ³ MARDI  ³MERCREDI³ JEUD");\r
 460          WRITELN("I  ³   VENDREDI   º      TOTAL        ³");\r
 461          WRITE("ÃÄÄÄÄÂÄÄÄÄÂÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄ");\r
 462          WRITELN("ÄÄÄÅÄÄÄÄÂÄÄÄÄÂÄÄÄÄÎÄÄÄÄÂÄÄÄÄÂÄÄÄÄÂÄÄÄÄ´");\r
 463          WRITE("³Exer³Plai³ $  ³ Etude  ³ Etude  ³ Etud");\r
 464          WRITELN("e  ³Exer³Plai³ $  ºExer³Plai³ $  ³Etud³");\r
 465          WRITE("ÃÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄ");\r
 466          WRITELN("ÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄÎÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄ´");\r
 467       END entete;\r
 468 \r
 469 \r
 470      UNIT fin : PROCEDURE;\r
 471      (* Affiche la fin du  tableau de resultat \85 l'\82cran.   *)\r
 472 \r
 473       BEGIN\r
 474          WRITE("ÀÄÄÄÄÁÄÄÄÄÁÄÄÄÄÁÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÁÄÄÄÄÄ");\r
 475          WRITELN("ÄÄÄÁÄÄÄÄÁÄÄÄÄÁÄÄÄÄÁÄÄÄÄÁÄÄÄÄÁÄÄÄÄÁÄÄÄÄÙ");\r
 476          WRITELN ("Appuyez sur une touche pour continuer...");\r
 477          touche := Getcar;\r
 478       END fin;\r
 479 \r
 480 \r
 481    BEGIN\r
 482      PREF IIUWGraph block;\r
 483       BEGIN\r
 484        (* Initialisation des tableaux et des variables de JEUX D'ESSAI *)\r
 485 \r
 486        N := 4;\r
 487        M := 3;\r
 488        N2 := 2;\r
 489        (* D\82claration d'intervalles  *)\r
 490        interv := 2;\r
 491        interv2 := 5;\r
 492        interv3 := 1;\r
 493        ARRAY res DIM (1:9);\r
 494        ARRAY L1 DIM (1:N2);\r
 495        FOR i := 1 TO N2\r
 496         DO\r
 497           ARRAY L1(i) DIM (1:N);\r
 498         OD;\r
 499        ARRAY L2 DIM (1:N2);\r
 500        FOR i := 1 TO N2\r
 501         DO\r
 502           ARRAY L2(i) DIM (1:M);\r
 503         OD;\r
 504        ARRAY MA DIM (1:N);\r
 505        ARRAY ME DIM (1:N);\r
 506        ARRAY JE DIM (1:N);\r
 507        ARRAY V1 DIM (1:N2);\r
 508        FOR i := 1 TO N2\r
 509         DO\r
 510           ARRAY V1(i) DIM (1:N);\r
 511         OD;\r
 512        ARRAY V2 DIM (1:N2);\r
 513        FOR i := 1 TO N2\r
 514         DO\r
 515           ARRAY V2(i) DIM (1:M);\r
 516         OD;\r
 517 \r
 518        (* Initialisation des tableaux jeux d'essai du mardi,mercredi et\r
 519           jeudi concernant les \82tudes.                                  *)\r
 520 \r
 521        FOR i := 1 TO N\r
 522          DO\r
 523               MA(i),ME(i),JE(i) := (i-1) * interv;\r
 524          OD;\r
 525 \r
 526        (* Initialisation des tableaux jeux d'essai du lundi et vendredi\r
 527           concernant l'argent.                                          *)\r
 528 \r
 529        L1(1,1),V1(1,1) := 0;\r
 530        L1(1,2),V1(1,2) := 0;\r
 531        L1(1,3),V1(1,3) := 0;\r
 532        L1(1,4),V1(1,4) := 20;\r
 533 \r
 534        (* Initialisation des tableaux jeux d'essai du lundi et vendredi\r
 535           concernant les exercices.                                     *)\r
 536 \r
 537        FOR i := 1 TO N\r
 538          DO\r
 539              L1(2,i),V1(2,i) := (i-1) * interv2;\r
 540          OD;\r
 541 \r
 542        (* Initialisation des tableaux jeux d'essai du lundi et vendredi\r
 543           concernant les plaisirs ou divertissements.                   *)\r
 544 \r
 545        L2(1,1),V2(1,1) := 0;\r
 546        L2(1,2),V2(1,2) := 0;\r
 547        L2(1,3),V2(1,3) := 20;\r
 548 \r
 549        FOR i := 1 TO M\r
 550          DO\r
 551             L2(2,i),V2(2,i) := (i-1) * interv3;\r
 552          OD;\r
 553 \r
 554        (*  Les contraintes d'une semaine \82quilibr\82e sont les suivantes :  *)\r
 555 \r
 556        argent := 30;\r
 557        etude := 14;\r
 558        exercice := 20;\r
 559        plaisir := 2;\r
 560 \r
 561        cpt := 0;\r
 562        CALL GRON(1);\r
 563        CALL menu_ps;\r
 564        CALL recurs(1,res);\r
 565        CALL fin;\r
 566        CALL GROFF;\r
 567       END;\r
 568    END SEM;\r
 569 \r
 570 \r
 571 \r
 572 (***************************************************************************)\r
 573 (*       LA  PARTIE GESTION  DU  JEU DES PIONS NOIRS ET BLANCS             *)\r
 574 (*                                                                         *)\r
 575 (*            il s'agit ici de la DECLARATION de l'objet PION              *)\r
 576 (*             (utilise la biblioth\8aque Graphique IIugraph)                *)\r
 577 (***************************************************************************)\r
 578 \r
 579 \r
 580    UNIT PION : IIuwgraph CLASS;\r
 581 \r
 582       VAR   n,i,M : integer,\r
 583             tab : ARRAYOF char,\r
 584             trouve,manuel: boolean;\r
 585 \r
 586 \r
 587       UNIT procent : PROCEDURE(A,B : char, P,NN : integer);\r
 588       (* La procedure procent permet de parcourir l'arbre des solutions  *)\r
 589       (* en anticipant le meilleur des chemins c'est a dire en parcourant*)\r
 590       (* le moins de chemin possible.                                    *)\r
 591       (* Les param\8atres d'entr\82s A et B prennent soit la valeur Noir et  *)\r
 592       (* Blanc ou Blanc et Noir. Idem pour les 2 entier P et NN qui      *)\r
 593       (* prennent en fonction de la couleur des pions soit la valeur 1 et*)\r
 594       (* M (2*n+1) ou -1 et 1. (P indique le sens de deplacement).       *)\r
 595 \r
 596              VAR bo : boolean,\r
 597                  j, k : integer;\r
 598 \r
 599          UNIT proc : PROCEDURE(X : char);\r
 600          (* La proc\82dure proc permet de connaitre si l'on se trouve dans *)\r
 601          (* position de blocage ou bien si l'on peut continuer dans ce   *)\r
 602          (* chemin. (Cas o\97 l'on place un pion \85 cot\82 d'un autre pion de *)\r
 603          (* m\88me couleur).                                               *)\r
 604 \r
 605             BEGIN\r
 606               bo := TRUE;\r
 607               k := 2;\r
 608               j := i + 2*P;\r
 609               IF (j >= 1) AND (j <= M) THEN\r
 610                           WHILE ((bo) AND (j <> NN+P))\r
 611                             DO\r
 612                                (* On test si tous les pions suivants sont\r
 613                                   de m\88me couleur. Si oui alors on poursuit\r
 614                                   le chemin dans l'arbre, sinon on se trouve\r
 615                                   bloqu\82.                                 *)\r
 616 \r
 617                                IF tab(j) <> X THEN bo := FALSE;\r
 618                                       ELSE k := k + 1;\r
 619                                FI;\r
 620                                j := j + P;\r
 621                              OD;\r
 622               FI;\r
 623             END proc;\r
 624 \r
 625 \r
 626           UNIT affect2 : PROCEDURE;\r
 627           (* La proc\82dure affect2 permet de d\82placer un pion en sautant *)\r
 628           (* par dessus un pion de couleur adverse.                    *)\r
 629           (* Le sens du d\82placement \82tant indiquer par l'entier  P.     *)\r
 630 \r
 631             BEGIN\r
 632                 tab(i) := tab(i-2*P);\r
 633                 tab(i-2*P) := ' ';\r
 634                 i := i - 2*P;\r
 635                 (* appel de la proc\82dure principale tentative *)\r
 636                 CALL tentative;\r
 637                 i := i + 2*P;\r
 638                 tab(i-2*P) := tab(i);\r
 639                 tab(i) := ' ';\r
 640             END affect2;\r
 641 \r
 642 \r
 643 \r
 644           UNIT affect1 : PROCEDURE;\r
 645           (* La procedure affect1 permet de d\82placer un pion d'une   *)\r
 646           (* case en avant (pion avance dans la case vide).          *)\r
 647           (* Le sens du d\82placement \82tant indiquer par l'entier  P.  *)\r
 648 \r
 649             BEGIN\r
 650                 tab(i) := tab(i-P);\r
 651                 tab(i-P) := ' ';\r
 652                 i := i - P;\r
 653                 (* appel de la proc\82dure principale tentative *)\r
 654                 CALL tentative;\r
 655                 i := i + P;\r
 656                 tab(i-P) := tab(i);\r
 657                 tab(i) := ' ';\r
 658             END affect1;\r
 659 \r
 660 \r
 661 \r
 662          BEGIN\r
 663            (* On test si l'on se trouve en bordures du jeux (du tableau)\r
 664               C'est a dire que l'on verifie que les indices de tables\r
 665               sont toujours valide pour continuer les tests suivants.    *)\r
 666            IF ((i-P) > 0) AND ((i-P) <= M) THEN\r
 667 \r
 668              (* On test si l'on peut avancer le pion dans la case vide en\r
 669                 fonction de P (indique le sens du d\82placement).           *)\r
 670              IF tab(i-P) = A THEN\r
 671 \r
 672                 (* On test si l'on se trouve en bordures du jeux, en\r
 673                    fonction du sens du d\82pacement.                    *)\r
 674                 IF ((i+P) > 0) AND ((i+P) <= M) THEN\r
 675 \r
 676                    (* On test si le pion situ\82 apr\8as la case vide est de\r
 677                       m\88me couleur que celui plac\82 avant.                *)\r
 678                    IF tab(i+P) = A THEN\r
 679                                      (* Si oui on appele la proc\82dure proc *)\r
 680                                      CALL proc(A);\r
 681                                      (* On test si l'on poursuit le chemin *)\r
 682                                      IF bo THEN\r
 683                                           CALL affect1;\r
 684                                           (* On test si l'on se trouve dans\r
 685                                              l'\82tat final du jeux. (k=n)   *)\r
 686                                           IF k = n THEN trouve := FALSE  FI;\r
 687                                           IF trouve THEN CALL aff_retour_ar FI;\r
 688                                      FI;\r
 689                         ELSE\r
 690                              (* Sinon on appele la proc\82dure d'affectation\r
 691                                 affect1, et on poursuit le chemin.        *)\r
 692                              CALL affect1;\r
 693                              IF trouve THEN CALL aff_retour_ar  FI;\r
 694                    FI;\r
 695                   ELSE\r
 696                       (* Sinon on appele la proc\82dure d'affectation affect1 *)\r
 697                       CALL affect1;\r
 698                       IF trouve THEN CALL aff_retour_ar  FI;\r
 699                FI;\r
 700               ELSE\r
 701 \r
 702                  (* On test si l'on se trouve en bordures du jeux (du tableau)\r
 703                     C'est a dire que l'on verifie que les indices de tables\r
 704                     sont toujours valide pour continuer les tests suivants. *)\r
 705                    IF ((i-2*P) > 0) AND ((i-2*P) <= M) THEN\r
 706 \r
 707                       (* On test si l'on peut avancer le pion plac\82 2 cases\r
 708                          avant la case vide en sautant un pion de couleur\r
 709                          adverse plac\82 une case avant la case vide, toujours\r
 710                          en fonction du sens P.                             *)\r
 711                       IF (tab(i-2*P) = A) AND (tab(i-P) = B) THEN\r
 712 \r
 713                          (* On test si l'on se trouve en bordures du jeux, en\r
 714                             fonction du sens du d\82pacement.                 *)\r
 715                          IF ((i+P) > 0) AND ((i+P) <= M) THEN\r
 716 \r
 717                             (* On test si le pion situ\82 apr\8as la case vide\r
 718                                est de m\88me couleur que celui plac\82 2 cases\r
 719                                avant la case vide.                        *)\r
 720                             IF tab(i+P) = A THEN\r
 721                                      (* Si oui on appele la proc\82dure proc *)\r
 722                                      CALL proc(A);\r
 723                                      (* On test si l'on poursuit le chemin *)\r
 724                                      IF bo THEN\r
 725                                          CALL affect2;\r
 726                                          (* On test si l'on se trouve dans\r
 727                                             l'\82tat final du jeux. (k=n)    *)\r
 728                                          IF k = n THEN  trouve := FALSE;  FI;\r
 729                                          IF trouve THEN CALL aff_retour_ar FI;\r
 730                                      FI;\r
 731                                 ELSE\r
 732                                  (* Sinon appel de la proc\82dure d'affectation\r
 733                                     affect2, et on poursuit le chemin.    *)\r
 734                                    CALL affect2;\r
 735                                    IF trouve THEN CALL aff_retour_ar  FI;\r
 736                                FI;\r
 737                             ELSE\r
 738                              (* appel de la proc\82dure d'affectation affect2 *)\r
 739                                CALL affect2;\r
 740                                IF trouve THEN CALL aff_retour_ar  FI;\r
 741                         FI;\r
 742                      FI;\r
 743                   FI;\r
 744               FI;\r
 745            FI;\r
 746        END procent;\r
 747 \r
 748 \r
 749 \r
 750 \r
 751       UNIT tentative : PROCEDURE;\r
 752       (* Cette proc\82dure permet de parcourir l'arbre du jeux des pions.  *)\r
 753       (* En faisant d'abord avancer les pions Noirs puis les pions Blancs*)\r
 754       (* Tant que l'\82tat final n'est pas atteint on affiche l'\82volution  *)\r
 755       (* du d\82placement dans l'arbre.                                    *)\r
 756 \r
 757        BEGIN\r
 758          IF trouve THEN\r
 759                         CALL cls;\r
 760                         (* On imprime le resultat a l'instant t *)\r
 761                         CALL imprim;\r
 762                         (* On d\82place les pions Noirs *)\r
 763                         CALL procent('N','B',1,M);\r
 764                         (* On d\82place les pions Blancs *)\r
 765                         CALL procent('B','N',-1,1);\r
 766 \r
 767          FI;\r
 768        END tentative;\r
 769 \r
 770 \r
 771 \r
 772    (*---------------------------------------------------------------------*)\r
 773    (*  PROCEDURES li\82es la gestion de l'AFFICHAGE \85 l'\82cran des resultats *)\r
 774    (*---------------------------------------------------------------------*)\r
 775 \r
 776 \r
 777       UNIT aff_retour_ar : PROCEDURE;\r
 778       (* Proc\82dure permettant d'indiquer \85 l'\82cran que l'on effectue *)\r
 779       (* un retour arri\8are (BACKTRACKING).                           *)\r
 780 \r
 781        BEGIN\r
 782             CALL CLS;\r
 783             CALL move(150,220);   CALL draw(360,220);\r
 784             CALL move(150,260);   CALL draw(360,260);\r
 785             CALL move(150,220);   CALL draw(150,260);\r
 786             CALL move(360,220);   CALL draw(360,260);\r
 787             CALL move(180,237);\r
 788             CALL outstring("RETOUR  ARRIERE ...");\r
 789             CALL imprim;\r
 790        END;\r
 791 \r
 792 \r
 793 \r
 794 \r
 795       UNIT imprim : PROCEDURE;\r
 796       (* Proc\82dure permettant d'afficher de mani\8are graphique les    *)\r
 797       (* pions Noirs et Blancs dans un tableaux proportionnel au     *)\r
 798       (* nombre de pions.                                            *)\r
 799       (* Les proc\82dures graphiques utilis\82es : outstring, move, draw *)\r
 800       (* cirb.                                                       *)\r
 801 \r
 802         VAR  l,col,xi,touche : integer;\r
 803 \r
 804        BEGIN\r
 805           CALL move(100,10);\r
 806           CALL outstring("LE PROBLEME DES PIONS NOIRS ET BLANCS");\r
 807 \r
 808           (* Affichage du tableau de jeux *)\r
 809           CALL move(70,80);   CALL draw(70+60*(2*n+1),80);\r
 810           CALL move(70,120);  CALL draw(70+60*(2*n+1),120);\r
 811           FOR l := 0 TO ((n+1)*2-1)  DO\r
 812               CALL move(70+(60*l),80);  CALL draw(70+(60*l),120);\r
 813           OD;\r
 814 \r
 815           (* Affichage des pions Noirs et Blancs  *)\r
 816           FOR l := 1 TO M\r
 817              DO\r
 818                xi := 100 + ((l-1) * 60);\r
 819                IF tab(l) <> ' '\r
 820                   THEN IF tab(l) = 'B' THEN col := 15;\r
 821                                 ELSE  col := 0;\r
 822                        FI;\r
 823                        CALL cirb(xi,100,20,10,10,15,col,2,2);\r
 824                FI;\r
 825              OD;\r
 826              IF manuel THEN\r
 827                     CALL move(50,300);\r
 828                     CALL outstring("Appuyez sur une touche pour continuer...");\r
 829                     touche := Getcar;\r
 830                 ELSE CALL attendre(2);\r
 831              FI;\r
 832        END imprim;\r
 833 \r
 834 \r
 835      UNIT menu_p : PROCEDURE;\r
 836           VAR choix : integer;\r
 837 \r
 838        BEGIN\r
 839          manuel := TRUE;\r
 840          CALL eff;\r
 841          WRITELN("        ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ");\r
 842          WRITELN("        ³  PROBLEME DES PIONS NOIRS ET BLANCS  ³ ");\r
 843          WRITELN("        ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ ");\r
 844          WRITELN; WRITELN;\r
 845          WRITELN ("   A partir d'un etat initial qui est le suivant :");\r
 846          WRITELN ("             NNN*BBB");\r
 847          WRITELN ("   Il faut aboutir \85 un etat final qui est le suivant :");\r
 848          WRITELN ("             BBB*NNN");\r
 849          WRITELN;\r
 850          WRITELN ("   Sachant que l'on \85 des r\8agles fix\82es :");\r
 851          WRITELN ("                                ÄÄ> <ÄÄ");\r
 852          WRITELN ("     - Les sens sont fix\82s :    NNN*BBB");\r
 853          WRITELN ("     - Un pion peut avancer dans une case vide '*' si :");\r
 854          WRITELN ("            * Elle est juste devant. ");\r
 855          WRITELN ("            * Il l'atteint en sautant par dessus un pion");\r
 856          WRITELN ("              de couleur adverse.");\r
 857          WRITELN;\r
 858          WRITELN ("   D\82sirez vous un traitement :");\r
 859          WRITELN;\r
 860          WRITELN ("          1 ......... MANUEL");\r
 861          WRITELN ("          2 ......... AUTOMATIQUE");\r
 862          WRITELN;\r
 863          WRITE ("  Votre choix : ");\r
 864          READLN (choix);\r
 865          IF choix = 2 THEN manuel := FALSE   FI;\r
 866          CALL eff;\r
 867          WRITELN; WRITELN; WRITELN; WRITELN;\r
 868          n := 0;\r
 869          WHILE ((n < 2) OR (n > 4))\r
 870           DO\r
 871               WRITE("       Donnez le Nombre de Pions (2,3 ou 4) : ");\r
 872               READLN (n);\r
 873           OD;\r
 874      END;\r
 875 \r
 876 \r
 877 \r
 878    BEGIN\r
 879      (* On utilise pour repr\82senter de fa\87on graphique \85 l'\82cran les pions *)\r
 880      (* Noirs et Blancs la Biblioth\82que graphique  IIugraph.               *)\r
 881 \r
 882      PREF IIUWGraph block;\r
 883        BEGIN\r
 884           CALL GRON(1);\r
 885           CALL menu_p;\r
 886 \r
 887           (* initialisation \85 l'\82tat initial du tableau de jeux en fonction *)\r
 888           (* du nombres de pions entr\82s pr\82alablement.    ex: NNN BBB       *)\r
 889 \r
 890           ARRAY tab DIM (1:(n*2)+1);\r
 891 \r
 892           FOR i := 1 TO n DO tab(i) := 'N' OD;\r
 893           tab(n+1) := ' ';\r
 894           FOR i := (n+2) TO (n*2)+1 DO tab(i) := 'B' OD;\r
 895 \r
 896           i := n + 1;\r
 897 \r
 898           (* La variable M repr\82sente l'indice maximum du tableau du jeux *)\r
 899           (* en fonction du nombres de pions.  ex: si n=3 ÄÄ> M=7         *)\r
 900           M := 2*n + 1;\r
 901 \r
 902           trouve := TRUE;\r
 903           (* Appel de la proc\82dure principale 'tentative' de parcours\r
 904              d'arbre.                                                 *)\r
 905           CALL tentative;\r
 906           CALL GROFF;\r
 907         END;\r
 908    END PION;\r
 909 \r
 910 \r
 911 \r
 912 (*******************************)\r
 913 (***  PROGRAMME  PRICIPAL  *****)\r
 914 (*******************************)\r
 915 \r
 916 BEGIN\r
 917      (* Appel du menu principal *)\r
 918      CALL menu;\r
 919 END BACTRACKING;\r
 920 \1a