examples/backtrac/stsearch.log

   1 PROGRAM STSEARCH;\r
   2   \r
   3   UNIT BACKTRACK: CLASS;\r
   4     HIDDEN SE,ELEM,TOP;\r
   5     VAR  ROOT:NODE,SEARCH:SE,FOUND,OPT:NODE,\r
   6          NUMBER_OF_NODES,NUMBER_OF_LEAVES,NUMBER_OF_ANSWERS:INTEGER;\r
   7          \r
   8 \r
   9     UNIT NODE: COROUTINE(FATHER:NODE);\r
  10       VAR NSONS,LEVEL, MY_NUMBER: INTEGER , DEADEND:BOOLEAN;\r
  11       UNIT VIRTUAL LEAF:  FUNCTION :BOOLEAN;\r
  12       END LEAF;\r
  13       UNIT VIRTUAL ANSWER :FUNCTION :BOOLEAN;\r
  14       END ANSWER;\r
  15       UNIT VIRTUAL LASTSON: FUNCTION : BOOLEAN;\r
  16       END LASTSON;\r
  17       UNIT VIRTUAL NEXTSON: FUNCTION : NODE;\r
  18       END NEXTSON;\r
  19       UNIT VIRTUAL EQUAL : FUNCTION (W:NODE):BOOLEAN;\r
  20       END EQUAL;\r
  21       UNIT VIRTUAL COST: FUNCTION :REAL;\r
  22       END COST;\r
  23       UNIT VIRTUAL Display: PROCEDURE;\r
  24       END DISPLAY;\r
  25     BEGIN\r
  26       MY_NUMBER := NUMBER_OF_NODES;\r
  27       NUMBER_OF_NODES := NUMBER_OF_NODES+1;\r
  28       IF FATHER =/= NONE\r
  29       THEN\r
  30         LEVEL:=FATHER.LEVEL+1\r
  31       ELSE\r
  32         LEVEL:=0\r
  33       FI;\r
  34       call this NODE.DISPLAY;\r
  35     END NODE;\r
  36 \r
  37     UNIT OK: FUNCTION (V:NODE):BOOLEAN;\r
  38        VAR W:NODE;\r
  39     BEGIN\r
  40       IF V=NONE THEN RESULT:=FALSE; RETURN FI;\r
  41       RESULT:=TRUE; W:=V.FATHER;\r
  42       WHILE W =/= NONE\r
  43       DO\r
  44         IF V.EQUAL(W) THEN RESULT:=FALSE; RETURN FI;\r
  45         W:=W.FATHER\r
  46       OD\r
  47     END OK;\r
  48 \r
  49     UNIT PURGE: PROCEDURE (V:NODE);\r
  50       VAR W: NODE;\r
  51     BEGIN\r
  52       IF V=NONE THEN RETURN FI;\r
  53       DO\r
  54         W:=V.FATHER; KILL(V);\r
  55         IF W=NONE THEN RETURN FI;\r
  56         W.NSONS:=W.NSONS-1;\r
  57         IF W.NSONS =/= 0 THEN RETURN FI;\r
  58         V:=W\r
  59       OD;\r
  60     END PURGE;\r
  61 \r
  62     VAR TOP:ELEM;\r
  63 \r
  64     UNIT ELEM: CLASS (NEXT:ELEM, V:NODE);\r
  65     END ELEM;\r
  66 \r
  67     UNIT VIRTUAL INSERT: PROCEDURE(V:NODE);\r
  68     BEGIN\r
  69       TOP:=NEW ELEM(TOP,V);\r
  70     END INSERT;\r
  71 \r
  72     UNIT VIRTUAL DELETE: FUNCTION :NODE;\r
  73       VAR E:ELEM;\r
  74     BEGIN\r
  75       IF TOP =/= NONE\r
  76       THEN\r
  77         RESULT:=TOP.V;\r
  78         E:=TOP; TOP:=TOP.NEXT; KILL(E);\r
  79       FI;\r
  80     END DELETE;\r
  81 \r
  82     UNIT SE: COROUTINE ;\r
  83       VAR I:INTEGER,V,W:NODE;\r
  84     BEGIN\r
  85       RETURN; CALL INSERT(ROOT);\r
  86       DO\r
  87         V:=DELETE;\r
  88         IF V=NONE THEN EXIT FI;\r
  89         ATTACH(V);\r
  90         IF V.ANSWER\r
  91         THEN\r
  92           NUMBER_OF_ANSWERS:=NUMBER_OF_ANSWERS+1;\r
  93           FOUND:=V;\r
  94           IF OPT=NONE ORIF V.COST < OPT.COST\r
  95           THEN\r
  96              OPT:=V\r
  97           FI;\r
  98           DETACH;\r
  99           (* HERE THE USER OF BACKTRACK MAY UNDERTAKE SOME ACTIONS\r
 100              ON THE ANSWER NODES. IF NOT NECESSARY DO ATTACH      *)\r
 101         ELSE\r
 102           IF V.DEADEND\r
 103           THEN\r
 104             NUMBER_OF_LEAVES:=NUMBER_OF_LEAVES+1;\r
 105             CALL PURGE(V);\r
 106           ELSE\r
 107             DO\r
 108               W:=V.NEXTSON; V.NSONS:=V.NSONS+1;\r
 109            (*   NUMBER_OF_NODES:=NUMBER_OF_NODES+1;   *)\r
 110               IF OK(W)\r
 111               THEN\r
 112                 W.DEADEND:=W.LEAF; \r
 113                 CALL INSERT(W);\r
 114               FI;\r
 115               IF V.LASTSON THEN EXIT FI;\r
 116             OD;\r
 117           FI;\r
 118         FI;\r
 119       OD;\r
 120       FOUND:=NONE;\r
 121     END SE;\r
 122 \r
 123 \r
 124     UNIT KILLALL :PROCEDURE;\r
 125       VAR V:NODE;\r
 126     BEGIN\r
 127       DO\r
 128         V:=DELETE;\r
 129         IF V=NONE THEN RETURN FI;\r
 130         CALL PURGE(V);\r
 131       OD;\r
 132     END KILLALL;\r
 133 \r
 134   BEGIN\r
 135     SEARCH:=NEW SE;\r
 136     INNER;\r
 137     KILL(SEARCH); CALL KILLALL;\r
 138   END BACKTRACK;\r
 139 \r
 140 \r
 141   VAR N,Q:INTEGER,\r
 142       H1,H2,H3:CHAR,\r
 143       f: file;\r
 144    (* Q - BOAT CAPACITY, N- NUMBER OF CANNIBALS, N- NUMBER OF MISSIONARIES *)\r
 145 \r
 146   BEGIN\r
 147    open(f,text,unpack("stsearch.his"));\r
 148    call rewrite(f);\r
 149    DO\r
 150     writeln; writeln;\r
 151     writeln("N Cannibals and N Missionars are to traverse a river in a boat");\r
 152 \r
 153     WRITE(" N= (tape 0 to stop program)");\r
 154     READLN(N);\r
 155     IF N=0 THEN EXIT FI;\r
 156     writeln("Cannibals & Missionars - program STSEARCH.LOG of 26.05.94 ");\r
 157     WRITELN(f," N= ",N);\r
 158     WRITE(" BOAT CAPACITY=");\r
 159     READLN(Q);\r
 160     WRITELN(f,"Boat capacity=",Q);\r
 161     PREF BACKTRACK BLOCK\r
 162     VAR M,C:INTEGER;\r
 163       (* M- NUMBER OF MISSIONARIES, C- NUMBER OF CANNIBALS ON THE BOAT *)\r
 164 \r
 165       UNIT STATE: NODE CLASS(ML,CL:INTEGER);\r
 166       VAR MR,CR:INTEGER, LEFT:BOOLEAN;\r
 167 \r
 168          (* ML- NUMBER OF MISSIONARIES ON THE LEFT BANK OF THE RIVER\r
 169             MR- NUMBER OF MISSIONARIES ON THE RIGHT BANK OF THE RIVER\r
 170             CL- NUMBER OF CANNIBALS ON THE LEFT BANK OF THE RIVER\r
 171             CR- NUMBER OF CANNIBALS ON THE RIGHT BANK OF THE RIVER\r
 172             LEFT- TRUE IFF THE BOAT IS ON THE LEFT BANK OF THE RIVER *)\r
 173 \r
 174       UNIT VIRTUAL ANSWER: FUNCTION: BOOLEAN;\r
 175       BEGIN\r
 176         RESULT:=ML=0 AND CL=0\r
 177       END ANSWER;\r
 178 \r
 179       UNIT VIRTUAL LEAF: FUNCTION : BOOLEAN;\r
 180       BEGIN\r
 181         IF  ML<0 ORIF MR<0 ORIF CL<0 ORIF CR<0 ORIF\r
 182             ML>N ORIF MR>N ORIF CL>N ORIF CR>N ORIF\r
 183             ML<CL AND ML>0 ORIF MR<CR AND MR>0\r
 184         THEN\r
 185           RESULT:=TRUE\r
 186         FI\r
 187       END LEAF;\r
 188 \r
 189 \r
 190       UNIT VIRTUAL LASTSON: FUNCTION :BOOLEAN;\r
 191       BEGIN\r
 192         IF C=0 AND M=Q\r
 193         THEN\r
 194           RESULT:=TRUE; M:=0; C:=0;\r
 195         FI;\r
 196       END;\r
 197 \r
 198       UNIT VIRTUAL NEXTSON : FUNCTION :STATE;\r
 199       BEGIN\r
 200         C:=C+1;\r
 201         IF M=0\r
 202         THEN\r
 203           IF C>Q\r
 204           THEN\r
 205             C:=0; M:=1\r
 206           FI\r
 207         ELSE\r
 208           IF M<C ORIF M+C>Q\r
 209           THEN\r
 210             C:=0; M:=M+1;\r
 211           FI\r
 212         FI;\r
 213         IF LEFT\r
 214         THEN\r
 215           IF C+M<Q\r
 216           THEN\r
 217             RESULT:=NONE\r
 218           ELSE\r
 219             RESULT:=NEW STATE(THIS STATE,ML-M,CL-C)\r
 220           FI\r
 221         ELSE\r
 222           RESULT:=NEW STATE(THIS STATE,ML+M,CL+C)\r
 223         FI;\r
 224       END NEXTSON;\r
 225 \r
 226       UNIT VIRTUAL EQUAL: FUNCTION(S:STATE):BOOLEAN;\r
 227       BEGIN\r
 228         RESULT:=LEFT=S.LEFT AND ML=S.ML AND CL=S.CL;\r
 229       END EQUAL;\r
 230 \r
 231       UNIT VIRTUAL COST: FUNCTION :REAL;\r
 232       BEGIN\r
 233         RESULT:=LEVEL\r
 234       END COST;\r
 235     \r
 236     UNIT VIRTUAL DISPLAY: PROCEDURE;\r
 237       VAR J,I:INTEGER, \r
 238           V, W:STATE,\r
 239           AT: ARRAYOF STATE;\r
 240     BEGIN\r
 241       V := this STATE;\r
 242       I:=V.LEVEL;\r
 243       ARRAY AT DIM (0:I);\r
 244       W:=V;\r
 245       FOR J:=I DOWNTO 0\r
 246       DO\r
 247         AT(J):=W; W:=W.FATHER\r
 248       OD;\r
 249       WRITELN(f);\r
 250       WRITE(f,"State no:",MY_NUMBER:4);\r
 251       if FATHER <> none then WRITE(f,"   son of state: ",FATHER.MY_NUMBER:4) fi;\r
 252       if ANSWER then WRITELN(f, "      SOLUTION!") \r
 253       else if LEAF then WRITELN(f,"      DEADEND")\r
 254            else if not OK(V) then WRITELN(f,"      REDUNDANT STATE")\r
 255                 else WRITELN(f)\r
 256                 fi\r
 257            fi\r
 258       fi;\r
 259 \r
 260       WRITELN(f,"MOVE NUMBER    LEFT SIDE  DIRECTION   RIGHT SIDE");\r
 261       FOR J:=0 TO I\r
 262       DO\r
 263         WRITE(f,J); WRITE(f,"     ");\r
 264         W:=AT(J);\r
 265         WRITE(f,W.ML,W.CL,"      ");\r
 266         IF W.LEFT\r
 267         THEN\r
 268           WRITE(f,"->");\r
 269         ELSE\r
 270           WRITE(f,"<-");\r
 271         FI;\r
 272         WRITELN(f,"    ",W.MR,W.CR);\r
 273       OD;\r
 274       KILL(AT);\r
 275     END DISPLAY;\r
 276 \r
 277 \r
 278     BEGIN\r
 279       LEFT:=LEVEL MOD 2 = 0;\r
 280       MR:=N-ML; CR:=N-CL;\r
 281       RETURN;\r
 282       DO\r
 283         DETACH\r
 284       OD;\r
 285     END STATE;\r
 286 \r
 287 \r
 288     UNIT DISPLAY: PROCEDURE(V:STATE);\r
 289       VAR J,I:INTEGER, W:STATE,AT: ARRAYOF STATE;\r
 290     BEGIN\r
 291       IF V=NONE THEN WRITELN(" NO MORE SOLUTIONS"); RETURN FI;\r
 292       I:=V.LEVEL;\r
 293       ARRAY AT DIM (0:I);\r
 294       W:=V;\r
 295       FOR J:=I DOWNTO 0\r
 296       DO\r
 297         AT(J):=W; W:=W.FATHER\r
 298       OD;\r
 299       WRITELN("MOVE NUMBER    LEFT SIDE  DIRECTION   RIGHT SIDE");\r
 300       FOR J:=0 TO I\r
 301       DO\r
 302         WRITE(J); WRITE("     ");\r
 303         W:=AT(J);\r
 304         WRITE(W.ML,W.CL,"      ");\r
 305         IF W.LEFT\r
 306         THEN\r
 307           WRITE("->");\r
 308         ELSE\r
 309           WRITE("<-");\r
 310         FI;\r
 311         WRITELN("    ",W.MR,W.CR);\r
 312       OD;\r
 313       KILL(AT);\r
 314     END DISPLAY;\r
 315 \r
 316     BEGIN\r
 317       ROOT:=NEW STATE(NONE,N,N);\r
 318       WRITE("DO YOU WANT TO OPTIMIZE ");\r
 319       WRITELN("OR TO PRINT ALL THE SOLUTIONS ?");\r
 320       WRITELN(" (ANSWER OPT OR ALL)");\r
 321       READLN(H1,H2,H3);\r
 322       IF H1='O' AND H2='P' AND H3='T'\r
 323       THEN\r
 324         DO\r
 325           ATTACH(SEARCH);\r
 326           IF FOUND=NONE THEN EXIT FI;\r
 327        (*   IF OPT =/= NONE ANDIF OPT.COST<FOUND.COST\r
 328           THEN\r
 329             EXIT\r
 330           FI;  *)\r
 331         OD;\r
 332         IF OPT =/= NONE\r
 333         THEN\r
 334           CALL DISPLAY(OPT);\r
 335           WRITELN("NUMBER OF NODES=",NUMBER_OF_NODES);\r
 336           WRITELN("NUMBER OF LEAVES=",NUMBER_OF_LEAVES);\r
 337           WRITELN("NUMBER OF ANSWERS=",NUMBER_OF_ANSWERS);\r
 338         ELSE\r
 339           WRITELN("NO SOLUTIONS");\r
 340           WRITELN("NUMBER OF NODES=",NUMBER_OF_NODES);\r
 341           WRITELN("NUMBER OF LEAVES=",NUMBER_OF_LEAVES);\r
 342         FI;\r
 343       ELSE\r
 344         IF H1='A' AND H2='L' AND H3='L'\r
 345         THEN\r
 346           DO\r
 347             ATTACH(SEARCH);\r
 348             CALL DISPLAY(FOUND);\r
 349             WRITELN("NUMBER OF NODES=",NUMBER_OF_NODES);\r
 350             WRITELN("NUMBER OF LEAVES=",NUMBER_OF_LEAVES);\r
 351             WRITELN("NUMBER OF ANSWERS=",NUMBER_OF_ANSWERS);\r
 352             IF FOUND=NONE THEN EXIT FI;\r
 353             WRITELN("DO YOU WANT TO CONTINUE?");\r
 354             READ(H1,H2);\r
 355             IF H1=/='Y' ORIF H2=/='E' THEN EXIT FI;\r
 356             READLN(H3);\r
 357             IF H3=/='S' THEN EXIT FI;\r
 358           OD;\r
 359         FI\r
 360       FI;\r
 361     END;  (* of prefixed block*)\r
 362   OD;\r
 363   kill(f);\r
 364   writeln("the tree is in the file STSEARCH.HIS");\r
 365 \r
 366   END;  (* of program *)\r
 367 \r
 368 \r
 369 \r