Prims - Update one-of to take lists. Rename agent-set to agentset

diff --git a/src/main/nvm/base.lisp b/src/main/nvm/base.lisp
index 8f1595c1677d6f0c7edcac97ac7e159b25868561..cd494a7be4c012e57b8bd6067662a3b6bbe48979 100644 (file)
--- a/src/main/nvm/base.lisp
+++ b/src/main/nvm/base.lisp
@@ -13,18 +13,18 @@
 (defstruct turtle who color heading xcor ycor (label "") (label-color 9.9d0) (size 1d0))
 (defstruct patch color xcor ycor)
 
-(defun agent-set-list (agent-set)
+(defun agentset-list (agentset)
  (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))))
+  ((eql agentset :turtles) *turtles*)
+  ((eql agentset :patches) *patches*)
+  ((and (listp agentset) (eql :agentset (car agentset))) (cdr agentset))
+  (t (error "Doesn't seem to be an agentset: ~A" agentset))))
 
-(defun agent-set-p (o)
+(defun agentset-p (o)
  (or
   (eql o :turtles)
   (eql o :patches)
-  (and (listp o) (eql :agent-set (car o)))))
+  (and (listp o) (eql :agentset (car o)))))
 
 (defun agent-p (o)
  (or (turtle-p o) (patch-p o)))

diff --git a/src/main/nvm/nvm.lisp b/src/main/nvm/nvm.lisp
index a59247442d02fa2fa5a927865ae2a0dacd8023ac..31d2f31ae4287af0e806e3b5f0a182d4cd11c6aa 100644 (file)
--- a/src/main/nvm/nvm.lisp
+++ b/src/main/nvm/nvm.lisp
@@ -119,67 +119,67 @@ DESCRIPTION:
   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#turtles"
  :turtles)
 
-(defun ask (agent-or-agent-set fn)
- "ASK AGENT-OR-AGENT-SET FN => RESULT
+(defun ask (agent-or-agentset fn)
+ "ASK AGENT-OR-AGENTSET FN => RESULT
 
-  AGENT-OR-AGENT-SET: AGENT | AGENT-SET
+  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
-  AGENT-SET: a NetLogo agentset
+  AGENTSET: a NetLogo agentset
 
 DESCRIPTION:
 
   ASK is equivalent to ask in NetLogo.
 
-  The specified AGENT-SET or AGENT runs the given FN.  In the case of an
-  AGENT-SET, the order in which the agents are run is random each time,
+  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
-  ((agent-set-p agent-or-agent-set)
+  ((agentset-p agent-or-agentset)
    (let
-    ((iter (shufflerator (agent-set-list agent-or-agent-set))))
+    ((iter (shufflerator (agentset-list agent-or-agentset))))
     (loop
      :for agent := (funcall iter)
      :while agent
      :do (let ((*myself* *self*) (*self* agent)) (funcall fn)))))
-  ((agent-p agent-or-agent-set)
-   (let ((*myself* *self*) (*self* agent-or-agent-set)) (funcall fn)))
+  ((agent-p agent-or-agentset)
+   (let ((*myself* *self*) (*self* agent-or-agentset)) (funcall fn)))
   (t
-   (error "Ask requires an agent-set or agent but got: ~A" agent-or-agent-set))))
+   (error "Ask requires an agentset or agent but got: ~A" agent-or-agentset))))
 
-(defun count (agent-set)
- "COUNT AGENT-SET => N
+(defun count (agentset)
+ "COUNT AGENTSET => N
 
 ARGUMENTS AND VALUES:
 
-  AGENT-SET: a NetLogo agentset
+  AGENTSET: a NetLogo agentset
   N: a number
 
 DESCRIPTION:
 
   COUNT is equivalent to count in NetLogo.  Returns N, the number of
-  agents in AGENT-SET.
+  agents in AGENTSET.
 
   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#count"
- (coerce (length (agent-set-list agent-set)) 'double-float))
+ (coerce (length (agentset-list agentset)) 'double-float))
 
-(defun of (fn agent-or-agent-set)
- "OF FN AGENT-OR-AGENT-SET => RESULT
+(defun of (fn agent-or-agentset)
+ "OF FN AGENT-OR-AGENTSET => RESULT
 
-  AGENT-OR-AGENT-SET: AGENT | AGENT-SET
+  AGENT-OR-AGENTSET: AGENT | AGENTSET
   RESULT: RESULT-LIST | RESULT-VALUE
 
 ARGUMENTS AND VALUES:
 
   FN: a function, run on each agent
   AGENT: a NetLogo agent
-  AGENT-SET: a NetLogo agentset
+  AGENTSET: a NetLogo agentset
   RESULT-LIST: a list
   RESULT-VALUE: a single value
 
@@ -187,30 +187,30 @@ DESCRIPTION:
 
   OF is equivalent to of in NetLogo.
 
-  The specified AGENT-SET or AGENT runs the given FN.  In the case of an
-  AGENT-SET, the order in which the agents are run is random each time,
+  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 AGENT-SET, but RESULT-VALUE
+  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
-  ((agent-set-p agent-or-agent-set)
+  ((agentset-p agent-or-agentset)
    (let
-    ((iter (shufflerator (agent-set-list agent-or-agent-set))))
+    ((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-agent-set)
-   (let ((*myself* *self*) (*self* agent-or-agent-set)) (funcall fn)))
+  ((agent-p agent-or-agentset)
+   (let ((*myself* *self*) (*self* agent-or-agentset)) (funcall fn)))
   (t
-   (error "Of requires an agent-set or agent but got: ~A" agent-or-agent-set))))
+   (error "Of requires an agentset or agent but got: ~A" agent-or-agentset))))
 
-(defun shufflerator (agent-set-list)
+(defun shufflerator (agentset-list)
  (let
-  ((copy (copy-list agent-set-list))
+  ((copy (copy-list agentset-list))
    (i 0)
    (agent nil))
   (flet
@@ -313,25 +313,38 @@ DESCRIPTION:
    (max (+ (max-pycor) 0.5d0)))
   (+ min (clnl-random:next-double (- max min)))))
 
-(defun one-of (agent-set)
- "ONE-OF AGENT-SET => RESULT
+(defun one-of (list-or-agentset)
+ "ONE-OF LIST-OR-AGENTSET => RESULT
 
-  RESULT: RANDOM-AGENT | :nobody
+  LIST-OR-AGENTSET: LIST | AGENTSET
+  RESULT: RANDOM-VALUE | RANDOM-AGENT | :nobody
 
 ARGUMENTS AND VALUES:
 
-  AGENT-SET: An agent set
-  RANDOM-AGENT: an agent if AGENT-SET is non empty
+  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 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"
- (let*
-  ((agent-set-list (agent-set-list agent-set))
-   (length (length agent-set-list)))
-  (if (zerop length) :nobody (nth (clnl-random:next-int length) agent-set-list))))
+ (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*))

diff --git a/src/main/parse.lisp b/src/main/parse.lisp
index b3dd3d79c919eedd3b169eb5bdd1fb2b7988fb1d..9c805749c26aaadc76e3d1fa96ebb82393f3c8c2 100644 (file)
--- a/src/main/parse.lisp
+++ b/src/main/parse.lisp
@@ -138,16 +138,16 @@ DESCRIPTION:
       (butlast half-parsed-remainder (- (length half-parsed-remainder) num-args))))))))
 
 (defun help-arg (arg-type arg)
- (case arg-type
-  (:command-block
+ (cond
+  ((eql arg-type :command-block)
    (if (not (and (consp arg) (eql 'block (car arg))))
     (error "Required a block, but found a ~A" arg)
     (cons :command-block (cdr arg))))
-  (:reporter-block
+  ((eql arg-type :reporter-block)
    (if (not (and (consp arg) (eql 'block (car arg))))
     (error "Required a block, but found a ~A" arg)
     (cons :reporter-block (cdr arg))))
-  (:list
+  ((or (eql arg-type :list) (and (listp arg-type) (find :list arg-type)))
    (if (and (consp arg) (eql 'block (car arg)))
     (cons :list-literal (cdr arg))
     arg))
@@ -238,7 +238,7 @@ DESCRIPTION:
 (defprim :label-color ())
 (defprim :not (:boolean))
 (defprim :nobody ())
-(defprim :one-of (t))
+(defprim :one-of ((:agentset :list)))
 (defprim :of (:reporter-block :agentset) :infix)
 (defprim :patches ())
 (defprim :pcolor ())

diff --git a/src/main/transpile.lisp b/src/main/transpile.lisp
index 627a6a8907cc3cb4855d2e843268f4ce67e1c8ec..5914a592eefbf634ed417a44e16375754fd55038 100644 (file)
--- a/src/main/transpile.lisp
+++ b/src/main/transpile.lisp
@@ -94,6 +94,7 @@ DESCRIPTION:
   ((symbolp reporter) (intern (symbol-name reporter) clnl:*model-package*))
   ((not (listp reporter)) (error "Expected a statement of some sort"))
   ((eql :command-block (car reporter)) (transpile-command-block reporter))
+  ((eql :list-literal (car reporter)) (cons 'list (mapcar #'transpile-reporter (cdr reporter))))
   ((eql :reporter-block (car reporter)) (transpile-reporter-block reporter))
   ((and (symbolp (car reporter)) (find (car reporter) *local-variables*))
    (intern (symbol-name (car reporter)) clnl:*model-package*))

diff --git a/src/test/simpletests.lisp b/src/test/simpletests.lisp
index b68cc1ae13ef5bd8706929f688bad849aa4e2bbd..7a362cd77d542a31343f1f9dc7bf537205e252a3 100644 (file)
--- a/src/test/simpletests.lisp
+++ b/src/test/simpletests.lisp
@@ -166,6 +166,12 @@
 (defreportertestwithsetup "one-of 3" "crt 10" "one-of turtles" "(turtle 5)"
  "A056ED8BF26A69FB4437E79F263E362C27F8820E")
 
+(defsimplereportertest "one-of 4" "one-of [green brown]" "35"
+ "0BDACB8E9D2BB768C01826E993B47D83D39FBD0C")
+
+(defsimplecommandtest "one-of 5" "crt 50 ask turtles [ set color one-of [green brown blue] ]"
+ "FD6AC9D531591C47FCE4E4AA0C4FA11CB7A06199")
+
 (defreportertestwithsetup "one-of / of" "crt 10" "[ color ] of one-of turtles" "65"
  "A056ED8BF26A69FB4437E79F263E362C27F8820E")