X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Frandom.lisp;h=3813f439315cdd0b55c22402db170cc267662f94;hb=53f45abc72ba5446160feb359d89972f29b34924;hp=a1f16bb0fe929f10840e6459f2ea83db4675f4fc;hpb=ff6eb7fc9763ef77df2336250d49c78780ab4676;p=fiveam.git diff --git a/src/random.lisp b/src/random.lisp index a1f16bb..3813f43 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 @@ -14,6 +14,16 @@ ;;;; failure we stop running and report what values of the variables ;;;; caused the code to fail. +;;;; The generation of the random data is done using "generator +;;;; functions" (see below for details). A generator function is a +;;;; function which creates, based on user supplied parameters, a +;;;; function which returns random data. In order to facilitate +;;;; generating good random data the FOR-ALL macro also supports guard +;;;; conditions and creating one random input based on the values of +;;;; another (see the FOR-ALL macro for details). + +;;;; *** Public Interface to the Random Tester + (defparameter *num-trials* 100 "Number of times we attempt to run the body of the FOR-ALL test.") @@ -27,13 +37,51 @@ where the test code is never run due to the guards never returning true. This second run limit prevents that.") (defmacro for-all (bindings &body body) - `(perform-random-testing - (list ,@(mapcar #'second bindings)) - (lambda ,(mapcar #'first bindings) - (if (and ,@(delete-if #'null (mapcar #'third bindings))) - (progn ,@body) - (throw 'run-once - (list :guard-conditions-failed)))))) + "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. + +Examples: + + (for-all ((a (gen-integer))) + (is (integerp 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 (((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) + (destructuring-bind ,(mapcar #'first bindings) + ,test-lambda-args + (if (and ,@(delete-if #'null (mapcar #'third bindings))) + (progn ,@body) + (throw 'run-once + (list :guard-conditions-failed)))))))) + +;;;; *** Implementation + +;;;; We could just make FOR-ALL a monster macro, but having FOR-ALL be +;;;; a preproccessor for the perform-random-testing function is +;;;; actually much easier. (defun perform-random-testing (generators body) (loop @@ -72,7 +120,7 @@ returning true. This second run limit prevents that.") (catch 'run-once (bind-run-state ((result-list '())) (let ((values (mapcar #'funcall generators))) - (apply body values) + (funcall body values) (cond ((null result-list) (throw 'run-once (list :no-tests))) @@ -96,7 +144,7 @@ returning true. This second run limit prevents that.") (: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) ()) @@ -113,37 +161,66 @@ returning true. This second run limit prevents that.") ;;;; We provide a set of built-in generators. (defun gen-integer (&key (max (1+ most-positive-fixnum)) - (min (1- most-negative-fixnum))) + (min (1- most-negative-fixnum))) "Returns a generator which produces random integers greater 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, which defaults to the most-positive value of TYPE, constrains +the results to be in the range (-BOUND, BOUND). + +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- (when only MIN is +supplied). This peculiar calling convention is designed for the common +case of generating positive values below a known limit. + +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. @@ -151,16 +228,16 @@ CODE must be a generator of random integers. ALPHANUMERICP, if non-NIL, 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)) @@ -186,5 +263,31 @@ producs objects." repeat (funcall length) collect (funcall elements)))) +(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-buffer (&key (length (gen-integer :min 0 :max 50)) + (element-type '(unsigned-byte 8)) + (elements (gen-integer :min 0 :max (1- (expt 2 8))))) + (lambda () + (let ((buffer (make-array (funcall length) :element-type element-type))) + (map-into buffer elements)))) + +(defun gen-one-element (&rest elements) + (lambda () + (nth (random (length elements)) elements))) + ;;;; The trivial always-produce-the-same-thing generator is done using ;;;; cl:constantly.