34 |
(total (car (last cumulative-weights))) |
(total (car (last cumulative-weights))) |
35 |
(r (gensym))) |
(r (gensym))) |
36 |
(assert (every #'plusp weights)) |
(assert (every #'plusp weights)) |
37 |
|
(when (typep total 'ratio) (setf total (coerce total 'double-float))) |
38 |
`(let ((,r (random ,total))) |
`(let ((,r (random ,total))) |
39 |
(cond |
(cond |
40 |
,@(loop for case in (butlast cases) |
,@(loop for case in (butlast cases) |
258 |
(make-list p :initial-element 1)) |
(make-list p :initial-element 1)) |
259 |
(t (mapcar #'1+ (random-partition* (- n p) p))))) |
(t (mapcar #'1+ (random-partition* (- n p) p))))) |
260 |
|
|
261 |
|
|
262 |
|
;;; Random method combination |
263 |
|
;;; Methods in this method combination take a single method qualifier, |
264 |
|
;;; which is a positive integer. Each method is invoked |
265 |
|
;;; with probability proportional to its qualifier. |
266 |
|
;;; |
267 |
|
;;; Inside a method, a throw to the symbol FAIL causes |
268 |
|
;;; the application to repeat. This enables methods to abort |
269 |
|
;;; and retry the random selection process. |
270 |
|
|
271 |
|
(defun positive-integer-qualifier-p (qualifiers) |
272 |
|
(typep qualifiers '(cons (integer 1) null))) |
273 |
|
|
274 |
|
(define-method-combination randomized nil ((method-list positive-integer-qualifier-p)) |
275 |
|
(assert method-list) |
276 |
|
(let ((clauses (mapcar #'(lambda (method) |
277 |
|
(let ((weight (car (method-qualifiers method)))) |
278 |
|
`(,weight (call-method ,method)))) |
279 |
|
method-list))) |
280 |
|
`(loop (catch 'fail (return (rcase ,@clauses)))))) |