/[gcl]/gcl/ansi-tests/random-aux.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/random-aux.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.5 by pfdietz, Fri Sep 12 02:37:33 2003 UTC revision 1.6 by pfdietz, Sun Sep 14 20:30:05 2003 UTC
# Line 18  Line 18 
18         ,@(loop for i from 0 for e in cases collect `(,i ,e))         ,@(loop for i from 0 for e in cases collect `(,i ,e))
19         (t (error "Can't happen?! (in random-case)~%")))))         (t (error "Can't happen?! (in random-case)~%")))))
20    
21    (defmacro rcase (&body cases)
22      "Usage: (RCASE (<weight> <form>+)+), where <weight> is a positive real
23       indicating the relative probability of executing the associated implicit
24       progn."
25      (assert cases)
26      (let* ((weights (mapcar #'car cases))
27             (cumulative-weights (let ((sum 0))
28                                   (loop for w in weights collect (incf sum w))))
29             (total (car (last cumulative-weights)))
30             (r (gensym)))
31        (assert (every #'plusp weights))
32        `(let ((,r (random ,total)))
33           (cond
34            ,@(loop for case in (butlast cases)
35                    for cw in cumulative-weights
36                    collect `((< ,r ,cw) ,@(cdr case)))
37            (t ,@(cdar (last cases)))))))
38    
39  (defun random-nonnegative-real ()  (defun random-nonnegative-real ()
40    (if (coin 3)    (if (coin 3)
41        (random-case        (random-case

Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26