From: Frank Duncan Date: Sat, 30 Apr 2016 18:07:42 +0000 (-0500) Subject: Prims - Update one-of to take lists. Rename agent-set to agentset X-Git-Tag: v0.1.0~30 X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?a=commitdiff_plain;h=5a7fb5c;p=clnl 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 8f1595c..cd494a7 100644 --- 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 a592474..31d2f31 100644 --- 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 b3dd3d7..9c80574 100644 --- 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 627a6a8..5914a59 100644 --- 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 b68cc1a..7a362cd 100644 --- 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")