guile-charting/examples/perf-chart/perf-chart.scm

(use-modules (charting) (charting csv) (ice-9 match) (ice-9 pretty-print))

(define (keyed-sorter key less?)
  (lambda (a b) (less? (key a) (key b))))

(define (group-by ls less? truncate zero add)
  (let lp ((ls (sort ls (keyed-sorter truncate less?)))
           (cur #f)
           (sum (zero)))
    (define (finish tail)
      (if cur
          (acons cur sum tail)
          tail))
    (match ls
      (() (finish '()))
      ((x . ls)
       (let ((x_ (truncate x)))
         (if (equal? x_ cur)
             (lp ls cur (add x sum))
             (finish (lp ls x_ (add x (zero))))))))))

(define (median ls)
  (let* ((ordered (list->vector (sort ls <)))
         (len (vector-length ordered)))
    (if (even? len)
        (/ (+ (vector-ref ordered (/ len 2))
              (vector-ref ordered (1- (/ len 2))))
           2)
        (vector-ref ordered (/ (1- len) 2)))))

(define (sort-by-first-non-baseline tests)
  (let ((medians 
         (match tests
           ((baseline
             (non-baseline (test . times) ...)
             . _)
            (map cons test (map median times))))))
    (define (extract-median test)
      (match test
        ((name . times)
         (or (assoc-ref medians name) 0.0))))
    (match tests
      (((baseline . tests) . rest)
       (cons (cons baseline (sort tests (keyed-sorter extract-median <)))
             rest)))))

(match (program-arguments)
  ((_ title output input)
   (let* ((rows (call-with-input-file input csv-port->row-list))
          (by-version
           (group-by rows
                     string<?
                     (match-lambda
                      (#(version test time) version))
                     (lambda () '())
                     (lambda (row data)
                       (match row
                         (#(version test time)
                          (acons test (string->number time) data))))))
          (by-version-and-test
           (map (lambda (test)
                  (match test
                    ((version . data)
                     (cons version
                           (group-by data
                                     string<?
                                     (match-lambda
                                       ((test . time) test))
                                     (lambda () '())
                                     (lambda (data times)
                                       (match data
                                         ((test . time)
                                          (cons time times)))))))))
                by-version))
          (normalized
           (let ((norms (match by-version-and-test
                          (((version . tests) . _)
                           (map (match-lambda
                                 ((test . times)
                                  (cons test (median times))))
                                tests)))))
             (map (lambda (test)
                    (match test
                      ((version . data)
                       (cons version
                             (map (match-lambda
                                   ((test . times)
                                    (let ((norm (or (assoc-ref norms test) 1.0)))
                                      (cons test
                                            (map (lambda (time) (/ time norm))
                                                 times)))))
                                  data)))))
                  by-version-and-test)))
          (sorted (sort-by-first-non-baseline normalized)))
     (make-performance-chart
      title
      sorted
      #:log-y-base 2
      #:y-axis-label
      (match sorted
        (((version . _) . _)
         (format #f "run time normalized to ~a; shorter is better" version)))
      #:baseline 1.0
      #:box-width 5
      #:box-spacing 0
      #:test-spacing 10
      #:vertical-xtick-labels? #t
      #:vertical-box-labels? #t
      #:box-label-height 8.5
      #:box-value-formatter
      (lambda (value)
        (let ((str (format #f "~,3f" value)))
          (if (equal? str "1.000")
              ""
              str)))
      #:write-to-png output))))