examples/backtrac/graphcol.log

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