; ABTkernel for the graph-coloring problem ; by Ionel Muscalagiu - mionel@fih.utt.ro ; and Jose 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 gata number-of-edges] ;MyContext (current-view in the ABT) 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. ;parent is the 'who' of the parent ;children is a list of the 'who' of the children ;level in the tree. root is 0 ;the-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 level descendant-neighbors the-neighbors dfs-neighbors dfs-change ChildrenA ParentA MyValue_colorn MyContext nogoods messages-received_ok messages-received_nogood nr_constraintc AgentC_Cost agent_nogood messages-received messages-received_nogoodold] ;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 "graf20-2.0-1.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 ;LoadColors end to LoadColors locals [i nod culoare] file-open "culorit.txt" set i 0 while [i < num-vertices] [ set nod file-read set culoare file-read set MyValue_colorn-of turtle nod culoare set i i + 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 ] ;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 messages-received 0 set messages-received_ok 0 set messages-received_nogood 0 set messages-received_nogoodold 0 set nr_constraintc 0 set AgentC_Cost 0 set MyContext get-list num-vertices -1 set nogoods get-list num-vertices 0 set message-queue [] 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 Myvalue_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 ask vertices [ show MyValue_colorn + " " ] end to WriteGrafFisier locals [i] if (file-exists? "graf.txt" ) [file-delete "graf.txt"] file-open "graf.txt" file-print num-vertices + " " + edge-density + " " + number-of-edges ask vertices [ set i 0 while [i < num-vertices] [if (neighbors? who i ) [file-print who +" " + i ] set i i + 1 ] ] file-close if (file-exists? "culori.txt" ) [file-delete "culori.txt"] file-open "culori.txt" ask vertices [ file-print who +" " + MyValue_colorn ] file-close end to WriteColors if (file-exists? "culorit.txt" ) [file-delete "culorit.txt"] file-open "culorit.txt" ask vertices [ file-print who +" " + MyValue_colorn ] file-close end to setup ca file-close clear-output setup-vertices setup-patches set gata false ask vertices [ ComputeParentA_ChildrenA initialize ] end to ComputeParentA_ChildrenA locals [i] set ChildrenA [] set ParentA [] foreach the-neighbors [ if (? > who ) [set ChildrenA lput ? ChildrenA] if (? < who ) [set ParentA lput ? ParentA] ] end to update set no-more-messages true set nr_cicluri nr_cicluri + 1 if (nr_cicluri > Max_cycle) [Stop] ask vertices [ if (not empty? message-queue)[ set no-more-messages false]] if (no-more-messages) [ WriteSolution stop] if (gata) [ show "no solution" 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=" + MyContext show "nogood=" + nogoods]] end 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 to initialize locals [msg] foreach childrenA [ set msg (list "info" (list who MyValue_colorn) AgentC_Cost) ask turtles with [who = ? ] [receive-message msg] ] end ;this is the ABTkernel procedure in the paper to handle-message locals [msg xj dj SenderC_Cost] if (empty? message-queue) [stop] set msg retrieve-message ;show msg if (first msg = "stop") [set gata true stop] if (first msg = "info") [set messages-received_ok messages-received_ok + 1 ProcessInfo msg ] if (first msg = "back") [ set messages-received_nogood messages-received_nogood + 1 set SenderC_Cost item 3 msg if SenderC_Cost > AgentC_Cost [ set AgentC_Cost SenderC_Cost ] ResolveConflict item 1 msg item 2 msg ] end to ProcessInfo [msg ] locals [xj dj SenderC_Cost ] set xj item 0 (item 1 msg) set dj item 1 (item 1 msg) set SenderC_Cost item 2 msg if SenderC_Cost > AgentC_Cost [ set AgentC_Cost SenderC_Cost ] UpdateContextInfo xj dj CheckAgentView end ;this is the CheckAgentView procedure in the ABTkernel algorithm to CheckAgentView locals [TempValue msg ] if (not Is-Consistent) [ set TempValue ChooseValue ifelse (TempValue > -1 ) [ set MyValue_colorn TempValue set color item MyValue_colorn domain foreach childrenA [ set msg (list "info" (list who MyValue_colorn) AgentC_Cost) ask turtles with [who = ? ] [receive-message msg] ] ] [Backtrack] ] end to CheckAgentView1 locals [TempValue msg ] set TempValue ChooseValue ifelse (TempValue > -1 ) [ set MyValue_colorn TempValue set color item MyValue_colorn domain foreach childrenA [ set msg (list "info" (list who MyValue_colorn) AgentC_Cost) ask turtles with [who = ? ] [receive-message msg] ] ] [Backtrack] end to UpdateContextInfo [Qj Vj ] locals [i j ] set MyContext replace-item Qj MyContext Vj ;set i Qj set nogoods get-list num-colors 0 set i 0 while [ i < who ] ;for each vertice [set j 0 while [ j < num-colors ] ;for each color [ set nr_constraintc nr_constraintc + 1 set AgentC_Cost AgentC_Cost + 1 if ((neighbors? i who) and ( j = (item i MyContext)) and (item i MyContext != -1 )) [set nogoods replace-item j nogoods 1] set j (j + 1)] set i (i + 1)] end to-report Is-Consistent locals [i consistent] set consistent true if (item MyValue_colorn nogoods = 1) [ set consistent false ] report consistent end ;this is the Coherent function in the ABTkernel algorithm to-report Is-obsolete [msgNogood Sender] locals [i res] set i 0 set res false while [i < who] [if ((item i MsgNogood != -1 ) and (item i MyContext != -1 ) and (item i msgNogood) != (item i MyContext) and member? i ParentA) ; [if ((item i msgNogood) != (item i MyContext) and member? i ParentA) [set res true] set i (i + 1)] if ( (item who MsgNogood != -1 ) and ((item who msgNogood) != MyValue_colorn)) ;if ( ((item who msgNogood) != MyValue_colorn)) [set res true] report res end to ResolveConflict [msgNogood Sender] locals [ i j msg TempValue] ;if it is consistent with the agent view, otherwise it is discarded due to obsolescence. ifelse ( Not Is-obsolete msgNogood Sender) ;An accepted nogood is used to update the agent view of agents not in PArentA ;Update MyContext [set i 0 while [i < who] [ if (((item i msgNogood) != -1) and (not member? i ParentA)) [set MyContext (replace-item i MyContext (item i msgNogood))] set i (i + 1) ] ;UpdateContextNogood ;The nogood is stored set nogoods replace-item MyValue_colorn nogoods 1 ;mark current position as nogood CheckAgentView1 ] [ set messages-received_nogoodold messages-received_nogoodold + 1 if (member? Sender childrenA) and ( (item who msgNogood = MyValue_colorn)) [ ;show "se trimite lui " + Sender set msg (list "info" (list who MyValue_colorn) AgentC_Cost) ask turtles with [who = Sender ] [receive-message msg] ] ] end to-report agents-in-context [cont] locals [i res] set i 0 set res [] while [i < who] [ if (item i cont != -1) and (item (item i cont) nogoods) = 1 [ set res lput i res ] set i i + 1 ] report res end ;;this is the BackTrack procedure in the ABT algorithm to BackTrack locals [msg i j wng m newNogood LAgents] set LAgents agents-in-context MyContext ifelse (who = 0) or empty? LAgents ;newNogood=empty; [set gata true set msg "stop" receive-message msg stop ] [ set wng last Lagents set newNogood MyContext set m item wng MyContext set i 0 while [i < who ] [ if (item i newNogood != -1) and (item (item i newNogood) nogoods = 0 ) [ set newNogood (replace-item i newNogood -1) ] set i i + 1 ] set msg (list "back" newNogood who AgentC_Cost ) ask turtles with [who = wng ] [receive-message msg] set MyContext (replace-item wng MyContext -1) UpdateContextConflict UpdateContextConflict1 m CheckAgentView1 ] end to UpdateContextConflict1 [culors] locals [i j msg TempValue] set nogoods replace-item culors nogoods 0 set i 0 while [ i < who ] ;for each vertice [ set nr_constraintc nr_constraintc + 1 set AgentC_Cost AgentC_Cost + 1 if ((neighbors? i who) and ( culors = (item i MyContext)) and (item i MyContext != -1 )) [set nogoods replace-item culors nogoods 1] set i (i + 1) ] end to UpdateContextConflict locals [i j ] set nogoods get-list num-colors 0 set i 0 while [ i < who ] ;for each vertice [set j 0 while [ j < num-colors ] ;for each color [set nr_constraintc nr_constraintc + 1 set AgentC_Cost AgentC_Cost + 1 if ((neighbors? i who) and ( j = (item i MyContext)) and (item i MyContext != -1 )) [set nogoods replace-item j nogoods 1] set j (j + 1)] set i (i + 1)] end to-report ChooseValue locals [i j ] set i 0 set j 0 while [ i < num-colors and j = 0] [if ( item i nogoods = 0 ) [ set j 1 report i ] set i (i + 1)] ; setxy (i - screen-edge-x) (screen-edge-y - who) report -1 end @#$#@#$#@ GRAPHICS-WINDOW 248 -3 739 503 151 149 1.59 1 10 1 1 1 CC-WINDOW 744 10 1002 515 Command Center BUTTON 0 10 81 43 NIL setup NIL 1 T OBSERVER T SLIDER 2 45 174 78 num-vertices num-vertices 0 20 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 4 282 247 461 Messages Nr de cicluri Mesaje nogood pe agent 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 249 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 162 151 244 200 Cycles nr_cicluri 0 1 MONITOR 5 231 115 280 Constraints checks sum (values-from vertices [nr_constraintc]) 0 1 PLOT 8 463 246 652 Constraint checks Nr de cicluri Constrangeri verificate pe agent 0.0 10.0 0.0 10.0 true false MONITOR 117 231 255 280 Cumulative cost - CCA max (values-from vertices [AgentC_Cost]) 0 1 SLIDER 4 113 176 146 edge-density edge-density 0.5 5 1.5 0.1 1 NIL SLIDER 3 149 150 182 num-colors num-colors 0 6 3 1 1 NIL SLIDER 3 190 154 223 max_cycle max_cycle 0 1000000 1000000 1 1 NIL @#$#@#$#@ Title: Graph Coloring using ABT kernel (ABT kernel is sound but may not terminate) Author: Ionel Muscalagiu, Jose M. Vidal Description: This is the implementation of the ABT kernel for the graph coloring problem. We solve the graph coloring problem using the ABT kernel algorithm from