examples/backtrac/roundcm.log

   1 PROGRAM BACKTRACKING;\r
   2   UNIT BACKTRACK: CLASS;\r
   3     HIDDEN SE;\r
   4     VAR  ROOT:NODE,SEARCH:SE,FOUND:NODE,\r
   5          NUMBER_OF_LEAVES,NUMBER_OF_ANSWERS:INTEGER;\r
   6 \r
   7     UNIT NODE: CLASS(FATHER:NODE);\r
   8       VAR NSONS,LEVEL: INTEGER , DEADEND:BOOLEAN;\r
   9       UNIT VIRTUAL LEAF:  FUNCTION :BOOLEAN;\r
  10       END LEAF;\r
  11       UNIT VIRTUAL ANSWER :FUNCTION :BOOLEAN;\r
  12       END ANSWER;\r
  13       UNIT VIRTUAL LASTSON: FUNCTION : BOOLEAN;\r
  14       END LASTSON;\r
  15       UNIT VIRTUAL NEXTSON: FUNCTION : NODE;\r
  16       END NEXTSON;\r
  17       UNIT VIRTUAL EQUAL : FUNCTION (W:NODE):BOOLEAN;\r
  18       END EQUAL;\r
  19       UNIT VIRTUAL COST: FUNCTION :REAL;\r
  20       END COST;\r
  21     BEGIN\r
  22       IF FATHER =/= NONE\r
  23       THEN\r
  24         LEVEL:=FATHER.LEVEL+1\r
  25       ELSE\r
  26         LEVEL:=0\r
  27       FI;\r
  28    END NODE;\r
  29 \r
  30     UNIT OK: FUNCTION (V:NODE):BOOLEAN;\r
  31       VAR W:NODE;\r
  32     BEGIN\r
  33       IF V=NONE THEN RESULT:=FALSE; RETURN FI;\r
  34       RESULT:=TRUE; W:=V.FATHER;\r
  35       WHILE W =/= NONE\r
  36       DO\r
  37         IF V.EQUAL(W) THEN RESULT:=FALSE; RETURN FI;\r
  38         W:=W.FATHER\r
  39       OD\r
  40     END OK;\r
  41 \r
  42     UNIT PURGE: PROCEDURE (V:NODE);\r
  43       VAR W: NODE;\r
  44     BEGIN\r
  45       IF V=NONE THEN RETURN FI;\r
  46       DO\r
  47         W:=V.FATHER; KILL(V);\r
  48         IF W=NONE THEN RETURN FI;\r
  49         W.NSONS:=W.NSONS-1;\r
  50         IF W.NSONS =/= 0 THEN RETURN FI;\r
  51         V:=W\r
  52       OD;\r
  53     END PURGE;\r
  54 \r
  55     UNIT VIRTUAL INSERT: PROCEDURE(V:NODE);\r
  56     END INSERT;\r
  57 \r
  58     UNIT VIRTUAL DELETE : FUNCTION :NODE;\r
  59     END DELETE;\r
  60 \r
  61     UNIT SE: COROUTINE ;\r
  62       VAR I:INTEGER,V,W:NODE;\r
  63     BEGIN\r
  64       RETURN; CALL INSERT(ROOT);\r
  65       DO\r
  66         V:=DELETE;\r
  67         IF V=NONE THEN EXIT FI;\r
  68         IF V.ANSWER\r
  69         THEN\r
  70           NUMBER_OF_ANSWERS:=NUMBER_OF_ANSWERS+1;\r
  71           FOUND:=V; DETACH; CALL PURGE(V);\r
  72         ELSE\r
  73           IF V.DEADEND\r
  74           THEN\r
  75             NUMBER_OF_LEAVES:=NUMBER_OF_LEAVES+1;\r
  76             CALL PURGE(V);\r
  77           ELSE\r
  78             DO\r
  79               W:=V.NEXTSON; V.NSONS:=V.NSONS+1;\r
  80               IF OK(W)\r
  81               THEN\r
  82                 W.DEADEND:=W.LEAF; CALL INSERT(W);\r
  83               FI;\r
  84               IF V.LASTSON THEN EXIT FI;\r
  85             OD;\r
  86           FI;\r
  87         FI;\r
  88       OD;\r
  89       FOUND:=NONE;\r
  90     END SE;\r
  91 \r
  92     UNIT OPTIMIZE: FUNCTION: NODE;\r
  93       VAR V,W:NODE;\r
  94     BEGIN\r
  95       CALL INSERT(ROOT);\r
  96       DO\r
  97         V:=DELETE;\r
  98         IF V=NONE THEN EXIT FI;\r
  99         IF V.ANSWER\r
 100         THEN\r
 101           NUMBER_OF_ANSWERS:=NUMBER_OF_ANSWERS+1;\r
 102           IF RESULT=NONE ORIF  RESULT.COST > V.COST\r
 103           THEN\r
 104             CALL PURGE(RESULT);  RESULT:=V\r
 105           FI;\r
 106         ELSE\r
 107           IF V.DEADEND\r
 108           THEN\r
 109             NUMBER_OF_LEAVES:=NUMBER_OF_LEAVES+1;\r
 110             CALL PURGE(V)\r
 111           ELSE\r
 112             DO\r
 113               W:=V.NEXTSON; V.NSONS:=V.NSONS+1;\r
 114               IF OK(W)\r
 115               THEN\r
 116                 W.DEADEND:=W.LEAF; CALL INSERT(W);\r
 117               FI;\r
 118               IF V.LASTSON THEN EXIT FI;\r
 119             OD;\r
 120           FI\r
 121         FI;\r
 122       OD;\r
 123     END OPTIMIZE;\r
 124 \r
 125 \r
 126     UNIT KILLALL :PROCEDURE;\r
 127       VAR V:NODE;\r
 128     BEGIN\r
 129       DO\r
 130         V:=DELETE;\r
 131         IF V=NONE THEN RETURN FI;\r
 132         CALL PURGE(V);\r
 133       OD;\r
 134     END KILLALL;\r
 135 \r
 136   BEGIN\r
 137     SEARCH:=NEW SE;\r
 138     INNER;\r
 139     KILL(SEARCH);\r
 140   END BACKTRACK;\r
 141 \r
 142   UNIT DFS :BACKTRACK CLASS;\r
 143     VAR TOP:ELEM;\r
 144 \r
 145     UNIT ELEM: CLASS (NEXT:ELEM, V:NODE);\r
 146     END ELEM;\r
 147 \r
 148     UNIT VIRTUAL INSERT: PROCEDURE(V:NODE);\r
 149     BEGIN\r
 150       TOP:=NEW ELEM(TOP,V);\r
 151     END INSERT;\r
 152 \r
 153     UNIT VIRTUAL DELETE: FUNCTION :NODE;\r
 154       VAR E:ELEM;\r
 155     BEGIN\r
 156       IF TOP =/= NONE\r
 157       THEN\r
 158         RESULT:=TOP.V;\r
 159         E:=TOP; TOP:=TOP.NEXT; KILL(E);\r
 160       FI;\r
 161     END DELETE;\r
 162 \r
 163   END DFS;\r
 164 \r
 165   VAR N,BC:INTEGER,H1,H2,H3:CHAR;\r
 166   BEGIN\r
 167    DO\r
 168     WRITE(" N= ");\r
 169     READLN(N);\r
 170     IF N=0 THEN EXIT FI;\r
 171     WRITE(" BOAT CAPACITY=");\r
 172     READLN(BC);\r
 173 \r
 174     PREF DFS BLOCK\r
 175     VAR M,C:INTEGER;  (* BC - BOAT CAPACITY, N- NUMBER OF CANNIBALS\r
 176                                              N- NUMBER OF MISSIONARS *)\r
 177     UNIT STATE: NODE CLASS(M1,C1:INTEGER);\r
 178       VAR M2,C2:INTEGER, LEFT:BOOLEAN;\r
 179             (* M1,M2 NUMBER OF MISSIONARS ON BOTH SIDES OF THE RIVER\r
 180                C1,C2 NUMBER OF CANNIBALS ON BOTH SIDES OF THE RIVER *)\r
 181 \r
 182       UNIT VIRTUAL ANSWER: FUNCTION: BOOLEAN;\r
 183       BEGIN\r
 184         RESULT:=M1=0 AND C1=0\r
 185       END ANSWER;\r
 186 \r
 187       UNIT VIRTUAL LEAF: FUNCTION : BOOLEAN;\r
 188       BEGIN\r
 189         IF  M1<0 ORIF M2<0 ORIF C1<0 ORIF C2<0 ORIF\r
 190             M1>N ORIF M2>N ORIF C1>N ORIF C2>N ORIF\r
 191             M1<C1 AND M1>0 ORIF M2<C2 AND M2>0\r
 192         THEN\r
 193           RESULT:=TRUE\r
 194         FI\r
 195       END LEAF;\r
 196 \r
 197 \r
 198       UNIT VIRTUAL LASTSON: FUNCTION :BOOLEAN;\r
 199       BEGIN\r
 200         IF C=0 AND M=BC\r
 201         THEN\r
 202           RESULT:=TRUE; M:=0; C:=0;\r
 203         FI;\r
 204       END;\r
 205 \r
 206       UNIT VIRTUAL NEXTSON : FUNCTION :STATE;\r
 207       BEGIN\r
 208         C:=C+1;\r
 209         IF M=0\r
 210         THEN\r
 211           IF C>BC\r
 212           THEN\r
 213             C:=0; M:=1\r
 214           FI\r
 215         ELSE\r
 216           IF M<C ORIF M+C>BC\r
 217           THEN\r
 218             C:=0; M:=M+1;\r
 219           FI\r
 220         FI;\r
 221         IF LEFT\r
 222         THEN\r
 223           IF C+M<BC\r
 224           THEN\r
 225             RESULT:=NONE\r
 226           ELSE\r
 227             RESULT:=NEW STATE(THIS STATE,M1-M,C1-C)\r
 228           FI\r
 229         ELSE\r
 230           RESULT:=NEW STATE(THIS STATE,M1+M,C1+C)\r
 231         FI;\r
 232       END NEXTSON;\r
 233 \r
 234       UNIT VIRTUAL EQUAL: FUNCTION(W:STATE):BOOLEAN;\r
 235       BEGIN\r
 236         RESULT:=LEFT=W.LEFT AND M1=W.M1 AND C1=W.C1;\r
 237       END EQUAL;\r
 238 \r
 239       UNIT VIRTUAL COST: FUNCTION :REAL;\r
 240       BEGIN\r
 241         RESULT:=LEVEL\r
 242       END COST;\r
 243 \r
 244 \r
 245     BEGIN\r
 246       LEFT:=LEVEL MOD 2 = 0;\r
 247       M2:=N-M1; C2:=N-C1;\r
 248     END STATE;\r
 249 \r
 250 \r
 251     UNIT DISPLAY: PROCEDURE(V:STATE);\r
 252       VAR J,I:INTEGER, W:STATE,AT: ARRAYOF STATE;\r
 253     BEGIN\r
 254       IF V=NONE THEN WRITELN(" NO MORE SOLUTIONS"); RETURN FI;\r
 255       I:=V.LEVEL;\r
 256       ARRAY AT DIM (0:I);\r
 257       W:=V;\r
 258       FOR J:=I DOWNTO 0\r
 259       DO\r
 260         AT(J):=W; W:=W.FATHER\r
 261       OD;\r
 262       WRITELN("MOVE NUMBER    LEFT SIDE  DIRECTION   RIGHT SIDE");\r
 263       FOR J:=0 TO I\r
 264       DO\r
 265         WRITE(J); WRITE("     ");\r
 266         W:=AT(J);\r
 267         WRITE(W.M1,W.C1,"      ");\r
 268         IF W.LEFT\r
 269         THEN\r
 270           WRITE("->");\r
 271         ELSE\r
 272           WRITE("<-");\r
 273         FI;\r
 274         WRITELN("    ",W.M2,W.C2);\r
 275       OD;\r
 276       KILL(AT);\r
 277     END DISPLAY;\r
 278 \r
 279     BEGIN\r
 280       ROOT:=NEW STATE(NONE,N,N);\r
 281       WRITE("DO YOU WANT TO OPTIMIZE ");\r
 282       WRITELN("OR TO PRINT ALL THE SOLUTIONS ?");\r
 283       WRITELN(" (ANSWER OPT OR ALL)");\r
 284       READLN(H1,H2,H3);\r
 285       IF H1='O' AND H2='P' AND H3='T'\r
 286       THEN\r
 287         FOUND:=OPTIMIZE;\r
 288         IF FOUND =/= NONE\r
 289         THEN\r
 290           CALL DISPLAY(FOUND);\r
 291           WRITELN("NUMBER OF LEAVES=",NUMBER_OF_LEAVES);\r
 292           WRITELN("NUMBER OF ANSWERS=",NUMBER_OF_ANSWERS);\r
 293         ELSE\r
 294           WRITELN(" NO SOLUTIONS");\r
 295           WRITELN("NUMBER OF LEAVES=",NUMBER_OF_LEAVES);\r
 296         FI;\r
 297         CALL KILLALL;\r
 298       ELSE\r
 299         IF H1='A' AND H2='L' AND H3='L'\r
 300         THEN\r
 301           DO\r
 302             ATTACH(SEARCH);\r
 303             CALL DISPLAY(FOUND);\r
 304             WRITELN("NUMBER OF LEAVES=",NUMBER_OF_LEAVES);\r
 305             WRITELN("NUMBER OF ANSWERS=",NUMBER_OF_ANSWERS);\r
 306             IF FOUND=NONE THEN EXIT FI\r
 307           OD;\r
 308           CALL KILLALL;\r
 309         FI\r
 310       FI;\r
 311     END;\r
 312   OD;\r
 313 \r
 314 \r
 315 \r
 316   END;\r
 317 \r
 318 END\r
 319 \r
 320 \r
 321 \1a