; ABT for the graph-coloring problem ; by Ionel Muscalagiu ( mionel@fih.utt.ro ) ; and Jose M. Vidal ; ; breeds [vertices ] ; ;edges is a list of lists: a 2D array indexed by who. The value is 1 if there is a link, 0 otherwise. ;num-colors ;domain is the list of allowed colors globals [edges domain no-more-messages tmp nr_cicluri number-of-edges done] ;parent is the 'who' of the parent ;parent-agent is the actual parent ;children is a list of the 'who' of the children ;children-agent is an agentset of the children ;level in the tree. root is 0 ;descendant-neighbors is a list of the 'who' of all vertices that are descendants and have a constraint with me ;the-neighbors is a list of the initial neighbors nodes ;extendend-neighbors is a list of the 'who' of all vertices that have a constraint with me ; ;message-queue contains the incoming messages. We take new ones out from the head. ;current-view is a list indexed by queen number [col0 col1 col2...] col = -1 if unknown. ;nogoods is a list of inconsistent positions [0 1 1 0 ... ] where 0 is good and 1 is no-good. ;messages-recieved is the number of messages this vertice has received. vertices-own [message-queue parent parent-agent children children-agent level descendant-neighbors the-neighbors extendend-neighbors dfs-neighbors dfs-change colorn current-view nogoods messages-received_ok messages-received_nogood nr_constraintc AgentC_Cost messages-received messages-received_nogoodold nrgstoc] ;returns a list of legnth n where each item is v to-report make-list [n v] locals [res] set res [] repeat n [ set res fput v res] report res end to make-link [v1 v2] locals [aux] if (v2 < v1)[ set aux v2 set v2 v1 set v1 aux] if (not neighbors? v1 v2) [ set edges replace-item v1 edges (lput v2 (item v1 edges)) ] end to-report neighbors? [v1 v2] locals [aux] if (v2 < v1) [ set aux v2 set v2 v1 set v1 aux] report member? v2 (item v1 edges) end ;reports true if edges and num-vertices represent a connected graph ;trebuie sa verificam pentru ca altfel nu are sens sa mai rezolvam problema to-report connected? locals [clique i j] set i 0 set clique [] set clique lput i clique set i 1 set j 0 while [j < num-vertices][ while [i < num-vertices][ if (not member? i clique)[ if (not empty? filter [neighbors? ? i] clique)[ set clique lput i clique if (length clique = num-vertices)[ report true ] ] ] set i i + 1 ] set j j + i ] report false end ;sets 'edges' and 'the-neighbors' to make-edges locals [edges-created v1 v2 aux] set edges make-list num-vertices [] set edges-created 0 if num-vertices * edge-density > (num-vertices * (num-vertices - 1)) / 2 [set edge-density ( num-vertices - 1 ) / 2] while [edges-created < num-vertices * edge-density][ set v1 (random-int-or-float num-vertices) set v2 (random-int-or-float num-vertices) if (v1 > v2) [ set aux v2 set v2 v1 set v1 aux ] if (v1 != v2 and (not neighbors? v1 v2))[ make-link v1 v2 set edges-created (edges-created + 1) ] ] set v1 0 while [v1 < num-vertices][ set tmp (item v1 edges) set (the-neighbors-of (turtle v1)) [] set v2 0 while [v2 < num-vertices][ if (neighbors? v1 v2)[ set (the-neighbors-of (turtle v1)) lput v2 the-neighbors-of (turtle v1) ] set v2 v2 + 1 ] set v1 v1 + 1 ] if (not connected?)[ print "Graph not connected. Generating again..." make-edges] set number-of-edges edges-created end to load-edges_file locals [edges-created v1 v2 aux i nod culoare] file-open "graf30-2.0.txt" set num-vertices file-read set edge-density file-read set number-of-edges file-read set edges make-list num-vertices [] set edges-created 0 while [edges-created < num-vertices * edge-density][ set v1 file-read set v2 file-read if (v1 > v2) [ set aux v2 set v2 v1 set v1 aux ] if (v1 != v2 and (not neighbors? v1 v2))[ make-link v1 v2 set edges-created (edges-created + 1) ] ] set v1 0 show edge-density show num-vertices while [v1 < num-vertices][ set tmp (item v1 edges) set (the-neighbors-of (turtle v1)) [] set v2 0 while [v2 < num-vertices][ if (neighbors? v1 v2)[ set (the-neighbors-of (turtle v1)) lput v2 the-neighbors-of (turtle v1) ] set v2 v2 + 1 ] set v1 v1 + 1 ] file-close end to set-parent locals [parents] set parents filter [? < who] dfs-neighbors ifelse (empty? parents) [ set parent -1 ;the root ][ if (dfs-change) [ ;jmv added dfs-change variable set parent max parents ] ] end to set-level ifelse (parent = -1)[ set level 0 ][ set level (level-of parent-agent) + 1 ] end ; n is length of list ; el is the element to-report get-list [n el] locals [i lst] set i 0 set lst [] while [i < n] [ set lst fput el lst set i i + 1] report lst end ;vertice function to find-best-position locals [possible-patches siblings best-patch] ifelse (parent = -1) [ set xcor 0 ][ set siblings vertices with [self != myself and (level = level-of myself or who = parent-of myself)] set possible-patches patches with [distance-nowrap myself < 20 and (pycor = round ycor-of myself)] set best-patch max-one-of possible-patches [sum values-from siblings [log (distance-nowrap myself + .1) 2]] set xcor (pxcor-of best-patch) if (xcor < 0 - screen-edge-x + 50) [set xcor 0 - screen-edge-x + 50] if (xcor > screen-edge-x - 10) [set xcor screen-edge-x - 10] ] end ;vertices function. Draws an edge from this vertice to other-vertice to draw-edge [other-vertice col] locals [dista oc ox oy] set oc color set ox xcor set oy ycor set color col set dista distance-nowrap other-vertice set heading towards-nowrap other-vertice pen-down fd dista pen-up set color oc setxy ox oy set heading 0 end to draw-edges locals [v1] set v1 0 while [v1 < num-vertices][ no-display ask (turtle v1) [ without-interruption [ foreach the-neighbors [ draw-edge (turtle ?) blue ] ] ] display set v1 v1 + 1 ] end to set-dfs-tree ask vertices [ set dfs-neighbors the-neighbors set parent -2 set children [] set message-queue [] set dfs-change true set-parent ] ;ugly hack: add an edge between any parent-child that does not have one ask vertices [ if (parent != -1 and (not member? parent the-neighbors))[ make-link who parent set the-neighbors lput parent the-neighbors set (the-neighbors-of (turtle parent)) lput who (the-neighbors-of (turtle parent)) show "Added extra edge " + who + " - " + parent ] ] ;sets the parent-agent and children ask vertices [ if (parent != -1) [ set parent-agent (turtle parent) set children-of parent-agent fput who (children-of parent-agent) ] ] end to setup-vertices locals [i] set nr_cicluri 0 show "Setup" set domain [] set i 0 while [i < num-colors][ set domain lput item i [15 105 64 125 45 85 35 55 5] domain set i i + 1 ] create-vertices num-vertices ask vertices [ set size 12 set shape "circle" set heading 0 set parent -2 set label who set messages-received 0 set messages-received_ok 0 set messages-received_nogood 0 set messages-received_nogoodold 0 set nr_constraintc 0 set current-view get-list num-vertices -1 set nogoods get-list num-vertices 0 set message-queue [] set AgentC_Cost 0 if (who != 0) [ set-current-plot "Messages" create-temporary-plot-pen "" + who set-current-plot-pen "" + who set-plot-pen-color (5 + 10 * who) mod 140 set-current-plot "Constraint checks" create-temporary-plot-pen "" + who set-current-plot-pen "" + who set-plot-pen-color (5 + 10 * who) mod 140 ] set color item (random-int-or-float num-colors) domain set colorn position color domain ] make-edges ;load-edges_file end to setup-patches locals [i] set-dfs-tree repeat num-vertices [ ask vertices [ set-level ] ] set i max values-from vertices [level] ; set i 8 ask vertices [ ;set level who + 1 set ycor (screen-edge-y - 20) - (level * ((screen-size-y - 30) / i)) ] repeat 8 [ ask vertices [ find-best-position ] ] draw-edges end to WriteSolution show "Solution" ask vertices [ show colorn + " " ] end to setup ca file-close clear-output setup-vertices setup-patches set done false ask vertices [initialize set extendend-neighbors the-neighbors ] end to update set no-more-messages true set nr_cicluri nr_cicluri + 1 if done [show "No solution" stop] ask vertices [ if (not empty? message-queue)[ set no-more-messages false]] if (no-more-messages) [ WriteSolution stop] ask vertices [handle-message] ask vertices [ set-current-plot "Messages" create-temporary-plot-pen "q" + who plot messages-received_nogood plot messages-received_ok set-current-plot "Constraint checks" create-temporary-plot-pen "q" + who plot nr_constraintc ] if (show-trace)[ print "==============" ask vertices [ show "view=" + current-view show "nogood=" + nogoods]] end ;;;; ;;vertices functions ;; to receive-message [msg] without-interruption [ set message-queue lput msg message-queue] end to-report retrieve-message locals [msg] without-interruption [ set msg first message-queue set message-queue butfirst message-queue ] report msg end ;;;Tree utility functions to send-message [receiver msg] without-interruption [ set message-queue-of (turtle receiver) lput msg (message-queue-of (turtle receiver)) ] set messages-received-of (turtle receiver) messages-received-of (turtle receiver) + 1 end to initialize locals [msg] foreach the-neighbors [ if (? > who) [set msg (list "ok" (list who colorn) AgentC_Cost) send-message ? msg] ] end ;Get the msg and dispatch it to the appropiate function to handle-message locals [msg xj dj sender msgnog SenderC_Cost] if (empty? message-queue) [stop] set msg retrieve-message ;set messages-received messages-received + 1 if (first msg = "ok") [ set xj item 0 (item 1 msg) set dj item 1 (item 1 msg) set messages-received_ok messages-received_ok + 1 set SenderC_Cost item 2 msg if SenderC_Cost > AgentC_Cost [ set AgentC_Cost SenderC_Cost ] ok xj dj ] if (first msg = "nogood") [ set SenderC_Cost item 3 msg if SenderC_Cost > AgentC_Cost [ set AgentC_Cost SenderC_Cost ] set sender item 1 msg set msgnog item 2 msg nogood sender msgnog set messages-received_nogood messages-received_nogood + 1 ] if (first msg = "addl") [ SetLink item 1 msg ] end ; this is the Ok? procedure in the paper where Qj = Xj and Vj = dj to ok [Qj Vj ] set current-view replace-item Qj current-view Vj check-agent-view end to-report agents-in-context [cont] locals [i res] set i 0 set res [] while [i < num-vertices][ if (item i cont != -1) [ set res lput i res ] set i i + 1 ] report res end to-report locate-who-nogood [ n ] locals [whon gasit lagent] set lagent agents-in-context current-view set whon n - 1 set gasit false while [not gasit ] [ ifelse ( member? whon lagent ) [set gasit true] [set whon whon - 1] ] report whon end to SetLink [ Sender] locals [msg] if not member? Sender extendend-neighbors [ set extendend-neighbors lput Sender extendend-neighbors set extendend-neighbors sort extendend-neighbors set msg (list "ok" (list who colorn) AgentC_Cost) send-message Sender msg ] end to-report Is_oldnogood [beef whosend] locals [i] set i 0 while [i < who ] [ if ( (item i beef) != (item i current-view) and (item i beef) != -1 and (item i current-view) != -1 and member? i extendend-neighbors) [report true] set i (i + 1) ] if ((item who beef) != (colorn) and (item who beef) != -1) [report true] report false end ; this is the nogood procedure from the paper to nogood [whosend beef ] locals [ i j msg whonog oldvalue k] ;does this nogood apply to my current view? if (Is_oldnogood beef whosend ) [ if (item who beef = colorn) ;and (member? whosend extendend-neighbors) [ set msg (list "ok" (list who colorn) AgentC_Cost) send-message whosend msg ] stop ] ;mark current position as no good ;set nogoods replace-item colorn nogoods 1 set nrgstoc nrgstoc + 1 set i 0 while [i < who ] [ if (not member? i extendend-neighbors) and ((item i beef ) != -1) [ set msg (list "addl" who ) send-message i msg set current-view (replace-item i current-view (item i beef)) set extendend-neighbors lput i extendend-neighbors set extendend-neighbors sort extendend-neighbors set extendend-neighbors remove-duplicates extendend-neighbors ] set i (i + 1) ] set oldvalue colorn set nogoods replace-item colorn nogoods 1 Check-agent-view1 if ( oldvalue = colorn ) [ set msg (list "ok" (list who colorn) AgentC_Cost) send-message whosend msg ] end to check-agent-view locals [ i j msg whonog consistent k col] set i 0 set consistent true while [ i < who ] ;for each vertices [ set nr_constraintc nr_constraintc + 1 set AgentC_Cost AgentC_Cost + 1 if (colorn = item i current-view) and ( neighbors? who i) [ set consistent false ] set i i + 1 ] set nogoods get-list num-colors 0 set i 0 while [ i < who ] ;for each vertices [ set j 0 while [ j < num-colors ] ;for each color [ set nr_constraintc nr_constraintc + 1 set AgentC_Cost AgentC_Cost + 1 if ( j = (item i current-view) and ( neighbors? i who ) and (item i current-view != -1 )) [set nogoods replace-item j nogoods 1] set j (j + 1)] set i (i + 1) ] if ( not consistent ) [ set col 0 set k 0 while [ col < num-colors and k = 0] [ if ( item Col nogoods = 0 ) [ set i 0 set consistent true while [ i < who ] ;for each vertices [ set nr_constraintc nr_constraintc + 1 set AgentC_Cost AgentC_Cost + 1 if ( col = (item i current-view) and ( neighbors? who i)) [ set consistent false] set i i + 1 ] if consistent [ set colorn col ;setxy (colorn - screen-edge-x) (screen-edge-y - who) set color item colorn domain set msg (list "ok" (list who colorn) AgentC_Cost) foreach extendend-neighbors [ if (? > who ) [send-message ? msg] ] set k 1 ] ; [ set nogoods replace-item col nogoods 1] ] set col (col + 1) ] if (k = 0 ) [BackTrack] ] end to check-agent-view1 locals [ i j msg whonog consistent k col] set col 0 set k 0 while [ col < num-colors and k = 0] [ if ( item Col nogoods = 0 ) [ set i 0 set consistent true while [ i < who ] ;for each vertices [ set nr_constraintc nr_constraintc + 1 set AgentC_Cost AgentC_Cost + 1 if ( col = (item i current-view) and ( neighbors? who i)) [ set consistent false] set i i + 1 ] if consistent [ set colorn col ;setxy (colorn - screen-edge-x) (screen-edge-y - who) set color item colorn domain set msg (list "ok" (list who colorn) AgentC_Cost) foreach extendend-neighbors [ if (? > who ) [send-message ? msg] ] set k 1 ] ] set col (col + 1) ] if (k = 0 ) [BackTrack ] end to BackTrack locals [msg whonog] if (who = 0);no consistent colors and I'm highest priority [ show "No solution" set done true stop ] set msg (list "nogood" who current-view AgentC_Cost ) set whonog locate-who-nogood who send-message whonog msg set current-view (replace-item whonog current-view -1) UpdateNogood check-agent-view1 end to UpdateNogood locals [i j] set nogoods get-list num-colors 0 set i 0 while [ i < who ] ;for each vertices [ set j 0 while [ j < num-colors ] ;for each color [ set nr_constraintc nr_constraintc + 1 set AgentC_Cost AgentC_Cost + 1 if ( j = (item i current-view) and ( neighbors? i who ) and (item i current-view != -1 )) [set nogoods replace-item j nogoods 1] set j (j + 1)] set i (i + 1) ] end @#$#@#$#@ GRAPHICS-WINDOW 248 10 719 496 153 151 1.502 1 10 1 1 1 CC-WINDOW 729 10 982 495 Command Center BUTTON 0 10 81 43 NIL setup NIL 1 T OBSERVER T SLIDER 2 45 174 78 num-vertices num-vertices 0 100 10 1 1 NIL BUTTON 82 10 163 43 NIL update NIL 1 T OBSERVER T BUTTON 163 10 245 45 NIL update T 1 T OBSERVER T SWITCH 4 78 109 111 show-trace show-trace 1 1 -1000 PLOT 5 264 242 443 Messages Cycles Msg nogood 0.0 10.0 0.0 10.0 true false PENS "Messages" 1.0 2 -16777216 true "default" 1.0 0 -16777216 true MONITOR 176 47 251 96 Msgs nogood sum (values-from vertices [messages-received_nogood]) 0 1 MONITOR 176 99 242 148 Msgs ok sum (values-from vertices [messages-received_ok]) 3 1 MONITOR 116 153 218 202 Cycles nr_cicluri 0 1 MONITOR 3 184 103 233 Constraint checks sum (values-from vertices [nr_constraintc]) 0 1 PLOT 7 450 243 630 Constraint checks Cycles Constraint checks 0.0 10.0 0.0 10.0 true false SLIDER 4 113 176 146 edge-density edge-density 0.5 5 1.6 0.1 1 NIL SLIDER 3 149 114 182 num-colors num-colors 0 10 3 1 1 NIL MONITOR 115 206 220 255 Cumulattive Cost max (values-from vertices [AgentC_Cost]) 3 1 @#$#@#$#@ Title: Graph Coloring using Asynchronous Backtracking Author: Ionel Muscalagiu, Jose M. Vidal Description: This is the implementation of the Asynchronous Backtracking for the graph coloring problem. We solve the graph coloring problem using the ABT algorithm from