From: Frank Duncan <frank@kank.net>
Date: Fri, 29 Apr 2016 18:52:10 +0000 (-0500)
Subject: Prims - Implement one-of
X-Git-Tag: v0.1.0~35
X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?a=commitdiff_plain;h=c11c429;p=clnl

Prims - Implement one-of
---

diff --git a/src/main/nvm/base.lisp b/src/main/nvm/base.lisp
index 5865d66..2288537 100644
--- 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 ecbcfd9..f59e181 100644
--- 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 bf12c26..a6dc067 100644
--- 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 8364e58..e7e05de 100644
--- 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 0c571e8..759d57b 100644
--- 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")