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)
 
 (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
  (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)
  (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)))
 
 (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)
 
   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
 
 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.
 
 
 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
   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
    (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)))))
     (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
   (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:
 
 
 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
   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"
 
   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
   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
 
   RESULT-LIST: a list
   RESULT-VALUE: a single value
 


@@ -187,30 +187,30 @@ DESCRIPTION:
 
   OF is equivalent to of in NetLogo.
 
 
   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.
 
   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
   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
    (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)))))
     (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
   (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
  (let

-  ((copy (copy-list agent-set-list))
+  ((copy (copy-list agentset-list))

    (i 0)
    (agent nil))
   (flet
    (i 0)
    (agent nil))
   (flet


@@ -313,25 +313,38 @@ DESCRIPTION:
    (max (+ (max-pycor) 0.5d0)))
   (+ min (clnl-random:next-double (- max min)))))
 
    (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:
 
 
 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:
 
 
 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"
 
   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*))
 
 (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)
       (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))))
    (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))))
    (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))
    (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 :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 ())
 (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))
   ((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*))
   ((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")
 
 (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")
 
 (defreportertestwithsetup "one-of / of" "crt 10" "[ color ] of one-of turtles" "65"
  "A056ED8BF26A69FB4437E79F263E362C27F8820E")