1 (in-package #:clnl-nvm)
3 ; Implementations of all the things the nvm can do.
10 VALUE: a NetLogo value
15 A command that prints the given NetLogo value to the command center.
17 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#show"
18 (format t "Showing: ~A~%" (dump-object value)))
20 (defun lookup-color (color)
21 "LOOKUP-COLOR COLOR => COLOR-NUMBER
25 COLOR: a symbol representing a color
26 COLOR-NUMBER: the NetLogo color integer
30 Returns the number used to represent colors in NetLogo.
32 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#Constants"
51 (defun create-turtle ()
58 :who (coerce *current-id* 'double-float)
59 :color (coerce (+ 5 (* 10 (clnl-random:next-int 14))) 'double-float)
60 :heading (coerce (clnl-random:next-int 360) 'double-float)
70 RESULT: undefined, commands don't return
74 The turtle or link dies
76 A dead agent ceases to exist. The effects of this include:
77 - The agent will not execute any further code.
78 - The agent will disappear from any agentsets it was in, reducing the size of those agentsets by one.
79 - Any variable that was storing the agent will now instead have nobody in it.
80 - If the dead agent was a turtle, every link connected to it also dies.
81 - If the observer was watching or following the agent, the observer's perspective resets.
83 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#die"
84 (when (not (turtle-p *self*)) (error "Gotta call die in turtle scope, dude (~A)" *self*))
85 (setf (turtle-who *self*) -1)
86 (setf *turtles* (remove *self* *turtles*)))
89 "PATCHES => ALL-PATCHES
93 ALL-PATCHES: a NetLogo agentset, all patches
97 Reports the agentset consisting of all the patches.
99 This agentset is special in that it represents the living patches
100 each time it's used, so changes depending on the state of the engine.
102 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#patches"
106 "TURTLES => ALL-TURTLES
108 ARGUMENTS AND VALUES:
110 ALL-TURTLES: a NetLogo agentset, all turtles
114 Reports the agentset consisting of all the turtles.
116 This agentset is special in that it represents the living turtles
117 each time it's used, so changes depending on the state of the engine.
119 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#turtles"
122 (defun ask (agent-or-agentset fn)
123 "ASK AGENT-OR-AGENTSET FN => RESULT
125 AGENT-OR-AGENTSET: AGENT | AGENTSET
127 ARGUMENTS AND VALUES:
129 FN: a function, run on each agent
130 RESULT: undefined, commands don't return
131 AGENT: a NetLogo agent
132 AGENTSET: a NetLogo agentset
136 ASK is equivalent to ask in NetLogo.
138 The specified AGENTSET or AGENT runs the given FN. In the case of an
139 AGENTSET, the order in which the agents are run is random each time,
140 and only agents that are in the set at the beginning of the call.
142 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#ask"
144 ((agentset-p agent-or-agentset)
146 ((iter (shufflerator (agentset-list agent-or-agentset))))
148 :for agent := (funcall iter)
150 :do (let ((*myself* *self*) (*self* agent)) (funcall fn)))))
151 ((agent-p agent-or-agentset)
152 (let ((*myself* *self*) (*self* agent-or-agentset)) (funcall fn)))
154 (error "Ask requires an agentset or agent but got: ~A" agent-or-agentset))))
156 (defun count (agentset)
159 ARGUMENTS AND VALUES:
161 AGENTSET: a NetLogo agentset
166 COUNT is equivalent to count in NetLogo. Returns N, the number of
169 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#count"
170 (coerce (length (agentset-list agentset)) 'double-float))
172 (defun of (fn agent-or-agentset)
173 "OF FN AGENT-OR-AGENTSET => RESULT
175 AGENT-OR-AGENTSET: AGENT | AGENTSET
176 RESULT: RESULT-LIST | RESULT-VALUE
178 ARGUMENTS AND VALUES:
180 FN: a function, run on each agent
181 AGENT: a NetLogo agent
182 AGENTSET: a NetLogo agentset
184 RESULT-VALUE: a single value
188 OF is equivalent to of in NetLogo.
190 The specified AGENTSET or AGENT runs the given FN. In the case of an
191 AGENTSET, the order in which the agents are run is random each time,
192 and only agents that are in the set at the beginning of the call.
194 RESULT-LIST is returned when the input is an AGENTSET, but RESULT-VALUE
195 is returned when only passed an AGENT.
197 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#of"
199 ((agentset-p agent-or-agentset)
201 ((iter (shufflerator (agentset-list agent-or-agentset))))
203 :for agent := (funcall iter)
205 :collect (let ((*myself* *self*) (*self* agent)) (funcall fn)))))
206 ((agent-p agent-or-agentset)
207 (let ((*myself* *self*) (*self* agent-or-agentset)) (funcall fn)))
209 (error "Of requires an agentset or agent but got: ~A" agent-or-agentset))))
211 (defun shufflerator (agentset-list)
213 ((copy (copy-list agentset-list))
219 ((idx (when (< i (1- (length copy))) (+ i (clnl-random:next-int (- (length copy) i))))))
220 (when idx (setf agent (nth idx copy)))
221 (when idx (setf (nth idx copy) (nth i copy)))
223 (fetch) ; we pre-fetch because netlogo does, rng sync hype!
226 ((> i (length copy)) nil)
227 ((= i (length copy)) (incf i) (car (last copy)))
228 (t (let ((result agent)) (fetch) result)))))))
230 (defun random-float (n)
231 "RANDOM-FLOAT N => RANDOM-NUMBER
233 ARGUMENTS AND VALUES:
235 N: a double, the upper bound of the random float
236 RANDOM-NUMBER: a double, the random result
240 Returns a random number strictly closer to zero than N.
242 If number is positive, returns a random floating point number greater than
243 or equal to 0 but strictly less than number.
245 If number is negative, returns a random floating point number less than or equal
246 to 0, but strictly greater than number.
248 If number is zero, the result is always 0.
250 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#random-float"
251 (clnl-random:next-double n))
254 "RANDOM N => RANDOM-NUMBER
256 ARGUMENTS AND VALUES:
258 N: an integer, the upper bound of the random
259 RANDOM-NUMBER: an integer, the random result
263 Returns a random number strictly closer to zero than N.
265 If number is positive, returns a random integer greater than or equal to 0,
266 but strictly less than number.
268 If number is negative, returns a random integer less than or equal to 0,
269 but strictly greater than number.
271 If number is zero, the result is always 0.
273 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#random"
274 (coerce (clnl-random:next-long (truncate n)) 'double-float))
276 (defun random-xcor ()
277 "RANDOM-XCOR => RANDOM-NUMBER
279 ARGUMENTS AND VALUES:
281 RANDOM-NUMBER: a float, the random result
285 Returns a random floating point number in the allowable range of turtle
286 coordinates along the x axis.
288 These range from min-pxcor - 0.5 (inclusive) to max-pxcor + 0.5 (exclusive)
290 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#random-cor"
292 ((min (- (min-pxcor) 0.5d0))
293 (max (+ (max-pxcor) 0.5d0)))
294 (+ min (clnl-random:next-double (- max min)))))
296 (defun random-ycor ()
297 "RANDOM-YCOR => RANDOM-NUMBER
299 ARGUMENTS AND VALUES:
301 RANDOM-NUMBER: a float, the random result
305 Returns a random floating point number in the allowable range of turtle
306 coordinates along the y axis.
308 These range from min-pycor - 0.5 (inclusive) to max-pycor + 0.5 (exclusive)
310 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#random-cor"
312 ((min (- (min-pycor) 0.5d0))
313 (max (+ (max-pycor) 0.5d0)))
314 (+ min (clnl-random:next-double (- max min)))))
316 (defun one-of (list-or-agentset)
317 "ONE-OF LIST-OR-AGENTSET => RESULT
319 LIST-OR-AGENTSET: LIST | AGENTSET
320 RESULT: RANDOM-VALUE | RANDOM-AGENT | :nobody
322 ARGUMENTS AND VALUES:
325 AGENTSET: An agent set
326 RANDOM-VALUE: a value in LIST
327 RANDOM-AGENT: an agent if AGENTSET is non empty
331 From an AGENTSET, returns a RANDOM-AGENT. If the agentset is empty, returns :nobody.
332 From a list, returns a RANDOM-VALUE. If the list is empty, an error occurs.
334 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#one-of"
336 ((agentset-p list-or-agentset)
338 ((agentset-list (agentset-list list-or-agentset))
339 (length (length agentset-list)))
340 (if (zerop length) :nobody (nth (clnl-random:next-int length) agentset-list))))
341 ((listp list-or-agentset)
343 ((length (length list-or-agentset)))
345 (error "one-of requires a nonempty list")
346 (nth (clnl-random:next-int length) list-or-agentset))))
347 (t (error "one-of requires a list or agentset"))))
350 (when (not (turtle-p *self*)) (error "Gotta call jump in turtle scope, dude (~A)" *self*))
354 (+ (turtle-xcor *self*) (* n (using-cached-sin (turtle-heading *self*))))))
358 (+ (turtle-ycor *self*) (* n (using-cached-cos (turtle-heading *self*)))))))
363 ARGUMENTS AND VALUES:
371 Sets the x-coordinate and y-coordinate for the turle. Equivalent to
372 set xcor x set ycor y, except it happens in one step inside of two.
374 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#setxy"
375 (when (not (turtle-p *self*)) (error "Gotta call setxy in turtle scope, dude (~A)" *self*))
376 (setf (turtle-xcor *self*) (wrap-x *topology* x))
377 (setf (turtle-ycor *self*) (wrap-y *topology* y)))
382 ARGUMENTS AND VALUES:
384 N: a double, the amount the turtle moves forward
389 Moves the current turtle forward N steps, one step at a time.
391 This moves forward one at a time in order to make the view updates look
392 good in the case of a purposefully slow running instance. If the number
393 is negative, the turtle moves backward.
395 If the current agent is not a turtle, it raises an error.
397 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#forward"
398 (when (not (turtle-p *self*)) (error "Gotta call fd in turtle scope, dude (~A)" *self*))
402 ((< (abs i) 3.2e-15) nil)
403 ((< (abs i) 1d0) (jump i))
404 (t (jump (if (> i 0d0) 1d0 -1d0)) (internal (- i (if (> i 0d0) 1d0 -1d0)))))))
407 (defun turn-right (n)
408 "TURN-RIGHT N => RESULT
410 ARGUMENTS AND VALUES:
412 N: a double, the amount the turtle turns
417 The turtle turns right by number degrees. (If number is negative, it turns left.)
419 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#right"
420 (when (not (turtle-p *self*)) (error "Gotta call fd in turtle scope, dude (~A)" *self*))
422 ((new-heading (+ (turtle-heading *self*) n)))
423 (setf (turtle-heading *self*)
425 ((< new-heading 0) (+ (mod new-heading -360) 360))
426 ((>= new-heading 360) (mod new-heading 360))
430 "TURN-LEFT N => RESULT
432 ARGUMENTS AND VALUES:
434 N: a double, the amount the turtle turns
439 The turtle turns left by number degrees. (If number is negative, it turns right.)
441 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#right"
444 (defun create-turtles (n)
445 "CREATE-TURTLES N => RESULT
447 ARGUMENTS AND VALUES:
449 N: an integer, the numbers of turtles to create
454 Creates number new turtles at the origin.
456 New turtles have random integer headings and the color is randomly selected
457 from the 14 primary colors. If commands are supplied, the new turtles
458 immediately run them (unimplemented).
460 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#create-turtles"
461 (loop :for i :from 1 :to n :do (create-turtle)))
463 (defun reset-ticks ()
464 "RESET-TICKS => RESULT
466 ARGUMENTS AND VALUES:
472 Resets the tick counter to zero, sets up all plots, then updates all plots.
474 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#reset-ticks"
478 "RESET-TICKS => RESULT
480 ARGUMENTS AND VALUES:
486 Advances the tick counter by one and updates all plots.
488 If the tick counter has not been started yet with reset-ticks, an error results.
490 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#tick"
492 (when (not *ticks*) (error "reset-ticks must be called"))
496 "TICKS => CURRENT-TICKS
498 ARGUMENTS AND VALUES:
500 CURRENT-TICKS: A positiv double, representing the current number of ticks
504 Reports the current value of the tick counter. The result is always a number and never negative.
506 If the tick counter has not been started yet with reset-ticks, an error results.
508 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#ticks"
509 (when (not *ticks*) (error "reset-ticks must be called"))
512 (defun create-world (&key dims)
513 "CREATE-WORLD &key DIMS => RESULT
515 DIMS: (:xmin XMIN :xmax XMAX :ymin YMIN :ymax YMAX)
517 ARGUMENTS AND VALUES:
520 XMIN: An integer representing the minimum patch coord in X
521 XMAX: An integer representing the maximum patch coord in X
522 YMIN: An integer representing the minimum patch coord in Y
523 YMAX: An integer representing the maximum patch coord in Y
527 Initializes the world in the NVM.
529 This should be called before using the engine in any real capacity. If
530 called when an engine is already running, it may do somethign weird."
531 (setf *dimensions* dims)
535 :for y :from (max-pycor) :downto (min-pycor)
537 :for x :from (min-pxcor) :to (max-pxcor)
539 :xcor (coerce x 'double-float)
540 :ycor (coerce y 'double-float)
543 (setf *current-id* 0))
545 ; These match netlogo's dump
546 (defgeneric dump-object (o))
548 (defmethod dump-object ((n double-float))
549 (multiple-value-bind (int rem) (floor n)
551 (format nil "~A" int)
553 ((output (format nil "~D" n)))
554 ; Someday we'll have d<posint>, but this is not that day!
555 (cl-ppcre:regex-replace "d-" (cl-ppcre:regex-replace "d0" output "") "E-")))))
557 (defmethod dump-object ((o string)) (format nil "~A" (cl-ppcre:regex-replace-all "\"" (format nil "~S" o) "\"\"")))
559 (defmethod dump-object ((o (eql t))) "true")
560 (defmethod dump-object ((o (eql nil))) "false")
562 (defmethod dump-object ((o list)) (format nil "[~{~A~^ ~}]" (mapcar #'dump-object o)))
564 (defmethod dump-object ((o patch))
565 (format nil "(patch ~A ~A)" (dump-object (patch-xcor o)) (dump-object (patch-ycor o))))
567 (defmethod dump-object ((o turtle)) (format nil "(turtle ~A)" (dump-object (turtle-who o))))
568 (defmethod dump-object ((o (eql :nobody))) (format nil "nobody"))
570 (defun current-state ()
571 "CURRENT-STATE => WORLD-STATE
573 ARGUMENTS AND VALUES:
575 WORLD-STATE: A list, the current state of the whole world
579 Dumps out the state of the world.
581 This is useful for visualizations and also storing in a common lisp
582 data structure for easy usage in a common lisp instance. It's preferable
583 to use this when working with the nvm than the output done by export-world.
585 Currently this only dumps out turtle and patch information.
587 This is called CURRENT-STATE because export-world is an actual primitive
593 :color (turtle-color turtle)
594 :xcor (turtle-xcor turtle)
595 :ycor (turtle-ycor turtle)
596 :heading (turtle-heading turtle)
597 :size (turtle-size turtle)))
602 :color (patch-color patch)
603 :xcor (patch-xcor patch)
604 :ycor (patch-ycor patch)))
607 (defun export-turtles ()
612 "\"who\",\"color\",\"heading\",\"xcor\",\"ycor\",\"shape\",\"label\",\"label-color\","
613 "\"breed\",\"hidden?\",\"size\",\"pen-size\",\"pen-mode\""))
617 "\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",\"\"\"default\"\"\",\"~A\",\"~A\",\"{all-turtles}\",\"false\",\"~A\",~A"
618 (dump-object (turtle-who turtle))
619 (dump-object (turtle-color turtle))
620 (dump-object (turtle-heading turtle))
621 (dump-object (turtle-xcor turtle))
622 (dump-object (turtle-ycor turtle))
623 (dump-object (turtle-label turtle))
624 (dump-object (turtle-label-color turtle))
625 (dump-object (turtle-size turtle))
626 "\"1\",\"\"\"up\"\"\""))
629 (defun export-patches ()
633 "\"pxcor\",\"pycor\",\"pcolor\",\"plabel\",\"plabel-color\"")
637 "\"~A\",\"~A\",\"~A\",\"\"\"\"\"\",\"9.9\""
638 (dump-object (patch-xcor patch))
639 (dump-object (patch-ycor patch))
640 (dump-object (patch-color patch))))
643 (defun export-world ()
644 "EXPORT-WORLD => WORLD-CSV
646 ARGUMENTS AND VALUES:
648 WORLD-CSV: A string, the csv of the world
652 Dumps out a csv matching NetLogo's export world.
654 This is useful for serializing the current state of the engine in order
655 to compare against NetLogo or to reimport later. Contains everything needed
656 to boot up a NetLogo instance in the exact same state."
657 (format nil "~{~A~%~}"
659 (format nil "~S" "RANDOM STATE")
660 (format nil "~S" (clnl-random:export))
662 (format nil "~S" "GLOBALS")
664 "\"min-pxcor\",\"max-pxcor\",\"min-pycor\",\"max-pycor\",\"perspective\",\"subject\","
665 "\"nextIndex\",\"directed-links\",\"ticks\",")
666 (format nil "\"~A\",\"~A\",\"~A\",\"~A\",\"0\",\"nobody\",\"~A\",\"\"\"NEITHER\"\"\",\"-1\""
667 (min-pxcor) (max-pxcor) (min-pycor) (max-pycor) *current-id*)
669 (format nil "~{~A~^~%~}" (export-turtles))
671 (format nil "~{~A~^~%~}" (export-patches))
673 (format nil "~S" "LINKS")
674 "\"end1\",\"end2\",\"color\",\"label\",\"label-color\",\"hidden?\",\"breed\",\"thickness\",\"shape\",\"tie-mode\""