PageRenderTime 19ms CodeModel.GetById 13ms app.highlight 3ms RepoModel.GetById 1ms app.codeStats 0ms

/src/random-weighted/source.scm

http://github.com/dharmatech/abstracting
Scheme | 38 lines | 24 code | 14 blank | 0 comment | 0 complexity | f61dc3e8fa62d1616a1b00e78b3ec5ce MD5 | raw file
Possible License(s): BSD-3-Clause
 1
 2(define (probabilities weights)
 3  ((-> weights '/n)
 4   (-> weights 'sum)))
 5
 6(define (layers probabilities)
 7
 8  (let ((n (+ (: probabilities 'len) 1)))
 9
10    ((-> (-> ((-> (int-to-vec n) 'map)
11	      (lambda (num)
12		((-> probabilities 'head) num)))
13	     'rest)
14	 'map)
15     (lambda (v) (-> v 'sum)))))
16	
17(define (random-weighted weights)
18  ((-> ((-> (layers (probabilities weights)) 'map)
19	(lambda (elt)
20	  (* 1000 elt)))
21       'index)
22   (let ((n (random-integer 1000)))
23     (lambda (elt)
24       (> elt n)))))
25  
26(define (call-random-weighted tbl)
27
28  (let ((weights ((-> tbl 'map) (lambda (ent) (: ent 'first)))))
29
30    (let ((i (random-weighted weights)))
31
32      (let ((procedure (: ((-> tbl 'ref) i) 'second)))
33
34	(procedure)))))
35
36
37
38