From 0a00e056cd1a8f022128525ac3cf3494cc36159d Mon Sep 17 00:00:00 2001 From: Frank Duncan Date: Sat, 30 Apr 2016 09:36:45 -0500 Subject: [PATCH] Prims - Implement random, random-xcor, random-ycor, setxy --- src/main/nvm/nvm.lisp | 84 ++++++++++++++++++++++++++++++++++++++- src/main/package.lisp | 7 +++- src/main/random.lisp | 31 +++++++++++++-- src/main/transpile.lisp | 4 ++ src/test/simpletests.lisp | 10 +++++ 5 files changed, 131 insertions(+), 5 deletions(-) diff --git a/src/main/nvm/nvm.lisp b/src/main/nvm/nvm.lisp index 0a819ae..f8fdd84 100644 --- a/src/main/nvm/nvm.lisp +++ b/src/main/nvm/nvm.lisp @@ -212,6 +212,69 @@ DESCRIPTION: See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#random-float" (clnl-random:next-double n)) +(defun random (n) + "RANDOM N => RANDOM-NUMBER + +ARGUMENTS AND VALUES: + + N: an integer, the upper bound of the random + RANDOM-NUMBER: an integer, the random result + +DESCRIPTION: + + Returns a random number strictly closer to zero than N. + + If number is positive, returns a random integer greater than or equal to 0, + but strictly less than number. + + If number is negative, returns a random integer less than or equal to 0, + but strictly greater than number. + + If number is zero, the result is always 0. + + See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#random" + (coerce (clnl-random:next-long (truncate n)) 'double-float)) + +(defun random-xcor () + "RANDOM-XCOR => RANDOM-NUMBER + +ARGUMENTS AND VALUES: + + RANDOM-NUMBER: a float, the random result + +DESCRIPTION: + + Returns a random floating point number in the allowable range of turtle + coordinates along the x axis. + + These range from min-pxcor - 0.5 (inclusive) to max-pxcor + 0.5 (exclusive) + + See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#random-cor" + (let + ((min (- (min-pxcor) 0.5d0)) + (max (+ (max-pxcor) 0.5d0))) + (+ min (clnl-random:next-double (- max min))))) + +(defun random-ycor () + "RANDOM-YCOR => RANDOM-NUMBER + +ARGUMENTS AND VALUES: + + RANDOM-NUMBER: a float, the random result + +DESCRIPTION: + + Returns a random floating point number in the allowable range of turtle + coordinates along the y axis. + + These range from min-pycor - 0.5 (inclusive) to max-pycor + 0.5 (exclusive) + + See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#random-cor" + (let + ((min (- (min-pycor) 0.5d0)) + (max (+ (max-pycor) 0.5d0))) + (+ min (clnl-random:next-double (- max min))))) + (defun one-of (agent-set) "ONE-OF AGENT-SET => RESULT @@ -233,7 +296,7 @@ DESCRIPTION: (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*)) + (when (not (turtle-p *self*)) (error "Gotta call jump in turtle scope, dude (~A)" *self*)) (setf (turtle-xcor *self*) (wrap-x *topology* @@ -243,6 +306,25 @@ DESCRIPTION: (wrap-y *topology* (+ (turtle-ycor *self*) (* n (using-cached-cos (turtle-heading *self*))))))) +(defun setxy (x y) + "SETXY X Y => RESULT + +ARGUMENTS AND VALUES: + + X: a double + Y: a double + RESULT: undefined + +DESCRIPTION: + + Sets the x-coordinate and y-coordinate for the turle. Equivalent to + set xcor x set ycor y, except it happens in one step inside of two. + + See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#setxy" + (when (not (turtle-p *self*)) (error "Gotta call setxy in turtle scope, dude (~A)" *self*)) + (setf (turtle-xcor *self*) (wrap-x *topology* x)) + (setf (turtle-ycor *self*) (wrap-y *topology* y))) + (defun forward (n) "FORWARD N => RESULT diff --git a/src/main/package.lisp b/src/main/package.lisp index a6dc067..356a408 100644 --- a/src/main/package.lisp +++ b/src/main/package.lisp @@ -33,7 +33,7 @@ other things.")) (defpackage #:clnl-random (:use :common-lisp) (:shadow #:export) - (:export #:export #:set-seed #:next-int #:next-double) + (:export #:export #:set-seed #:next-int #:next-double #:next-long) (:documentation "Wrapper around mt19937. @@ -64,6 +64,7 @@ into an ast that can be transpiled later.")) (defpackage #:clnl-nvm (:use :common-lisp) + (:shadow #:random) (:export #:export-world #:create-world #:current-state ; API as used by transpiled NetLogo programs #:agent-value @@ -76,7 +77,11 @@ into an ast that can be transpiled later.")) #:one-of #:patches #:reset-ticks + #:random #:random-float + #:random-xcor + #:random-ycor + #:setxy #:show #:turtles #:tick diff --git a/src/main/random.lisp b/src/main/random.lisp index fad9431..4175073 100644 --- a/src/main/random.lisp +++ b/src/main/random.lisp @@ -24,16 +24,41 @@ ARGUMENTS AND VALUES: DESCRIPTION: - NEXT-INTEGER returns the next randomly generated integer. + NEXT-INT returns the next randomly generated integer. It does so in a way that's in accordance with java.util.Random and the MerseinneTwisterFast that's in NetLogo. It also advances the RNG and is bounded by N." (if - (= n (logand n (- n) )) - (ash (* n (ash (mt19937:random-chunk mt19937:*random-state*) -1) ) -31) + (= n (logand n (- n))) + (ash (* n (ash (mt19937:random-chunk mt19937:*random-state*) -1)) -31) (rem (ash (mt19937:random-chunk mt19937:*random-state*) -1) n))) +(defun next-long (n) + "NEXT-LONG N => LONG + +ARGUMENTS AND VALUES: + + N: A long representing the upper bound + LONG: A long + +DESCRIPTION: + + NEXT-LONG returns the next randomly generated long. + + It does so in a way that's in accordance with java.util.Random and + the MerseinneTwisterFast that's in NetLogo. It also advances the + RNG and is bounded by N." + (flet + ((unsigned-to-signed (value size) ; We need this because MersenneTwisterFast + (if (logbitp (1- size) value) (dpb value (byte size 0) -1) value)) + (signed-to-unsigned (value size) (ldb (byte size 0) value))) + (let + ((y (unsigned-to-signed (mt19937:random-chunk mt19937:*random-state*) 32)) + (z (unsigned-to-signed (mt19937:random-chunk mt19937:*random-state*) 32))) + ;(mod (+ (ash y 32) z) n))) + (mod (signed-to-unsigned (ash (+ (ash y 32) z) -1) 63) n)))) + (defun next-double (&optional (n 1d0)) "NEXT-DOUBLE &optional N => DOUBLE diff --git a/src/main/transpile.lisp b/src/main/transpile.lisp index 1bac2b6..ea53bfc 100644 --- a/src/main/transpile.lisp +++ b/src/main/transpile.lisp @@ -160,10 +160,14 @@ DESCRIPTION: (defsimpleprim :patches :reporter clnl-nvm:patches) (defagentvalueprim :pcolor) (defsimpleprim :reset-ticks :command clnl-nvm:reset-ticks) +(defsimpleprim :random :reporter clnl-nvm:random) (defsimpleprim :random-float :reporter clnl-nvm:random-float) +(defsimpleprim :random-xcor :reporter clnl-nvm:random-xcor) +(defsimpleprim :random-ycor :reporter clnl-nvm:random-ycor) (defsimpleprim :rt :command clnl-nvm:turn-right) (defsimpleprim :show :command clnl-nvm:show) (defsimpleprim :set :command cl:setf) +(defsimpleprim :setxy :command clnl-nvm:setxy) (defagentvalueprim :size) (defsimpleprim :tick :command clnl-nvm:tick) (defsimpleprim :ticks :reporter clnl-nvm:ticks) diff --git a/src/test/simpletests.lisp b/src/test/simpletests.lisp index efc71f7..43bed46 100644 --- a/src/test/simpletests.lisp +++ b/src/test/simpletests.lisp @@ -177,3 +177,13 @@ (defsimplecommandtest "size 1" "crt 10 ask turtles [ set size 5 ]" "8837CF2681A2091B0664FAA2C32062B19F548ED6") + +(defsimplereportertest "random 1" "random 100000" "85402" + "17D1BF7FF7BF2C7F3F5F7DD7CF67CFF2772CFFFC") + +(defreportertestwithsetup "random 2" "crt 10" "[ random 1000000 ] of turtles" + "[512564 490953 127774 976371 218233 692751 909837 655769 977588 485347]" + "2048ED1C553B0342D5DE1302577394CD09DE88DA") + +(defsimplecommandtest "setxy 1" "crt 10 ask turtles [ setxy random-xcor random-ycor ]" + "B02FD5B864A129AED5254A68C499607F7F6EA236") -- 2.25.1