X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?p=clnl;a=blobdiff_plain;f=src%2Fmain%2Fnvm%2Fnvm.lisp;h=67b3ec4855117f4b5d7e904c3335d1fae0908d28;hp=c590f2f60a7d5e67faa2dbd885630db507271773;hb=083d6c2;hpb=bc4ccb4263ccbcc915d913c7111fdd40e2e998fe diff --git a/src/main/nvm/nvm.lisp b/src/main/nvm/nvm.lisp index c590f2f..67b3ec4 100644 --- a/src/main/nvm/nvm.lisp +++ b/src/main/nvm/nvm.lisp @@ -206,6 +206,30 @@ DESCRIPTION: (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)) @@ -459,7 +483,7 @@ DESCRIPTION: See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#create-turtles" (let ((new-turtles (loop :repeat n :collect (create-turtle)))) - (when fn (ask (list->agentset new-turtles) fn)))) + (when fn (ask (list->agentset new-turtles :turtles) fn)))) (defun reset-ticks () "RESET-TICKS => RESULT @@ -560,7 +584,10 @@ DESCRIPTION: (defmethod dump-object ((o (eql t))) "true") (defmethod dump-object ((o (eql nil))) "false") -(defmethod dump-object ((o list)) (format nil "[~{~A~^ ~}]" (mapcar #'dump-object o))) +(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))))