Prims - Implement one-of

diff --git a/src/main/nvm/base.lisp b/src/main/nvm/base.lisp
index 5865d66e0e325b4f12369d5d45e89a2e2004b632..228853767bde0968e763e7bd955314db5805e4e0 100644 (file)
--- a/src/main/nvm/base.lisp
+++ b/src/main/nvm/base.lisp
@@ -12,3 +12,6 @@
 
 (defstruct turtle who color heading xcor ycor)
 (defstruct patch color xcor ycor)
+
+(defun agent-set-list (agent-set)
+ agent-set)

diff --git a/src/main/nvm/nvm.lisp b/src/main/nvm/nvm.lisp
index ecbcfd9f492c0854e9626ebe264da05ca064fc87..f59e18138a0bd1d1d0b874f7284ab058c85a8c21 100644 (file)
--- a/src/main/nvm/nvm.lisp
+++ b/src/main/nvm/nvm.lisp
@@ -138,7 +138,7 @@ DESCRIPTION:
 
   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#ask"
  (let
-  ((iter (shufflerator agent-set)))
+  ((iter (shufflerator (agent-set-list agent-set))))
   (loop
    :for agent := (funcall iter)
    :while agent
@@ -164,15 +164,15 @@ DESCRIPTION:
 
   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#of"
  (let
-  ((iter (shufflerator agent-set)))
+  ((iter (shufflerator (agent-set-list agent-set))))
   (loop
    :for agent := (funcall iter)
    :while agent
    :collect (let ((*myself* *self*) (*self* agent)) (funcall fn)))))
 
-(defun shufflerator (agent-set)
+(defun shufflerator (agent-set-list)
  (let
-  ((copy (copy-list agent-set))
+  ((copy (copy-list agent-set-list))
    (i 0)
    (agent nil))
   (flet
@@ -212,6 +212,26 @@ DESCRIPTION:
   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#random-float"
  (clnl-random:next-double n))
 
+(defun one-of (agent-set)
+ "ONE-OF AGENT-SET => RESULT
+
+  RESULT: RANDOM-AGENT | :nobody
+
+ARGUMENTS AND VALUES:
+
+  AGENT-SET: An agent set
+  RANDOM-AGENT: an agent if AGENT-SET is non empty
+
+DESCRIPTION:
+
+  From an agentset, returns a random agent. If the agentset is empty, returns nobody.
+
+  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))))
+
 (defun jump (n)
  (when (not (turtle-p *self*)) (error "Gotta call fd in turtle scope, dude (~A)" *self*))
  (setf
@@ -408,6 +428,12 @@ DESCRIPTION:
 
 (defmethod dump-object ((o list)) (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"))
+
 (defun current-state ()
  "CURRENT-STATE => WORLD-STATE
 

diff --git a/src/main/package.lisp b/src/main/package.lisp
index bf12c26612a0df187131f47773c22d2ebd0c653e..a6dc0672c2b2f42a21783dd4f6d52443b0bc8c5e 100644 (file)
--- a/src/main/package.lisp
+++ b/src/main/package.lisp
@@ -73,6 +73,7 @@ into an ast that can be transpiled later."))
   #:of
   #:forward
   #:lookup-color
+  #:one-of
   #:patches
   #:reset-ticks
   #:random-float

diff --git a/src/main/transpile.lisp b/src/main/transpile.lisp
index 8364e58b0ba74baa9f20a945923d83400247f85e..e7e05de93e8b83b63520895910bcd41e83e3d8b1 100644 (file)
--- a/src/main/transpile.lisp
+++ b/src/main/transpile.lisp
@@ -152,6 +152,7 @@ DESCRIPTION:
 (defprim-alias :if-else :ifelse)
 (defsimpleprim :lt :command clnl-nvm:turn-left)
 (defkeywordprim :nobody)
+(defsimpleprim :one-of :reporter clnl-nvm:one-of)
 (defsimpleprim :of :reporter clnl-nvm:of)
 (defsimpleprim :patches :reporter clnl-nvm:patches)
 (defagentvalueprim :pcolor)

diff --git a/src/test/simpletests.lisp b/src/test/simpletests.lisp
index 0c571e890a66b2f0a60c33a899cd894e8a1dcf9b..759d57b7f85d1053a6fab130d91d8e6e640f52d4 100644 (file)
--- a/src/test/simpletests.lisp
+++ b/src/test/simpletests.lisp
@@ -156,3 +156,12 @@
 (defreportertestwithsetup "set / pcolor" "ask patches [ set pcolor green ]" "[ pcolor ] of patches"
  "[55 55 55 55 55 55 55 55 55]"
  "3E246C518581E004BC65EFB074A09BA2EEBB2910")
+
+(defsimplereportertest "one-of 1" "one-of patches" "(patch -1 -1)"
+ "0BDACB8E9D2BB768C01826E993B47D83D39FBD0C")
+
+(defsimplereportertest "one-of 2" "one-of turtles" "nobody"
+ "E1DE30F072D785E0D0B59F28B0F7853E3D3E0D8B")
+
+(defreportertestwithsetup "one-of 3" "crt 10" "one-of turtles" "(turtle 5)"
+ "A056ED8BF26A69FB4437E79F263E362C27F8820E")