1 PROGRAM GraphColoring;
\r
2 UNIT BACKTRACK: CLASS;
\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
8 UNIT NODE: COROUTINE(FATHER:NODE);
\r
9 VAR NSONS,LEVEL,MY_NUMBER: INTEGER , DEADEND:BOOLEAN;
\r
10 UNIT VIRTUAL LEAF: FUNCTION :BOOLEAN;
\r
12 UNIT VIRTUAL ANSWER :FUNCTION :BOOLEAN;
\r
14 UNIT VIRTUAL LASTSON: FUNCTION : BOOLEAN;
\r
16 UNIT VIRTUAL NEXTSON: FUNCTION : NODE;
\r
18 UNIT VIRTUAL EQUAL : FUNCTION (W:NODE):BOOLEAN;
\r
20 UNIT VIRTUAL COST: FUNCTION :REAL;
\r
23 NUMERO_DE_NOEUDS := NUMERO_DE_NOEUDS + 1;
\r
24 MY_NUMBER := NUMERO_DE_NOEUDS;
\r
27 LEVEL:=FATHER.LEVEL+1
\r
33 UNIT OK: FUNCTION (V:NODE):BOOLEAN;
\r
36 IF V=NONE THEN RESULT:=FALSE; RETURN FI;
\r
37 RESULT:=TRUE; W:=V.FATHER;
\r
40 IF V.EQUAL(W) THEN RESULT:=FALSE; RETURN FI;
\r
45 UNIT PURGE: PROCEDURE (V:NODE);
\r
48 IF V=NONE THEN RETURN FI;
\r
50 W:=V.FATHER; KILL(V);
\r
51 IF W=NONE THEN RETURN FI;
\r
53 IF W.NSONS =/= 0 THEN RETURN FI;
\r
60 UNIT ELEM: CLASS (NEXT:ELEM, V:NODE);
\r
63 UNIT VIRTUAL INSERT: PROCEDURE(V:NODE);
\r
65 TOP:=NEW ELEM(TOP,V);
\r
68 UNIT VIRTUAL DELETE: FUNCTION :NODE;
\r
74 E:=TOP; TOP:=TOP.NEXT; KILL(E);
\r
78 UNIT SE: COROUTINE ;
\r
79 VAR I:INTEGER,V,W:NODE;
\r
81 RETURN; CALL INSERT(ROOT);
\r
84 IF V=NONE THEN EXIT FI;
\r
88 NUMBER_OF_ANSWERS:=NUMBER_OF_ANSWERS+1;
\r
90 IF OPT=NONE ORIF V.COST < OPT.COST
\r
95 (* HERE THE USER OF BACKTRACK MAY UNDERTAKE SOME ACTIONS
\r
96 ON THE ANSWER NODES. IF NOT NECESSARY DO ATTACH *)
\r
100 NUMBER_OF_LEAVES:=NUMBER_OF_LEAVES+1;
\r
104 W:=V.NEXTSON; V.NSONS:=V.NSONS+1;
\r
105 NUMBER_OF_NODES:=NUMBER_OF_NODES+1;
\r
108 W.DEADEND:=W.LEAF; CALL INSERT(W);
\r
110 IF V.LASTSON THEN EXIT FI;
\r
119 UNIT KILLALL :PROCEDURE;
\r
124 IF V=NONE THEN RETURN FI;
\r
130 NUMBER_OF_NODES := 1;
\r
133 KILL(SEARCH); CALL KILLALL;
\r
137 VAR N,M,I,J:INTEGER,H1,H2,H3:CHAR;
\r
138 VAR INC: ARRAYOF ARRAYOF BOOLEAN,
\r
141 open(f, text, unpack("colourng.his"));
\r
145 writeln("An aplication of Backtracking to Graph Colouring");
\r
146 WRITE(" NUMBER OF VERTICES= (exit on zero) ");
\r
150 IF N=0 THEN EXIT FI;
\r
152 WRITEln(f," NUMBER OF VERTICES= ",N);
\r
153 WRITE(" NUMBER OF COLOURS= ");
\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
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
166 WRITELN(" VERTEX ",I:3," IS INCIDENT WITH VERTICES=");
\r
167 WRITELN(f," VERTEX ",I:3," IS INCIDENT WITH VERTICES=");
\r
169 READ(J); WRITE(f,J);
\r
170 IF J>1 AND J<=N THEN INC(J,I):=TRUE ELSE EXIT FI;
\r
172 WRITELN(" END OF EDGES WITH VERTEX", I:3);
\r
173 WRITELN(f," END OF EDGES WITH VERTEX", I:3);
\r
175 WRITELN(" GRAPH HAS THE FOLLOWING INCIDENCE MATRIX");
\r
176 WRITELN(f," GRAPH HAS THE FOLLOWING INCIDENCE MATRIX");
\r
182 THEN WRITE(1:2); write(f,1:2)
\r
183 ELSE WRITE(0:2); write(f,0:2)
\r
186 WRITELN; writeln(f);
\r
188 PREF BACKTRACK BLOCK
\r
190 UNIT STATE: NODE CLASS(I,J,NC:INTEGER);
\r
192 (*I- VERTEX, J-COLOUR, NC-NUMBER OF COLOURS *)
\r
194 UNIT VIRTUAL ANSWER: FUNCTION: BOOLEAN;
\r
196 RESULT:= I=N AND OKGO(THIS STATE)
\r
199 UNIT VIRTUAL LEAF: FUNCTION :BOOLEAN;
\r
201 RESULT:=I=N OR NOT OKGO(THIS STATE)
\r
204 UNIT OKGO: FUNCTION(V:STATE) : BOOLEAN;
\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
216 UNIT VIRTUAL LASTSON: FUNCTION :BOOLEAN;
\r
225 UNIT VIRTUAL NEXTSON : FUNCTION :STATE;
\r
226 VAR V:STATE,NCK:INTEGER;
\r
232 IF V=NONE THEN NCK:=NCK+1; EXIT FI;
\r
233 IF V.J=K THEN EXIT FI;
\r
236 RESULT:=NEW STATE(THIS STATE,I+1,K,NCK);
\r
237 call DISPLAY(result);
\r
240 UNIT VIRTUAL EQUAL: FUNCTION(S:STATE):BOOLEAN;
\r
242 RESULT:=I=S.I AND J=S.J
\r
245 UNIT VIRTUAL COST: FUNCTION :REAL;
\r
259 UNIT DISPLAY: PROCEDURE(V:STATE);
\r
262 THEN WRITELN(" NO SOLUTIONS"); writeln(f,"no solutions"); RETURN
\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
268 if V.LEAF then WRITELN(" DEADEND ")
\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
276 if V.LEAF then WRITELN(f," DEADEND ")
\r
280 WRITELN("VERTEX COLOUR");
\r
281 WRITELN(f,"VERTEX COLOUR");
\r
283 WRITE(V.I); WRITE(" "); WRITELN(V.J);
\r
284 WRITE(f,V.I); WRITE(f," "); WRITELN(f,V.J);
\r
286 IF V=NONE THEN EXIT FI
\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
299 IF H1='O' AND H2='P' AND H3='T'
\r
303 IF FOUND=NONE THEN EXIT FI;
\r
304 IF OPT =/= NONE ANDIF OPT.COST<FOUND.COST
\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
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
329 IF H1='A' AND H2='L' AND H3='L'
\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
341 IF FOUND=NONE THEN EXIT FI;
\r
342 WRITELN("DO YOU WANT TO CONTINUE?");
\r
344 IF H1=/='Y' ORIF H2=/='E' THEN EXIT FI;
\r
346 IF H3=/='S' THEN EXIT FI;
\r
350 END (* of PREFIXED block *) ;
\r
355 END; (* of program *)
\r