I have some plot code for dice statistics (unfinished). It seems from some observations that using unicode characters in the y-axis ticks makes the plot nearly unresponsive. Conversely, using ASCII-only characters has no issue.

If anyone can shed some light on why or how to improve things I would greatly appreciate it.

Here's some sample code. Change the characters in `face->string`

to ASCII characters (*e.g.*, `*`

, `s`

, `o`

, `b`

, `d`

) to see a more performant version.

dice.rkt

```
#lang racket
(require syntax/parse/define
(for-syntax syntax/parse)
racket/hash
"distributions.rkt")
(begin-for-syntax
(define-syntax-class pip
[pattern n:number
#:with v #'n
#:with key #''accuracy]
[pattern {~datum ☼}
#:with v #'1
#:with key #''damage]
[pattern {~datum ↯}
#:with v #'1
#:with key #''surge]
[pattern {~datum ∅}
#:with v #'1
#:with key #''evade]
[pattern {~datum ▲}
#:with v #'1
#:with key #''block]
[pattern {~datum ※}
#:with v #'1
#:with key #''dodge]))
;; face: hash[attr -> count]
(define-syntax-parse-rule (face p:pip ...)
(for/fold ([f (hash)])
([k (list p.key ...)]
[v (list p.v ...)])
(hash-update f k (curry + v) 0)))
;; die: cons[label, list[face]]
(define-syntax-parse-rule (die label:string [pip:expr ...] ...)
(cons label (list (face pip ...) ...)))
(define (combine-faces f0 . fs)
(apply hash-union #:combine + f0 fs))
(define (face->string f)
(define (r k) (hash-ref f k 0))
(define repeat make-string)
(~a (r 'accuracy)
(repeat (r 'damage) #\☼)
(repeat (r 'surge) #\↯)
(repeat (r 'evade) #\∅)
(repeat (r 'block) #\▲)
(repeat (r 'dodge) #\※)))
(define red (die "red" [☼] [☼ ☼] [☼ ☼] [☼ ☼ ↯] [☼ ☼ ☼] [☼ ☼ ☼]))
(define blue (die "blue" [↯ 2] [☼ 2] [☼ ☼ 3] [☼ ↯ 3] [☼ ☼ 4] [☼ 5]))
(define green (die "green" [↯ 1] [☼ ↯ 1] [☼ ☼ 1] [☼ ↯ 2] [☼ ☼ 2] [☼ ☼ 3]))
(define yellow (die "yellow" [↯] [↯ ↯ ☼] [☼ ☼ 1] [☼ ↯ 1] [↯ 2] [☼ 2]))
;;
(define black (die "black" [▲] [▲] [▲ ▲] [▲ ▲] [▲ ▲ ▲] [∅]))
(define white (die "white" [] [▲] [∅] [▲ ∅] [▲ ∅] [※]))
;; red blue green yellow black white (exit)
;; TODO: make bag just the "c" value below (counter), and make `bag-xs` produce the equivalent of the xs value
;; bag like an unordered list
;; two bags equal if they have the same number of equivalent objects
(struct bag [xs c]
#:methods gen:equal+hash
[(define (equal-proc b1 b2 rec)
(rec (bag-c b1) (bag-c b2)))
(define (hash-proc b rec)
(rec (bag-c b)))
(define (hash2-proc b rec)
(hash-proc b rec))])
(define (make-bag xs)
(bag xs (counter xs)))
(define (merge-bag b1 b2)
(bag (append (bag-xs b1) (bag-xs b2))
(hash-union #:combine + (bag-c b1) (bag-c b2))))
(define (counter xs)
(for/fold ([c (hash)])
([x xs])
(hash-update c x add1 0)))
(module+ test
(require rackunit)
(check-equal? (make-bag (list 1 2 3 1)) (make-bag (list 3 1 1 2))))
;; roll: Dicrete-Dist[result]
;; result: hash[label -> bag[rerolled?[face]]]
;; rerolled?[X]: (cons boolean X)
;; total: face
;; outcome: Any (mapped out of face, typically by spending surges/evades/blocks/etc.?)
;; roll -> Discrete-Dist[face]
(define (total-roll r)
(dist-flatmap
r
(λ (r)
(list (apply combine-faces (map cdr (append-map bag-xs (hash-values r))))))))
(define (roll d0 . ds)
(foldl then-roll (roll1 d0) ds))
(define (then-roll d dist)
(define outcomes (discrete-dist-values (roll1 d)))
(dist-flatmap dist (λ (x) (map (curry merge-outcome x) outcomes))))
(define (merge-outcome x y)
(hash-union x y #:combine merge-bag))
(define (roll1 d)
(match-define (cons label faces) d)
(discrete-dist
(map (λ (face) (hash label (make-bag (list (cons #f face))))) faces)))
;; roll -> roll
(define (focus r)
(then-roll green r))
;;;
(require plot)
(define (p d xs . rs)
(parameterize ([plot-new-window? #t])
(plot (cons (discrete-histogram
(map vector xs (discrete-dist-probs d))
#:x-min 0 #:label "P[x]" #:invert? #t)
rs))))
(define the-roll (time (focus (roll blue green))))
(let* ([xs (discrete-dist-values the-roll)]
[labels
(for/list ([r xs])
(string-join
(for/list ([(label b) r])
(format "[~a: ~a]"
label
(string-join
(map (match-lambda
[(cons rerolled? f)
(format "~a~a"
(face->string f)
(if rerolled? "!" ""))])
(bag-xs b)))))))])
(p the-roll labels))
(define the-total-roll (time (total-roll the-roll)))
;; (define f (face 5 ☼ ☼ ☼ ↯))
(define f (face 7 ☼ ☼ ☼ ☼ ☼ ↯))
(define pd (pdf the-total-roll f))
(let ([xs (discrete-dist-values the-total-roll)])
(p the-total-roll (map face->string xs)
(point-label (vector pd (add1 (index-of xs f)))
(~a (/ (round (* 10000 pd)) 100) "%")
#:anchor 'right)))
```

distributions.rkt

```
#lang typed/racket
(provide (all-from-out math/distributions
math/statistics)
dist-flatmap)
(require math/distributions
math/statistics)
(define #:forall (A B)
(dist-flatmap [d : (Discrete-Dist A)]
[f : (A → (Listof B))]) : (Discrete-Dist B)
(define values (discrete-dist-values d))
(define ps (discrete-dist-probs d))
(define p-result
(hash->list
(for/fold ([r : (HashTable B Real) (hash)])
([v values]
[p ps])
(define new-vs (f v))
(define p* (/ p (length new-vs)))
(for/fold ([r r])
([v* new-vs])
(hash-update r v* (λ ([x : Real]) (+ p* x)) (thunk 0))))))
(discrete-dist (map (inst car B Real) p-result)
(map (inst cdr B Real) p-result)))
(module* example racket
(provide (all-defined-out))
(require (submod ".."))
(define d
(let ([d (discrete-dist '(a b c) '(2 5 3))])
(dist-flatmap d (match-lambda
['a (list 'a)]
['b (list 'a 'b)]
['c (list 'c 'd)])))))
(module* test racket
(require (submod ".." example)
math/distributions
rackunit)
(check-equal? (list->set (discrete-dist-values d)) (set 'a 'b 'c 'd))
(for ([x (discrete-dist-values d)])
(check-equal? (pdf d x)
(match x
['a 0.45]
['b 0.25]
['c 0.15]
['d 0.15]))))
(module* main racket
(require (submod "..")
(submod ".." example)
plot)
(plot-new-window? #t)
(define n 10000)
(define h (samples->hash (sample d n)))
(define xs (discrete-dist-values d))
(plot (list (discrete-histogram
(map vector xs (map (distribution-pdf d) xs))
#:x-min 0 #:skip 2 #:label "P[x]")
(discrete-histogram
(map vector xs (map (λ (x) (/ (hash-ref h x) n)) xs))
#:x-min 1 #:skip 2 #:line-style 'dot #:alpha 0.5 #:label "est. P[x]"))))
```