Prims - Implement random, random-xcor, random-ycor, setxy
authorFrank Duncan <frank@kank.net>
Sat, 30 Apr 2016 14:36:45 +0000 (09:36 -0500)
committerFrank Duncan <frank@kank.net>
Sat, 30 Apr 2016 14:48:11 +0000 (09:48 -0500)
src/main/nvm/nvm.lisp
src/main/package.lisp
src/main/random.lisp
src/main/transpile.lisp
src/test/simpletests.lisp

index 0a819ae4041322011e584b7dda08a59f2f792863..f8fdd84bde3a72ecdc4c8e87f6db905e5c42ca44 100644 (file)
@@ -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
 
index a6dc0672c2b2f42a21783dd4f6d52443b0bc8c5e..356a408179b4f2a417c0becba1208b8db1e409ff 100644 (file)
@@ -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
index fad9431ff26a4a8040f2df12b481209f77aa978d..4175073a429883e4aad326b30e45e04df1718df5 100644 (file)
@@ -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
 
index 1bac2b6701500cde209f8cda61ed09338c2152c0..ea53bfcc7a4c984d08139f977f3082b42f4f1927 100644 (file)
@@ -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)
index efc71f7359f316fe5e4875ca282c56394f00f924..43bed4601954c71f079be82585de54bf63dbaf44 100644 (file)
 
 (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")