From: Frank Duncan Date: Sat, 30 Apr 2016 17:01:33 +0000 (-0500) Subject: Make agentsets annotated lists, Implement count X-Git-Tag: v0.1.0~32 X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?a=commitdiff_plain;h=3528ea7;p=clnl Make agentsets annotated lists, Implement count --- diff --git a/src/main/nvm/base.lisp b/src/main/nvm/base.lisp index 9c49c99..1df5022 100644 --- a/src/main/nvm/base.lisp +++ b/src/main/nvm/base.lisp @@ -14,4 +14,8 @@ (defstruct patch color xcor ycor) (defun agent-set-list (agent-set) - agent-set) + (cond + ((eql agent-set :turtles) *turtles*) + ((eql agent-set :patches) *patches*) + ((and (listp agent-set) (eql :agent-set (car agent-set))) (cdr agent-set)) + (t (error "Doesn't seem to be an agent-set: ~A" agent-set)))) diff --git a/src/main/nvm/nvm.lisp b/src/main/nvm/nvm.lisp index f8fdd84..da42870 100644 --- a/src/main/nvm/nvm.lisp +++ b/src/main/nvm/nvm.lisp @@ -100,7 +100,7 @@ DESCRIPTION: 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*) + :patches) (defun turtles () "TURTLES => ALL-TURTLES @@ -117,7 +117,7 @@ DESCRIPTION: 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*) + :turtles) (defun ask (agent-set fn) "ASK AGENT-SET FN => RESULT @@ -144,6 +144,22 @@ DESCRIPTION: :while agent :do (let ((*myself* *self*) (*self* agent)) (funcall fn))))) +(defun count (agent-set) + "COUNT AGENT-SET => N + +ARGUMENTS AND VALUES: + + AGENT-SET: a NetLogo agentset + N: a number + +DESCRIPTION: + + COUNT is equivalent to count in NetLogo. Returns N, the number of + agents in AGENT-SET. + + See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#count" + (coerce (length (agent-set-list agent-set)) 'double-float)) + (defun of (fn agent-set) "OF FN AGENT-SET => RESULT diff --git a/src/main/package.lisp b/src/main/package.lisp index 356a408..d9d95af 100644 --- a/src/main/package.lisp +++ b/src/main/package.lisp @@ -64,11 +64,12 @@ into an ast that can be transpiled later.")) (defpackage #:clnl-nvm (:use :common-lisp) - (:shadow #:random) + (:shadow #:random #:count) (:export #:export-world #:create-world #:current-state ; API as used by transpiled NetLogo programs #:agent-value #:ask + #:count #:create-turtles #:die #:of diff --git a/src/main/parse.lisp b/src/main/parse.lisp index 2f6b77f..b3dd3d7 100644 --- a/src/main/parse.lisp +++ b/src/main/parse.lisp @@ -224,7 +224,7 @@ DESCRIPTION: (defprim :clear-all ()) (defprim :crt (:number)) (defprim :color ()) -(defprim :count ()) +(defprim :count (:agentset)) (defprim :die ()) (defprim :display ()) (defprim :with (:reporter-block)) diff --git a/src/main/transpile.lisp b/src/main/transpile.lisp index ea53bfc..627a6a8 100644 --- a/src/main/transpile.lisp +++ b/src/main/transpile.lisp @@ -138,9 +138,10 @@ DESCRIPTION: (defsimpleprim :+ :reporter cl:+) (defsimpleprim :* :reporter cl:*) (defsimpleprim :/ :reporter cl:/) -(defprim :any? :reporter (lambda (agentset) `(> (length ,agentset) 0))) +(defprim :any? :reporter (lambda (agentset) `(> (clnl-nvm:count ,agentset) 0))) (defsimpleprim :ask :command clnl-nvm:ask) (defagentvalueprim :color) +(defsimpleprim :count :reporter clnl-nvm:count) (defsimpleprim :crt :command clnl-nvm:create-turtles) (defsimpleprim :die :command clnl-nvm:die) (defsimpleprim :fd :command clnl-nvm:forward) diff --git a/src/test/simpletests.lisp b/src/test/simpletests.lisp index 43bed46..22b2d19 100644 --- a/src/test/simpletests.lisp +++ b/src/test/simpletests.lisp @@ -187,3 +187,12 @@ (defsimplecommandtest "setxy 1" "crt 10 ask turtles [ setxy random-xcor random-ycor ]" "B02FD5B864A129AED5254A68C499607F7F6EA236") + +(defsimplereportertest "count 1" "count turtles" "0" + "E1DE30F072D785E0D0B59F28B0F7853E3D3E0D8B") + +(defreportertestwithsetup "count 2" "crt 10" "count turtles" "10" + "A925E39EC022967568D238D31F70F0A375024A89") + +(defsimplereportertest "count 3" "count patches" "9" + "E1DE30F072D785E0D0B59F28B0F7853E3D3E0D8B")