X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Frandom.lisp;h=0b79c8cf60bb35b51ccabb716c8cd488b572db0d;hb=ba63acfa943d02a524ae0a81ffd59477f1ccd6b3;hp=e869a1c114c43cd0891bef662f0c195b363ac40d;hpb=a6753a0dbc0f074600d0bd7fc033d10955620ef4;p=fiveam.git

diff --git a/src/random.lisp b/src/random.lisp
index e869a1c..0b79c8c 100644
--- a/src/random.lisp
+++ b/src/random.lisp
@@ -1,6 +1,6 @@
-;; -*- lisp -*-
+;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
 
-(in-package :it.bese.FiveAM)
+(in-package :it.bese.fiveam)
 
 ;;;; ** Random (QuickCheck-ish) testing
 
@@ -32,41 +32,60 @@
   FOR-ALL test including when the body is skipped due to failed
   guard conditions.
 
-Since we have guard conditions we may get into infinite loops
-where the test code is never run due to the guards never
-returning true. This second run limit prevents that.")
+Since we have guard conditions we may get into infinite loops where
+the test code is never run due to the guards never returning
+true. This second limit prevents that from happening.")
 
 (defmacro for-all (bindings &body body)
-  "Bind BINDINGS to random variables and test BODY *num-trials* times.
-
-BINDINGS is a list of binding forms, each element is a list
-of (BINDING VALUE &optional GUARD). Value, which is evaluated
-once when the for-all is evaluated, must return a generator which
-be called each time BODY is evaluated. BINDING is either a symbol
-or a list which will be passed to destructuring-bind. GUARD is a
-form which, if present, stops BODY from executing when IT returns
-NIL. The GUARDS are evaluated after all the random data has been
-generated and they can refer to the current value of any
-binding. NB: Generator forms, unlike guard forms, can not contain
-references to the boud variables.
+  "Bind BINDINGS to random variables and execute BODY `*num-trials*` times.
+
+BINDINGS::
+
+A a list of binding forms, each element is a list of:
++
+    (BINDING VALUE &optional GUARD)
++
+VALUE, which is evaluated once when the for-all is evaluated, must
+return a generator which be called each time BODY is
+evaluated. BINDING is either a symbol or a list which will be passed
+to destructuring-bind. GUARD is a form which, if present, stops BODY
+from executing when it returns NIL. The GUARDS are evaluated after all
+the random data has been generated and they can refer to the current
+value of any binding.
++
+\[NOTE]
+Generator forms, unlike guard forms, can not contain references to the
+bound variables.
+
+BODY::
+
+The code to run. Will be run `*NUM-TRIALS*` times (unless the `*MAX-TRIALS*` limit is reached).
 
 Examples:
 
-  (for-all ((a (gen-integer)))
-    (is (integerp a)))
+--------------------------------
+\(for-all ((a (gen-integer)))
+  (is (integerp a)))
 
-  (for-all ((a (gen-integer) (plusp a)))
-    (is (integerp a))
-    (is (plusp a)))
+\(for-all ((a (gen-integer) (plusp a)))
+  (is (integerp a))
+  (is (plusp a)))
 
-  (for-all ((less (gen-integer))
-            (more (gen-integer) (< less more)))
-    (is (<= less more)))
+\(for-all ((less (gen-integer))
+          (more (gen-integer) (< less more)))
+  (is (<= less more)))
 
-  (for-all (((a b) (gen-two-integers)))
-    (is (integerp a))
-    (is (integerp b)))"
-  (with-unique-names (test-lambda-args)
+\(defun gen-two-integers ()
+  (lambda ()
+    (list (funcall (gen-integer))
+          (funcall (gen-integer)))))
+
+\(for-all (((a b) (gen-two-integers)))
+  (is (integerp a))
+  (is (integerp b)))
+--------------------------------
+"
+  (with-gensyms (test-lambda-args)
     `(perform-random-testing
       (list ,@(mapcar #'second bindings))
       (lambda (,test-lambda-args)
@@ -77,7 +96,7 @@ Examples:
               (throw 'run-once
                 (list :guard-conditions-failed))))))))
 
-;;;; *** Implementation 
+;;;; *** Implementation
 
 ;;;; We could just make FOR-ALL a monster macro, but having FOR-ALL be
 ;;;; a preproccessor for the perform-random-testing function is
@@ -144,7 +163,7 @@ Examples:
   (:method ((object t)) nil))
 
 (defmethod reason ((result for-all-test-failed))
-  (format nil "Falsafiable with ~S" (slot-value result 'failure-values)))
+  (format nil "Falsifiable with ~S" (slot-value result 'failure-values)))
 
 (defclass for-all-test-no-tests (test-failure for-all-test-result)
   ())
@@ -167,79 +186,177 @@ than or equal to MIN and less than or equal to MIN."
   (lambda ()
     (+ min (random (1+ (- max min))))))
 
-(defun gen-float (&key bound (type 'short-float))
-  "Returns a generator which producs floats of type TYPE. BOUND,
-if specified, constrains the ruselts to be in the range (-BOUND,
-BOUND)."
+(defun type-most-negative (floating-point-type)
+  (ecase floating-point-type
+    (short-float most-negative-short-float)
+    (single-float most-negative-single-float)
+    (double-float most-negative-double-float)
+    (long-float most-negative-long-float)))
+
+(defun type-most-positive (floating-point-type)
+  (ecase floating-point-type
+    (short-float most-positive-short-float)
+    (single-float most-positive-single-float)
+    (double-float most-positive-double-float)
+    (long-float most-positive-long-float)) )
+
+(defun gen-float (&key bound (type 'short-float) min max)
+  "Returns a generator which producs floats of type TYPE.
+
+BOUND::
+
+Constrains the results to be in the range (-BOUND, BOUND). Default
+value is the most-positive value of TYPE.
+
+MIN and MAX::
+
+If supplied, cause the returned float to be within the floating point
+interval (MIN, MAX). It is the caller's responsibility to ensure that
+the range between MIN and MAX is less than the requested type's
+maximum interval. MIN defaults to 0.0 (when only MAX is supplied), MAX
+defaults to MOST-POSITIVE-<TYPE> (when only MIN is supplied). This
+peculiar calling convention is designed for the common case of
+generating positive values below a known limit.
+
+TYPE::
+
+The type of the returned float. Defaults to `SHORT-FLOAT`. Effects the
+default values of BOUND, MIN and MAX.
+
+\[NOTE]
+Since GEN-FLOAT is built on CL:RANDOM the distribution of returned
+values will be continuous, not discrete. In other words: the values
+will be evenly distributed across the specified numeric range, the
+distribution of possible floating point values, when seen as a
+sequence of bits, will not be even."
   (lambda ()
-    (let* ((most-negative (ecase type
-                            (short-float most-negative-short-float)
-                            (single-float most-negative-single-float)
-                            (double-float most-negative-double-float)
-                            (long-float most-negative-long-float)))
-           (most-positive (ecase type
-                            (short-float most-positive-short-float)
-                            (single-float most-positive-single-float)
-                            (double-float most-positive-double-float)
-                            (long-float most-positive-long-float)))
-           (bound (or bound (max most-positive (- most-negative)))))
-      (coerce 
-       (ecase (random 2)
-         (0 ;; generate a positive number
-          (random (min most-positive bound)))
-         (1 ;; generate a negative number
-          (- (random (min (- most-negative) bound)))))
-       type))))
-
-(defun gen-character (&key (code (gen-integer :min 0 :max (1- char-code-limit)))
+    (flet ((rand (limit) (random (coerce limit type))))
+      (when (and bound (or min max))
+        (error "GET-FLOAT does not support specifying :BOUND and :MAX/:MIN."))
+      (if (or min max)
+          (handler-bind ((arithmetic-error (lambda (c)
+                                             (error "ERROR ~S occured when attempting to generate a random value between ~S and ~S." c min max))))
+            (setf min (or min 0)
+                  max (or max (type-most-positive type)))
+            (+ min (rand (- max min))))
+          (let ((min (if bound bound (- (type-most-negative type))))
+                (max (if bound bound (type-most-positive type))))
+            (ecase (random 2)
+              (0 ;; generate a positive number
+               (rand max))
+              (1 ;; generate a negative number NB: min is actually
+               ;; positive. see the if statement above.
+               (- (rand min)))))))))
+
+(defun gen-character (&key (code-limit char-code-limit)
+                           (code (gen-integer :min 0 :max (1- code-limit)))
                            (alphanumericp nil))
   "Returns a generator of characters.
 
-CODE must be a generator of random integers. ALPHANUMERICP, if
-non-NIL, limits the returned chars to those which pass
-alphanumericp."
+CODE::
+
+A generater for random integers.
+
+CODE-LIMIT::
+
+If set only characters whose code-char is below this value will be
+returned.
+
+ALPHANUMERICP::
+
+Limits the returned chars to those which pass alphanumericp.
+"
   (lambda ()
-    (if alphanumericp            
-        (loop
-           for count upfrom 0
-           for char = (code-char (funcall code))
-           until (alphanumericp char)
-           when (= 1000 count)
-             do (error "After 1000 iterations ~S has still not generated an alphanumeric character :(."
-                       code)
-           finally (return char))
-        (code-char (funcall code)))))
+    (loop
+       for count upfrom 0
+       for char = (code-char (funcall code))
+       until (and char
+                  (or (not alphanumericp)
+                      (alphanumericp char)))
+       when (= 1000 count)
+       do (error "After 1000 iterations ~S has still not generated ~:[a valid~;an alphanumeric~] character :(."
+                 code alphanumericp)
+       finally (return char))))
 
 (defun gen-string (&key (length (gen-integer :min 0 :max 80))
-                        (elements (gen-character))
-                        (element-type 'character))
-  "Returns a generator which producs random strings. LENGTH must
-be a generator which producs integers, ELEMENTS must be a
-generator which produces characters of type ELEMENT-TYPE."
+                        (elements (gen-character)))
+  "Returns a generator which producs random strings of characters.
+
+LENGTH::
+
+A random integer generator specifying how long to make the generated string.
+
+ELEMENTS::
+
+A random character generator which producs the characters in the
+string.
+"
+  (gen-buffer :length length
+              :element-type 'character
+              :elements elements))
+
+(defun gen-buffer (&key (length (gen-integer :min 0 :max 50))
+                     (element-type '(unsigned-byte 8))
+                     (elements (gen-integer :min 0 :max (1- (expt 2 8)))))
+  "Generates a random vector, defaults to a random (unsigned-byte 8)
+vector with elements between 0 and 255.
+
+LENGTH::
+
+The length of the buffer to create (a random integer generator)
+
+ELEMENT-TYPE::
+
+The type of array to create.
+
+ELEMENTS::
+
+The random element generator.
+"
   (lambda ()
-    (loop
-       with length = (funcall length)
-       with string = (make-string length :element-type element-type)
-       for index below length
-       do (setf (aref string index) (funcall elements))
-       finally (return string))))
+    (let ((buffer (make-array (funcall length) :element-type element-type)))
+      (map-into buffer elements))))
 
 (defun gen-list (&key (length (gen-integer :min 0 :max 10))
                       (elements (gen-integer :min -10 :max 10)))
-  "Returns a generator which producs random lists. LENGTH must be
-an integer generator and ELEMENTS must be a generator which
-producs objects."
+  "Returns a generator which producs random lists.
+
+LENGTH::
+
+As with GEN-STRING, a random integer generator specifying the length of the list to create.
+
+ELEMENTS::
+
+A random object generator.
+"
   (lambda ()
     (loop
        repeat (funcall length)
        collect (funcall elements))))
 
-(defun gen-buffer (&key (length (gen-integer :min 0 :max 50))
-                        (element-type '(unsigned-byte 8))
-                        (elements (gen-integer :min 0 :max (1- (expt 2 8)))))
+(defun gen-tree (&key (size 20)
+                      (elements (gen-integer :min -10 :max 10)))
+  "Returns a generator which producs random trees. SIZE control
+the approximate size of the tree, but don't try anything above
+ 30, you have been warned. ELEMENTS must be a generator which
+will produce the elements."
+  (labels ((rec (&optional (current-depth 0))
+             (let ((key (random (+ 3 (- size current-depth)))))
+               (cond ((> key 2)
+                      (list (rec (+ current-depth 1))
+                            (rec (+ current-depth 1))))
+                     (t (funcall elements))))))
+    (lambda ()
+      (rec))))
+
+(defun gen-one-element (&rest elements)
+  "Produces one randomly selected element of ELEMENTS.
+
+ELEMENTS::
+
+A list of objects (note: objects, not generators) to choose from."
   (lambda ()
-    (let ((buffer (make-array (funcall length) :element-type element-type)))
-      (map-into buffer elements))))
+    (nth (random (length elements)) elements)))
 
 ;;;; The trivial always-produce-the-same-thing generator is done using
 ;;;; cl:constantly.