guile-charting/charting.scm

;; guile-charting
;; Copyright (C) 2007, 2012, 2014, 2019 Andy Wingo <wingo at pobox dot com>

;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
;; License as published by the Free Software Foundation; either
;; version 3 of the License, or (at your option) any later version.
;;
;; This library is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; Lesser General Public License for more details.
;;
;; You should have received a copy of the GNU Lesser General Public
;; License along with this library; if not, see
;; <http://www.gnu.org/licenses/>.

;;; Commentary:
;;
;;
;;; Code:

(define-module (charting)
  #:use-module (cairo)
  #:use-module (charting util)
  #:use-module (charting draw)
  #:use-module (ice-9 format)
  #:use-module (ice-9 match)
  #:use-module ((srfi srfi-1) #:select (lset-adjoin))
  #:export (make-bar-chart
            make-chart
            make-performance-chart
            make-bar-chart/histograms
            make-performance-series
            make-scatter-plot
            make-page-map))

(define-syntax-rule (with-move-to cr x y body ...)
  (begin
    (cairo-move-to cr x y)
    body ...))

(define (fold proc seed list)
  (if (null? list)
      seed
      (fold proc (proc (car list) seed) (cdr list))))

(define-with-kwargs (text-measurer (family "Bitstream Vera Sans")
                                   (size 10))
  (lambda (text)
    (if text
        (let ((cr (cairo-create (cairo-image-surface-create 'argb32 100 100))))
          (cairo-select-font-face cr family 'normal 'normal)
          (cairo-set-font-size cr size)
          (inexact->exact
           (round (cairo-text-extents:width (cairo-text-extents cr text)))))
        0)))

(define-with-kwargs (make-chart title
                                (chart-height 360)
                                (chart-width 360)
                                (font-family "Bitstream Vera Sans")
                                (line-width 1)
                                (title-text-height 16)
                                (axis-text-height 12)
                                x-axis-label
                                y-axis-label
                                (tick-size 5)
                                y-axis-ticks
                                x-axis-ticks
                                y-axis-tick-labels
                                x-axis-tick-labels
                                (vertical-x-axis-tick-labels? #f)
                                (x-axis-tick-mode 'none)
                                (y-axis-tick-mode 'grid)
                                (chart-margin 5)
                                (margin 5)
                                (padding-left 0)
                                (padding-right 0)
                                (padding-top 0)
                                (padding-bottom 0)
                                (make-surface
                                 (lambda (x y)
                                   (cairo-image-surface-create
                                    'argb32
                                    (inexact->exact (ceiling x))
                                    (inexact->exact (ceiling y))))))
  "Make a chart.

@var{tick-lables} is an alist of label-value pairs, where the
value is given in chart height coordinates. The label can be #f.

This function makes the basic chart, setting up the basics like
the title, axes, etc. You probably don't want to call this unless
you are making a custom chart type.

This function returns a cairo context whose coordinate system has
been flipped so that the origin of the chart is (0, 0), with
positive in the northeast quadrant.
"
  (define measure-text
    (text-measurer font-family axis-text-height))

  (let* ((x-axis-text-length (if x-axis-tick-labels
                                 (apply max (map measure-text
                                                 (map car x-axis-tick-labels)))
                                 0))
         (y-axis-text-length (if y-axis-tick-labels
                                 (apply max (map measure-text
                                                 (map car y-axis-tick-labels)))
                                 0))
         (total-width (+ chart-width (if y-axis-ticks tick-size 0)
                         (if y-axis-label axis-text-height 0)
                         (if (zero? y-axis-text-length) 0
                             (+ y-axis-text-length chart-margin))
                         chart-margin chart-margin margin margin
                         padding-left padding-right))

         (total-height (+ chart-height (if title title-text-height 0)
                          (if x-axis-ticks tick-size 0)
                          (if x-axis-tick-labels
                              (if vertical-x-axis-tick-labels?
                                  x-axis-text-length
                                  axis-text-height)
                              0)
                          (if x-axis-label axis-text-height 0)
                          chart-margin chart-margin margin margin
                          padding-top padding-bottom))
         (surface (make-surface total-width total-height))
         (cr (cairo-create surface)))

    ;; Move to cartesian coordinates centered at graph origin.
    (cairo-translate cr (+ margin chart-margin padding-left
                           (if y-axis-ticks tick-size 0)
                           y-axis-text-length
                           (if y-axis-label axis-text-height 0))
                     (+ margin chart-margin padding-top
                        (if title title-text-height 0) chart-height))
    (cairo-scale cr 1.0 -1.0)

    (cairo-set-line-width cr line-width)
    (cairo-select-font-face cr font-family 'normal 'normal)

    (draw-background cr)
    (with-move-to
     cr 0 0
     (draw-chart-area cr chart-width chart-height))
    (with-move-to
     cr (/ chart-width 2) (+ chart-height chart-margin)
     (draw-title cr title title-text-height))
    
    (when x-axis-ticks
      (case x-axis-tick-mode
        ((grid)
         (with-move-to
          cr 0 0
          (draw-grid cr x-axis-ticks chart-height #f)))
        ((none) #t)
        ((ticks)
         (with-move-to
          cr 0 0
          (draw-ticks cr x-axis-ticks tick-size #f)))
        (else (error "unknown tick mode" x-axis-tick-mode))))
    (when y-axis-ticks
      (case y-axis-tick-mode
        ((grid)
         (with-move-to
          cr 0 0
          (draw-grid cr y-axis-ticks chart-width #t)))
        ((none) #t)
        ((ticks)
         (with-move-to
          cr 0 0
          (draw-ticks cr y-axis-ticks tick-size #t)))
        (else (error "unknown tick mode" y-axis-tick-mode))))

    (when x-axis-tick-labels
      (with-move-to
       cr 0 0
       (draw-tick-labels cr x-axis-tick-labels tick-size #f
                         vertical-x-axis-tick-labels? axis-text-height)))
    (when y-axis-tick-labels
      (with-move-to
       cr 0 0
       (draw-tick-labels cr y-axis-tick-labels tick-size #t #f
                         axis-text-height)))
    (when x-axis-label
      (with-move-to
       cr 0 (- (+ axis-text-height
                  (if vertical-x-axis-tick-labels?
                      x-axis-text-length
                      tick-size)))
       (draw-axis-label cr x-axis-label axis-text-height chart-width #f)))
    (when y-axis-label
      (with-move-to
       cr
       (- 0 (if (zero? y-axis-text-length) 0
                (+ y-axis-text-length chart-margin))
          tick-size)
       0
       (draw-axis-label cr y-axis-label axis-text-height chart-height #t)))

    cr))

(define (make-uniform-ticks min max step)
  (let lp ((pos min) (out '()))
    (if (> pos max)
        (reverse! out)
        (lp (+ pos step)
            (cons pos out)))))

(define* (make-sensible-ticks min max #:optional log-base (max-count 20))
  (cond
   (log-base
    (let ((logn (lambda (n) (/ (log n) (log log-base))))
          (exptn (lambda (n) (expt log-base n))))
      (let lp ((x (ceiling (logn min))))
        (if (< x (logn max))
            (cons (exptn x) (lp (1+ x)))
            '()))))
   (else
    (let ((range (- max min)))
      (let lp ((step (/ (expt 10 (ceiling (log10 range))) 100)))
        (if (> (/ range step) max-count)
            (lp (* step 2))
            (make-uniform-ticks (* step (ceiling/ min step)) max step)))))))

(define* (default-formatter value #:optional (precision 3))
  (cond
   ((and (exact? value) (integer? value))
    (number->string value))
   ((zero? value)
    "0")
   (else
    (let ((order (inexact->exact (floor (log10 (abs value))))))
      (cond
       ((>= order precision)
        ;; integer
        (number->string (inexact->exact (round value))))
       ((>= order -1)
        ;; decimal
        (format #f "~,vf" (- precision order) value))
       (else
        ;; scientific
        (format #f "~,v,,,,,'ee" (1- precision) value)))))))

(define-with-kwargs (make-bar-chart title
                                    data 
                                    write-to-png
                                    (bar-width 40)
                                    (group-spacing 40)
                                    (chart-height 360)
                                    (max-y #f)
                                    (chart-params '())
                                    (legend-params '())
                                    (ytick-label-formatter default-formatter)
                                    (bar-value-formatter #f))
  "Make a bar chart.

The format of @var{data} is defined as follows:

@table @var
@item data
 (@var{group}+)
@item group
 (@var{group-label} @var{bar}+)
@item group-label
A string, to be written to the X axis.
@item bar
 (@var{height} @var{bar-params}?)
@item height
The bar height, as a number.
@item bar-params
A property list suitable to passing to
@ref{charting draw draw-bar}.
@end table

This function returns the cairo surface. By default, make-chart
will create an image surface, but you may override this by
passing a @code{#:make-surface} function in the
@var{chart-params}. In this way you can render charts to any
surface supported by Cairo, e.g. PS, PDF, SVG, GDK, etc.

The #:write-to-png option will write the chart out to the PNG file
that you name.

An example invocation might look like:

@example
 (make-bar-chart \"Average Height at Iihenda JSS\"
                 '((\"Grade 9\" (150 \"Boys\") (140 \"Girls\"))
                   (\"Grade 10\" (150 \"Boys\")
                               (140 \"Girls\" (#:y+-bracket 5 #:y--bracket 4.5))))
                 #:write-to-png \"/tmp/graph.png\")
@end example"
  (let* ((num-groups (length data))
         (max-group-bars (1- (apply max (map length data))))
         (chart-width (* num-groups (+ (* max-group-bars bar-width)
                                       group-spacing)))
         (max-height (or max-y
                         (* (apply max (map (lambda (x) 
                                              (apply max (map car (cdr x))))
                                            data))
                            5/4)))
         (height-scale (/ chart-height max-height))
         (yticks-unscaled (make-uniform-ticks
                           0 max-height
                           ((lambda (x) (if (<= (/ max-height x) 5)
                                            (/ x 2)
                                            x))
                            (expt 10 (1- (round
                                          (log10 max-height)))))))
         (yticks (map (lambda (x) (* x height-scale)) yticks-unscaled))
         (ytick-labels (map (lambda (pos) (cons (ytick-label-formatter pos)
                                                (* pos height-scale)))
                            yticks-unscaled))
         (xticks (make-uniform-ticks
                  0 chart-width
                  (+ (* max-group-bars bar-width) group-spacing)))
         (xtick-labels (let ((step (+ (* max-group-bars bar-width)
                                      group-spacing)))
                         (map cons
                              (map car data)
                              (make-uniform-ticks
                               (/ step 2) chart-width step))))
         (series-list (reverse! 
                       (fold (lambda (group series-list)
                               (fold
                                (lambda (bar series-list)
                                  (if (not (member (cadr bar) series-list))
                                      (cons (cadr bar) series-list)
                                      series-list))
                                series-list
                                (cdr group)))
                             '()
                             data)))
         (cr (apply make-chart title chart-height chart-width
                    #:y-axis-ticks yticks #:y-axis-tick-labels ytick-labels
                    #:x-axis-ticks xticks #:x-axis-tick-labels xtick-labels
                    chart-params)))

    (for-each
     (lambda (group pos)
       (with-move-to
        cr pos 0
        (draw-bar-group cr (cdr group) bar-width height-scale
                        bar-value-formatter)))
     data
     (map cdr xtick-labels))

    (with-move-to
     cr 5 (- chart-height 5)
     (apply draw-legend cr #t #t #:series-list series-list legend-params))

    (if write-to-png
        (cairo-surface-write-to-png (cairo-get-target cr) write-to-png))
    (cairo-get-target cr)))

(define (tests-minmax f tests)
  (apply f (map (lambda (points) (apply f points))
                (map cdr tests))))
(define (scenarios-minmax f scenarios)
  (apply f (map (lambda (tests) (tests-minmax f tests))
                (map cdr scenarios))))

(define* (make-performance-chart title
                                 data
                                 #:key
                                 write-to-png
                                 (box-width 20)
                                 (box-spacing 8)
                                 (test-spacing 24)
                                 chart-height
                                 (baseline #f)
                                 (log-y-base #f)
                                 (min-y
                                  (if log-y-base
                                      (/ (scenarios-minmax min data)
                                         log-y-base)
                                      0))
                                 (max-y
                                  (if log-y-base
                                      (* (scenarios-minmax max data)
                                         log-y-base)
                                      (+ min-y
                                         (* 7/6 (- (scenarios-minmax max data)
                                                   min-y)))))
                                 (axis-text-height 12)
                                 (chart-params '())
                                 (legend-params '())
                                 (y-axis-label "Benchmark score")
                                 (vertical-xtick-labels? #f)
                                 (vertical-box-labels? #f)
                                 (ytick-label-formatter default-formatter)
                                 (box-value-formatter default-formatter)
                                 (box-label-height 10))
  "Make a performance chart.

A performance chart compares runtimes for some set of tests across some
set of scenarios.

The format of @var{data} is defined as follows:

@example
 ((@var{scenario} (@var{test} @var{data-point} ...) ...) ...)
@end example

@var{scenario} and @var{test} should be strings.
@var{data-point} should be numbers.

The resulting plot will have time on the Y axis, and one X axis entry
for each test.  Each test/scenario data set will be represented as a box
plot.  In the future we should add more options (for example, a small
vertical histogram on the plot).

This function returns the cairo surface. By default, make-chart
will create an image surface, but you may override this by
passing a @code{#:make-surface} function in the
@var{chart-params}. In this way you can render charts to any
surface supported by Cairo, e.g. PS, PDF, SVG, GDK, etc.

The #:write-to-png option will write the chart out to the PNG file
that you name.

An example invocation might look like:

@example
 (make-performance-chart
  \"Gabriel Benchmarks\"
  '((\"guile-1.8\"
     (\"tak\" 0.12 0.13 0.17)
     (\"fib\" 1.13 1.24 1.05))
    (\"guile-2.0\"
     (\"tak\" 0.05 0.051 0.047)
     (\"fib\" 0.64 0.59 0.71)))
  #:write-to-png \"/tmp/graph.png\")
@end example"
  (let* ((test-folder (lambda (f)
                        (lambda (scenario seed)
                          (fold f seed (cdr scenario)))))
         (datum-folder (lambda (f)
                        (lambda (test seed)
                          (fold f seed (cdr test)))))
         (num-scenarios (length data))
         (tests (reverse
                 (fold (test-folder
                        (lambda (test tests)
                          (lset-adjoin equal? tests (car test))))
                       '() data)))
         (num-tests (length tests))
         (max-x-label-length
          (let ((measurer (text-measurer #:size axis-text-height)))
            (fold (lambda (scenario seed)
                    (fold (lambda (series seed)
                            (max (measurer (car series)) seed))
                          seed
                          (cdr scenario)))
                  0
                  data)))
         (test-width (max (if vertical-xtick-labels?
                              axis-text-height
                              max-x-label-length)
                          (+ (* num-scenarios box-width)
                             (* (1- num-scenarios) box-spacing))))
         (test-step (+ test-width test-spacing))
         (chart-width (max (* num-tests test-step) 400))
         (x-scale (/ (/ chart-width num-tests) test-step))
         (test-step (* test-step x-scale))
         (test-width (* test-width x-scale))
         (test-spacing (* test-spacing x-scale))
         (box-width (* box-width x-scale))
         (box-spacing (* box-spacing x-scale))
         (chart-height (or chart-height
                           (round/ (* chart-width 3) 4)))
         (height (- max-y min-y))
         (height-scale (/ chart-height height))
         (translate-y (if log-y-base
                          (lambda (y)
                            (* (/ (log (/ y min-y)) (log (/ max-y min-y)))
                               chart-height))
                          (lambda (y)
                            (* (/ (- y min-y) height) chart-height))))
         (yticks-unscaled (make-sensible-ticks min-y max-y log-y-base))
         (yticks (map translate-y yticks-unscaled))
         (ytick-labels (map (lambda (y pos)
                              (cons (ytick-label-formatter y) pos))
                            yticks-unscaled yticks))
         (xticks (make-uniform-ticks 0 chart-width test-step))
         (xtick-labels (map cons
                            tests
                            (make-uniform-ticks
                             (/ test-step 2) chart-width test-step)))
         (legend-dimensions
          (call-with-values (lambda ()
                              (apply draw-legend #f #:measure-only? #t
                                     #:series-list (map car data)
                                     #:text-measurer
                                     (lambda (size)
                                       (text-measurer #:size size))
                                     legend-params))
            cons))
         (cr (apply make-chart title chart-height chart-width
                    #:axis-text-height axis-text-height
                    #:y-axis-ticks yticks #:y-axis-tick-labels ytick-labels
                    #:x-axis-ticks xticks #:x-axis-tick-labels xtick-labels
                    #:y-axis-label y-axis-label
                    #:x-axis-label ""
                    #:padding-right (car legend-dimensions)
                    #:vertical-x-axis-tick-labels? vertical-xtick-labels?
                    chart-params)))

    (for-each
     (lambda (test pos)
       (with-move-to
        cr pos 0
        (draw-perf-test cr
                        (map (lambda (scenario)
                               (cons (car scenario)
                                     (or (assoc-ref (cdr scenario) test)
                                         '())))
                             data)
                        box-width box-spacing
                        translate-y box-value-formatter
                        box-label-height vertical-box-labels?
                        baseline)))
     tests
     (map cdr xtick-labels))

    (with-move-to
     cr (+ chart-width 5) (- chart-height 5)
     (apply draw-legend cr #t #t #:series-list (map car data)
            #:draw-outlines? #f #:draw-background? #f
            legend-params))

    (if write-to-png
        (cairo-surface-write-to-png (cairo-get-target cr) write-to-png))
    (cairo-get-target cr)))

(define* (make-bar-chart/histograms title
                                    data
                                    #:key
                                    write-to-png
                                    (box-width 20)
                                    (box-spacing 12)
                                    (scenario-spacing 24)
                                    chart-height
                                    (baseline #f)
                                    (log-y-base #f)
                                    (min-y
                                     (if log-y-base
                                         (/ (tests-minmax min data)
                                            log-y-base)
                                         0))
                                    (max-y
                                     (if log-y-base
                                         (* (tests-minmax max data)
                                            log-y-base)
                                         (+ min-y
                                            (* 7/6 (- (tests-minmax max data)
                                                      min-y)))))
                                    (axis-text-height 12)
                                    (y-axis-label "Benchmark score")
                                    (chart-params '())
                                    (legend-params '())
                                    (ytick-label-formatter default-formatter)
                                    (box-value-formatter default-formatter)
                                    (box-label-height 10)
                                    (vertical-box-labels? #f))
  "Make a bar chart, with overlaid histograms on the bars.

A performance chart compares runtimes for a test across some set of
scenarios.

The format of @var{data} is defined as follows:

@example
 ((@var{scenario} @var{data-point} ...) ...)
@end example

@var{scenario} should be strings.  @var{data-point} should be numbers.

The resulting plot will have the data points on the Y axis, and one
bar+histogram for each scenario.

This function returns the cairo surface. By default, make-chart will
create an image surface, but you may override this by passing a
@code{#:make-surface} function in the @var{chart-params}. In this way
you can render charts to any surface supported by Cairo, e.g. PS, PDF,
SVG, GDK, etc.

The #:write-to-png option will write the chart out to the PNG file
that you name.

An example invocation might look like:

@example
 (make-bar-chart/histograms
  \"Fibonacci benchmark\"
  '((\"guile-1.8\" 1.13 1.24 1.05)
    (\"guile-2.0\" 0.64 0.59 0.71))
  #:write-to-png \"/tmp/graph.png\")
@end example"
  (let* ((datum-folder (lambda (f)
                         (lambda (scenario seed)
                           (match scenario
                             ((name . datums)
                              (fold f seed datums))))))
         (num-scenarios (length data))
         (scenario-names (match data (((name . _) ...) name)))
         (scenario-width (let ((measurer (text-measurer #:size axis-text-height)))
                           (+ box-spacing
                              (fold (lambda (name width)
                                      (max (measurer name) width))
                                    box-width
                                    scenario-names))))
         (natural-width (+ (* num-scenarios scenario-width) scenario-spacing))
         (chart-width (max natural-width 400))
         (x-scale (/ chart-width natural-width 1.0))
         (scenario-width (* scenario-width x-scale))
         (scenario-spacing (* scenario-spacing x-scale))
         (box-width (* (/ box-width (+ box-width box-spacing))
                       scenario-width))
         (box-spacing (* (/ box-spacing (+ box-width box-spacing))
                         scenario-spacing))
         (box-spacing (* box-spacing x-scale))
         (chart-height (or chart-height
                           (round/ (* chart-width 3) 4)))
         (height (- max-y min-y))
         (height-scale (/ chart-height height))
         (translate-y (if log-y-base
                          (lambda (y)
                            (* (/ (log (/ y min-y)) (log (/ max-y min-y)))
                               chart-height))
                          (lambda (y)
                            (* (/ (- y min-y) height) chart-height))))
         (yticks-unscaled (make-sensible-ticks min-y max-y log-y-base))
         (yticks (map translate-y yticks-unscaled))
         (ytick-labels (map (lambda (y pos)
                              (cons (ytick-label-formatter y) pos))
                            yticks-unscaled yticks))
         (xticks (make-uniform-ticks (/ scenario-spacing 2.)
                                     chart-width scenario-width))
         (xtick-labels (map cons
                            scenario-names
                            (make-uniform-ticks
                             (/ (+ scenario-spacing scenario-width) 2)
                             chart-width scenario-width)))
         (cr (apply make-chart title chart-height chart-width
                    #:axis-text-height axis-text-height
                    #:y-axis-ticks yticks #:y-axis-tick-labels ytick-labels
                    #:x-axis-ticks xticks #:x-axis-tick-labels xtick-labels
                    #:y-axis-label y-axis-label
                    chart-params)))

    (for-each
     (lambda (scenario pos)
       (with-move-to
        cr pos 0
        (draw-perf-test cr
                        (list scenario)
                        box-width box-spacing
                        translate-y
                        box-value-formatter
                        box-label-height
                        vertical-box-labels?
                        baseline)))
     data
     (map cdr xtick-labels))

    (if write-to-png
        (cairo-surface-write-to-png (cairo-get-target cr) write-to-png))
    (cairo-get-target cr)))

(define-with-kwargs (make-performance-series title
                                             data
                                             write-to-png
                                             (box-width 20)
                                             (box-spacing 4)
                                             (test-spacing 12)
                                             chart-height
                                             (max-y #f)
                                             (min-y 0)
                                             (chart-params '())
                                             (annotations '())
                                             (ytick-label-formatter default-formatter)
                                             (box-value-formatter default-formatter))
  "Make a performance chart.

A performance chart compares runtimes for some set of tests across some
set of scenarios.

The format of @var{data} is defined as follows:

@example
 ((@var{x} @var{data-point} ...) ...)
@end example

@var{x} and @var{data-point} should be numbers.

The resulting plot will have time on the Y axis, and one X axis entry
for each test.  Each  data set will be represented as a box
plot.  In the future we should add more options (for example, a small
vertical histogram on the plot).

This function returns the cairo surface. By default, make-chart
will create an image surface, but you may override this by
passing a @code{#:make-surface} function in the
@var{chart-params}. In this way you can render charts to any
surface supported by Cairo, e.g. PS, PDF, SVG, GDK, etc.

The #:write-to-png option will write the chart out to the PNG file
that you name.

An example invocation might look like:

@example
 (make-performance-chart
  \"Gabriel Benchmarks\"
  '((\"guile-1.8\"
     (\"tak\" 0.12 0.13 0.17)
     (\"fib\" 1.13 1.24 1.05))
    (\"guile-2.0\"
     (\"tak\" 0.05 0.051 0.047)
     (\"fib\" 0.64 0.59 0.71)))
  #:write-to-png \"/tmp/graph.png\")
@end example"
  (let* ((datum-folder (lambda (f)
                         (lambda (test seed)
                           (fold f seed (cdr test)))))
         (num-tests (length data))
         (test-width (+ (* num-tests box-width)
                        (* (1- num-tests) box-spacing)))
         (test-step (+ test-width test-spacing))
         (chart-width (min (* num-tests test-step) 800))
         (x-scale (/ (/ chart-width num-tests) test-step))
         (test-step (* test-step x-scale))
         (test-width (* test-width x-scale))
         (test-spacing (* test-spacing x-scale))
         (box-width (* box-width x-scale))
         (box-spacing (* box-spacing x-scale))
         (chart-height (or chart-height
                           (round/ (* chart-width 3) 7)))
         (max-y* (fold (datum-folder max) 0 data))
         (min-y* (fold (datum-folder min) 0 data))
         (max-y (or max-y
                    (+ max-y* (* 1/6 (- max-y* min-y*)))))
         (min-y (or min-y
                    (max (- min-y* (* 1/6 (- max-y* min-y*))) 0)))
         (height (- max-y min-y))
         (height-scale (/ chart-height height))
         (yticks-unscaled (make-sensible-ticks min-y max-y))
         (yticks (map (lambda (y) (* (- y min-y) height-scale))
                      yticks-unscaled))
         (ytick-labels (map (lambda (y) (cons (ytick-label-formatter y)
                                              (* (- y min-y) height-scale)))
                            yticks-unscaled))
         (xticks (make-uniform-ticks 0 chart-width test-step))
         (xtick-labels (map cons
                            (map car data)
                            (make-uniform-ticks
                             (/ test-step 2) chart-width test-step)))
         (cr (apply make-chart title chart-height chart-width
                    #:y-axis-ticks yticks #:y-axis-tick-labels ytick-labels
                    #:x-axis-ticks xticks #:x-axis-tick-labels xtick-labels
                    #:y-axis-label "Benchmark score"
                    #:x-axis-label "Warmup time (ms)"
                    chart-params)))

    (draw-annotations cr annotations xtick-labels chart-width chart-height)
    (draw-perf-series cr data (map cdr xtick-labels)
                      box-width box-spacing
                      min-y height-scale
                      box-value-formatter)

    (if write-to-png
        (cairo-surface-write-to-png (cairo-get-target cr) write-to-png))
    (cairo-get-target cr)))

(define-with-kwargs (make-scatter-plot title
                                       data
                                       write-to-png
                                       (test-spacing 24)
                                       (chart-height 300)
                                       (chart-width 400)
                                       (min-x 0)
                                       (max-x #f)
                                       (min-y 0)
                                       (max-y #f)
                                       (log-x-base #f)
                                       (log-y-base #f)
                                       (chart-params '())
                                       (legend-params '())
                                       (x-axis-label "")
                                       (y-axis-label "")
                                       (x-ticks #f)
                                       (y-ticks #f)
                                       (tick-label-formatter default-formatter))
  "Make a scatter plot.

A scatter plot shows a number of series as individual points.

The format of @var{data} is defined as follows:

@example
 ((@var{series} (@var{x} . @var{y}) ...) ...)
@end example

@var{series} should be a string.  @var{x} and @var{y} should be numbers.

This function returns the cairo surface. By default, make-chart
will create an image surface, but you may override this by
passing a @code{#:make-surface} function in the
@var{chart-params}. In this way you can render charts to any
surface supported by Cairo, e.g. PS, PDF, SVG, GDK, etc.

The #:write-to-png option will write the chart out to the PNG file
that you name.

An example invocation might look like:

@example
 (make-scatter-plot
  \"MPG for cars\"
  '((\"ford\" (1 . 2) (2 . 3))
    (\"opel\" (1.2 . 3.5) (4.5 . 1)))
  #:write-to-png \"/tmp/graph.png\")
@end example"
  (let* ((datum-folder (lambda (f cxr)
                         (lambda (series seed)
                           (fold (lambda (pair seed)
                                   (f (cxr pair) seed))
                                 seed (cdr series)))))
         (num-series (length data))
         (series-names (map car data))
         (min-x* (fold (datum-folder min car) 0 data))
         (max-x* (fold (datum-folder max car) 0 data))
         (min-y* (fold (datum-folder min cdr) 0 data))
         (max-y* (fold (datum-folder max cdr) 0 data))
         (min-y (or min-y (max (- min-y* (* 1/6 (- max-y* min-y*))) 0)))
         (max-y (or max-y (+ max-y* (* 1/6 (- max-y* min-y*)))))
         (min-x (or min-x (max (- min-x* (* 1/6 (- max-x* min-x*))) 0)))
         (max-x (or max-x (+ max-x* (* 1/6 (- max-x* min-x*)))))
         (width (- max-x min-x))
         (height (- max-y min-y))
         (translate-x (if log-x-base
                          (lambda (x)
                            (* (/ (log (- x min-x)) (log width)) chart-width))
                          (lambda (x)
                            (* (/ (- x min-x) width) chart-width))))
         (translate-y (if log-y-base
                          (lambda (y)
                            (* (/ (log (- y min-y)) (log height)) chart-height))
                          (lambda (y)
                            (* (/ (- y min-y) height) chart-height))))
         (width-scale (/ chart-width width))
         (height-scale (/ chart-height height))
         (xticks-unscaled (or x-ticks
                              (make-sensible-ticks min-x max-x log-x-base)))
         (xticks (map translate-x xticks-unscaled))
         (xtick-labels (map (lambda (x pos) (cons (tick-label-formatter x) pos))
                            xticks-unscaled xticks))
         (yticks-unscaled (or y-ticks
                              (make-sensible-ticks min-y max-y log-y-base)))
         (yticks (map translate-y yticks-unscaled))
         (ytick-labels (map (lambda (y pos) (cons (tick-label-formatter y) pos))
                            yticks-unscaled yticks))
         (legend-dimensions
          (call-with-values (lambda ()
                              (apply draw-legend #f #:measure-only? #t
                                     #:series-list (map car data)
                                     #:text-measurer
                                     (lambda (size)
                                       (text-measurer #:size size))
                                     legend-params))
            cons))
         (cr (apply make-chart title chart-height chart-width
                    #:y-axis-ticks yticks #:y-axis-tick-labels ytick-labels
                    #:x-axis-ticks xticks #:x-axis-tick-labels xtick-labels
                    #:x-axis-label x-axis-label
                    #:y-axis-label y-axis-label
                    #:padding-right (car legend-dimensions)
                    #:x-axis-tick-mode 'grid
                    chart-params)))

    (for-each
     (match-lambda
      ((series (x . y) ...)
       (for-each (lambda (x y)
                   (draw-point cr (translate-x x) (translate-y y) series))
                 x y)))
     data)

    (with-move-to
     cr (+ chart-width 5) (- chart-height 5)
     (apply draw-legend cr #t #t #:series-list (map car data)
            #:draw-outlines? #f #:draw-background? #f
            legend-params))

    (if write-to-png
        (cairo-surface-write-to-png (cairo-get-target cr) write-to-png))
    (cairo-get-target cr)))

(define-with-kwargs (make-page-map title data write-to-png
                                   (margin 10)
                                   (page-size 4096)
                                   (page-width 512)
                                   (page-height 2)
                                   (page-spacing 1)
                                   (title-text-height 10)
                                   (text-height 10)
                                   (label-bar-spacing 2)
                                   (font-family "Bitstream Vera Sans"))
  "Make a page map.

A page map shows the components of a one-dimensional space.  Each
component has a label, a start, and a size.  The result is a graphical
representation of the space, divided in @var{page-size} strips, along
with a summary list of the different components.

The format of @var{data} is as follows:

@example
 ((@var{label} . (@var{start} . @var{size})) ...)}
@end example

@var{label} should be a string.  @var{start} and @var{size} should be
numbers.

The #:write-to-png option will write the chart out to the PNG file
that you name.

An example invocation might look like:

@example
 (make-page-map
  \"foo.so\"
  '((\".text\" 1024 65535)
    (\".data\" 65536 20)
    (\".rodata\" 65556 200))
  #:write-to-png \"foo.png\")
@end example"
  (call-with-values (lambda ()
                      (ceiling/ (match data
                                  (((labels . (starts . sizes)) ...)
                                   (apply max (map + starts sizes))))
                                page-size))
    (lambda (pages last-page-empty)
      (let* ((chart-width (+ margin page-width margin))
             (chart-height (+ (* pages page-height)
                              (* (- pages 1) page-spacing)))
             (total-height (+ margin
                              (if title (+ title-text-height margin) 0)
                              chart-height
                              margin
                              (* (length data)
                                 (+ text-height label-bar-spacing))
                              margin))
             (total-width (+ margin chart-width margin))
             (surface (cairo-image-surface-create 'argb32
                                                  total-width total-height))
             (cr (cairo-create surface)))

        ;; Move to cartesian coordinates centered at graph origin.
        (cairo-translate cr margin
                         (+ margin
                            (if title (+ title-text-height margin) 0)
                            chart-height))
        (cairo-scale cr 1.0 -1.0)

        (cairo-set-line-width cr 1)
        (cairo-select-font-face cr font-family 'normal 'normal)
        (draw-background cr)
        (with-move-to
         cr (/ chart-width 2) (+ chart-height margin)
         (draw-title cr title title-text-height))
        (draw-page-map cr data chart-width chart-height
                       #:page-size page-size
                       #:page-height page-height
                       #:page-spacing page-spacing)
        (with-move-to
         cr 0 (- margin)
         (draw-bar-legend cr data chart-width
                          #:text-height text-height
                          #:font-family font-family
                          #:horizontal-spacing margin
                          #:vertical-spacing label-bar-spacing))
        (when write-to-png
          (cairo-surface-write-to-png (cairo-get-target cr) write-to-png))
        (cairo-get-target cr)))))