Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 84 lines (71 sloc) 1.72 kb
2fff16e @TurtleKitty Let's Roll.
authored
1 #lang racket
2
3 (define (poly-deg p)
67c2b49 @TurtleKitty Massive performance improvements via mutable state
authored
4 (vector-length p))
2fff16e @TurtleKitty Let's Roll.
authored
5
6 (define (poly-mul p1 p2)
67c2b49 @TurtleKitty Massive performance improvements via mutable state
authored
7 (define deg1 (poly-deg p1))
8 (define deg2 (poly-deg p2))
9 (for*/fold ([noob (make-vector (- (+ deg1 deg2) 1))])
10 ([ i (in-range 1 deg1)]
11 [ j (in-range 1 deg2)])
12 (begin
13 (vector-set!
14 noob (+ i j)
15 (+ (vector-ref noob (+ i j))
16 (* (vector-ref p1 i) (vector-ref p2 j))))
17 noob)))
2fff16e @TurtleKitty Let's Roll.
authored
18
19 (define (mega-mul ps)
20 (foldl poly-mul (car ps) (cdr ps)))
21
22 (define (mkdie d)
67c2b49 @TurtleKitty Massive performance improvements via mutable state
authored
23 (make-vector (+ 1 d) 1))
2fff16e @TurtleKitty Let's Roll.
authored
24
25 (define (mkroll r)
26 (define n (car r))
27 (define d (cdr r))
28 (cons (mkdie d)
29 (cond
30 [(equal? n 1) empty]
31 [else (mkroll (cons (- n 1) d))])))
32
33 (define (push xs x)
34 (append xs (list x)))
35
36 (define (cool-round x y)
37 (define scalar (expt 10 y))
38 (/ (round (* x scalar)) scalar))
39
40 (define (args)
41 (define yarr
42 (vector->list
43 (current-command-line-arguments)))
44 (for/fold
45 ([yash '(() . 0)])
46 ([arg yarr])
47 (cond
48 [(regexp-match #rx"d" arg)
49 (cons
50 (push (car yash)
51 (let ([y (regexp-split #rx"d" arg)])
52 (cons (string->number (car y)) (string->number (cadr y)))))
53 (cdr yash))]
54 [else
55 (cons
56 (car yash)
57 (+ (cdr yash) (string->number arg)))])))
58
59 (define input (args))
60 (define rolls (car input))
61 (define addme (cdr input))
62 (define combinations
63 (foldl
64 (λ (x sum) (+ sum (expt (cdr x) (car x))))
65 0.0
66 rolls))
67
68 (define dist
67c2b49 @TurtleKitty Massive performance improvements via mutable state
authored
69 (vector-map
70 (λ (x) (cool-round (/ x combinations) 5))
71 (mega-mul
72 (for/fold
73 ([ls '()])
74 ([r rolls])
75 (append (mkroll r) ls)))))
2fff16e @TurtleKitty Let's Roll.
authored
76
77 (newline)
67c2b49 @TurtleKitty Massive performance improvements via mutable state
authored
78 (for ([i (in-range 0 (vector-length dist))])
79 (if (> (vector-ref dist i) 0)
80 (displayln (format "~a~a~a" (+ i addme) #\tab (vector-ref dist i)))
81 ""))
2fff16e @TurtleKitty Let's Roll.
authored
82 (newline)
83
Something went wrong with that request. Please try again.