PasteRack.org
Paste # 66996
2022-01-14 19:57:46

Fork as a new paste.

Paste viewed 169 times.


Embed:

  1. #lang racket
  2.  
  3. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  4. ;; require
  5.  
  6. (require math/statistics
  7.          plot/pict
  8.          plot/utils)
  9.  
  10. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  11. ;; violin
  12.  
  13. (define (violin vals
  14.                 #:bandwidth [bandwidth (silverman (second vals))]
  15.                 #:x-min [x-min #f]
  16.                 #:x-max [x-max #f]
  17.                 #:y-min [y-min #f]
  18.                 #:y-max [y-max #f]
  19.                 #:color [color (interval-color)]
  20.                 #:style [style (interval-style)]
  21.                 #:line1-color [line1-color (interval-line1-color)]
  22.                 #:line1-width [line1-width (interval-line1-width)]
  23.                 #:line1-style [line1-style (interval-line1-style)]
  24.                 #:line2-color [line2-color (interval-line2-color)]
  25.                 #:line2-width [line2-width (interval-line2-width)]
  26.                 #:line2-style [line2-style (interval-line2-style)]
  27.                 #:alpha [alpha (interval-alpha)]
  28.                 #:label [label #f])
  29.   (define y-shift (first vals))
  30.   (define-values (f low high)
  31.     (kde (second vals) bandwidth))
  32.   (define x-axis (const 0))
  33.   (define x-min* (or x-min low))
  34.   (define x-max* (or x-max high))
  35.   (define settings
  36.     `([#:y-min . ,y-min]
  37.       [#:y-max . ,y-max]
  38.       [#:color . ,color]
  39.       [#:style . ,style]
  40.       [#:line1-color . ,line1-color]
  41.       [#:line1-width . ,line1-width]
  42.       [#:line1-style . ,line1-style]
  43.       [#:line2-color . ,line2-color]
  44.       [#:line2-width . ,line2-width]
  45.       [#:line2-style . ,line2-style]
  46.       [#:alpha . ,alpha]
  47.       [#:label . ,label]))
  48.   (list (keyword-apply/dict function-interval settings
  49.                             (shift-up (invert f) y-shift)
  50.                             (shift-up f y-shift)
  51.                             x-min* x-max* null)))
  52.  
  53. (define (shift-up f shift)
  54.   (λ (x)
  55.     (+ (f x) shift)))
  56.  
  57. (define ((invert f) x)
  58.   (- (f x)))
  59.  
  60. (define (silverman vals)
  61.   (define iqr (interquartile-range vals))
  62.   (define n (length vals))
  63.   (* 0.9
  64.      (min (stddev vals) (/ iqr 1.34))
  65.      (expt n -0.2)))
  66.  
  67. (define (interquartile-range vals)
  68.   (- (quantile 3/4 < vals)
  69.      (quantile 1/4 < vals)))
  70.  
  71. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  72. ;; example
  73. ;;
  74. ;; `(violin (list y-center x-data))`
  75. ;;
  76.  
  77. (parameterize ([plot-y-ticks no-ticks]
  78.                [plot-y-label #f]
  79.                [plot-x-far-ticks no-ticks]
  80.                [plot-x-label "Time (sec)"])
  81.   (plot (list (violin `[0.00 (0 1 1 2 3 4 4 4 5 6 7 9 10 10 10 11 13)])
  82.               (violin `[0.30 (15 16 17 18 19 20 20 21 23 30)]))))

=>

image