parent
a1a21ce212
commit
af3c747de5
@ -1,48 +1,28 @@
|
|||||||
;;;; cl-rng.lisp
|
|
||||||
|
|
||||||
(in-package #:cl-rng)
|
|
||||||
|
|
||||||
(defun urandom (&key (limit 1.0) (precision 1) (transform nil))
|
(in-package :cl-rng)
|
||||||
(let ((transform (or transform (lambda (x) x))))
|
|
||||||
(with-open-file (rng "/dev/urandom" :element-type 'unsigned-byte)
|
|
||||||
(assert (> precision 0))
|
|
||||||
(if (= precision 1)
|
|
||||||
(funcall transform (* limit (/ (read-byte rng) 255)))
|
|
||||||
(let* ((val (apply '+ (loop for i from 0 below precision collect (read-byte rng))))
|
|
||||||
(max (* precision 255))
|
|
||||||
(frac (/ val max)))
|
|
||||||
(values (* limit frac) frac))))))
|
|
||||||
|
|
||||||
(defun %urandom-vector (range &rest params)
|
(defparameter *default-randomness-provider* #'urandom)
|
||||||
(loop for x from 0 below (length range) collect
|
|
||||||
(setf (aref range x) (apply 'urandom params))))
|
|
||||||
|
|
||||||
(defun %urandom-list (range &rest params)
|
(defun chance (fraction &key (provider *default-randomness-provider*))
|
||||||
(setf (car range) (apply 'urandom params))
|
(< (funcall provider) fraction))
|
||||||
(when (not (null (cdr range)))
|
|
||||||
(cons (car range) (apply '%urandom-list (cons (cdr range) params)))))
|
|
||||||
|
|
||||||
(defun urandom-range (range &rest params)
|
(export '*default-randomness-provider*)
|
||||||
(if (listp range)
|
(export 'chance)
|
||||||
(apply '%urandom-list (cons range params))
|
|
||||||
(apply '%urandom-vector (cons range params))))
|
|
||||||
|
|
||||||
(export 'urandom)
|
|
||||||
(export 'urandom-range)
|
|
||||||
|
|
||||||
;(defparameter *dice-results* (make-list 10))
|
|
||||||
|
|
||||||
|
|
||||||
; (let ((num 0)
|
|
||||||
; (max 10000)
|
|
||||||
; (low 50))
|
|
||||||
; (format t "~%Searching ~a values for >= ~a...~%" max low)
|
|
||||||
; (loop for i from 0 below max do
|
|
||||||
; (let ((value (apply '+ (urandom-range *dice-results* :limit 6 :transform (lambda (x) (1+ (floor x)))))))
|
|
||||||
; (and (>= value low)
|
|
||||||
; (incf num)
|
|
||||||
; (format t " -> ~a: ~a~%" i value))))
|
|
||||||
; (format t "Found ~a / ~a (~,8f %)~%" num max (* 100 (/ num max))))
|
|
||||||
|
|
||||||
|
(defun weighted (weights &key (default nil) (provider *default-randomness-provider*))
|
||||||
|
(let ((previous 0)
|
||||||
|
(result (funcall provider))
|
||||||
|
(rval default))
|
||||||
|
(mapc (lambda (x)
|
||||||
|
(let ((value (car x))
|
||||||
|
(weight (cdr x)))
|
||||||
|
(and (>= result previous)
|
||||||
|
(<= result (+ previous weight))
|
||||||
|
(setf rval value))
|
||||||
|
(incf previous weight)))
|
||||||
|
weights)
|
||||||
|
(values rval result)))
|
||||||
|
|
||||||
|
(export 'weighted)
|
||||||
|
|
||||||
|
@ -0,0 +1,48 @@
|
|||||||
|
;;;; cl-rng.lisp
|
||||||
|
|
||||||
|
(in-package #:cl-rng)
|
||||||
|
|
||||||
|
(defun urandom (&key (limit 1.0) (precision 1) (transform nil))
|
||||||
|
(let ((transform (or transform #'identity)))
|
||||||
|
(with-open-file (rng "/dev/urandom" :element-type 'unsigned-byte)
|
||||||
|
(assert (> precision 0))
|
||||||
|
(if (= precision 1)
|
||||||
|
(funcall transform (* limit (/ (read-byte rng) 255)))
|
||||||
|
(let* ((val (apply '+ (loop for i from 0 below precision collect (read-byte rng))))
|
||||||
|
(max (* precision 255))
|
||||||
|
(frac (/ val max)))
|
||||||
|
(values (* limit frac) frac))))))
|
||||||
|
|
||||||
|
(defun %urandom-vector (range &rest params)
|
||||||
|
(loop for x from 0 below (length range) collect
|
||||||
|
(setf (aref range x) (apply 'urandom params))))
|
||||||
|
|
||||||
|
(defun %urandom-list (range &rest params)
|
||||||
|
(setf (car range) (apply 'urandom params))
|
||||||
|
(unless (null (cdr range))
|
||||||
|
(cons (car range) (apply '%urandom-list (cons (cdr range) params)))))
|
||||||
|
|
||||||
|
(defun urandom-range (range &rest params)
|
||||||
|
(if (listp range)
|
||||||
|
(apply '%urandom-list (cons range params))
|
||||||
|
(apply '%urandom-vector (cons range params))))
|
||||||
|
|
||||||
|
(export 'urandom)
|
||||||
|
(export 'urandom-range)
|
||||||
|
|
||||||
|
;(defparameter *dice-results* (make-list 10))
|
||||||
|
|
||||||
|
|
||||||
|
; (let ((num 0)
|
||||||
|
; (max 10000)
|
||||||
|
; (low 50))
|
||||||
|
; (format t "~%Searching ~a values for >= ~a...~%" max low)
|
||||||
|
; (loop for i from 0 below max do
|
||||||
|
; (let ((value (apply '+ (urandom-range *dice-results* :limit 6 :transform (lambda (x) (1+ (floor x)))))))
|
||||||
|
; (and (>= value low)
|
||||||
|
; (incf num)
|
||||||
|
; (format t " -> ~a: ~a~%" i value))))
|
||||||
|
; (format t "Found ~a / ~a (~,8f %)~%" num max (* 100 (/ num max))))
|
||||||
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in new issue