X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?p=clnl;a=blobdiff_plain;f=src%2Fmain%2Fnvm%2Fnvm.lisp;h=7927909859eed04ba570018eb03a133c8003aef3;hp=fa28fca86a40c0485cc29cba4b687742a1062f0d;hb=885270b122c568ecdba52a465dae0125adae8c18;hpb=db4e12948a1751fbcd20cb76ce28973191b9eb5a diff --git a/src/main/nvm/nvm.lisp b/src/main/nvm/nvm.lisp index fa28fca..7927909 100644 --- a/src/main/nvm/nvm.lisp +++ b/src/main/nvm/nvm.lisp @@ -1,22 +1,5 @@ (in-package #:clnl-nvm) -; Implementations of all the things the nvm can do. - -(defun show (value) - "SHOW VALUE => RESULT - -ARGUMENTS AND VALUES: - - VALUE: a NetLogo value - RESULT: undefined - -DESCRIPTION: - - A command that prints the given NetLogo value to the command center. - - See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#show" - (format t "Showing: ~A~%" (dump-object value))) - (defun lookup-color (color) "LOOKUP-COLOR COLOR => COLOR-NUMBER @@ -73,248 +56,6 @@ DESCRIPTION: (incf *current-id*) new-turtle)) -(defun die () - "DIE => RESULT - -ARGUMENTS AND VALUES: - - RESULT: undefined, commands don't return - -DESCRIPTION: - - The turtle or link dies - - A dead agent ceases to exist. The effects of this include: - - The agent will not execute any further code. - - The agent will disappear from any agentsets it was in, reducing the size of those agentsets by one. - - Any variable that was storing the agent will now instead have nobody in it. - - If the dead agent was a turtle, every link connected to it also dies. - - If the observer was watching or following the agent, the observer's perspective resets. - - See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#die" - (when (not (turtle-p *self*)) (error "Gotta call die in turtle scope, dude (~A)" *self*)) - (setf (turtle-who *self*) -1) - (setf *turtles* (remove *self* *turtles*)) - (let - ((patch (patch-at (turtle-xcor *self*) (turtle-ycor *self*)))) - (setf (patch-turtles patch) (remove *self* (patch-turtles patch)))) - (error (make-condition 'death))) - -(defun patches () - "PATCHES => ALL-PATCHES - -ARGUMENTS AND VALUES: - - ALL-PATCHES: a NetLogo agentset, all patches - -DESCRIPTION: - - Reports the agentset consisting of all the patches. - - This agentset is special in that it represents the living patches - each time it's used, so changes depending on the state of the engine. - - See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#patches" - :patches) - -(defun turtles () - "TURTLES => ALL-TURTLES - -ARGUMENTS AND VALUES: - - ALL-TURTLES: a NetLogo agentset, all turtles - -DESCRIPTION: - - Reports the agentset consisting of all the turtles. - - This agentset is special in that it represents the living turtles - each time it's used, so changes depending on the state of the engine. - - See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#turtles" - :turtles) - -(defun turtles-here (&optional breed) - "TURTLES-HERE => TURTLES - -ARGUMENTS AND VALUES: - - TURTLES: an agentset - -DESCRIPTION: - - Returns the agentset consisting of all the turtles sharing the patch - with the agent in by *self* - - See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#turtles-here" - (when (not (turtle-p *self*)) (error "Gotta call turtles-here with a turtle")) - (let - ((patch-turtles (patch-turtles (patch-at (turtle-xcor *self*) (turtle-ycor *self*))))) - (list->agentset - (if breed (remove breed patch-turtles :key #'turtle-breed :test-not #'eql) patch-turtles) - (or breed :turtles)))) - -(defun ask (agent-or-agentset fn) - "ASK AGENT-OR-AGENTSET FN => RESULT - - AGENT-OR-AGENTSET: AGENT | AGENTSET - -ARGUMENTS AND VALUES: - - FN: a function, run on each agent - RESULT: undefined, commands don't return - AGENT: a NetLogo agent - AGENTSET: a NetLogo agentset - -DESCRIPTION: - - ASK is equivalent to ask in NetLogo. - - The specified AGENTSET or AGENT runs the given FN. In the case of an - AGENTSET, the order in which the agents are run is random each time, - and only agents that are in the set at the beginning of the call. - - See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#ask" - (cond - ((agentset-p agent-or-agentset) - (let - ((iter (shufflerator (agentset-list agent-or-agentset)))) - (loop - :for agent := (funcall iter) - :while agent - :do (when (not (and (turtle-p agent) (= -1 (turtle-who agent)))) - (let ((*myself* *self*) (*self* agent)) (with-stop-and-death-handler (funcall fn))))))) - ((agent-p agent-or-agentset) - (let ((*myself* *self*) (*self* agent-or-agentset)) (with-stop-and-death-handler (funcall fn)))) - (t - (error "Ask requires an agentset or agent but got: ~A" agent-or-agentset)))) - -(defun count (agentset) - "COUNT AGENTSET => N - -ARGUMENTS AND VALUES: - - AGENTSET: a NetLogo agentset - N: a number - -DESCRIPTION: - - COUNT is equivalent to count in NetLogo. Returns N, the number of - agents in AGENTSET. - - See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#count" - (coerce (length (agentset-list agentset)) 'double-float)) - -(defun clear-all () - "CLEAR-ALL => RESULT - -ARGUMENTS AND VALUES: - - RESULT: undefined - -DESCRIPTION: - - Clears ticks, turtles, patches, globals (unimplemented). - - See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#clear-all" - (clear-turtles) - (clear-patches) - (clear-ticks)) - -(defun display () - "DISPLAY => RESULT - -ARGUMENTS AND VALUES: - - RESULT: undefined - -DESCRIPTION: - - As of yet, this does nothing. A placeholder method for forced dipslay - updates from the engine. - - See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#display" - nil) - -(defun stop () - "STOP => RESULT - -ARGUMENTS AND VALUES: - - RESULT: undefined - -DESCRIPTION: - - Returns from the current stop block, which will halt the currently running - thing, be that the program, current ask block, or procedure. Stop has odd - semantics that are best gleaned from the actual NetLogo manual. - - See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#stop" - (error (make-condition 'stop))) - -(defun of (fn agent-or-agentset) - "OF FN AGENT-OR-AGENTSET => RESULT - - AGENT-OR-AGENTSET: AGENT | AGENTSET - RESULT: RESULT-LIST | RESULT-VALUE - -ARGUMENTS AND VALUES: - - FN: a function, run on each agent - AGENT: a NetLogo agent - AGENTSET: a NetLogo agentset - RESULT-LIST: a list - RESULT-VALUE: a single value - -DESCRIPTION: - - OF is equivalent to of in NetLogo. - - The specified AGENTSET or AGENT runs the given FN. In the case of an - AGENTSET, the order in which the agents are run is random each time, - and only agents that are in the set at the beginning of the call. - - RESULT-LIST is returned when the input is an AGENTSET, but RESULT-VALUE - is returned when only passed an AGENT. - - See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#of" - (cond - ((agentset-p agent-or-agentset) - (let - ((iter (shufflerator (agentset-list agent-or-agentset)))) - (loop - :for agent := (funcall iter) - :while agent - :collect (let ((*myself* *self*) (*self* agent)) (funcall fn))))) - ((agent-p agent-or-agentset) - (let ((*myself* *self*) (*self* agent-or-agentset)) (funcall fn))) - (t - (error "Of requires an agentset or agent but got: ~A" agent-or-agentset)))) - -(defun with (agentset fn) - "WITH AGENTSET FN => RESULT-AGENTSET - -ARGUMENTS AND VALUES: - - AGENTSET: a NetLogo agentset - FN: a boolean function, run on each agent to determine if included - RESULT-AGENTSET: an agentset of valid agents - -DESCRIPTION: - - WITH is equivalent to with in NetLogo. - - Returns a new agentset containing only those agents that reported true - when FN is called. - - See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#with" - (list->agentset - (remove-if-not - (lambda (agent) - (let ((*myself* *self*) (*self* agent)) (funcall fn))) - (agentset-list agentset)) - (agentset-breed agentset))) - (defun shufflerator (agentset-list) (let ((copy (copy-list agentset-list)) @@ -335,355 +76,6 @@ DESCRIPTION: ((= i (length copy)) (incf i) (car (last copy))) (t (let ((result agent)) (fetch) result))))))) -(defun random-float (n) - "RANDOM-FLOAT N => RANDOM-NUMBER - -ARGUMENTS AND VALUES: - - N: a double, the upper bound of the random float - RANDOM-NUMBER: a double, the random result - -DESCRIPTION: - - Returns a random number strictly closer to zero than N. - - If number is positive, returns a random floating point number greater than - or equal to 0 but strictly less than number. - - If number is negative, returns a random floating point number less than or equal - to 0, but strictly greater than number. - - If number is zero, the result is always 0. - - See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#random-float" - (clnl-random:next-double n)) - -(defun random (n) - "RANDOM N => RANDOM-NUMBER - -ARGUMENTS AND VALUES: - - N: an integer, the upper bound of the random - RANDOM-NUMBER: an integer, the random result - -DESCRIPTION: - - Returns a random number strictly closer to zero than N. - - If number is positive, returns a random integer greater than or equal to 0, - but strictly less than number. - - If number is negative, returns a random integer less than or equal to 0, - but strictly greater than number. - - If number is zero, the result is always 0. - - See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#random" - (coerce (clnl-random:next-long (truncate n)) 'double-float)) - -(defun random-xcor () - "RANDOM-XCOR => RANDOM-NUMBER - -ARGUMENTS AND VALUES: - - RANDOM-NUMBER: a float, the random result - -DESCRIPTION: - - Returns a random floating point number in the allowable range of turtle - coordinates along the x axis. - - These range from min-pxcor - 0.5 (inclusive) to max-pxcor + 0.5 (exclusive) - - See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#random-cor" - (let - ((min (- (min-pxcor) 0.5d0)) - (max (+ (max-pxcor) 0.5d0))) - (+ min (clnl-random:next-double (- max min))))) - -(defun random-ycor () - "RANDOM-YCOR => RANDOM-NUMBER - -ARGUMENTS AND VALUES: - - RANDOM-NUMBER: a float, the random result - -DESCRIPTION: - - Returns a random floating point number in the allowable range of turtle - coordinates along the y axis. - - These range from min-pycor - 0.5 (inclusive) to max-pycor + 0.5 (exclusive) - - See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#random-cor" - (let - ((min (- (min-pycor) 0.5d0)) - (max (+ (max-pycor) 0.5d0))) - (+ min (clnl-random:next-double (- max min))))) - -(defun one-of (list-or-agentset) - "ONE-OF LIST-OR-AGENTSET => RESULT - - LIST-OR-AGENTSET: LIST | AGENTSET - RESULT: RANDOM-VALUE | RANDOM-AGENT | :nobody - -ARGUMENTS AND VALUES: - - LIST: A list - AGENTSET: An agent set - RANDOM-VALUE: a value in LIST - RANDOM-AGENT: an agent if AGENTSET is non empty - -DESCRIPTION: - - From an AGENTSET, returns a RANDOM-AGENT. If the agentset is empty, returns :nobody. - From a list, returns a RANDOM-VALUE. If the list is empty, an error occurs. - - See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#one-of" - (cond - ((agentset-p list-or-agentset) - (let* - ((agentset-list (agentset-list list-or-agentset)) - (length (length agentset-list))) - (if (zerop length) :nobody (nth (clnl-random:next-int length) agentset-list)))) - ((listp list-or-agentset) - (let* - ((length (length list-or-agentset))) - (if (zerop length) - (error "one-of requires a nonempty list") - (nth (clnl-random:next-int length) list-or-agentset)))) - (t (error "one-of requires a list or agentset")))) - -(defun jump (n) - (when (not (turtle-p *self*)) (error "Gotta call jump in turtle scope, dude (~A)" *self*)) - (with-patch-update *self* - (setf - (turtle-xcor *self*) - (wrap-x *topology* - (+ (turtle-xcor *self*) (* n (using-cached-sin (turtle-heading *self*)))))) - (setf - (turtle-ycor *self*) - (wrap-y *topology* - (+ (turtle-ycor *self*) (* n (using-cached-cos (turtle-heading *self*)))))))) - -(defun setxy (x y) - "SETXY X Y => RESULT - -ARGUMENTS AND VALUES: - - X: a double - Y: a double - RESULT: undefined - -DESCRIPTION: - - Sets the x-coordinate and y-coordinate for the turle. Equivalent to - set xcor x set ycor y, except it happens in one step inside of two. - - See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#setxy" - (when (not (turtle-p *self*)) (error "Gotta call setxy in turtle scope, dude (~A)" *self*)) - (setf (turtle-xcor *self*) (wrap-x *topology* x)) - (setf (turtle-ycor *self*) (wrap-y *topology* y))) - -(defun set-default-shape (breed shape) - "SET-DEFAULT-SHAPE BREED SHAPE => RESULT - -ARGUMENTS AND VALUES: - - BREED: a valid breed - SHAPE: a string - RESULT: undefined - -DESCRIPTION: - - Specifies a default initial shape for a BREED. When a turtle, or it changes breeds, - its shape is set to the given shape. - - SET-DEFAULT-SHAPE doesn't affect existing agents, only agents you create afterwards. - - See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#set-default-shape" - (when (not (breed-p breed)) (error "Need a valid breed")) - (setf (breed-default-shape breed) shape)) - -(defun forward (n) - "FORWARD N => RESULT - -ARGUMENTS AND VALUES: - - N: a double, the amount the turtle moves forward - RESULT: undefined - -DESCRIPTION: - - Moves the current turtle forward N steps, one step at a time. - - This moves forward one at a time in order to make the view updates look - good in the case of a purposefully slow running instance. If the number - is negative, the turtle moves backward. - - If the current agent is not a turtle, it raises an error. - - See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#forward" - (when (not (turtle-p *self*)) (error "Gotta call fd in turtle scope, dude (~A)" *self*)) - (labels - ((internal (i) - (cond - ((< (abs i) 3.2e-15) nil) - ((< (abs i) 1d0) (jump i)) - (t (jump (if (> i 0d0) 1d0 -1d0)) (internal (- i (if (> i 0d0) 1d0 -1d0))))))) - (internal n))) - -(defun turn-right (n) - "TURN-RIGHT N => RESULT - -ARGUMENTS AND VALUES: - - N: a double, the amount the turtle turns - RESULT: undefined - -DESCRIPTION: - - The turtle turns right by number degrees. (If number is negative, it turns left.) - - See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#right" - (when (not (turtle-p *self*)) (error "Gotta call fd in turtle scope, dude (~A)" *self*)) - (let - ((new-heading (+ (turtle-heading *self*) n))) - (setf (turtle-heading *self*) - (cond - ((< new-heading 0) (+ (mod new-heading -360) 360)) - ((>= new-heading 360) (mod new-heading 360)) - (t new-heading))))) - -(defun turn-left (n) - "TURN-LEFT N => RESULT - -ARGUMENTS AND VALUES: - - N: a double, the amount the turtle turns - RESULT: undefined - -DESCRIPTION: - - The turtle turns left by number degrees. (If number is negative, it turns right.) - - See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#right" - (turn-right (- n))) - -(defun create-turtles (n &optional breed fn) - "CREATE-TURTLES N &optional BREED FN => RESULT - -ARGUMENTS AND VALUES: - - N: an integer, the numbers of turtles to create - BREED: a breed - FN: A function, applied to each turtle after creation - RESULT: undefined - -DESCRIPTION: - - Creates N new turtles at the origin. - - New turtles have random integer headings and the color is randomly selected - from the 14 primary colors. If FN is supplied, the new turtles immediately - run it. If a BREED is supplied, that is the breed the new turtles are set - to. - - See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#create-turtles" - (let - ((new-turtles (loop :repeat n :collect (create-turtle breed)))) - (when fn (ask (list->agentset new-turtles :turtles) fn)))) - -(defun hatch (n &optional fn) - "HATCH N &optional FN => RESULT - -ARGUMENTS AND VALUES: - - N: an integer, the numbers of turtles to hatch - FN: A function, applied to each turtle after creation - RESULT: undefined - -DESCRIPTION: - - The turtle in *self* creates N new turtles. Each new turtle inherits of all its - variables, including its location, from self. - - If FN is supplied, the new turtles immediately run it. - - See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#hatch" - (when (not (turtle-p *self*)) (error "Can only hatch from turtle scope")) - (let - ((new-turtles (loop :repeat n :collect (create-turtle nil *self*)))) - (when fn (ask (list->agentset new-turtles :turtles) fn)))) - -(defun reset-ticks () - "RESET-TICKS => RESULT - -ARGUMENTS AND VALUES: - - RESULT: undefined - -DESCRIPTION: - - Resets the tick counter to zero, sets up all plots, then updates all plots. - - See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#reset-ticks" - (setf *ticks* 0d0)) - -(defun tick () - "RESET-TICKS => RESULT - -ARGUMENTS AND VALUES: - - RESULT: undefined - -DESCRIPTION: - - Advances the tick counter by one and updates all plots. - - If the tick counter has not been started yet with reset-ticks, an error results. - - See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#tick" - - (when (not *ticks*) (error "reset-ticks must be called")) - (incf *ticks*)) - -(defun ticks () - "TICKS => CURRENT-TICKS - -ARGUMENTS AND VALUES: - - CURRENT-TICKS: A positiv double, representing the current number of ticks - -DESCRIPTION: - - Reports the current value of the tick counter. The result is always a number and never negative. - - If the tick counter has not been started yet with reset-ticks, an error results. - - See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#ticks" - (when (not *ticks*) (error "reset-ticks must be called")) - *ticks*) - -(defun clear-patches () - (setf - *patches* - (loop - :for y :from (max-pycor) :downto (min-pycor) - :append (loop - :for x :from (min-pxcor) :to (max-pxcor) - :collect (make-patch - :xcor (coerce x 'double-float) - :ycor (coerce y 'double-float) - :color 0d0))))) - -(defun clear-turtles () - (setf *turtles* nil) - (setf *current-id* 0)) - -(defun clear-ticks () - (setf *ticks* nil)) - (defun create-world (&key dims globals turtles-own-vars patches-own-vars breeds) "CREATE-WORLD &key DIMS GLOBALS TURTLES-OWN-VARS PATCHES-OWN-VARS BREEDS => RESULT @@ -725,39 +117,6 @@ DESCRIPTION: (clear-patches) (clear-turtles)) -; These match netlogo's dump -(defgeneric dump-object (o)) - -(defmethod dump-object ((n double-float)) - (multiple-value-bind (int rem) (floor n) - (if (eql 0d0 rem) - (format nil "~A" int) - (let - ((output (format nil "~D" n))) - ; Someday we'll have d, but this is not that day! - (cl-ppcre:regex-replace "d-" (cl-ppcre:regex-replace "d0" output "") "E-"))))) - -(defmethod dump-object ((o string)) (format nil "~A" (cl-ppcre:regex-replace-all "\"" (format nil "~S" o) "\"\""))) - -(defmethod dump-object ((o (eql t))) "true") -(defmethod dump-object ((o (eql nil))) "false") - -(defmethod dump-object ((o list)) - (cond - ((agentset-p o) (format nil "(agentset, ~A ~A)" (dump-object (count o)) (string-downcase (agentset-breed o)))) - (t (format nil "[~{~A~^ ~}]" (mapcar #'dump-object o))))) - -(defmethod dump-object ((o patch)) - (format nil "(patch ~A ~A)" (dump-object (patch-xcor o)) (dump-object (patch-ycor o)))) - -(defmethod dump-object ((o turtle)) (format nil "(turtle ~A)" (dump-object (turtle-who o)))) -(defmethod dump-object ((o (eql :nobody))) (format nil "nobody")) -(defmethod dump-object ((o (eql :turtles))) (format nil "{all-turtles}")) -(defmethod dump-object ((o symbol)) - (cond - ((find o *breeds* :key #'car) (format nil "{breed ~(~A~)}" o)) - (t (error "Keyword unrecognized by dump object: ~A" o)))) - (defun current-state () "CURRENT-STATE => WORLD-STATE @@ -796,82 +155,35 @@ DESCRIPTION: :ycor (patch-ycor patch))) *patches*))) -(defun export-turtles () - (append - (list - "\"TURTLES\"" - (format nil "~A~A~{,\"~A\"~}" - "\"who\",\"color\",\"heading\",\"xcor\",\"ycor\",\"shape\",\"label\",\"label-color\"," - "\"breed\",\"hidden?\",\"size\",\"pen-size\",\"pen-mode\"" - (mapcar #'string-downcase *turtles-own-vars*))) - (mapcar - (lambda (turtle) - (format nil - "\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",\"false\",\"~A\",~A~{,\"~A\"~}" - (dump-object (turtle-who turtle)) - (dump-object (turtle-color turtle)) - (dump-object (turtle-heading turtle)) - (dump-object (turtle-xcor turtle)) - (dump-object (turtle-ycor turtle)) - (dump-object (turtle-shape turtle)) - (dump-object (turtle-label turtle)) - (dump-object (turtle-label-color turtle)) - (dump-object (turtle-breed turtle)) - (dump-object (turtle-size turtle)) - "\"1\",\"\"\"up\"\"\"" - (mapcar #'dump-object (mapcar (lambda (var) (agent-value-inner turtle var)) *turtles-own-vars*)))) - *turtles*))) - -(defun export-patches () - (append - (list - "\"PATCHES\"" - (format nil "\"pxcor\",\"pycor\",\"pcolor\",\"plabel\",\"plabel-color\"~{,\"~A\"~}" - (mapcar #'string-downcase *patches-own-vars*))) - (mapcar - (lambda (patch) - (format nil - "\"~A\",\"~A\",\"~A\",\"\"\"\"\"\",\"9.9\"~{,\"~A\"~}" - (dump-object (patch-xcor patch)) - (dump-object (patch-ycor patch)) - (dump-object (patch-color patch)) - (mapcar #'dump-object (mapcar (lambda (var) (agent-value-inner patch var)) *patches-own-vars*)))) - *patches*))) +; These match netlogo's dump +(defgeneric dump-object (o)) -(defun export-world () - "EXPORT-WORLD => WORLD-CSV +(defmethod dump-object ((n double-float)) + (multiple-value-bind (int rem) (floor n) + (if (eql 0d0 rem) + (format nil "~A" int) + (let + ((output (format nil "~D" n))) + ; Someday we'll have d, but this is not that day! + (cl-ppcre:regex-replace "d-" (cl-ppcre:regex-replace "d0" output "") "E-"))))) -ARGUMENTS AND VALUES: +(defmethod dump-object ((o string)) (format nil "~A" (cl-ppcre:regex-replace-all "\"" (format nil "~S" o) "\"\""))) - WORLD-CSV: A string, the csv of the world +(defmethod dump-object ((o (eql t))) "true") +(defmethod dump-object ((o (eql nil))) "false") -DESCRIPTION: +(defmethod dump-object ((o list)) + (cond + ((agentset-p o) (format nil "(agentset, ~A ~A)" (dump-object (count o)) (string-downcase (agentset-breed o)))) + (t (format nil "[~{~A~^ ~}]" (mapcar #'dump-object o))))) - Dumps out a csv matching NetLogo's export world. +(defmethod dump-object ((o patch)) + (format nil "(patch ~A ~A)" (dump-object (patch-xcor o)) (dump-object (patch-ycor o)))) - This is useful for serializing the current state of the engine in order - to compare against NetLogo or to reimport later. Contains everything needed - to boot up a NetLogo instance in the exact same state." - (let - ((ordered-globals (sort (copy-list *globals*) #'string< :key (lambda (global) (symbol-name (car global)))))) - (format nil "~{~A~%~}" - (list - (format nil "~S" "RANDOM STATE") - (format nil "~S" (clnl-random:export)) - "" - (format nil "~S" "GLOBALS") - (format nil "~A~A~{\"~A\"~^,~}" - "\"min-pxcor\",\"max-pxcor\",\"min-pycor\",\"max-pycor\",\"perspective\",\"subject\"," - "\"nextIndex\",\"directed-links\",\"ticks\"," - (mapcar #'string-downcase (mapcar #'car ordered-globals))) - (format nil "\"~A\",\"~A\",\"~A\",\"~A\",\"0\",\"nobody\",\"~A\",\"\"\"NEITHER\"\"\",\"~A\"~{,\"~A\"~}" - (min-pxcor) (max-pxcor) (min-pycor) (max-pycor) *current-id* (dump-object (or *ticks* -1d0)) - (mapcar #'dump-object (mapcar #'funcall (mapcar #'cadr ordered-globals)))) - "" - (format nil "~{~A~^~%~}" (export-turtles)) - "" - (format nil "~{~A~^~%~}" (export-patches)) - "" - (format nil "~S" "LINKS") - "\"end1\",\"end2\",\"color\",\"label\",\"label-color\",\"hidden?\",\"breed\",\"thickness\",\"shape\",\"tie-mode\"" - "")))) +(defmethod dump-object ((o turtle)) (format nil "(turtle ~A)" (dump-object (turtle-who o)))) +(defmethod dump-object ((o (eql :nobody))) (format nil "nobody")) +(defmethod dump-object ((o (eql :turtles))) (format nil "{all-turtles}")) +(defmethod dump-object ((o symbol)) + (cond + ((find o *breeds* :key #'car) (format nil "{breed ~(~A~)}" o)) + (t (error "Keyword unrecognized by dump object: ~A" o))))