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
|
||||
racket/match
|
||||
racket/function
|
||||
math/statistics
|
||||
math/distributions
|
||||
plot/no-gui
|
||||
(only-in plot/utils known-point-symbols)
|
||||
"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
|
||||
(for/hash ([t all-types] [c colors])
|
||||
(values t c)))
|
||||
(make-parameter (let ([cur-c 0]
|
||||
[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)
|
||||
(make-plot
|
||||
(extract-data/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)
|
||||
(for/list ([d (in-list (filter
|
||||
(make-event-filter 'counterexample)
|
||||
|
|
@ -37,77 +67,131 @@
|
|||
(directory-list dir-path
|
||||
#:build? dir-path)))))
|
||||
|
||||
(define (extract-log-name ld-list)
|
||||
(match (filter (make-event-filter 'finished) ld-list)
|
||||
[(list fin)
|
||||
((datum-selector '#:model) fin)]))
|
||||
(define (extract-log-names ld-list)
|
||||
(remove-duplicates
|
||||
(map ((curry datum-selector) '#:model)
|
||||
(filter (make-event-filter 'finished) ld-list))))
|
||||
|
||||
(define (extract-names/log-directory dir-path)
|
||||
(remove-duplicates
|
||||
(map
|
||||
extract-log-name
|
||||
(append-map
|
||||
extract-log-names
|
||||
(map read-logfile
|
||||
(filter
|
||||
file-exists?
|
||||
(directory-list dir-path
|
||||
#:build? dir-path))))))
|
||||
|
||||
#:build? dir-path))))))
|
||||
(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]
|
||||
[plot-x-tick-label-anchor 'right]
|
||||
[error-bar-width 12]
|
||||
[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
|
||||
#:divisors '(1))
|
||||
(λ (_1 _2 pts) (map tlabel pts)))]
|
||||
[plot-y-ticks (log-ticks #:number 20 #:base 10)])
|
||||
(plot-pict
|
||||
(make-plot-renderers/internal data-stats name-avgs)
|
||||
#:x-min 0
|
||||
#:y-min 0.01
|
||||
#:y-max (* 1.1 (/ (apply max (filter values (map (λ (d) (list-ref d 2)) data))) 1000))
|
||||
#:x-max (+ 0.5 (length all-names)))))
|
||||
|
||||
(define (error-bar times)
|
||||
(define sdev (stddev times #:bias #t))
|
||||
(define this-z (if (> (length times) 30)
|
||||
z
|
||||
(hash-ref t-inv-cdf-97.5 (sub1 (length times)))))
|
||||
(if (confidence-interval)
|
||||
(/ (* z sdev) (sqrt (length times)))
|
||||
(/ (stddev times #:bias #t) (sqrt (length times)))))
|
||||
(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 name-avgs (make-hash))
|
||||
(define (make-plot-renderers/internal data-stats name-avgs)
|
||||
|
||||
(define (rewrite-name n)
|
||||
(regexp-replace #rx"verification-" n "rvm-"))
|
||||
(define types (remove-duplicates
|
||||
(map second data-stats)))
|
||||
|
||||
(for ([b (in-list all-names)])
|
||||
(hash-set! name-avgs (rewrite-name b) '()))
|
||||
(define name-order (make-name-order name-avgs))
|
||||
|
||||
(define data-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)))))
|
||||
(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 '())))])
|
||||
(list (car name/type)
|
||||
(cdr name/type)
|
||||
(mean times)
|
||||
(if (equal? (cdr name/type) 'ordered)
|
||||
0
|
||||
(error-bar times))))])))
|
||||
(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 (name-order (list-ref l 0)) (list-ref l 2)))
|
||||
this-type)
|
||||
#:label (string-append ((type-names) type)
|
||||
(format " (~s successes)" (length this-type)))
|
||||
#:sym ((type-symbols) type)
|
||||
#:size (* (point-size) 1.5)
|
||||
#:color ((type-colors) type)))
|
||||
(if (equal? type 'ordered)
|
||||
ps
|
||||
(list (error-bars
|
||||
(map (λ (d)
|
||||
(list (name-order (list-ref d 0))
|
||||
(list-ref d 2)
|
||||
(list-ref d 3)))
|
||||
this-type)
|
||||
#:y-min 0.01
|
||||
#:color "dark gray")
|
||||
ps)))
|
||||
|
||||
(for/list ([t (in-list types)]
|
||||
[n (in-naturals)])
|
||||
(plot-type t n)))
|
||||
|
||||
|
||||
(define name-order
|
||||
;; this function is mysteriously called a LOT...
|
||||
(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)])
|
||||
(λ (name)
|
||||
(hash-ref memo name
|
||||
|
|
@ -130,161 +214,20 @@
|
|||
(hash-set! memo name ans)
|
||||
ans)))))
|
||||
|
||||
(define (get-name-num name n)
|
||||
(+ (if (offset?)
|
||||
(+ (/ n 12)
|
||||
(- (/ (sub1 (length (types))) 12)))
|
||||
0)
|
||||
(name-order name)))
|
||||
(define (rewrite-name n)
|
||||
(regexp-replace #rx"verification-" n "rvm-"))
|
||||
|
||||
(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 Min-Trials 2)
|
||||
|
||||
(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 (process-data data)
|
||||
(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/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 sdev (stddev times #:bias #t))
|
||||
(define this-z (if (> (length times) 30)
|
||||
z
|
||||
(hash-ref t-inv-cdf-97.5 (sub1 (length times)))))
|
||||
(if (confidence-interval)
|
||||
(/ (* 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))
|
||||
(/ (* this-z sdev) (sqrt (length times))))
|
||||
|
||||
(define z (inv-cdf (normal-dist) 0.975))
|
||||
|
||||
|
||||
(define t-inv-cdf-97.5
|
||||
(hash 1 12.706
|
||||
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