redex: refactor benchmark plotting
- add sane interface for points plot - add the line plot
This commit is contained in:
Burke Fetscher
parent
6a1ace3522
commit
f347af3c98
|
|
@ -2,24 +2,54 @@
|
||||||
|
|
||||||
(require racket/list
|
(require racket/list
|
||||||
racket/match
|
racket/match
|
||||||
|
racket/function
|
||||||
math/statistics
|
math/statistics
|
||||||
math/distributions
|
math/distributions
|
||||||
plot/no-gui
|
plot/no-gui
|
||||||
|
(only-in plot/utils known-point-symbols)
|
||||||
"logging.rkt")
|
"logging.rkt")
|
||||||
|
|
||||||
(provide type-colors)
|
(provide type-colors
|
||||||
|
type-names
|
||||||
|
type-symbols
|
||||||
|
extract-data/log-directory
|
||||||
|
extract-log-data
|
||||||
|
plot/log-directory
|
||||||
|
extract-log-names
|
||||||
|
extract-names/log-directory
|
||||||
|
process-data)
|
||||||
|
|
||||||
(define all-types '(grammar search enum ordered))
|
|
||||||
(define colors '(1 2 3 4))
|
|
||||||
(define type-colors
|
(define type-colors
|
||||||
(for/hash ([t all-types] [c colors])
|
(make-parameter (let ([cur-c 0]
|
||||||
(values t c)))
|
[cur-tcs (make-hash)])
|
||||||
|
(λ (type)
|
||||||
|
(hash-ref! cur-tcs type
|
||||||
|
(begin0
|
||||||
|
cur-c
|
||||||
|
(set! cur-c (add1 cur-c))))))))
|
||||||
|
|
||||||
|
(define type-symbols
|
||||||
|
(make-parameter (let ([syms (drop known-point-symbols 3)]
|
||||||
|
[cur-tss (make-hash)])
|
||||||
|
(λ (type)
|
||||||
|
(hash-ref! cur-tss type
|
||||||
|
(if (empty? syms)
|
||||||
|
(error 'type-symbols "no more symbols available!")
|
||||||
|
(begin0 (car syms)
|
||||||
|
(set! syms (cdr syms)))))))))
|
||||||
|
|
||||||
|
(define type-names (make-parameter symbol->string))
|
||||||
|
|
||||||
(define (plot/log-directory path)
|
(define (plot/log-directory path)
|
||||||
(make-plot
|
(make-plot
|
||||||
(extract-data/log-directory path)
|
(extract-data/log-directory path)
|
||||||
(extract-names/log-directory path)))
|
(extract-names/log-directory path)))
|
||||||
|
|
||||||
|
(define (plot/log-data data)
|
||||||
|
(make-plot
|
||||||
|
(extract-log-data data)
|
||||||
|
(extract-log-names data)))
|
||||||
|
|
||||||
(define (extract-log-data ld-list)
|
(define (extract-log-data ld-list)
|
||||||
(for/list ([d (in-list (filter
|
(for/list ([d (in-list (filter
|
||||||
(make-event-filter 'counterexample)
|
(make-event-filter 'counterexample)
|
||||||
|
|
@ -37,77 +67,131 @@
|
||||||
(directory-list dir-path
|
(directory-list dir-path
|
||||||
#:build? dir-path)))))
|
#:build? dir-path)))))
|
||||||
|
|
||||||
(define (extract-log-name ld-list)
|
(define (extract-log-names ld-list)
|
||||||
(match (filter (make-event-filter 'finished) ld-list)
|
(remove-duplicates
|
||||||
[(list fin)
|
(map ((curry datum-selector) '#:model)
|
||||||
((datum-selector '#:model) fin)]))
|
(filter (make-event-filter 'finished) ld-list))))
|
||||||
|
|
||||||
(define (extract-names/log-directory dir-path)
|
(define (extract-names/log-directory dir-path)
|
||||||
(remove-duplicates
|
(remove-duplicates
|
||||||
(map
|
(append-map
|
||||||
extract-log-name
|
extract-log-names
|
||||||
(map read-logfile
|
(map read-logfile
|
||||||
(filter
|
(filter
|
||||||
file-exists?
|
file-exists?
|
||||||
(directory-list dir-path
|
(directory-list dir-path
|
||||||
#:build? dir-path))))))
|
#:build? dir-path))))))
|
||||||
|
|
||||||
(define (make-plot data all-names)
|
(define (make-plot data all-names)
|
||||||
|
(define-values (data-stats name-avgs)
|
||||||
|
(process-data data all-names))
|
||||||
|
(define name-order (make-name-order name-avgs))
|
||||||
|
(define (tlabel pre-tick)
|
||||||
|
(define v (pre-tick-value pre-tick))
|
||||||
|
(define label-list
|
||||||
|
(filter
|
||||||
|
(λ (n) (= (name-order n) v))
|
||||||
|
(hash-keys name-avgs)))
|
||||||
|
(if (empty? label-list)
|
||||||
|
""
|
||||||
|
(car label-list)))
|
||||||
(parameterize ([plot-x-tick-label-angle 75]
|
(parameterize ([plot-x-tick-label-angle 75]
|
||||||
[plot-x-tick-label-anchor 'right]
|
[plot-x-tick-label-anchor 'right]
|
||||||
[error-bar-width 12]
|
[error-bar-width 12]
|
||||||
[plot-y-transform (axis-transform-bound log-transform 0.00001 +inf.0)]
|
[plot-y-transform (axis-transform-bound log-transform 0.00001 +inf.0)]
|
||||||
[plot-legend-anchor 'bottom-right])
|
[plot-legend-anchor 'bottom-right]
|
||||||
|
[plot-x-ticks (ticks (linear-ticks-layout #:number 30 #:base 10
|
||||||
(define (error-bar times)
|
#:divisors '(1))
|
||||||
(define sdev (stddev times #:bias #t))
|
(λ (_1 _2 pts) (map tlabel pts)))]
|
||||||
(define this-z (if (> (length times) 30)
|
[plot-y-ticks (log-ticks #:number 20 #:base 10)])
|
||||||
z
|
(plot-pict
|
||||||
(hash-ref t-inv-cdf-97.5 (sub1 (length times)))))
|
(make-plot-renderers/internal data-stats name-avgs)
|
||||||
(if (confidence-interval)
|
#:x-min 0
|
||||||
(/ (* z sdev) (sqrt (length times)))
|
#:y-min 0.01
|
||||||
(/ (stddev times #:bias #t) (sqrt (length times)))))
|
#:y-max (* 1.1 (/ (apply max (filter values (map (λ (d) (list-ref d 2)) data))) 1000))
|
||||||
|
#:x-max (+ 0.5 (length all-names)))))
|
||||||
(define name-avgs (make-hash))
|
|
||||||
|
(define (make-plot-renderers data all-names)
|
||||||
|
(define-values (data-stats name-avgs)
|
||||||
|
(process-data data all-names))
|
||||||
|
(make-plot-renderers/internal data-stats name-avgs))
|
||||||
|
|
||||||
|
(define (make-plot-renderers/internal data-stats name-avgs)
|
||||||
|
|
||||||
(define (rewrite-name n)
|
(define types (remove-duplicates
|
||||||
(regexp-replace #rx"verification-" n "rvm-"))
|
(map second data-stats)))
|
||||||
|
|
||||||
(for ([b (in-list all-names)])
|
(define name-order (make-name-order name-avgs))
|
||||||
(hash-set! name-avgs (rewrite-name b) '()))
|
|
||||||
|
(define (plot-type type n)
|
||||||
(define data-stats
|
(define this-type
|
||||||
(let loop ([d data]
|
(map (λ (d)
|
||||||
[sorted-times (hash)])
|
(define name (rewrite-name (last (regexp-split #rx"/" (car d)))))
|
||||||
(match d
|
(cons name (cdr d)))
|
||||||
[(cons (list name type time) rest)
|
(filter
|
||||||
(loop rest
|
(λ (l)
|
||||||
(hash-set sorted-times (cons name type)
|
(and (equal? type (list-ref l 1))
|
||||||
(cons (/ time 1000)
|
(list-ref l 2)))
|
||||||
(hash-ref sorted-times (cons name type)
|
data-stats)))
|
||||||
(λ () '())))))]
|
(define ps
|
||||||
['()
|
(points
|
||||||
(for/list ([(name/type times) (in-hash sorted-times)]
|
(map
|
||||||
#:unless (and ((length times) . < . (min-trials))
|
(λ (l)
|
||||||
(not (equal? (cdr name/type) 'ordered))))
|
(list (name-order (list-ref l 0)) (list-ref l 2)))
|
||||||
(define name (rewrite-name (last (regexp-split #rx"/" (car name/type)))))
|
this-type)
|
||||||
(cond
|
#:label (string-append ((type-names) type)
|
||||||
[(equal? (cdr name/type) (order-by))
|
(format " (~s successes)" (length this-type)))
|
||||||
(hash-set! name-avgs name (mean times))]
|
#:sym ((type-symbols) type)
|
||||||
[(list? (hash-ref name-avgs name '()))
|
#:size (* (point-size) 1.5)
|
||||||
(hash-set! name-avgs
|
#:color ((type-colors) type)))
|
||||||
name
|
(if (equal? type 'ordered)
|
||||||
(cons (mean times) (hash-ref name-avgs name '())))])
|
ps
|
||||||
(list (car name/type)
|
(list (error-bars
|
||||||
(cdr name/type)
|
(map (λ (d)
|
||||||
(mean times)
|
(list (name-order (list-ref d 0))
|
||||||
(if (equal? (cdr name/type) 'ordered)
|
(list-ref d 2)
|
||||||
0
|
(list-ref d 3)))
|
||||||
(error-bar times))))])))
|
this-type)
|
||||||
|
#:y-min 0.01
|
||||||
|
#:color "dark gray")
|
||||||
(define name-order
|
ps)))
|
||||||
;; this function is mysteriously called a LOT...
|
|
||||||
|
(for/list ([t (in-list types)]
|
||||||
|
[n (in-naturals)])
|
||||||
|
(plot-type t n)))
|
||||||
|
|
||||||
|
|
||||||
|
(define (process-data data all-names)
|
||||||
|
(define name-avgs (make-hash))
|
||||||
|
(for ([b (in-list all-names)])
|
||||||
|
(hash-set! name-avgs (rewrite-name b) '()))
|
||||||
|
(define d-stats
|
||||||
|
(let loop ([d data]
|
||||||
|
[sorted-times (hash)])
|
||||||
|
(match d
|
||||||
|
[(cons (list name type time) rest)
|
||||||
|
(loop rest
|
||||||
|
(hash-set sorted-times (cons name type)
|
||||||
|
(cons (/ time 1000)
|
||||||
|
(hash-ref sorted-times (cons name type)
|
||||||
|
(λ () '())))))]
|
||||||
|
['()
|
||||||
|
(for/list ([(name/type times) (in-hash sorted-times)]
|
||||||
|
#:unless (and ((length times) . < . Min-Trials)
|
||||||
|
(not (equal? (cdr name/type) 'ordered))))
|
||||||
|
(define name (rewrite-name (last (regexp-split #rx"/" (car name/type)))))
|
||||||
|
(hash-set! name-avgs
|
||||||
|
name
|
||||||
|
(cons (mean times) (hash-ref name-avgs name '())))
|
||||||
|
(list (car name/type)
|
||||||
|
(cdr name/type)
|
||||||
|
(mean times)
|
||||||
|
(if (equal? (cdr name/type) 'ordered)
|
||||||
|
0
|
||||||
|
(error-bar times))))])))
|
||||||
|
(values d-stats
|
||||||
|
name-avgs))
|
||||||
|
|
||||||
|
(define (make-name-order name-avgs)
|
||||||
(let ([memo (make-hash)])
|
(let ([memo (make-hash)])
|
||||||
(λ (name)
|
(λ (name)
|
||||||
(hash-ref memo name
|
(hash-ref memo name
|
||||||
|
|
@ -129,162 +213,21 @@
|
||||||
'())))
|
'())))
|
||||||
(hash-set! memo name ans)
|
(hash-set! memo name ans)
|
||||||
ans)))))
|
ans)))))
|
||||||
|
|
||||||
(define (get-name-num name n)
|
|
||||||
(+ (if (offset?)
|
|
||||||
(+ (/ n 12)
|
|
||||||
(- (/ (sub1 (length (types))) 12)))
|
|
||||||
0)
|
|
||||||
(name-order name)))
|
|
||||||
|
|
||||||
(define (plot-type type n)
|
|
||||||
(define this-type
|
|
||||||
(map (λ (d)
|
|
||||||
(define name (rewrite-name (last (regexp-split #rx"/" (car d)))))
|
|
||||||
(cons name (cdr d)))
|
|
||||||
(filter
|
|
||||||
(λ (l)
|
|
||||||
(and (equal? type (list-ref l 1))
|
|
||||||
(list-ref l 2)))
|
|
||||||
data-stats)))
|
|
||||||
(define ps
|
|
||||||
(points
|
|
||||||
(map
|
|
||||||
(λ (l)
|
|
||||||
(list (get-name-num (list-ref l 0) n) (list-ref l 2)))
|
|
||||||
this-type)
|
|
||||||
#:label (string-append (hash-ref type-names type)
|
|
||||||
(format " (~s successes)" (length this-type)))
|
|
||||||
#:sym (hash-ref type-symbols type)
|
|
||||||
#:size (* (point-size) 1.5)
|
|
||||||
#:color (hash-ref type-colors type)))
|
|
||||||
(if (equal? type 'ordered)
|
|
||||||
ps
|
|
||||||
(list (error-bars
|
|
||||||
(map (λ (d)
|
|
||||||
(list (get-name-num (list-ref d 0) n)
|
|
||||||
(list-ref d 2)
|
|
||||||
(list-ref d 3)))
|
|
||||||
this-type)
|
|
||||||
#:y-min 0.01
|
|
||||||
#:color "dark gray")
|
|
||||||
ps)))
|
|
||||||
|
|
||||||
(define (zero->neg n)
|
|
||||||
(if (zero? n)
|
|
||||||
(- 500)
|
|
||||||
n))
|
|
||||||
|
|
||||||
(define (tlabel pre-tick)
|
|
||||||
(define v (pre-tick-value pre-tick))
|
|
||||||
(define label-list
|
|
||||||
(filter
|
|
||||||
(λ (n) (= (name-order n) v))
|
|
||||||
(hash-keys name-avgs)))
|
|
||||||
(if (empty? label-list)
|
|
||||||
""
|
|
||||||
(car label-list)))
|
|
||||||
|
|
||||||
(parameterize ([plot-x-ticks
|
|
||||||
(ticks (linear-ticks-layout #:number 30 #:base 10
|
|
||||||
#:divisors '(1))
|
|
||||||
(λ (_1 _2 pts) (map tlabel pts)))]
|
|
||||||
[plot-y-ticks
|
|
||||||
(log-ticks #:number 20 #:base 10)]
|
|
||||||
[plot-y-label "Average Number of Seconds to Find Each Bug"]
|
|
||||||
[plot-x-label ""])
|
|
||||||
|
|
||||||
(if (output-file)
|
|
||||||
(plot-file
|
|
||||||
(for/list ([t (if (empty? (types)) all-types (types))]
|
|
||||||
[n (in-naturals)])
|
|
||||||
(plot-type t n))
|
|
||||||
(output-file)
|
|
||||||
'pdf
|
|
||||||
#:x-min 0
|
|
||||||
#:y-min (min-y)
|
|
||||||
#:y-max (if (max-t)
|
|
||||||
(* 60 (max-t))
|
|
||||||
(+ 5 (/ (apply max (filter values (map (λ (d) (list-ref d 2)) data))) 1000)))
|
|
||||||
#:x-max (+ 0.5 (length (hash-keys name-avgs))))
|
|
||||||
(plot-pict
|
|
||||||
(for/list ([t (if (empty? (types)) all-types (types))]
|
|
||||||
[n (in-naturals)])
|
|
||||||
(plot-type t n))
|
|
||||||
#:x-min 0
|
|
||||||
#:y-min (min-y)
|
|
||||||
#:y-max (if (max-t)
|
|
||||||
(* 60 (max-t))
|
|
||||||
(+ 5 (/ (apply max (filter values (map (λ (d) (list-ref d 2)) data))) 1000)))
|
|
||||||
#:x-max (+ 0.5 (length (hash-keys name-avgs))))))))
|
|
||||||
|
|
||||||
#;
|
(define (rewrite-name n)
|
||||||
(define (process-data data)
|
(regexp-replace #rx"verification-" n "rvm-"))
|
||||||
(let loop ([d data]
|
|
||||||
[sorted-times (hash)])
|
(define Min-Trials 2)
|
||||||
(match d
|
|
||||||
[(cons (list name type time) rest)
|
|
||||||
(loop rest
|
|
||||||
(hash-set sorted-times (cons name type)
|
|
||||||
(cons (/ time 1000)
|
|
||||||
(hash-ref sorted-times (cons name type)
|
|
||||||
(λ () '())))))]
|
|
||||||
['()
|
|
||||||
(for/fold ([dstats '()] [name-avgs (for/hash ([b (in-list all-names)])
|
|
||||||
(values b '()))])
|
|
||||||
([(name/type times) (in-hash sorted-times)]
|
|
||||||
#:unless (and ((length times) . < . (min-trials))
|
|
||||||
(not (equal? (cdr name/type) 'ordered))))
|
|
||||||
(define name (last (regexp-split #rx"/" (car name/type))))
|
|
||||||
(values
|
|
||||||
(cons (list (car name/type)
|
|
||||||
(cdr name/type)
|
|
||||||
(mean times)
|
|
||||||
(if (equal? (cdr name/type) 'ordered)
|
|
||||||
0
|
|
||||||
(error-bar times))) dstats)
|
|
||||||
(cond
|
|
||||||
[(equal? (cdr name/type) (order-by))
|
|
||||||
(hash-set name-avgs name (mean times))]
|
|
||||||
[(list? (hash-ref name-avgs name '()))
|
|
||||||
(hash-set name-avgs
|
|
||||||
name
|
|
||||||
(cons (mean times) (hash-ref name-avgs name '())))]
|
|
||||||
[else name-avgs])))])))
|
|
||||||
|
|
||||||
(define min-trials (make-parameter 2))
|
|
||||||
(define (error-bar times)
|
(define (error-bar times)
|
||||||
(define sdev (stddev times #:bias #t))
|
(define sdev (stddev times #:bias #t))
|
||||||
(define this-z (if (> (length times) 30)
|
(define this-z (if (> (length times) 30)
|
||||||
z
|
z
|
||||||
(hash-ref t-inv-cdf-97.5 (sub1 (length times)))))
|
(hash-ref t-inv-cdf-97.5 (sub1 (length times)))))
|
||||||
(if (confidence-interval)
|
(/ (* this-z sdev) (sqrt (length times))))
|
||||||
(/ (* this-z sdev) (sqrt (length times)))
|
|
||||||
(/ (stddev times #:bias #t) (sqrt (length times)))))
|
|
||||||
|
|
||||||
|
|
||||||
(define types (make-parameter '()))
|
|
||||||
(define names '("adhoc random" "search" "uniform random"
|
|
||||||
"in-order enumeration"))
|
|
||||||
(define symbols '(circle triangle diamond plus))
|
|
||||||
(define type-names
|
|
||||||
(for/hash ([t all-types] [n names])
|
|
||||||
(values t n)))
|
|
||||||
(define type-symbols
|
|
||||||
(for/hash ([t all-types] [s symbols])
|
|
||||||
(values t s)))
|
|
||||||
|
|
||||||
(define confidence-interval (make-parameter #f))
|
|
||||||
(define order-by (make-parameter #f))
|
|
||||||
(define max-t (make-parameter #f))
|
|
||||||
(define offset? (make-parameter #f))
|
|
||||||
(define min-y (make-parameter 0.01))
|
|
||||||
|
|
||||||
(define output-file (make-parameter #f))
|
|
||||||
|
|
||||||
(define z (inv-cdf (normal-dist) 0.975))
|
(define z (inv-cdf (normal-dist) 0.975))
|
||||||
|
|
||||||
|
|
||||||
(define t-inv-cdf-97.5
|
(define t-inv-cdf-97.5
|
||||||
(hash 1 12.706
|
(hash 1 12.706
|
||||||
2 4.303
|
2 4.303
|
||||||
|
|
|
||||||
|
|
@ -0,0 +1,136 @@
|
||||||
|
#lang racket/base
|
||||||
|
|
||||||
|
(require racket/list
|
||||||
|
plot/no-gui
|
||||||
|
"graph-data.rkt")
|
||||||
|
|
||||||
|
(provide line-plot
|
||||||
|
line-plot-renderer/log-directory
|
||||||
|
line-plot-renderer)
|
||||||
|
|
||||||
|
(define (line-plot dir [output #f])
|
||||||
|
(parameterize ([plot-x-transform log-transform]
|
||||||
|
[plot-x-label "Time in Seconds"]
|
||||||
|
[plot-y-label "Number of Bugs Found"]
|
||||||
|
[plot-width 600]
|
||||||
|
[plot-height 300]
|
||||||
|
[plot-x-ticks (log-ticks #:number 20 #:base 10)])
|
||||||
|
(if output
|
||||||
|
(plot-file (line-plot-renderer/log-directory dir)
|
||||||
|
output
|
||||||
|
#:x-min 0.05)
|
||||||
|
(plot-pict (line-plot-renderer/log-directory dir)
|
||||||
|
#:x-min 0.05))))
|
||||||
|
|
||||||
|
(define (line-plot-renderer/log-directory dir)
|
||||||
|
(define-values (data _)
|
||||||
|
(process-data (extract-data/log-directory dir)
|
||||||
|
(extract-names/log-directory dir)))
|
||||||
|
(make-renderers data))
|
||||||
|
|
||||||
|
(define (line-plot-renderer log-data)
|
||||||
|
(define-values (data _)
|
||||||
|
(process-data (extract-log-data log-data)
|
||||||
|
(extract-log-names log-data)))
|
||||||
|
(make-renderers data))
|
||||||
|
|
||||||
|
(define line-styles
|
||||||
|
(list 'solid 'dot 'long-dash
|
||||||
|
'short-dash 'dot-dash))
|
||||||
|
|
||||||
|
(define (make-renderers stats)
|
||||||
|
(define max-t (apply max (map third stats)))
|
||||||
|
|
||||||
|
;; (listof (list/c type data))
|
||||||
|
(define types+datas
|
||||||
|
(for/list ([(type avgs) (in-hash (sort-stats stats))]
|
||||||
|
[n (in-naturals)])
|
||||||
|
(define pts
|
||||||
|
(for/fold ([l '()])
|
||||||
|
([a (sort avgs <)]
|
||||||
|
[c (in-naturals)])
|
||||||
|
(cons (list a (add1 c))
|
||||||
|
(cons
|
||||||
|
(list a c)
|
||||||
|
l))))
|
||||||
|
(list type (reverse (cons (list max-t (/ (length pts) 2)) pts)))))
|
||||||
|
|
||||||
|
(unless (= 3 (length types+datas))
|
||||||
|
(error 'plot-lines.rkt "ack: assuming that there are only three competitors"))
|
||||||
|
(define-values (_ crossover-points)
|
||||||
|
(for/fold ([last-winner #f]
|
||||||
|
[crossover-points '()])
|
||||||
|
([grammar-pr (in-list (list-ref (assoc 'grammar types+datas) 1))]
|
||||||
|
[enum-pr (in-list (list-ref (assoc 'enum types+datas) 1))]
|
||||||
|
[ordered-pr (in-list (list-ref (assoc 'ordered types+datas) 1))])
|
||||||
|
(unless (and (= (list-ref grammar-pr 1)
|
||||||
|
(list-ref enum-pr 1))
|
||||||
|
(= (list-ref grammar-pr 1)
|
||||||
|
(list-ref ordered-pr 1)))
|
||||||
|
(error 'plot-lines.rkt "ack: expected points to match up ~s ~s ~s"
|
||||||
|
grammar-pr
|
||||||
|
enum-pr
|
||||||
|
ordered-pr))
|
||||||
|
(define y-position (list-ref grammar-pr 1))
|
||||||
|
(define grammar-time (list-ref grammar-pr 0))
|
||||||
|
(define enum-time (list-ref enum-pr 0))
|
||||||
|
(define ordered-time (list-ref ordered-pr 0))
|
||||||
|
(define best (min grammar-time enum-time ordered-time))
|
||||||
|
(define current-winner
|
||||||
|
(cond
|
||||||
|
[(= grammar-time best) 'grammar]
|
||||||
|
[(= ordered-time best) 'ordered]
|
||||||
|
[(= enum-time best) 'enum]))
|
||||||
|
(values current-winner
|
||||||
|
(cond
|
||||||
|
[(and last-winner (not (equal? last-winner current-winner)))
|
||||||
|
(cons (point-label (vector best y-position)
|
||||||
|
(format "~a, ~a"
|
||||||
|
(number+unit/s y-position "bug")
|
||||||
|
(format-time best))
|
||||||
|
#:anchor 'bottom-right)
|
||||||
|
crossover-points)]
|
||||||
|
[else
|
||||||
|
crossover-points]))))
|
||||||
|
(append
|
||||||
|
crossover-points
|
||||||
|
(for/list ([type+pts (in-list types+datas)]
|
||||||
|
[n (in-naturals)])
|
||||||
|
(define type (list-ref type+pts 0))
|
||||||
|
(define pts (list-ref type+pts 1))
|
||||||
|
(lines
|
||||||
|
(reverse pts)
|
||||||
|
;#:width 2
|
||||||
|
#:color ((type-colors) type)
|
||||||
|
#:style (list-ref line-styles n)
|
||||||
|
#:label ((type-names) type)))))
|
||||||
|
|
||||||
|
(define (format-time number)
|
||||||
|
(cond
|
||||||
|
[(<= number 60) (number+unit/s number "second")]
|
||||||
|
[(<= number (* 60 60)) (number+unit/s (/ number 60) "minute")]
|
||||||
|
[(<= number (* 60 60 24)) (number+unit/s (/ number 60 60) "hour")]
|
||||||
|
[else (number+unit/s (/ number 60 60 24) "day")]))
|
||||||
|
|
||||||
|
(define (number+unit/s raw-n unit)
|
||||||
|
(define n (round raw-n))
|
||||||
|
(format "~a ~a~a" n unit (if (= n 1) "" "s")))
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(require rackunit)
|
||||||
|
(check-equal? (format-time 0) "0 seconds")
|
||||||
|
(check-equal? (format-time 1) "1 second")
|
||||||
|
(check-equal? (format-time 59) "59 seconds")
|
||||||
|
(check-equal? (format-time 70) "1 minute")
|
||||||
|
(check-equal? (format-time 110) "2 minutes")
|
||||||
|
(check-equal? (format-time (* 60 60 2)) "2 hours")
|
||||||
|
(check-equal? (format-time (* 60 60 #e2.2)) "2 hours")
|
||||||
|
(check-equal? (format-time (* 60 60 #e8.2)) "8 hours")
|
||||||
|
(check-equal? (format-time (* 60 60 24 3)) "3 days"))
|
||||||
|
|
||||||
|
(define (sort-stats stats)
|
||||||
|
(for/fold ([h (hash)])
|
||||||
|
([s (in-list stats)])
|
||||||
|
(hash-set h (second s)
|
||||||
|
(cons (third s)
|
||||||
|
(hash-ref h (second s) '())))))
|
||||||
Loading…
Reference in New Issue
Block a user