Finished first draft of tick/axis overhaul

collects/plot/common/area.rkt

@@ -14,6 +14,7 @@
          "contract.rkt"
          "draw.rkt"
          "math.rkt"
+         "vector.rkt"
          "parameters.rkt")
 
 (provide plot-area% (struct-out legend-entry))
@@ -250,105 +251,118 @@
       (send dc set-alpha old-alpha))
     
     (define/public (draw-point v)
-      (match-define (vector x y) v)
+      (when (vregular? v)
-      (send dc draw-point x y))
+        (match-define (vector x y) v)
+        (send dc draw-point x y)))
     
     (define/public (draw-polygon vs [fill-style 'winding])
-      (send dc draw-polygon (map coord->cons vs) 0 0 fill-style))
+      (when (andmap vregular? vs)
+        (send dc draw-polygon (map coord->cons vs) 0 0 fill-style)))
     
     (define/public (draw-rectangle v1 v2)
-      (match-define (vector x1 y1) v1)
+      (when (and (vregular? v1) (vregular? v2))
-      (match-define (vector x2 y2) v2)
+        (match-define (vector x1 y1) v1)
-      (draw-polygon
+        (match-define (vector x2 y2) v2)
-       (list (vector x1 y1) (vector x1 y2) (vector x2 y2) (vector x2 y1))))
+        (draw-polygon
+         (list (vector x1 y1) (vector x1 y2) (vector x2 y2) (vector x2 y1)))))
     
     (define/public (draw-lines vs)
-      (send dc draw-lines (map coord->cons vs)))
+      (when (andmap vregular? vs)
+        (send dc draw-lines (map coord->cons vs))))
     
     (define/public (draw-line v1 v2)
-      (match-define (vector x1 y1) v1)
+      (when (and (vregular? v1) (vregular? v2))
-      (match-define (vector x2 y2) v2)
+        (match-define (vector x1 y1) v1)
-      (send dc draw-line x1 y1 x2 y2))
+        (match-define (vector x2 y2) v2)
+        (send dc draw-line x1 y1 x2 y2)))
     
     (define/public (draw-text str v [anchor 'top-left] [angle 0] #:outline? [outline? #f])
-      (match-define (vector x y) v)
+      (when (vregular? v)
+        (match-define (vector x y) v)
         
-      (when outline?
+        (when outline?
-        (define alpha (send dc get-alpha))
+          (define alpha (send dc get-alpha))
-        (define fg (send dc get-text-foreground))
+          (define fg (send dc get-text-foreground))
           
-        (send dc set-alpha (alpha-expt alpha 1/8))
+          (send dc set-alpha (alpha-expt alpha 1/8))
-        (send dc set-text-foreground (send dc get-background))
+          (send dc set-text-foreground (send dc get-background))
-        (for* ([dx  (list -1 0 1)]
+          (for* ([dx  (list -1 0 1)]
-               [dy  (list -1 0 1)]
+                 [dy  (list -1 0 1)]
-               #:when (not (and (zero? dx) (zero? dy))))
+                 #:when (not (and (zero? dx) (zero? dy))))
-          (draw-text/anchor dc str (+ x dx) (+ y dy) anchor #t 0 angle))
+            (draw-text/anchor dc str (+ x dx) (+ y dy) anchor #t 0 angle))
-        (send dc set-alpha alpha)
+          (send dc set-alpha alpha)
-        (send dc set-text-foreground fg))
+          (send dc set-text-foreground fg))
         
-      (draw-text/anchor dc str x y anchor #t 0 angle))
+        (draw-text/anchor dc str x y anchor #t 0 angle)))
     
     (define/public (get-text-corners str v [anchor 'top-left] [angle 0])
-      (match-define (vector x y) v)
+      (when (vregular? v)
-      (get-text-corners/anchor dc str x y anchor #t 0 angle))
+        (match-define (vector x y) v)
+        (get-text-corners/anchor dc str x y anchor #t 0 angle)))
     
     (define/public (draw-arrow v1 v2)
-      (match-define (vector x1 y1) v1)
+      (when (and (vregular? v1) (vregular? v2))
-      (match-define (vector x2 y2) v2)
+        (match-define (vector x1 y1) v1)
-      (define dx (- x2 x1))
+        (match-define (vector x2 y2) v2)
-      (define dy (- y2 y1))
+        (define dx (- x2 x1))
-      (define angle (if (and (zero? dy) (zero? dx)) 0 (atan dy dx)))
+        (define dy (- y2 y1))
-      (define dist (sqrt (+ (sqr dx) (sqr dy))))
+        (define angle (if (and (zero? dy) (zero? dx)) 0 (atan dy dx)))
-      (define head-r (* 2/5 dist))
+        (define dist (sqrt (+ (sqr dx) (sqr dy))))
-      (define head-angle (* 1/6 pi))
+        (define head-r (* 2/5 dist))
-      (define dx1 (* (cos (+ angle head-angle)) head-r))
+        (define head-angle (* 1/6 pi))
-      (define dy1 (* (sin (+ angle head-angle)) head-r))
+        (define dx1 (* (cos (+ angle head-angle)) head-r))
-      (define dx2 (* (cos (- angle head-angle)) head-r))
+        (define dy1 (* (sin (+ angle head-angle)) head-r))
-      (define dy2 (* (sin (- angle head-angle)) head-r))
+        (define dx2 (* (cos (- angle head-angle)) head-r))
-      (send dc draw-line x1 y1 x2 y2)
+        (define dy2 (* (sin (- angle head-angle)) head-r))
-      (send dc draw-line x2 y2 (- x2 dx1) (- y2 dy1))
+        (send dc draw-line x1 y1 x2 y2)
-      (send dc draw-line x2 y2 (- x2 dx2) (- y2 dy2)))
+        (send dc draw-line x2 y2 (- x2 dx1) (- y2 dy1))
+        (send dc draw-line x2 y2 (- x2 dx2) (- y2 dy2))))
     
     ;; -----------------------------------------------------------------------------------------------
     ;; Glyph (point sym) primitives
     
     (define/public ((make-draw-circle-glyph r) v)
-      (match-define (vector x y) v)
+      (when (vregular? v)
-      (send dc draw-ellipse (- x r -1/2) (- y r -1/2) (* 2 r) (* 2 r)))
+        (match-define (vector x y) v)
+        (send dc draw-ellipse (- x r -1/2) (- y r -1/2) (* 2 r) (* 2 r))))
     
     (define/public (make-draw-polygon-glyph r sides start-angle)
       (define angles (linear-seq start-angle (+ start-angle (* 2 pi)) (+ 1 sides)))
       (λ (v)
-        (match-define (vector x y) v)
+        (when (vregular? v)
-        (send dc draw-polygon (map (λ (a) (cons (+ x (* (cos a) r)) (+ y (* (sin a) r))))
+          (match-define (vector x y) v)
-                                   angles))))
+          (send dc draw-polygon (map (λ (a) (cons (+ x (* (cos a) r)) (+ y (* (sin a) r))))
+                                     angles)))))
     
     (define/public (make-draw-star-glyph r sides start-angle)
       (define angles (linear-seq start-angle (+ start-angle (* 2 pi)) (+ 1 (* 2 sides))))
       (λ (v)
-        (match-define (vector x y) v)
+        (when (vregular? v)
-        (define pts
+          (match-define (vector x y) v)
-          (for/list ([a  (in-list angles)] [i  (in-naturals)])
+          (define pts
-            (define r-cos-a (* r (cos a)))
+            (for/list ([a  (in-list angles)] [i  (in-naturals)])
-            (define r-sin-a (* r (sin a)))
+              (define r-cos-a (* r (cos a)))
-            (cond [(odd? i)  (cons (+ x r-cos-a) (+ y r-sin-a))]
+              (define r-sin-a (* r (sin a)))
-                  [else      (cons (+ x (* 1/2 r-cos-a)) (+ y (* 1/2 r-sin-a)))])))
+              (cond [(odd? i)  (cons (+ x r-cos-a) (+ y r-sin-a))]
-        (send dc draw-polygon pts)))
+                    [else      (cons (+ x (* 1/2 r-cos-a)) (+ y (* 1/2 r-sin-a)))])))
+          (send dc draw-polygon pts))))
     
     (define/public (make-draw-flare-glyph r sticks start-angle)
       (define step (/ (* 2 pi) sticks))
       (define angles (build-list sticks (λ (n) (+ start-angle (* n step)))))
       (λ (v)
-        (match-define (vector x y) v)
+        (when (vregular? v)
-        (for ([a  (in-list angles)])
+          (match-define (vector x y) v)
-          (send dc draw-line x y (+ x (* (cos a) r)) (+ y (* (sin a) r))))))
+          (for ([a  (in-list angles)])
+            (send dc draw-line x y (+ x (* (cos a) r)) (+ y (* (sin a) r)))))))
     
     (define/public (make-draw-tick r angle)
       (define dx (* (cos angle) r))
       (define dy (* (sin angle) r))
       (λ (v)
-        (match-define (vector x y) v)
+        (when (vregular? v)
-        (send dc draw-line (- x dx) (- y dy) (+ x dx) (+ y dy))))
+          (match-define (vector x y) v)
+          (send dc draw-line (- x dx) (- y dy) (+ x dx) (+ y dy)))))
     
     (define/public (draw-tick v r angle)
       ((make-draw-tick r angle) v))
@@ -363,14 +377,15 @@
       (define dx2 (* (cos (- angle head-angle)) head-r))
       (define dy2 (* (sin (- angle head-angle)) head-r))
       (λ (v)
-        (match-define (vector x y) v)
+        (when (vregular? v)
-        (define head-x (+ x dx))
+          (match-define (vector x y) v)
-        (define head-y (+ y dy))
+          (define head-x (+ x dx))
-        (define tail-x (- x dx))
+          (define head-y (+ y dy))
-        (define tail-y (- y dy))
+          (define tail-x (- x dx))
-        (send dc draw-line head-x head-y tail-x tail-y)
+          (define tail-y (- y dy))
-        (send dc draw-line head-x head-y (- head-x dx1) (- head-y dy1))
+          (send dc draw-line head-x head-y tail-x tail-y)
-        (send dc draw-line head-x head-y (- head-x dx2) (- head-y dy2))))
+          (send dc draw-line head-x head-y (- head-x dx1) (- head-y dy1))
+          (send dc draw-line head-x head-y (- head-x dx2) (- head-y dy2)))))
     
     (define/public (draw-arrow-glyph v r angle)
       ((make-draw-arrow-glyph r angle) v))
@@ -380,8 +395,9 @@
       (define dx (* 1/2 x-size))
       (define dy (* 1/2 y-size))
       (λ (v)
-        (match-define (vector x y) v)
+        (when (vregular? v)
-        (send dc draw-text str (- x dx) (- y dy) #t)))
+          (match-define (vector x y) v)
+          (send dc draw-text str (- x dx) (- y dy) #t))))
     
     (define ((mix-draw-glyph d1 d2) v)
       (d1 v)

collects/plot/common/axis-transform.rkt

@@ -5,29 +5,70 @@
          "contract.rkt" "contract-doc.rkt")
 
 (provide (struct-out invertible-function)
-         make-axis-transform
+         id-function
+         axis-transform/c
          id-transform
+         apply-transform
+         make-axis-transform
+         axis-transform-compose
          log-transform
          cbrt-transform
-         hand-drawn-transform)
+         hand-drawn-transform
+         stretch-transform
+         collapse-transform)
 
 (define-struct/contract invertible-function ([f (real? . -> . real?)] [finv (real? . -> . real?)])
   #:transparent)
 
+(define (invertible-compose f1 f2)
+  (match-let ([(invertible-function f1 g1)  f1]
+              [(invertible-function f2 g2)  f2])
+    (invertible-function (compose f1 f2) (compose g2 g1))))
+
+(define axis-transform/c (real? real? invertible-function? . -> . invertible-function?))
+
+(defproc (id-transform [x-min real?] [x-max real?] [old-function invertible-function?]
+                       ) invertible-function?
+  old-function)
+
+(define id-function (invertible-function (λ (x) x) (λ (x) x)))
+
+(defproc (apply-transform [t axis-transform/c] [x-min real?] [x-max real?]) invertible-function?
+  (t x-min x-max id-function))
+
 ;; Turns any total, surjective, monotone flonum op and its inverse into an axis transform
-(define ((make-axis-transform flop flinv) x-min x-max)
+(define ((make-axis-transform f g) x-min x-max old-function)
-  (let ([x-min  (exact->inexact x-min)]
+  (define fx-min (f x-min))
-        [x-max  (exact->inexact x-max)])
+  (define fx-scale (/ (- x-max x-min) (- (f x-max) fx-min)))
-    (define fx-min (flop x-min))
+  (define (new-f x) (+ x-min (* (- (f x) fx-min) fx-scale)))
-    (define fx-scale (fl/ (fl- x-max x-min)
+  (define (new-g y) (g (+ fx-min (/ (- y x-min) fx-scale))))
-                          (fl- (flop x-max) fx-min)))
+  (invertible-compose (invertible-function new-f new-g) old-function))
-    (define (f x)
+
-      (fl+ x-min (fl* (fl- (flop (exact->inexact x)) fx-min)
+;; ===================================================================================================
-                      fx-scale)))
+;; Axis transform combinators
-    (define (finv y)
+
-      (flinv (fl+ fx-min (fl/ (fl- (exact->inexact y) x-min)
+(defproc (axis-transform-compose [t1 axis-transform/c] [t2 axis-transform/c]) axis-transform/c
-                              fx-scale))))
+  (λ (x-min x-max old-function)
-    (invertible-function f finv)))
+    (t1 x-min x-max (t2 x-min x-max old-function))))
+
+(defproc (axis-transform-append [t1 axis-transform/c] [t2 axis-transform/c] [x-mid real?]
+                                ) axis-transform/c
+  (λ (x-min x-max old-function)
+    (match-define (invertible-function old-f old-g) old-function)
+    (let ([x-mid  (old-f x-mid)])
+      (cond [(x-mid . >= . x-max)  (t1 x-min x-max old-function)]
+            [(x-mid . <= . x-min)  (t2 x-min x-max old-function)]
+            [else
+             (match-define (invertible-function f1 g1) (t1 x-min x-mid old-function))
+             (match-define (invertible-function f2 g2) (t2 x-mid x-max old-function))
+             ((make-axis-transform (λ (x) (cond [((old-f x) . < . x-mid)  (f1 x)]
+                                                [else  (f2 x)]))
+                                   (λ (x) (cond [(x . < . x-mid)  (g1 x)]
+                                                [else  (g2 x)])))
+              x-min x-max id-function)]))))
+
+(defproc (axis-transform-bound [t axis-transform/c] [x-min real?] [x-max real?]) axis-transform/c
+  (axis-transform-append (axis-transform-append id-transform t x-min) id-transform x-max))
 
 ;; ===================================================================================================
 ;; Specific axis transforms
@@ -65,21 +106,60 @@
   (let ([x  (exact->inexact x)])
     (fl* x (fl* x x))))
 
+(define (real-log x)
+  (fllog (exact->inexact x)))
 
-(defproc (id-transform [x-min real?] [x-max real?]) invertible-function?
+(define (real-exp x)
-  (invertible-function values values))
+  (flexp (exact->inexact x)))
 
-(defproc (log-transform [x-min real?] [x-max real?]) invertible-function?
+(defproc (log-transform [x-min real?] [x-max real?] [old-function invertible-function?]
+                        ) invertible-function?
   (when ((exact->inexact x-min) . <= . 0)
     (raise-type-error 'log-transform "positive real" 0 x-min x-max))
-  ((make-axis-transform fllog flexp) x-min x-max))
+  ((make-axis-transform real-log real-exp) x-min x-max old-function))
 
-(define cbrt-trans (make-axis-transform cbrt cube))
+(defproc (cbrt-transform [x-min real?] [x-max real?] [old-function invertible-function?]
+                         ) invertible-function?
+  ((make-axis-transform cbrt cube) x-min x-max old-function))
 
-(defproc (cbrt-transform [x-min real?] [x-max real?]) invertible-function?
+(defproc (hand-drawn-transform [freq (>/c 0)]) axis-transform/c
-  (cbrt-trans x-min x-max))
+  (λ (x-min x-max old-function)
+    (define d (/ freq (- x-max x-min)))
+    ((make-axis-transform (sine-diag d) (sine-diag-inv d)) x-min x-max old-function)))
 
-(defproc (hand-drawn-transform [freq (>/c 0)]) (real? real? . -> . invertible-function?)
+;; ===================================================================================================
-  (λ (mn mx)
+
-    (define d (/ freq (- mx mn)))
+(define (stretch a b s)
-    ((make-axis-transform (sine-diag d) (sine-diag-inv d)) mn mx)))
+  (define d (- b a))
+  (define ds (* d s))
+  (λ (x)
+    (cond [(x . < . a)  x]
+          [(x . > . b)  (+ (- x d) ds)]
+          [else         (+ a (* (- x a) s))])))
+
+(defproc (stretch-transform [a real?] [b real?] [scale (and/c real? (not/c (=/c 0)))]
+                            ) axis-transform/c
+  (when (a . > . b) (error 'stretch-transform "expected a <= b; given ~e and ~e" a b))
+  (λ (x-min x-max old-function)
+    (match-define (invertible-function old-f old-g) old-function)
+    (let ([a  (old-f a)]
+          [b  (old-f b)])
+      (define f (stretch a b scale))
+      (define g (stretch (f a) (f b) (/ 1 scale)))
+      ((make-axis-transform f g) x-min x-max old-function))))
+
+(defproc (collapse-transform [a real?] [b real?]) axis-transform/c
+  (when (a . > . b) (error 'stretch-transform "expected a <= b; given ~e and ~e" a b))
+  (λ (x-min x-max old-function)
+    (match-define (invertible-function old-f old-g) old-function)
+    (let ([a  (old-f a)]
+          [b  (old-f b)])
+      (define 1/2size (* 1/2 (- b a)))
+      (define center (* 1/2 (+ a b)))
+      (define (f x) (cond [(x . < . a)  (+ x 1/2size)]
+                          [(x . > . b)  (- x 1/2size)]
+                          [else  center]))
+      (define (g x) (cond [(x . < . center)  (- x 1/2size)]
+                          [(x . > . center)   (+ x 1/2size)]
+                          [else  center]))
+      ((make-axis-transform f g) x-min x-max old-function))))

collects/plot/common/contract-doc.rkt

@@ -9,7 +9,7 @@
          (prefix-in s. scribble/core)
          (prefix-in s. scribble/html-properties))
 
-(provide defproc defparam defcontract doc-apply)
+(provide defproc defparam defthing defcontract doc-apply)
 
 (begin-for-syntax
   (struct proc+doc (proc-transformer doc-transformer)
@@ -148,6 +148,24 @@
      (quasisyntax/loc stx
        (defparam name #,(parameter-name->arg-name #'name) contract default))]))
 
+(define-syntax (defthing stx)
+  (syntax-parse stx
+    [(_ name:id contract:expr value:expr)
+     (with-syntax ([value-name           (make-value-name #'name)]
+                   [serialized-contract  (serialize-syntax #'contract)])
+       (syntax/loc stx
+         (begin
+           (define/contract value-name contract value)
+           (define-syntax name
+             (make-proc+doc
+              #'value-name
+              (λ (doc-stx)
+                (syntax-case doc-stx ()
+                  [(ctx . pre-flows)
+                   (with-syntax ([doc-name      (make-doc-name #'ctx #'name)]
+                                 [doc-contract  (unserialize-syntax #'ctx 'serialized-contract)])
+                     #'(s.defthing doc-name doc-contract . pre-flows))])))))))]))
+
 ;; Define a contract or a procedure that returns a contract
 (define-syntax (defcontract stx)
   (syntax-parse stx

collects/plot/common/currency.rkt

@@ -0,0 +1,122 @@
+#lang racket/base
+
+(provide (all-defined-out))
+
+(define currency-code->sign
+  #hash((ALL . "Lek")
+        (AFN . "\u60b")
+        (ARS . "$")
+        (AWG . "\u192")
+        (AUD . "$")
+        (AZN . "\u43c\u430\u43d")
+        (BSD . "$")
+        (BBD . "$")
+        (BYR . "p.")
+        (BZD . "BZ$")
+        (BMD . "$")
+        (BOB . "$b")
+        (BAM . "KM")
+        (BWP . "P")
+        (BGN . "\u43b\u432")
+        (BRL . "R$")
+        (BND . "$")
+        (KHR . "\u17db")
+        (CAD . "$")
+        (KYD . "$")
+        (CLP . "$")
+        (CNY . "\ua5")
+        (COP . "$")
+        (CRC . "\u20a1")
+        (HRK . "kn")
+        (CUP . "\u20b1")
+        (CZK . "\u4b\u10d")
+        (DKK . "kr")
+        (DOP . "RD$")
+        (XCD . "$")
+        (EGP . "\ua3")
+        (SVC . "$")
+        (EEK . "kr")
+        (EUR . "\u20ac")
+        (FKP . "\ua3")
+        (FJD . "$")
+        (GHC . "\ua2")
+        (GIP . "\ua3")
+        (GTQ . "Q")
+        (GGP . "\ua3")
+        (GYD . "$")
+        (HNL . "L")
+        (HKD . "$")
+        (HUF . "Ft")
+        (ISK . "kr")
+        (INR . "\u20B9")
+        (IDR . "Rp")
+        (IRR . "\ufdfc")
+        (IMP . "\ua3")
+        (ILS . "\u20aa")
+        (JMD . "J$")
+        (JPY . "\ua5")
+        (JEP . "\ua3")
+        (KZT . "\u43b\u432")
+        (KPW . "\u20a9")
+        (KRW . "\u20a9")
+        (KGS . "\u43b\u432")
+        (LAK . "\u20ad")
+        (LVL . "Ls")
+        (LBP . "\ua3")
+        (LRD . "$")
+        (LTL . "Lt")
+        (MKD . "\u434\u435\u43d")
+        (MYR . "RM")
+        (MUR . "\u20a8")
+        (MXN . "$")
+        (MNT . "\u20ae")
+        (MZN . "MT")
+        (NAD . "$")
+        (NPR . "\u20a8")
+        (ANG . "\u192")
+        (NZD . "$")
+        (NIO . "C$")
+        (NGN . "\u20a6")
+        (KPW . "\u20a9")
+        (NOK . "kr")
+        (OMR . "\ufdfc")
+        (PKR . "\u20a8")
+        (PAB . "B/.")
+        (PYG . "Gs")
+        (PEN . "S/.")
+        (PHP . "\u20b1")
+        (PLN . "z\u142")
+        (QAR . "\ufdfc")
+        (RON . "lei")
+        (RUB . "\u440\u443\u431")
+        (SHP . "\ua3")
+        (SAR . "\ufdfc")
+        (RSD . "\u414\u438\u43d.")
+        (SCR . "\u20a8")
+        (SGD . "$")
+        (SBD . "$")
+        (SOS . "S")
+        (ZAR . "R")
+        (KRW . "\u20a9")
+        (LKR . "\u20a8")
+        (SEK . "kr")
+        (CHF . "CHF")
+        (SRD . "$")
+        (SYP . "\ua3")
+        (TWD . "NT$")
+        (THB . "\ue3f")
+        (TTD . "TT$")
+        (TRY . "TL")
+        (TRL . "\u20a4")
+        (TVD . "$")
+        (UAH . "\u20b4")
+        (GBP . "\ua3")
+        (USD . "$")
+        (UYU . "$U")
+        (UZS . "\u43b\u432")
+        (VEF . "Bs")
+        (VND . "\u20ab")
+        (YER . "\ufdfc")
+        (ZWD . "Z$")))
+
+(define known-currency-codes (sort (hash-keys currency-code->sign) string<=? #:key symbol->string))

collects/plot/common/date-time.rkt

@@ -0,0 +1,186 @@
+#lang racket/base
+
+(require racket/date racket/contract racket/match
+         (prefix-in srfi-date: srfi/19)
+         db
+         "contract.rkt"
+         "contract-doc.rkt"
+         "math.rkt"
+         "format.rkt")
+
+(provide (all-defined-out))
+
+(define seconds-per-minute 60)
+(define seconds-per-hour (* 60 seconds-per-minute))
+(define seconds-per-day (* 24 seconds-per-hour))
+(define seconds-per-week (* 7 seconds-per-day))
+(define avg-seconds-per-year (* #e365.2425 seconds-per-day))
+(define avg-seconds-per-month (* 1/12 avg-seconds-per-year))
+
+;; ===================================================================================================
+;; UTC dates for plotting
+
+;; A date is always represented by the number of seconds since the platform-specific, UTC epoch
+
+(define (date*->seconds dt [local-time? #t])
+  (match-define (date* s mn h d m y wd yd dst? tz ns tz-name)
+    dt)
+  (+ (date->seconds (date s mn h d m y wd yd dst? tz) local-time?)
+     (/ ns 1000000000)))
+
+(define (date*->utc-seconds dt)
+  (- (date*->seconds dt #f) (date-time-zone-offset dt)))
+
+(define (date->utc-seconds dt)
+  (- (date->seconds dt #f) (date-time-zone-offset dt)))
+
+(define (utc-seconds-second secs)
+  (define w (floor secs))
+  (define f (- secs w))
+  (+ f (date-second (seconds->date w #f))))
+
+(define (utc-seconds-round-year secs)
+  (define dt (seconds->date secs #f))
+  (define y1 (date-year dt))
+  ;; Find start of this year, start of next year, and difference between them in UTC seconds
+  (define s1 (date->seconds (date 0 0 0 1 1 y1 0 0 #f 0) #f))
+  (define s2 (date->seconds (date 0 0 0 1 1 (+ y1 1) 0 0 #f 0) #f))
+  (define diff (- s2 s1))
+  ;; Round by 1) subtracting this year; 2) rounding to this year or next; 3) adding this year
+  (+ (* (round (/ (- secs s1) diff)) diff) s1))
+
+(define (utc-seconds-round-month secs)
+  (define dt (seconds->date secs #f))
+  (define m1 (date-month dt))
+  (define y1 (date-year dt))
+  ;; Find start of this month, start of next month, and difference between them in UTC seconds
+  (define s1 (date->seconds (date 0 0 0 1 m1 y1 0 0 #f 0) #f))
+  (define-values (m2 y2) (cond [((+ m1 1) . > . 12)  (values 1 (+ y1 1))]
+                               [else                 (values (+ m1 1) y1)]))
+  (define s2 (date->seconds (date 0 0 0 1 m2 y2 0 0 #f 0) #f))
+  (define diff (- s2 s1))
+  ;; Round by 1) subtracting this month; 2) rounding to this month or next; 3) adding this month
+  (+ (* (round (/ (- secs s1) diff)) diff) s1))
+
+;; ===================================================================================================
+;; Time
+
+;; A date-independent representation of time
+
+(define-struct/contract plot-time ([second (and/c (>=/c 0) (</c 60))]
+                                   [minute (integer-in 0 59)]
+                                   [hour (integer-in 0 23)]
+                                   [day exact-integer?]
+                                   ) #:transparent)
+
+(define (seconds->plot-time s)
+  (let* ([s  (inexact->exact s)]
+         [day  (floor (/ s seconds-per-day))]
+         [s  (- s (* day seconds-per-day))]
+         [hour  (floor (/ s seconds-per-hour))]
+         [s  (- s (* hour seconds-per-hour))]
+         [minute  (floor (/ s seconds-per-minute))]
+         [s  (- s (* minute seconds-per-minute))])
+    (plot-time s minute hour day)))
+
+(define (plot-time->seconds t)
+  (match-define (plot-time second minute hour day) t)
+  (+ second
+     (* minute seconds-per-minute)
+     (* hour seconds-per-hour)
+     (* day seconds-per-day)))
+
+(defproc (datetime->real [x (or/c plot-time? date? date*? sql-date? sql-time? sql-timestamp?)]) real?
+  (match x
+    [(? plot-time?)    (plot-time->seconds x)]
+    [(? date*?)        (date*->utc-seconds x)]
+    [(? date?)         (date->utc-seconds x)]
+    [(sql-date y m d)  (date->utc-seconds (date 0 0 0 d m y 0 0 #t 0))]
+    [(sql-time h m s ns tz)  (plot-time->seconds (- (plot-time (+ s (/ ns 1000000000)) m h 0)
+                                                    (if tz tz 0)))]
+    [(sql-timestamp y m d h mn s ns tz)  (date*->utc-seconds
+                                          (date* s mn h d m y 0 0 #t (if tz tz 0) ns "UTC"))]))
+
+;; ===================================================================================================
+;; Formatting following SRFI 19, with alterations
+
+#|
+Supported format specifiers:
+
+~a	locale's abbreviated weekday name (Sun...Sat)
+~A	locale's full weekday name (Sunday...Saturday)
+~b	locale's abbreviate month name (Jan...Dec)
+~B	locale's full month day (January...December)
+~d	day of month, zero padded (01...31)
+~D	date (mm/dd/yy)
+~e	day of month, blank padded ( 1...31)
+~h	same as ~b
+~H	hour, zero padded, 24-hour clock (00...23)
+~I	hour, zero padded, 12-hour clock (01...12)
+~j	day of year, zero padded
+~k	hour, blank padded, 24-hour clock (00...23)
+~l	hour, blank padded, 12-hour clock (01...12)
+~m	month, zero padded (01...12)
+~M	minute, zero padded (00...59)
+~N	nanosecond, zero padded
+~p	locale's AM or PM
+~r	time, 12 hour clock, same as "~I:~M:~S ~p"
+~S	second, zero padded (00...60)
+~f	seconds+fractional seconds, using locale's decimal separator (e.g. 5.2).
+~s	number of full seconds since "the epoch" (in UTC)
+~T	time, 24 hour clock, same as "~H:~M:~S"
+~U	week number of year with Sunday as first day of week (00...53)
+~V	week number of year with Monday as first day of week (01...52)
+~w	day of week (0...6)
+~W	week number of year with Monday as first day of week (01...52)
+~x	week number of year with Monday as first day of week (00...53)
+~X	locale's date representation, for example: "07/31/00"
+~y	last two digits of year (00...99)
+~Y	year
+~1	ISO-8601 year-month-day format
+~3	ISO-8601 hour-minute-second format
+~5	ISO-8601 year-month-day-hour-minute-second format
+|#
+
+(define (plot-date-formatter x-min x-max)
+  (define digits (digits-for-range x-min x-max))
+  (λ (fmt secs)
+    (case fmt
+      [(~f)  (define s (utc-seconds-second secs))
+             (define str (real->string/trunc s (max 0 digits)))
+             (if (s . < . 10) (format "0~a" str) str)]
+      [(~s)  (real->plot-label secs digits)]
+      [(~a ~A ~b ~B ~d ~D ~e ~h ~H ~I ~j ~k ~l ~m ~M ~N
+           ~p ~r ~S ~f ~s ~T ~U ~V ~w ~W ~x ~X ~y ~Y ~1 ~3 ~5)
+       (match-define (date* s mn h d m y _wd _yd _dst? tz ns _tz-name)
+         (seconds->date secs #f))
+       (srfi-date:date->string (srfi-date:make-date ns s mn h d m y tz) (symbol->string fmt))]
+      [else  #f])))
+
+#|
+Supported format specifiers:
+
+~d	day
+~H	hour, zero padded, 24-hour clock (00...23)
+~I	hour, zero padded, 12-hour clock (01...12)
+~k	hour, blank padded, 24-hour clock ( 0...23)
+~l	hour, blank padded, 12-hour clock ( 1...12)
+~p	locale's AM or PM
+~M	minute, zero padded (00...59)
+~S	second, zero padded (00...60)
+~f	seconds+fractional seconds, using locale's decimal separator (e.g. 5.2).
+~s	second, formatted (nanoseconds, etc.)
+~r	time, 12 hour clock, same as "~I:~M:~S ~p"
+~T	time, 24 hour clock, same as "~H:~M:~S"
+~3	ISO-8601 hour-minute-second format
+|#
+
+(define (plot-time-formatter x-min x-max)
+  (define digits (digits-for-range x-min x-max))
+  (λ (fmt secs)
+    (case fmt
+      [(~H ~I ~k ~l ~p ~M ~S ~f ~s ~r ~T ~3)
+       ((plot-date-formatter x-min x-max) fmt (real-modulo secs seconds-per-day))]
+      [(~d)  (define digits (digits-for-range (/ x-min seconds-per-day) (/ x-max seconds-per-day)))
+             (real->plot-label (plot-time-day (seconds->plot-time secs)) digits)]
+      [else  #f])))

collects/plot/common/format.rkt

@@ -4,9 +4,46 @@
 
 (require racket/string racket/list racket/pretty racket/contract racket/match
          "math.rkt"
-         "contract.rkt" "contract-doc.rkt")
+         "contract.rkt"
+         "contract-doc.rkt")
 
-(provide digits-for-range real->plot-label ->plot-label real->string/trunc)
+(provide integer->superscript
+         real->decimal-string* real->string/trunc
+         digits-for-range real->plot-label ->plot-label
+         parse-format-string apply-formatter)
+
+(define (string-map f str)
+  (list->string (map f (string->list str))))
+
+(defproc (integer->superscript [x exact-integer?]) string?
+  (string-map (λ (c) (case c
+                       [(#\0)  #\u2070]
+                       [(#\1)  #\u00b9]
+                       [(#\2)  #\u00b2]
+                       [(#\3)  #\u00b3]
+                       [(#\4)  #\u2074]
+                       [(#\5)  #\u2075]
+                       [(#\6)  #\u2076]
+                       [(#\7)  #\u2077]
+                       [(#\8)  #\u2078]
+                       [(#\9)  #\u2079]
+                       [(#\+)  #\u207a]
+                       [(#\-)  #\u207b]
+                       [else   c]))
+              (number->string x)))
+
+(defproc (real->decimal-string* [x  real?]
+                                [min-digits exact-nonnegative-integer?]
+                                [max-digits exact-nonnegative-integer? min-digits]) string?
+  (when (min-digits . > . max-digits)
+    (error 'real->decimal-string* "expected min-digits <= max-digits; given ~e and ~e"
+           min-digits max-digits))
+  (define str (real->decimal-string x max-digits))
+  (let loop ([i  (string-length str)] [j (- max-digits min-digits)])
+    (cond [(zero? j)  (substring str 0 i)]
+          [(zero? i)  "0"]  ; shouldn't happen, as real->decimal-string guarantees a "0." prefix
+          [(char=? #\0 (string-ref str (- i 1)))  (loop (- i 1) (- j 1))]
+          [else  (substring str 0 i)])))
 
 (define (remove-trailing-zeros str)
   (let loop ([i  (string-length str)])
@@ -19,7 +56,7 @@
 (defproc (digits-for-range [x-min real?] [x-max real?]
                            [extra-digits exact-integer? 3]) exact-integer?
   (define range (abs (- x-max x-min)))
-  (+ extra-digits (if (zero? range) 0 (- (floor-log10 range)))))
+  (+ extra-digits (if (zero? range) 0 (- (floor-log/base 10 range)))))
 
 (define (int-str->e-str str)
   (define n (string-length str))
@@ -27,37 +64,42 @@
         [else
          (define fst (substring str 0 1))
          (define rst (substring str 1 n))
-         (format "~ae~a" (remove-trailing-zeros (format "~a.~a" fst rst)) (sub1 n))]))
+         (format "~a×10~a"
+                 (remove-trailing-zeros (format "~a.~a" fst rst))
+                 (integer->superscript (sub1 n)))]))
 
+#;
 (begin
   (require rackunit)
   (check-equal? (int-str->e-str "") "0")
   (check-equal? (int-str->e-str "0") "0")
-  (check-equal? (int-str->e-str "10") "1e1"))
+  (check-equal? (int-str->e-str "10") "1×10\u00b9"))
 
 (define (frac-str->e-str str)
   (define n (string-length str))
   (let loop ([i 0])
     (cond [(= i n)  "0"]
           [(char=? #\0 (string-ref str i))  (loop (add1 i))]
-          [else
+          [else  (define fst (substring str i (add1 i)))
-           (define fst (substring str i (add1 i)))
+                 (define rst (substring str (add1 i) n))
-           (define rst (substring str (add1 i) n))
+                 (cond [(= 0 (string-length rst))
-           (cond [(= 0 (string-length rst))  (format "~ae~a" fst (- (add1 i)))]
+                        (format "~a×10~a" fst (integer->superscript (- (add1 i))))]
-                 [else  (format "~a.~ae~a" fst rst (- (add1 i)))])])))
+                       [else
+                        (format "~a.~a×10~a" fst rst (integer->superscript (- (add1 i))))])])))
 
+#;
 (begin
   (require rackunit)
   (check-equal? (frac-str->e-str "") "0")
   (check-equal? (frac-str->e-str "0") "0")
   (check-equal? (frac-str->e-str "00") "0")
-  (check-equal? (frac-str->e-str "1") "1e-1")
+  (check-equal? (frac-str->e-str "1") "1×10\u207b\u00b9")
-  (check-equal? (frac-str->e-str "01") "1e-2"))
+  (check-equal? (frac-str->e-str "01") "1×10\u207b\u00b2"))
 
 (define (zero-string n)
   (list->string (build-list n (λ _ #\0))))
 
-(defproc (real->plot-label [x real?] [digits exact-integer?]) any
+(defproc (real->plot-label [x real?] [digits exact-integer?] [scientific? boolean? #t]) any
   (cond
     [(zero? x)  "0"]
     [else
@@ -72,36 +114,43 @@
          (match-let ([(list _ int-str frac-str)
                       (regexp-match #rx"(.*)\\.(.*)" (real->decimal-string y (max 0 digits)))])
            (values int-str (remove-trailing-zeros frac-str))))
-       ;; Get scientific notation for the integer and fractional parts
-       (define int-e-str (int-str->e-str int-str))
-       (define frac-e-str (frac-str->e-str frac-str))
-       ;(printf "int-str = ~v, frac-str = ~v~n" int-str frac-str)
-       ;(printf "int-e-str = ~v, frac-e-str = ~v~n" int-e-str frac-e-str)
        (define int-zero? (string=? int-str "0"))
        (define frac-zero? (string=? frac-str "0"))
-       (define int-e-zero? (string=? int-e-str "0"))
+       (cond
-       (define frac-e-zero? (string=? frac-e-str "0"))
+         [scientific?
-       ;; Build a list of possible output strings
+          ;; Get scientific notation for the integer and fractional parts
-       (define strs
+          (define int-e-str (int-str->e-str int-str))
-         (list (cond [(and int-zero? frac-zero?)  "0"]
+          (define frac-e-str (frac-str->e-str frac-str))
-                     [int-zero?   (format "~a.~a" front-sign frac-str)]
+          ;(printf "int-str = ~v, frac-str = ~v~n" int-str frac-str)
-                     [frac-zero?  (format "~a~a" front-sign int-str)]
+          ;(printf "int-e-str = ~v, frac-e-str = ~v~n" int-e-str frac-e-str)
-                     [else        (format "~a~a.~a" front-sign int-str frac-str)])
+          (define int-e-zero? (string=? int-e-str "0"))
-               (cond [(and int-e-zero? frac-zero?)  "0"]
+          (define frac-e-zero? (string=? frac-e-str "0"))
-                     [int-e-zero?  (format "~a.~a" front-sign frac-str)]
+          ;; Build a list of possible output strings
-                     [frac-zero?   (format "~a~a" front-sign int-e-str)]
+          (define strs
-                     [else         (format "~a(~a)~a.~a" front-sign int-e-str mid-sign frac-str)])
+            (list (cond [(and int-zero? frac-zero?)  "0"]
-               (cond [(and int-zero? frac-e-zero?)  "0"]
+                        [int-zero?   (format "~a.~a" front-sign frac-str)]
-                     [int-zero?     (format "~a~a" front-sign frac-e-str)]
+                        [frac-zero?  (format "~a~a" front-sign int-str)]
-                     [frac-e-zero?  (format "~a~a" front-sign int-str)]
+                        [else        (format "~a~a.~a" front-sign int-str frac-str)])
-                     [else          (format "~a~a~a(~a)" front-sign int-str mid-sign frac-e-str)])
+                  (cond [(and int-e-zero? frac-zero?)  "0"]
-               (cond [(and int-e-zero? frac-e-zero?)  "0"]
+                        [int-e-zero?  (format "~a.~a" front-sign frac-str)]
-                     [int-e-zero?   (format "~a~a" front-sign frac-e-str)]
+                        [frac-zero?   (format "~a~a" front-sign int-e-str)]
-                     [frac-e-zero?  (format "~a~a" front-sign int-e-str)]
+                        [else         (format "~a(~a)~a.~a" front-sign int-e-str mid-sign frac-str)])
-                     [else
+                  (cond [(and int-zero? frac-e-zero?)  "0"]
-                      (format "~a(~a)~a(~a)" front-sign int-e-str mid-sign frac-e-str)])))
+                        [int-zero?     (format "~a~a" front-sign frac-e-str)]
-       ;; Return the shortest possible output string
+                        [frac-e-zero?  (format "~a~a" front-sign int-str)]
-       (argmin string-length strs))]))
+                        [else          (format "~a~a~a(~a)" front-sign int-str mid-sign frac-e-str)])
+                  (cond [(and int-e-zero? frac-e-zero?)  "0"]
+                        [int-e-zero?   (format "~a~a" front-sign frac-e-str)]
+                        [frac-e-zero?  (format "~a~a" front-sign int-e-str)]
+                        [else
+                         (format "~a(~a)~a(~a)" front-sign int-e-str mid-sign frac-e-str)])))
+          ;; Return the shortest possible output string
+          (argmin string-length strs)]
+         [else
+          (cond [(and int-zero? frac-zero?)  "0"]
+                [int-zero?   (format "~a.~a" front-sign frac-str)]
+                [frac-zero?  (format "~a~a" front-sign int-str)]
+                [else        (format "~a~a.~a" front-sign int-str frac-str)])]))]))
 
 (defproc (->plot-label [a any/c] [digits exact-integer? 7]) string?
   (let loop ([a a])
@@ -117,3 +166,24 @@
 ;; Like real->decimal-string, but removes trailing zeros
 (defproc (real->string/trunc [x real?] [e exact-integer?]) string?
   (remove-trailing-zeros (real->decimal-string x (max 0 e))))
+
+;; ===================================================================================================
+;; Format strings
+
+(defproc (parse-format-string [str string?]) (listof (or/c string? symbol?))
+  (define n (string-length str))
+  (let loop ([i 0] [fmt-list  empty])
+    (cond [(i . >= . n)  (reverse fmt-list)]
+          [(i . = . (- n 1))  (reverse (cons (substring str i (+ i 1)) fmt-list))]
+          [(char=? #\~ (string-ref str i))
+           (loop (+ i 2) (cons (string->symbol (substring str i (+ i 2))) fmt-list))]
+          [else  (loop (+ i 1) (cons (substring str i (+ i 1)) fmt-list))])))
+
+(define (apply-formatter [formatter (symbol? . -> . (or/c string? #f))]
+                         [fmt-list (listof (or/c string? symbol?))]
+                         [d any/c]) (listof string?)
+  (for/list ([fmt  (in-list fmt-list)])
+    (cond [(eq? fmt '~~)  "~"]
+          [(symbol? fmt)  (let ([val  (formatter fmt d)])
+                            (if val val (symbol->string fmt)))]
+          [(string? fmt)  fmt])))

collects/plot/common/legend.rkt

@@ -20,17 +20,14 @@
                         (send plot-area set-alpha 1)
                         (send plot-area draw-line (vector x-min y) (vector x-max y)))))
 
-(define (line-legend-entries label zs colors widths styles)
+(define (line-legend-entries label zs z-labels colors widths styles)
-  (define z-min (first zs))
-  (define z-max (last zs))
-  (define digits (digits-for-range z-min z-max))
   (define hash
-    (for/fold ([hash  empty]) ([z      (in-list zs)]
+    (for/fold ([hash  empty]) ([z        (in-list zs)]
-                               [color  (in-cycle (maybe-apply/list colors zs))]
+                               [z-label  (in-list z-labels)]
-                               [width  (in-cycle (maybe-apply/list widths zs))]
+                               [color    (in-cycle (maybe-apply/list colors zs))]
-                               [style  (in-cycle (maybe-apply/list styles zs))])
+                               [width    (in-cycle (maybe-apply/list widths zs))]
-      (define entry-label (real->plot-label z digits))
+                               [style    (in-cycle (maybe-apply/list styles zs))])
-      (assoc-cons hash (list color width style) entry-label)))
+      (assoc-cons hash (list color width style) z-label)))
   
   (reverse
    (for/list ([entry  (in-list hash)])
@@ -92,15 +89,15 @@
                         (send plot-area set-pen line2-color line2-width line2-style)
                         (send plot-area draw-line (vector x-min y-min) (vector x-max y-min)))))
 
-(define (interval-legend-entries label zs fill-colors fill-styles line-colors line-widths line-styles
+(define (interval-legend-entries label zs labels fill-colors fill-styles
+                                 line-colors line-widths line-styles
                                  line1-colors line1-widths line1-styles
                                  line2-colors line2-widths line2-styles)
-  (define z-min (first zs))
-  (define z-max (last zs))
-  (define digits (digits-for-range z-min z-max))
   (define hash
     (for/fold ([hash  empty]) ([za           (in-list zs)]
                                [zb           (in-list (rest zs))]
+                               [la           (in-list labels)]
+                               [lb           (in-list (rest labels))]
                                [fill-color   (in-cycle (maybe-apply/list fill-colors zs))]
                                [fill-style   (in-cycle (maybe-apply/list fill-styles zs))]
                                [line-color   (in-cycle (maybe-apply/list line-colors zs))]
@@ -112,8 +109,7 @@
                                [line2-color  (in-cycle (maybe-apply/list line2-colors zs))]
                                [line2-width  (in-cycle (maybe-apply/list line2-widths zs))]
                                [line2-style  (in-cycle (maybe-apply/list line2-styles zs))])
-      (define entry-label
+      (define entry-label (format "[~a,~a]" la lb))
-        (format "[~a,~a]" (real->plot-label za digits) (real->plot-label zb digits)))
       (assoc-cons hash
                   (list fill-color fill-style line-color line-width line-style
                         line1-color line1-width line1-style
@@ -132,22 +128,21 @@
                             line1-color line1-width line1-style
                             line2-color line2-width line2-style))))
 
-(define (contour-intervals-legend-entries label z-min z-max zs
+(define (contour-intervals-legend-entries label zs labels
                                           fill-colors fill-styles line-colors line-widths line-styles
                                           contour-colors contour-widths contour-styles)
-  (define interval-zs (append (list z-min) zs (list z-max)))
+  (define n (- (length zs) 2))
-  
   (define ccs (append (list 0)
-                      (sequence-take (in-cycle (maybe-apply/list contour-colors zs)) 0 (length zs))
+                      (sequence-take (in-cycle (maybe-apply/list contour-colors zs)) 0 n)
                       (list 0)))
   (define cws (append (list 0)
-                      (sequence-take (in-cycle (maybe-apply/list contour-widths zs)) 0 (length zs))
+                      (sequence-take (in-cycle (maybe-apply/list contour-widths zs)) 0 n)
                       (list 0)))
   (define css (append '(transparent)
-                      (sequence-take (in-cycle (maybe-apply/list contour-styles zs)) 0 (length zs))
+                      (sequence-take (in-cycle (maybe-apply/list contour-styles zs)) 0 n)
                       '(transparent)))
   
-  (interval-legend-entries label interval-zs
+  (interval-legend-entries label zs labels
                            fill-colors fill-styles line-colors line-widths line-styles
                            ccs cws css (rest ccs) (rest cws) (rest css)))
 

collects/plot/common/math.rkt

@@ -126,11 +126,17 @@
     (if x (if y (max* x y) x)
         (if y y #f))))
 
-(define (floor-log10 x)
+(defproc (floor-log/base [b (and/c exact-integer? (>=/c 2))] [x (>/c 0)]) real?
-  (inexact->exact (floor (/ (log (abs x)) (log 10)))))
+  (define y (inexact->exact (floor (/ (log x) (log b)))))
+  (cond [(exact? x)
+         (let loop ([y y] [x  (/ x (expt b y))])
+           (cond [(x . >= . b)  (loop (add1 y) (/ x b))]
+                 [(x . < . 1)   (loop (sub1 y) (* x b))]
+                 [else  y]))]
+        [else  y]))
 
-(define (ceiling-log10 x)
+(define (ceiling-log/base b x)
-  (inexact->exact (ceiling (/ (log (abs x)) (log 10)))))
+  (inexact->exact (ceiling (/ (log (abs x)) (log b)))))
 
 (define (bin-samples bin-bounds xs)
   (let* ([bin-bounds  (filter (compose not nan?) (remove-duplicates bin-bounds))]

collects/plot/common/parameters.rkt

@@ -5,7 +5,8 @@
 (require racket/contract
          "contract.rkt" "contract-doc.rkt"
          "draw.rkt"
-         "axis-transform.rkt")
+         "axis-transform.rkt"
+         "ticks.rkt")
 
 (provide (all-defined-out))
 
@@ -50,6 +51,31 @@
   (cond [(plot-animating?)  (max 2 (ceiling (* 1/4 samples)))]
         [else  samples]))
 
+;; Sampling
+
+(defparam plot-x-transform axis-transform/c id-transform)
+(defparam plot-y-transform axis-transform/c id-transform)
+(defparam plot-z-transform axis-transform/c id-transform)
+
+;; Ticks
+
+(defparam plot-x-max-ticks exact-positive-integer? 5)
+(defparam plot-y-max-ticks exact-positive-integer? 5)
+(defparam plot-z-max-ticks exact-positive-integer? 8)
+
+(defparam plot-x-ticks ticks? (linear-ticks))
+(defparam plot-y-ticks ticks? (linear-ticks))
+(defparam plot-z-ticks ticks? (linear-ticks))
+
+(defproc (default-x-ticks [x-min real?] [x-max real?]) (listof tick?)
+  ((plot-x-ticks) x-min x-max (plot-x-max-ticks) (plot-x-transform)))
+
+(defproc (default-y-ticks [y-min real?] [y-max real?]) (listof tick?)
+  ((plot-y-ticks) y-min y-max (plot-y-max-ticks) (plot-y-transform)))
+
+(defproc (default-z-ticks [z-min real?] [z-max real?]) (listof tick?)
+  ((plot-z-ticks) z-min z-max (plot-z-max-ticks) (plot-z-transform)))
+
 ;; Lines
 
 (defparam line-samples (and/c exact-integer? (>=/c 2)) 500)
@@ -134,18 +160,13 @@
 
 (defparam polar-axes-number exact-positive-integer? 12)
 (defparam polar-axes-ticks? boolean? #t)
+(defparam polar-axes-max-ticks exact-positive-integer? 8)
 
 (defparam label-anchor anchor/c 'left)
 (defparam label-angle real? 0)
 (defparam label-alpha (real-in 0 1) 1)
 (defparam label-point-size (>=/c 0) 4)
 
-;; Sampling
-
-(defparam plot-x-transform (real? real? . -> . invertible-function?) id-transform)
-(defparam plot-y-transform (real? real? . -> . invertible-function?) id-transform)
-(defparam plot-z-transform (real? real? . -> . invertible-function?) id-transform)
-
 ;; ===================================================================================================
 ;; 3D-specific parameters
 

collects/plot/common/sample.rkt

@@ -3,11 +3,14 @@
 ;; Functions that sample from functions, and functions that create memoized samplers.
 
 (require racket/match racket/flonum racket/math racket/contract racket/list
-         "contract.rkt" "contract-doc.rkt"
+         "contract.rkt"
+         "contract-doc.rkt"
          "math.rkt"
          "axis-transform.rkt"
          "parameters.rkt"
-         "contract.rkt")
+         "contract.rkt"
+         "format.rkt"
+         "ticks.rkt")
 
 (provide (all-defined-out))
 
@@ -23,10 +26,10 @@
     [_  (map f xs)]))
 
 (defproc (nonlinear-seq [start real?] [end real?] [num exact-nonnegative-integer?]
-                        [transform (real? real? . -> . invertible-function?)]
+                        [transform axis-transform/c]
                         [#:start? start? boolean? #t]
                         [#:end? end? boolean? #t]) (listof real?)
-  (match-define (invertible-function _ finv) (transform start end))
+  (match-define (invertible-function _ finv) (apply-transform transform start end))
   (map finv (linear-seq start end num #:start? start? #:end? end?)))
 
 (define ((2d-polar->3d-function f) x y z)
@@ -103,3 +106,50 @@
               [ds   (in-vector dss)]
               [d    (in-vector ds)])
     d))
+
+;; ===================================================================================================
+;; Common memoized samplers
+
+(define function->sampler (make-function->sampler plot-x-transform))
+(define inverse->sampler (make-function->sampler plot-y-transform))
+(define 2d-function->sampler (make-2d-function->sampler plot-x-transform plot-y-transform))
+(define 3d-function->sampler
+  (make-3d-function->sampler plot-x-transform plot-y-transform plot-z-transform))
+
+;; ===================================================================================================
+;; Contour ticks
+
+(defproc (contour-ticks [z-min real?] [z-max real?]
+                        [levels (or/c 'auto exact-positive-integer? (listof real?))]
+                        [intervals? boolean?]) (listof tick?)
+  (define epsilon (expt 10 (- (digits-for-range z-min z-max))))
+  (match-define (ticks layout format) (plot-z-ticks))
+  (define ts
+    (cond [(eq? levels 'auto)  (filter pre-tick-major?
+                                       (layout z-min z-max (plot-z-max-ticks) (plot-z-transform)))]
+          [else  (define zs (cond [(list? levels)  (filter (λ (z) (<= z-min z z-max)) levels)]
+                                  [else  (linear-seq z-min z-max levels #:start? #f #:end? #f)]))
+                 (map (λ (z) (pre-tick z #t)) zs)]))
+  (define all-ts
+    (cond [intervals?
+           (let* ([ts  (cond [((abs (- z-min (pre-tick-value (first ts)))) . < . epsilon)  ts]
+                             [else  (cons (pre-tick z-min #t) ts)])]
+                  [ts  (cond [((abs (- z-max (pre-tick-value (last ts)))) . < . epsilon)  ts]
+                             [else  (append ts (list (pre-tick z-max #t)))])])
+             ts)]
+          [else
+           (let* ([ts  (cond [((abs (- z-min (pre-tick-value (first ts)))) . >= . epsilon)  ts]
+                             [else  (rest ts)])]
+                  [ts  (cond [((abs (- z-max (pre-tick-value (last ts)))) . >= . epsilon)  ts]
+                             [else  (take ts (- (length ts) 1))])])
+             ts)]))
+  (match-define (list (pre-tick zs majors) ...) all-ts)
+  (define labels (format z-min z-max all-ts))
+  (map tick zs majors labels))
+
+(defproc (auto-contour-values [z-min real?] [z-max real?]) (listof real?)
+  (define ts (default-z-ticks z-min z-max))
+  (let* ([zs  (map pre-tick-value (filter pre-tick-major? ts))]
+         [zs  (if (= (first zs) z-min) (rest zs) zs)]
+         [zs  (if (= (last zs) z-max) (take zs (sub1 (length zs))) zs)])
+    zs))

collects/plot/common/ticks.rkt

@@ -2,50 +2,620 @@
 
 ;; Data structure that represents a tick, and functions that produce ticks.
 
-(require racket/string racket/list racket/contract racket/pretty
+(require racket/string racket/list racket/contract racket/pretty racket/match
          "math.rkt"
          "format.rkt"
          "utils.rkt"
-         "contract.rkt" "contract-doc.rkt"
+         "contract.rkt"
-         "parameters.rkt")
+         "contract-doc.rkt"
+         "date-time.rkt"
+         "axis-transform.rkt"
+         "currency.rkt")
 
-(provide (all-defined-out))
+(provide (struct-out pre-tick) (struct-out tick) (struct-out ticks)
+         ;; No ticks
+         no-ticks-layout no-ticks-format no-ticks
+         ;; Linear ticks
+         linear-ticks-base linear-ticks-divisors
+         linear-ticks-layout linear-ticks-format linear-ticks
+         ;; Uniform ticks
+         uniform-ticks-layout uniform-ticks
+         ;; Log-scale ticks
+         log-ticks-base
+         log-ticks-layout log-ticks-format log-ticks
+         ;; Date ticks
+         date-ticks-formats 24h-descending-date-ticks-formats 12h-descending-date-ticks-formats
+         date-ticks-layout date-ticks-format date-ticks
+         ;; Time ticks
+         time-ticks-formats descending-time-ticks-formats
+         time-ticks-layout time-ticks-format time-ticks
+         ;; Bit/byte ticks
+         bit/byte-ticks-format bit/byte-ticks
+         ;; Currency ticks and formats
+         currency-scale-suffixes
+         us-currency-scale-suffixes uk-currency-scale-suffixes eu-currency-scale-suffixes
+         currency-format-strings
+         us-currency-format-strings uk-currency-format-strings eu-currency-format-strings
+         currency-ticks-format currency-ticks
+         ;; Fractions
+         fraction-ticks-format fraction-ticks
+         )
 
-(define-struct/contract tick
+(define-struct/contract pre-tick ([value real?] [major? boolean?]) #:transparent)
-  ([p real?] [label string?] [major? boolean?])
+(define-struct/contract (tick pre-tick) ([label string?]) #:transparent)
-  #:transparent)
 
-(define (tick-ps->majors ps major-skip)
+(defcontract ticks-layout/c
-  (define zero-idx (list-index 0 ps =))
+  (real? real? exact-positive-integer? axis-transform/c . -> . (listof pre-tick?)))
-  (define zero-idx-rem (if (zero-idx . < . 0) 0 (remainder zero-idx major-skip)))
-  (for/list ([n  (in-range (length ps))])
-    (= (remainder n major-skip) zero-idx-rem)))
 
-(define (linear-ticks major-skip x-min x-max)
+(defcontract ticks-format/c
-  (when (x-min . >= . x-max)
+  (real? real? (listof pre-tick?) . -> . (listof string?)))
-    (error 'default-range->ticks "expected x-min < x-max; got x-min = ~e and x-max = ~e" x-min x-max))
-  (let ([x-min  (inexact->exact x-min)]
-        [x-max  (inexact->exact x-max)])
-    (define e (floor-log10 (- x-max x-min)))
-    (define mag (expt 10 e))
-    (define step (let ([y  (/ (- x-max x-min) mag)])
-                   (cond [(y . < . 2)  (* 1/5 mag)]
-                         [(y . < . 5)  (* 1/2 mag)]
-                         [else         mag])))
-    (define start (* (ceiling (/ x-min step)) step))
-    (define stop (* (floor (/ x-max step)) step))
-    (define num (+ 1 (round (/ (- stop start) step))))
-    (define ps (linear-seq start stop num))
-    (define digits (digits-for-range x-min x-max))
-    (define labels (map (λ (p) (real->plot-label p digits)) ps))
-    (define majors (tick-ps->majors ps major-skip))
-    (map tick ps labels majors)))
 
-(defproc (default-ticks-fun [x-min real?] [x-max real?]) (listof tick?)
+(define-struct/contract ticks ([layout ticks-layout/c] [format ticks-format/c]) #:transparent
-  (linear-ticks 2 x-min x-max))
+  #:property prop:procedure
+  (λ (t x-min x-max max-ticks transform)
+    (match-define (ticks layout format) t)
+    (define ts (layout x-min x-max max-ticks transform))
+    (match-define (list (pre-tick xs majors) ...) ts)
+    (map tick xs majors (format x-min x-max ts))))
 
-(defproc (auto-contour-zs [z-min real?] [z-max real?]) (listof real?)
+;; ===================================================================================================
-  (let* ([zs  (map tick-p (default-ticks-fun z-min z-max))]
+;; Helpers
-         [zs  (if (= (first zs) z-min) (rest zs) zs)]
+
-         [zs  (if (= (last zs) z-max) (take zs (sub1 (length zs))) zs)])
+(define-syntax-rule (with-exact-bounds x-min x-max body ...)
-    zs))
+  (cond [(x-min . >= . x-max)
+         (error 'bounds-check "expected min < max; given min = ~e and max = ~e" x-min x-max)]
+        [else  (let ([x-min  (inexact->exact x-min)]
+                     [x-max  (inexact->exact x-max)])
+                 body ...)]))
+
+(define (linear-seq-args x-min x-max step)
+  (define start (* (ceiling (/ x-min step)) step))
+  (define end (* (floor (/ x-max step)) step))
+  (define num (+ 1 (inexact->exact (round (/ (- end start) step)))))
+  (values start end num))
+
+(define (linear-major-values/step x-min x-max step)
+  (define-values (start end num) (linear-seq-args x-min x-max step))
+  (linear-seq start end num))
+
+(defproc (linear-minor-values/step [major-xs (listof real?)] [major-step real?]
+                                   [minor-ticks exact-nonnegative-integer?]) (listof real?)
+  (cond [(or (zero? minor-ticks) (empty? major-xs))  empty]
+        [else
+         (define major-start (first major-xs))
+         (define minor-step (/ major-step (+ minor-ticks 1)))
+         (for*/list ([x  (in-list (cons (- major-start major-step) major-xs))]
+                     [i  (in-range 1 (+ minor-ticks 1))])
+           (+ x (* i minor-step)))]))
+
+(defproc (tick-values->pre-ticks [major-xs (listof real?)] [minor-xs (listof real?)]
+                                 ) (listof pre-tick?)
+  (define major-ts (map (λ (x) (pre-tick x #t)) major-xs))
+  (define minor-ts (map (λ (x) (pre-tick x #f)) minor-xs))
+  (sort (append major-ts minor-ts) < #:key pre-tick-value))
+
+;; ===================================================================================================
+;; No ticks
+
+(defthing no-ticks-layout ticks-layout/c
+  (λ (x-min x-max max-ticks transform)
+    empty))
+
+(defthing no-ticks-format ticks-format/c
+  (λ (x-min x-max ts)
+    empty))
+
+(defthing no-ticks ticks?
+  (ticks no-ticks-layout no-ticks-format))
+
+;; ===================================================================================================
+;; Linear ticks (default tick function, evenly spaced)
+
+(defparam linear-ticks-base (and/c exact-integer? (>=/c 2)) 10)
+(defparam linear-ticks-divisors (listof exact-positive-integer?) '(1 2 5))
+
+(defproc (linear-tick-step+divisor [x-min real?] [x-max real?]
+                                   [max-ticks exact-positive-integer?]
+                                   [base (and/c exact-integer? (>=/c 2))]
+                                   [divisors (listof exact-positive-integer?)]
+                                   ) (values real? exact-positive-integer?)
+  (define range (- x-max x-min))
+  (define mag (expt base (floor-log/base base range)))
+  (define ds (sort divisors >))
+  (let/ec break
+    (for* ([e  (in-range (floor-log/base base max-ticks) -2 -1)]
+           [d  (in-list ds)])
+      ;(printf "new-d = ~v~n" (* d (expt base e)))
+      (define step (/ mag d (expt base e)))
+      (define-values (_start _end num) (linear-seq-args x-min x-max step))
+      (when (num . <= . max-ticks)
+        (break step d)))
+    ;(printf "default!~n")
+    (values (/ range max-ticks) max-ticks)))
+
+(defproc (linear-tick-values [x-min real?] [x-max real?]
+                             [max-ticks exact-positive-integer?]
+                             [base (and/c exact-integer? (>=/c 2))]
+                             [divisors (listof exact-positive-integer?)]
+                             ) (values (listof real?) (listof real?))
+  (with-exact-bounds
+   x-min x-max
+   (define-values (step d) (linear-tick-step+divisor x-min x-max max-ticks base divisors))
+   (define major-xs (linear-major-values/step x-min x-max step))
+   (define major-ticks (length major-xs))
+   
+   (define ns (filter (λ (n) (zero? (remainder (* n d) base))) divisors))
+   (define n
+     (cond [(empty? ns)  1]
+           [else  (argmin (λ (n) (abs (- (* n major-ticks) max-ticks))) (sort ns <))]))
+   (define minor-xs (linear-minor-values/step major-xs step (- n 1)))
+   (values major-xs (filter (λ (x) (<= x-min x x-max)) minor-xs))))
+
+(defproc (linear-ticks-layout [#:base base (and/c exact-integer? (>=/c 2)) (linear-ticks-base)]
+                              [#:divisors divisors (listof exact-positive-integer?)
+                                          (linear-ticks-divisors)]
+                              ) ticks-layout/c
+  (λ (x-min x-max max-ticks transform)
+    (define-values (major-xs minor-xs) (linear-tick-values x-min x-max max-ticks base divisors))
+    (tick-values->pre-ticks major-xs minor-xs)))
+
+(defproc (linear-ticks-format) ticks-format/c
+  (λ (x-min x-max ts)
+    (with-exact-bounds
+     x-min x-max
+     (define digits (digits-for-range x-min x-max))
+     (for/list ([t  (in-list ts)])
+       (real->plot-label (pre-tick-value t) digits)))))
+
+(defproc (linear-ticks [#:base base (and/c exact-integer? (>=/c 2)) (linear-ticks-base)]
+                       [#:divisors divisors (listof exact-positive-integer?) (linear-ticks-divisors)]
+                       ) ticks?
+  (ticks (linear-ticks-layout #:base base #:divisors divisors)
+         (linear-ticks-format)))
+
+;; ===================================================================================================
+;; Uniform spacing ticks
+
+(defproc (uniform-ticks-layout [#:layout layout ticks-layout/c (linear-ticks-layout)]) ticks-layout/c
+  (λ (x-min x-max max-ticks transform)
+    (define ts (layout x-min x-max max-ticks transform))
+    (define xs (map pre-tick-value ts))
+    (define majors (map pre-tick-major? ts))
+    (define new-xs (map (invertible-function-finv (apply-transform transform x-min x-max)) xs))
+    (map pre-tick new-xs majors)))
+
+(defproc (uniform-ticks [#:layout layout ticks-layout/c (linear-ticks-layout)]) ticks?
+  (ticks (uniform-ticks-layout #:layout layout)
+         (linear-ticks-format)))
+
+;; ===================================================================================================
+;; Exponential ticks (use for log scale)
+
+(defparam log-ticks-base (and/c exact-integer? (>=/c 2)) 10)
+
+(defproc (log-ticks-layout [#:base base (and/c exact-integer? (>=/c 2)) (log-ticks-base)]
+                           ) ticks-layout/c
+  (λ (x-min x-max max-ticks transform)
+    (with-exact-bounds
+     x-min x-max
+     (when ((exact->inexact x-min) . <= . 0)
+       (raise-type-error 'log-ticks-layout "positive real" 0 x-min x-max))
+     (define log-start (floor-log/base base x-min))
+     (define log-end (ceiling-log/base base x-max))
+     (define log-xs (for/list ([i  (in-range log-start (add1 log-end))]) i))
+     (define skip (max 1 (floor (/ (+ (length log-xs) 2) 5))))
+     (filter (λ (t) (<= x-min (pre-tick-value t) x-max))
+             (append*
+              (for/list ([log-x  (in-list log-xs)]
+                         [m      (in-cycle (in-range skip))])
+                (define x (expt base log-x))
+                (cond [(= skip 1)  (for/list ([i  (in-range 0 (sub1 base) skip)])
+                                     (pre-tick (+ x (* i x))
+                                               (and (zero? i) (zero? m))))]
+                      [else  (list (cond [(zero? m)  (pre-tick x #t)]
+                                         [else  (pre-tick x #f)]))])))))))
+
+(defproc (log-ticks-format [#:base base (and/c exact-integer? (>=/c 2)) (log-ticks-base)]
+                           ) ticks-format/c
+  (define base-str (number->string base))
+  (λ (x-min x-max ts)
+    (with-exact-bounds
+     x-min x-max
+     (define epsilon (expt 10 (- (digits-for-range x-min x-max))))
+     (define base-digits (digits-for-range 0 base))
+     (for/list ([t  (in-list ts)])
+       (define x (pre-tick-value t))
+       (define log-x (floor-log/base base x))
+       (define round? ((abs (- x (expt base log-x))) . < . epsilon))
+       (define major-str (format "~a~a" base-str (integer->superscript log-x)))
+       (cond [round?  major-str]
+             [else    (format "~a×~a"
+                              (real->plot-label (/ x (expt base log-x)) base-digits)
+                              major-str)])))))
+
+(defproc (log-ticks [#:base base (and/c exact-integer? (>=/c 2)) (log-ticks-base)]) ticks?
+  (ticks (log-ticks-layout #:base base)
+         (log-ticks-format #:base base)))
+
+;; ===================================================================================================
+;; Date/time helpers
+
+(defproc (find-linear-tick-step [x-min real?] [x-max real?] [max-ticks exact-positive-integer?]
+                                [steps (listof real?)]) real?
+  (with-exact-bounds
+   x-min x-max
+   (let/ec break
+     (for ([step  (in-list (sort steps <))])
+       (define-values (_start _end num) (linear-seq-args x-min x-max step))
+       (when (num . <= . max-ticks)
+         (break step)))
+     #f)))
+
+(define (count-unchanging-fields formatter fmt-list xs)
+  (let ([fmt-list  (filter symbol? fmt-list)])
+    (define formatted-dates (for/list ([x  (in-list xs)])
+                              (apply-formatter formatter fmt-list x)))
+    (count equal?* (transpose formatted-dates))))
+
+(define (choose-format-list formatter fmt-lists xs)
+  (let ([fmt-lists  (sort fmt-lists >
+                          #:key (λ (fmt-list) (count symbol? fmt-list))
+                          #:cache-keys? #t)])
+    (argmin (λ (fmt-list) (count-unchanging-fields formatter fmt-list xs))
+            fmt-lists)))
+
+;; ===================================================================================================
+;; Date ticks
+
+(define 12h-descending-date-ticks-formats
+  '("~Y-~m-~d ~I:~M:~f~p"
+    "~Y-~m-~d ~I:~M~p"
+    "~Y-~m-~d ~I~p"
+    "~Y-~m-~d"
+    "~Y-~m"
+    "~Y"
+    
+    "~m-~d ~I:~M:~f~p"
+    "~m-~d ~I:~M~p"
+    "~m-~d ~I~p"
+    "~m-~d"
+    
+    "~I:~M:~f~p"
+    "~I:~M~p"
+    
+    "~M:~fs"
+    
+    "~fs"))
+
+(define 24h-descending-date-ticks-formats
+  '("~Y-~m-~d ~H:~M:~f"
+    "~Y-~m-~d ~H:~M"
+    "~Y-~m-~d ~Hh"
+    "~Y-~m-~d"
+    "~Y-~m"
+    "~Y"
+    
+    "~m-~d ~H:~M:~f"
+    "~m-~d ~H:~M"
+    "~m-~d ~Hh"
+    "~m-~d"
+    
+    "~H:~M:~f"
+    "~H:~M"
+    
+    "~M:~fs"
+    
+    "~fs"))
+
+(defparam date-ticks-formats (listof string?) 24h-descending-date-ticks-formats)
+
+;; Tick steps to try, in seconds
+(define date-steps
+  (list 1 2 5 10 15 20 30 40 45
+        seconds-per-minute
+        (* 2 seconds-per-minute)
+        (* 5 seconds-per-minute)
+        (* 10 seconds-per-minute)
+        (* 15 seconds-per-minute)
+        (* 20 seconds-per-minute)
+        (* 30 seconds-per-minute)
+        seconds-per-hour
+        (* 2 seconds-per-hour)
+        (* 3 seconds-per-hour)
+        (* 4 seconds-per-hour)
+        (* 6 seconds-per-hour)
+        (* 8 seconds-per-hour)
+        (* 12 seconds-per-hour)
+        seconds-per-day
+        (* 2 seconds-per-day)
+        (* 5 seconds-per-day)
+        (* 10 seconds-per-day)
+        seconds-per-week
+        (* 2 seconds-per-week)
+        avg-seconds-per-month
+        (* 2 avg-seconds-per-month)
+        (* 3 avg-seconds-per-month)
+        (* 4 avg-seconds-per-month)
+        (* 6 avg-seconds-per-month)
+        (* 8 avg-seconds-per-month)
+        (* 9 avg-seconds-per-month)
+        avg-seconds-per-year
+        (* 2 avg-seconds-per-year)
+        (* 5 avg-seconds-per-year)))
+
+(define (date-tick-values x-min x-max max-ticks)
+  (with-exact-bounds
+   x-min x-max
+   (define range (- x-max x-min))
+   (define step
+     (cond [(range . < . (* max-ticks (first date-steps)))
+            (define-values (step _)
+              (linear-tick-step+divisor x-min x-max max-ticks 10 '(1 2 5)))
+            step]
+           [(range . > . (* max-ticks (last date-steps)))
+            (define-values (step _)
+              (linear-tick-step+divisor (/ x-min avg-seconds-per-year)
+                                        (/ x-max avg-seconds-per-year)
+                                        max-ticks 10 '(1 2 5)))
+            (* step avg-seconds-per-year)]
+           [else  (find-linear-tick-step x-min x-max max-ticks date-steps)]))
+   (define date-round
+     (cond [(step . >= . avg-seconds-per-year)   utc-seconds-round-year]
+           [(step . >= . avg-seconds-per-month)  utc-seconds-round-month]
+           [else  (λ (d) d)]))
+   (define major-xs (linear-major-values/step x-min x-max step))
+   (values (map date-round major-xs) empty)))
+
+(defproc (date-ticks-layout) ticks-layout/c
+  (λ (x-min x-max max-ticks transform)
+    (define-values (major-xs minor-xs) (date-tick-values x-min x-max max-ticks))
+    (tick-values->pre-ticks major-xs minor-xs)))
+
+(defproc (date-ticks-format [#:formats formats (listof string?) (date-ticks-formats)]) ticks-format/c
+  (define fmt-lists (map parse-format-string formats))
+  (λ (x-min x-max ts)
+    (with-exact-bounds
+     x-min x-max
+     (define formatter (plot-date-formatter x-min x-max))
+     (define xs (map pre-tick-value ts))
+     (define fmt-list (choose-format-list formatter fmt-lists xs))
+     (for/list ([x  (in-list xs)])
+       (string-append* (apply-formatter formatter fmt-list x))))))
+
+(defproc (date-ticks [#:formats formats (listof string?) (date-ticks-formats)]) ticks?
+  (ticks (date-ticks-layout)
+         (date-ticks-format #:formats formats)))
+
+;; ===================================================================================================
+;; Time ticks
+
+(define descending-time-ticks-formats
+  '("~dd ~H:~M:~f"
+    "~dd ~H:~M"
+    "~dd ~Hh"
+    "~dd"
+    
+    "~H:~M:~f"
+    "~H:~M"
+    "~Hh"
+    
+    "~M:~f"
+    "~Mm"
+    
+    "~ss"))
+
+(defparam time-ticks-formats (listof string?) descending-time-ticks-formats)
+
+;; Tick steps to try, in seconds
+(define time-steps
+  (list 1 2 5 10 15 20 30 40 45
+        seconds-per-minute
+        (* 2 seconds-per-minute)
+        (* 5 seconds-per-minute)
+        (* 10 seconds-per-minute)
+        (* 15 seconds-per-minute)
+        (* 20 seconds-per-minute)
+        (* 30 seconds-per-minute)
+        (* 45 seconds-per-minute)
+        seconds-per-hour
+        (* 2 seconds-per-hour)
+        (* 3 seconds-per-hour)
+        (* 4 seconds-per-hour)
+        (* 6 seconds-per-hour)
+        (* 8 seconds-per-hour)
+        (* 12 seconds-per-hour)
+        (* 18 seconds-per-hour)
+        seconds-per-day
+        (* 2 seconds-per-day)
+        (* 5 seconds-per-day)
+        (* 10 seconds-per-day)
+        (* 15 seconds-per-day)
+        (* 30 seconds-per-day)
+        (* 60 seconds-per-day)
+        (* 90 seconds-per-day)))
+
+(define (time-tick-values x-min x-max max-ticks)
+  (with-exact-bounds
+   x-min x-max
+   (define range (- x-max x-min))
+   (define step
+     (cond [(range . < . (* max-ticks (first time-steps)))
+            (define-values (step _)
+              (linear-tick-step+divisor x-min x-max max-ticks 10 '(1 2 5)))
+            step]
+           [(range . > . (* max-ticks (last time-steps)))
+            (define-values (step _)
+              (linear-tick-step+divisor (/ x-min seconds-per-day)
+                                        (/ x-max seconds-per-day)
+                                        max-ticks 10 '(1 2 5)))
+            (* step seconds-per-day)]
+           [else
+            (find-linear-tick-step x-min x-max max-ticks time-steps)]))
+   (define major-xs (linear-major-values/step x-min x-max step))
+   (values major-xs empty)))
+
+(defproc (time-ticks-layout) ticks-layout/c
+  (λ (x-min x-max max-ticks transform)
+    (define-values (major-xs minor-xs) (time-tick-values x-min x-max max-ticks))
+    (tick-values->pre-ticks major-xs minor-xs)))
+
+(defproc (time-ticks-format [#:formats formats (listof string?) (time-ticks-formats)]) ticks-format/c
+  (define fmt-lists (map parse-format-string formats))
+  (λ (x-min x-max ts)
+    (with-exact-bounds
+     x-min x-max
+     (define formatter (plot-time-formatter x-min x-max))
+     (define xs (map pre-tick-value ts))
+     (define fmt-list (choose-format-list formatter fmt-lists xs))
+     (for/list ([x  (in-list xs)])
+       (string-append* (apply-formatter formatter fmt-list x))))))
+
+(defproc (time-ticks [#:formats formats (listof string?) (time-ticks-formats)]) ticks?
+  (ticks (time-ticks-layout)
+         (time-ticks-format #:formats formats)))
+
+;; ===================================================================================================
+;; Byte and bit ticks
+
+;; "", Kilo, Mega, Giga, Tera, Peta, Exa, Zeta, Yotta
+(define byte-suffixes #("B" "KB" "MB" "GB" "TB" "PB" "EB" "ZB" "YB"))
+(define bit-suffixes #("b" "Kb" "Mb" "Gb" "Tb" "Pb" "Eb" "Zb" "Yb"))
+
+(defproc (bit/byte-ticks-format [#:size size (or/c 'byte 'bit) 'byte]
+                                [#:kind kind (or/c 'CS 'SI) 'CS]) ticks-format/c
+  (λ (x-min x-max ts)
+    (with-exact-bounds
+     x-min x-max
+     (define suffixes (if (eq? size 'bit) bit-suffixes byte-suffixes))
+     (define-values (base pow) (case kind
+                                 [(SI)  (values 10 3)]
+                                 [else  (values 2 10)]))
+     (define x-largest (max* (abs x-min) (abs x-max)))
+     (define b (floor-log/base (expt base pow) x-largest))
+     (define format-str
+       (cond [(and (b . >= . 0) (b . < . (vector-length suffixes)))
+              (format "~a ~a" "~a" (vector-ref suffixes b))]
+             [else
+              (format "~a×~a~a ~a" "~a"
+                      base (integer->superscript (* b pow)) (vector-ref suffixes 0))]))
+     (define unit (expt base (* b pow)))
+     (define digits (digits-for-range (/ x-min unit) (/ x-max unit)))
+     (for/list ([t  (in-list ts)])
+       (define unit-x (/ (pre-tick-value t) unit))
+       (format format-str (real->plot-label unit-x digits #f))))))
+
+(defproc (bit/byte-ticks [#:size size (or/c 'byte 'bit) 'byte]
+                         [#:kind kind (or/c 'CS 'SI) 'CS]) ticks?
+  (define layout
+    (case kind
+      [(SI)  (linear-ticks-layout #:base 10 #:divisors '(1 2 5))]
+      [else  (linear-ticks-layout #:base 2 #:divisors '(1 2))]))
+  (ticks layout (bit/byte-ticks-format #:size size #:kind kind)))
+
+;; ===================================================================================================
+;; Currency
+
+;; US "short scale" suffixes
+(define us-currency-scale-suffixes '("" "K" "M" "B" "T"))
+;; The UK officially uses the short scale now
+;; Million is abbreviated "m" instead of "mn" because "mn" stands for minutes; also, the Daily
+;; Telegraph Style Guide totally says to use "m"
+(define uk-currency-scale-suffixes '("" "k" "m" "bn" "tr"))
+;; European countries use the long scale: million, milliard, billion
+(define eu-currency-scale-suffixes '("" "K" "M" "Md" "B"))
+;; The larger the scale suffixes get, the less standardized they are; so we stop at trillion (short)
+
+;; US negative amounts are in parenthesis:
+(define us-currency-format-strings '("~$~w.~f~s" "(~$~w.~f~s)" "~$0"))
+;; The UK is more reasonable, using a negative sign for negative amounts:
+(define uk-currency-format-strings '("~$~w.~f ~s" "-~$~w.~f ~s" "~$0"))
+;; The more common EU format (e.g. France, Germany, Italy, Spain):
+(define eu-currency-format-strings '("~w,~f ~s~$" "-~w,~f ~s~$" "0 ~$"))
+
+(defparam currency-scale-suffixes (listof string?) us-currency-scale-suffixes)
+(defparam currency-format-strings (list/c string? string? string?) us-currency-format-strings)
+
+(struct amount-data (sign whole fractional unit suffix) #:transparent)
+
+(define (currency-formatter x-min x-max)
+  (λ (fmt data)
+    (case fmt
+      [(~$)  (amount-data-sign data)]
+      [(~w)  (number->string (amount-data-whole data))]
+      [(~f)  (match-define (amount-data _sign _whole f unit _suffix) data)
+             (define digits (digits-for-range (/ x-min unit) (/ x-max unit)))
+             (cond [(= 1 unit)  (substring (real->decimal-string* f 2 (max 2 digits)) 2)]
+                   [(zero? f)   "0"]
+                   [else        (substring (real->decimal-string* f 1 (max 1 digits)) 2)])]
+      [(~s)  (amount-data-suffix data)]
+      [else  #f])))
+
+(defproc (currency-ticks-format [#:kind kind (or/c string? symbol?) 'USD]) ticks-format/c
+  (λ (x-min x-max ts)
+    (with-exact-bounds
+     x-min x-max
+     (define formatter (currency-formatter x-min x-max))
+     (match-define (list positive-format-string negative-format-string zero-format-string)
+       (currency-format-strings))
+     (define positive-format-list (parse-format-string positive-format-string))
+     (define negative-format-list (parse-format-string negative-format-string))
+     (define zero-format-list (parse-format-string zero-format-string))
+     (define suffixes (list->vector (currency-scale-suffixes)))
+     (define n (vector-length suffixes))
+     (define sign (cond [(string? kind)  kind]
+                        [else  (hash-ref currency-code->sign kind (λ () (symbol->string kind)))]))
+     (define x-largest (max* (abs x-min) (abs x-max)))
+     (define b (let ([b  (floor-log/base 1000 x-largest)])
+                 (if (b . < . 0) (+ b 1) b)))
+     (define suffix
+       (cond [(and (b . >= . 0) (b . < . n))  (vector-ref suffixes b)]
+             [else  (format "×10~a" (integer->superscript (* b 3)))]))
+     (define unit
+       (cond [(= 0 (string-length suffix))  1]
+             [else  (expt 1000 b)]))
+     (for/list ([t  (in-list ts)])
+       (define x (pre-tick-value t))
+       (define format-list (cond [(positive? x)  positive-format-list]
+                                 [(negative? x)  negative-format-list]
+                                 [else           zero-format-list]))
+       (define unit-x (/ (abs x) unit))
+       (string-append*
+        (apply-formatter formatter format-list
+                         (amount-data sign (floor unit-x) (- unit-x (floor unit-x)) unit suffix)))))))
+
+(defproc (currency-ticks-layout) ticks-layout/c
+  (linear-ticks-layout #:base 10 #:divisors '(1 2 4 5)))
+
+(defproc (currency-ticks [#:kind kind (or/c string? symbol?) 'USD]) ticks?
+  (ticks (currency-ticks-layout)
+         (currency-ticks-format #:kind kind)))
+
+;; ===================================================================================================
+;; Fractions
+
+(defparam fraction-ticks-base (and/c exact-integer? (>=/c 2)) 10)
+(defparam fraction-ticks-divisors (listof exact-positive-integer?) '(1 2 3 4 5))
+
+(define (format-fraction x)
+  (cond [(inexact? x)  (format-fraction (inexact->exact x))]
+        [(x . < . 0)  (format "-~a" (format-fraction (- x)))]
+        [(x . = . 0)  "0"]
+        [(x . < . 1)  (format "~a/~a" (numerator x) (denominator x))]
+        [else
+         (define d (denominator x))
+         (cond [(d . = . 1)  (format "~a" (numerator x))]
+               [else
+                (define w (floor x))
+                (let ([x  (- x w)])
+                  (format "~a ~a/~a" w (numerator x) (denominator x)))])]))
+
+(defproc (fraction-ticks-format) ticks-format/c
+  (λ (x-min x-max ts)
+    (for/list ([t  (in-list ts)])
+      (format-fraction (pre-tick-value t)))))
+
+(defproc (fraction-ticks [#:base base (and/c exact-integer? (>=/c 2)) (fraction-ticks-base)]
+                         [#:divisors divisors (listof exact-positive-integer?)
+                                     (fraction-ticks-divisors)]) ticks?
+  (ticks (linear-ticks #:base base #:divisors divisors)
+         (fraction-ticks-format)))

collects/plot/common/utils.rkt

@@ -37,3 +37,23 @@
     (let ([sorted-lst  (sort lst)])
       (make-hash (map cons sorted-lst (f sorted-lst)))))
   (map (λ (e) (hash-ref h e)) lst))
+
+(define (transpose lsts)
+  (apply map list lsts))
+
+(define (equal?* xs)
+  (cond [(empty? xs)         #f]
+        [(empty? (rest xs))  #t]
+        [else  (and (equal? (first xs) (second xs))
+                    (equal?* (rest xs)))]))
+
+(define (group-neighbors lst equiv?)
+  (reverse
+   (map reverse
+        (cond
+          [(empty? lst)  empty]
+          [else
+           (for/fold ([res  (list (list (first lst)))]) ([e  (in-list (rest lst))])
+             (cond
+               [(andmap (λ (e2) (equiv? e e2)) (first res))  (cons (cons e (first res)) (rest res))]
+               [else  (list* (list e) res)]))]))))

collects/plot/compat.rkt

@@ -6,13 +6,14 @@
          ;; Plotting
          "common/contract.rkt"
          "common/contract-doc.rkt"
-         "common/ticks.rkt"
+         ;"common/ticks.rkt"
          "plot2d/area.rkt"
          "plot2d/renderer.rkt"
          "plot3d/area.rkt"
          "plot3d/renderer.rkt"
          (prefix-in new. (only-in "main.rkt"
                                   x-axis y-axis
+                                  default-x-ticks default-y-ticks default-z-ticks
                                   points error-bars vector-field
                                   plot-title plot-x-label plot-y-label plot-z-label
                                   plot-foreground plot-background
@@ -72,8 +73,8 @@
                [#:lncolor lncolor (list/c byte? byte? byte?) '(255 0 0)]
                [#:out-file out-file (or/c path-string? output-port? #f) #f]
                ) (is-a?/c image-snip%)
-  (define x-ticks (default-ticks-fun x-min x-max))
+  (define x-ticks (new.default-x-ticks x-min x-max))
-  (define y-ticks (default-ticks-fun y-min y-max))
+  (define y-ticks (new.default-y-ticks y-min y-max))
   
   (parameterize ([new.plot-title       title]
                  [new.plot-x-label     x-label]
@@ -110,9 +111,9 @@
                  [#:lncolor lncolor (list/c byte? byte? byte?) '(255 0 0)]
                  [#:out-file out-file (or/c path-string? output-port? #f) #f]
                  ) (is-a?/c image-snip%)
-  (define x-ticks (default-ticks-fun x-min x-max))
+  (define x-ticks (new.default-x-ticks x-min x-max))
-  (define y-ticks (default-ticks-fun y-min y-max))
+  (define y-ticks (new.default-y-ticks y-min y-max))
-  (define z-ticks (default-ticks-fun z-min z-max))
+  (define z-ticks (new.default-z-ticks z-min z-max))
   
   (parameterize ([new.plot-title       title]
                  [new.plot-x-label     x-label]

collects/plot/main.rkt

@@ -12,8 +12,10 @@
          (all-from-out "common/contract.rkt"))
 
 (require "common/axis-transform.rkt")
-(provide invertible-function?
+(provide (all-from-out "common/axis-transform.rkt"))
-         id-transform log-transform cbrt-transform hand-drawn-transform)
+
+(require "common/ticks.rkt")
+(provide (all-from-out "common/ticks.rkt"))
 
 (require "common/math.rkt")
 (provide (contract-out (struct ivl ([min real?] [max real?]))))

collects/plot/plot2d/area.rkt

@@ -1,6 +1,6 @@
 #lang racket/base
 
-(require racket/draw racket/class racket/contract racket/match racket/math racket/list
+(require racket/draw racket/class racket/contract racket/match racket/math racket/list racket/string
          "../common/area.rkt"
          "../common/ticks.rkt"
          "../common/vector.rkt"
@@ -10,14 +10,14 @@
          "../common/sample.rkt"
          "../common/legend.rkt"
          "../common/parameters.rkt"
-         "clip.rkt"
+         "../common/utils.rkt"
-         "sample.rkt")
+         "clip.rkt")
 
 (provide 2d-plot-area%)
 
 (define 2d-plot-area%
   (class plot-area%
-    (init-field x-ticks y-ticks x-min x-max y-min y-max)
+    (init-field rx-ticks ry-ticks x-min x-max y-min y-max)
     (init dc dc-x-min dc-y-min dc-x-size dc-y-size)
     (inherit
       set-alpha set-pen set-major-pen set-minor-pen set-brush set-background set-text-foreground
@@ -31,25 +31,22 @@
     
     (reset-drawing-params)
     
-    (define max-y-tick-label-width
+    (define x-ticks (filter (λ (t) (<= x-min (pre-tick-value t) x-max)) rx-ticks))
-      (for/fold ([max-w 0]) ([t  (in-list y-ticks)])
+    (define y-ticks (filter (λ (t) (<= y-min (pre-tick-value t) y-max)) ry-ticks))
-        (cond [(tick-major? t)  (define-values (w h _1 _2)
+    
-                                  (get-text-extent (tick-label t)))
+    (define (max-tick-label-width ts)
-                                (max max-w w)]
+      (apply max 0 (for/list ([t  (in-list ts)] #:when (pre-tick-major? t))
-              [else  max-w])))
+                     (get-text-width (tick-label t)))))
+    
+    (define max-x-tick-label-width (max-tick-label-width x-ticks))
+    (define max-y-tick-label-width (max-tick-label-width y-ticks))
     
     (define char-height (get-char-height))    
     
-    
     (define last-x-tick-label-width
-      (cond [(empty? x-ticks)  0]
+      (let ([x-ticks  (filter pre-tick-major? x-ticks)])
-            [else
+        (cond [(empty? x-ticks)  0]
-             (define last-x-tick (argmax tick-p x-ticks))
+              [else  (get-text-width (tick-label (argmax pre-tick-value x-ticks)))])))
-             (cond [(tick-major? last-x-tick)  (define-values (w _1 _2 _3)
-                                                 (get-text-extent
-                                                  (tick-label last-x-tick)))
-                                               w]
-                   [else  0])]))
     
     (define dc-x-max (+ dc-x-min dc-x-size))
     (define dc-y-max (+ dc-y-min dc-y-size))
@@ -169,18 +166,19 @@
            (equal? (plot-y-transform) id-transform)))
     
     (define plot->view
-      (cond [identity-transforms?  (λ (v) v)]
+      (cond
-            [else
+        [identity-transforms?  (λ (v) v)]
-             (match-define (invertible-function fx _) ((plot-x-transform) x-min x-max))
+        [else
-             (match-define (invertible-function fy _) ((plot-y-transform) y-min y-max))
+         (match-define (invertible-function fx _) (apply-transform (plot-x-transform) x-min x-max))
-             (λ (v)
+         (match-define (invertible-function fy _) (apply-transform (plot-y-transform) y-min y-max))
-               (match-define (vector x y) v)
+         (λ (v)
-               (vector (fx x) (fy y)))]))
+           (match-define (vector x y) v)
+           (vector (fx x) (fy y)))]))
     
     (define/public (plot->dc v)
       (view->dc (plot->view v)))
     
-    ;; -------------------------------------------------------------------------
+    ;; ===============================================================================================
     ;; Plot decoration
     
     (define (draw-borders)
@@ -189,33 +187,56 @@
       (draw-rectangle (vector area-x-min area-y-min)
                       (vector area-x-max area-y-max)))
     
+    (define (collapse-ticks ts dc-pos)
+      (define (dc-dist t1 t2) (abs (- (dc-pos t1) (dc-pos t2))))
+      (let ([ts  (sort ts < #:key pre-tick-value)])
+        (define tss
+          (group-neighbors ts (λ (t1 t2) ((dc-dist t1 t2) . <= . (* 2 (plot-line-width))))))
+        (for/list ([ts  (in-list tss)])
+          (match-define (list (tick xs majors labels) ...) ts)
+          (define x (let ([xs  (remove-duplicates xs)])
+                      (/ (apply + xs) (length xs))))
+          (define major? (ormap values majors))
+          (define label (string-join (remove-duplicates (map tick-label (filter pre-tick-major? ts)))
+                                     "|"))
+          (tick x major? label))))
+    
+    (define collapsed-x-ticks
+      (collapse-ticks x-ticks (λ (t) (vector-ref (plot->dc (vector (pre-tick-value t) y-min)) 0))))
+    (define collapsed-y-ticks
+      (collapse-ticks y-ticks (λ (t) (vector-ref (plot->dc (vector x-min (pre-tick-value t))) 1))))
+    
     (define (draw-x-ticks)
-      (define half (* 1/2 (plot-tick-size)))
+      (define radius (* 1/2 (plot-tick-size)))
-      (for ([t  (in-list x-ticks)])
+      (define 1/2radius (* 1/2 radius))
-        (match-define (tick x x-str major?) t)
+      (for ([t  (in-list collapsed-x-ticks)])
+        (match-define (tick x major? _) t)
         (if major? (set-major-pen) (set-minor-pen))
-        (put-tick (vector x y-min) half 1/2pi)
+        (put-tick (vector x y-min) (if major? radius 1/2radius) 1/2pi)
-        (put-tick (vector x y-max) half 1/2pi)))
+        (put-tick (vector x y-max) (if major? radius 1/2radius) 1/2pi)))
     
     (define (draw-y-ticks)
-      (define half (* 1/2 (plot-tick-size)))
+      (define radius (* 1/2 (plot-tick-size)))
-      (for ([t  (in-list y-ticks)])
+      (define 1/2radius (* 1/2 radius))
-        (match-define (tick y y-str major?) t)
+      (for ([t  (in-list collapsed-y-ticks)])
+        (match-define (tick y major? _) t)
         (if major? (set-major-pen) (set-minor-pen))
-        (put-tick (vector x-min y) half 0)
+        (put-tick (vector x-min y) (if major? radius 1/2radius) 0)
-        (put-tick (vector x-max y) half 0)))
+        (put-tick (vector x-max y) (if major? radius 1/2radius) 0)))
     
     (define (draw-x-tick-labels)
       (define offset (vector 0 (+ (pen-gap) (* 1/2 (plot-tick-size)))))
-      (for ([t  (in-list (filter tick-major? x-ticks))])
+      (for ([t  (in-list collapsed-x-ticks)])
-        (match-define (tick x x-str major?) t)
+        (match-define (tick x major? label) t)
-        (draw-text x-str (v+ (plot->dc (vector x y-min)) offset) 'top)))
+        (when (and major? ((string-length label) . > . 0))
+          (draw-text label (v+ (plot->dc (vector x y-min)) offset) 'top))))
     
     (define (draw-y-tick-labels)
       (define offset (vector (+ (pen-gap) (* 1/2 (plot-tick-size))) 0))
-      (for ([t  (in-list (filter tick-major? y-ticks))])
+      (for ([t  (in-list collapsed-y-ticks)])
-        (match-define (tick y y-str major?) t)
+        (match-define (tick y major? label) t)
-        (draw-text y-str (v- (plot->dc (vector x-min y)) offset) 'right)))
+        (when (and major? ((string-length label) . > . 0))
+          (draw-text label (v- (plot->dc (vector x-min y)) offset) 'right))))
     
     (define (draw-title)
       (define-values (title-x-size _1 _2 _3)

collects/plot/plot2d/contour.rkt

@@ -6,14 +6,15 @@
          "../common/math.rkt"
          "../common/draw.rkt"
          "../common/marching-squares.rkt"
-         "../common/contract.rkt" "../common/contract-doc.rkt"
+         "../common/contract.rkt"
+         "../common/contract-doc.rkt"
          "../common/legend.rkt"
          "../common/sample.rkt"
          "../common/parameters.rkt"
          "../common/ticks.rkt"
          "../common/vector.rkt"
-         "renderer.rkt"
+         "../common/format.rkt"
-         "sample.rkt")
+         "renderer.rkt")
 
 (provide contours contour-intervals)
 
@@ -30,10 +31,7 @@
         (when (empty? zs) (return empty))
         (values (apply min* zs) (apply max* zs))))
     
-    (define zs
+    (match-define (list (tick zs _ labels) ...) (contour-ticks z-min z-max levels #f))
-      (cond [(list? levels)      levels]
-            [(eq? levels 'auto)  (auto-contour-zs z-min z-max)]
-            [else  (linear-seq z-min z-max levels #:start? #f #:end? #f)]))
     
     (define cs (maybe-apply/list colors zs))
     (define ws (maybe-apply/list widths zs))
@@ -64,7 +62,7 @@
           (match-define (vector x1 y1 x2 y2) (scale-normalized-line line xa xb ya yb))
           (send area put-line (vector x1 y1) (vector x2 y2)))))
     
-    (cond [label  (line-legend-entries label zs colors widths styles)]
+    (cond [label  (line-legend-entries label zs labels colors widths styles)]
           [else   empty])))
 
 (defproc (contours
@@ -100,12 +98,8 @@
         (when (empty? flat-zs) (return empty))
         (values (apply min* flat-zs) (apply max* flat-zs))))
     
-    (define contour-zs
+    (match-define (list (tick zs _ labels) ...) (contour-ticks z-min z-max levels #t))
-      (cond [(list? levels)      levels]
-            [(eq? levels 'auto)  (auto-contour-zs z-min z-max)]
-            [else  (linear-seq z-min z-max levels #:start? #f #:end? #f)]))
     
-    (define zs (append (list z-min) contour-zs (list z-max)))
     (define cs (map ->brush-color (maybe-apply/list colors zs)))
     (define fss (map ->brush-style (maybe-apply/list styles zs)))
     (define pss (map (λ (fill-style) (if (eq? fill-style 'solid) 'solid 'transparent)) fss))
@@ -163,8 +157,7 @@
      area)
     
     (cond [label  (contour-intervals-legend-entries
-                   label z-min z-max contour-zs
+                   label zs labels cs fss cs '(1) pss contour-colors contour-widths contour-styles)]
-                   cs fss cs '(1) pss contour-colors contour-widths contour-styles)]
           [else   empty])))
 
 (defproc (contour-intervals

collects/plot/plot2d/decoration.rkt

@@ -6,19 +6,21 @@
          "../common/ticks.rkt"
          "../common/math.rkt"
          "../common/format.rkt"
-         "../common/contract.rkt" "../common/contract-doc.rkt"
+         "../common/contract.rkt"
+         "../common/contract-doc.rkt"
          "../common/legend.rkt"
          "../common/vector.rkt"
          "../common/area.rkt"
          "../common/sample.rkt"
          "../common/parameters.rkt"
+         "../common/axis-transform.rkt"
          "renderer.rkt"
          "area.rkt"
          "line.rkt"
          "interval.rkt"
          "point.rkt"
          "contour.rkt"
-         "sample.rkt")
+         "clip.rkt")
 
 (provide x-axis y-axis axes
          polar-axes
@@ -38,72 +40,128 @@
   (define x-ticks (send area get-x-ticks))
   (define half (* 1/2 (plot-tick-size)))
   
-  (send area set-minor-pen)
+  (send area set-alpha 1/2)
+  (send area set-major-pen)
   (send area put-line (vector x-min y) (vector x-max y))
   
   (when ticks?
     (for ([t  (in-list x-ticks)])
-      (match-define (tick x _ major?) t)
+      (match-define (tick x major? _) t)
       (if major? (send area set-major-pen) (send area set-minor-pen))
       (send area put-tick (vector x y) half 1/2pi)))
   
   empty)
 
+(define ((x-axis-ticks-fun y) x-min x-max y-min y-max)
+  (define digits (digits-for-range y-min y-max))
+  (values empty (list (tick y #t (real->plot-label y digits)))))
+
+(defproc (x-axis [y real? 0] [add-y-tick? boolean? #f]
+                 [#:ticks? ticks? boolean? (x-axis-ticks?)]) renderer2d?
+  (renderer2d (x-axis-render-proc y ticks?)
+              (if add-y-tick? (x-axis-ticks-fun y) null-2d-ticks-fun)
+              null-2d-bounds-fun #f #f #f #f))
+
 (define ((y-axis-render-proc x ticks?) area)
   (define y-min (send area get-y-min))
   (define y-max (send area get-y-max))
   (define y-ticks (send area get-y-ticks))
   (define half (* 1/2 (plot-tick-size)))
   
-  (send area set-minor-pen)
+  (send area set-alpha 1/2)
+  (send area set-major-pen)
   (send area put-line (vector x y-min) (vector x y-max))
   
   (when ticks?
     (for ([t  (in-list y-ticks)])
-      (match-define (tick y _ major?) t)
+      (match-define (tick y major? _) t)
       (if major? (send area set-major-pen) (send area set-minor-pen))
       (send area put-tick (vector x y) half 0)))
   
   empty)
 
-(defproc (x-axis [y real? 0] [#:ticks? ticks? boolean? (x-axis-ticks?)]) renderer2d?
+(define ((y-axis-ticks-fun x) x-min x-max y-min y-max)
-  (renderer2d (x-axis-render-proc y ticks?) null-2d-ticks-fun null-2d-bounds-fun #f #f #f #f))
+  (define digits (digits-for-range x-min x-max))
+  (values (list (tick x #t (real->plot-label x digits))) empty))
 
-(defproc (y-axis [x real? 0] [#:ticks? ticks? boolean? (y-axis-ticks?)]) renderer2d?
+(defproc (y-axis [x real? 0] [add-x-tick? boolean? #f]
-  (renderer2d (y-axis-render-proc x ticks?) null-2d-ticks-fun null-2d-bounds-fun #f #f #f #f))
+                 [#:ticks? ticks? boolean? (y-axis-ticks?)]) renderer2d?
+  (renderer2d (y-axis-render-proc x ticks?)
+              (if add-x-tick? (y-axis-ticks-fun x) null-2d-ticks-fun)
+              null-2d-bounds-fun #f #f #f #f))
 
-(defproc (axes [x real? 0] [y real? 0]
+(defproc (axes [x real? 0] [y real? 0] [add-x-tick? boolean? #f] [add-y-tick? boolean? #f]
                [#:x-ticks? x-ticks? boolean? (x-axis-ticks?)]
                [#:y-ticks? y-ticks? boolean? (y-axis-ticks?)]
                ) (listof renderer2d?)
-  (list (x-axis y #:ticks? x-ticks?)
+  (list (x-axis y add-y-tick? #:ticks? x-ticks?)
-        (y-axis x #:ticks? y-ticks?)))
+        (y-axis x add-x-tick? #:ticks? y-ticks?)))
 
 ;; ===================================================================================================
 ;; Polar axes
 
+(define (build-polar-axes num x-min x-max y-min y-max)
+  (define step (/ (* 2 pi) num))
+  (define θs (build-list num (λ (n) (* n step))))
+  (define max-r (max (vmag (vector x-min y-min)) (vmag (vector x-min y-max))
+                     (vmag (vector x-max y-max)) (vmag (vector x-max y-min))))
+  (define-values (r-mins r-maxs)
+    (for/lists (r-mins r-maxs) ([θ  (in-list θs)])
+      (define-values (v1 v2)
+        (clip-line (vector 0 0) (vector (* max-r (cos θ)) (* max-r (sin θ)))
+                   x-min x-max y-min y-max))
+      (values (if v1 (vmag v1) #f)
+              (if v2 (vmag v2) #f))))
+  (for/lists (θs r-mins r-maxs) ([θ  (in-list θs)] [r-min  (in-list r-mins)] [r-max  (in-list r-maxs)]
+                                                   #:when (and r-min r-max (not (= r-min r-max))))
+    (values θ r-min r-max)))
+
 (define ((polar-axes-render-proc num ticks?) area)
   (define x-min (send area get-x-min))
   (define x-max (send area get-x-max))
   (define y-min (send area get-y-min))
   (define y-max (send area get-y-max))
   
-  (define step (/ (* 2 pi) num))
+  (define-values (θs r-mins r-maxs) (build-polar-axes num x-min x-max y-min y-max))
-  (define θs (build-list num (λ (n) (* n step))))
   
-  (send area set-minor-pen)
+  ;; Draw the axes
-  (let ([r  (* 2 (max (- x-min) x-max (- y-min) y-max))])
+  (send area set-alpha 1/2)
-    (for ([θ  (in-list θs)])
+  (send area set-major-pen)
-      (send area put-line (vector 0 0) (vector (* r (cos θ)) (* r (sin θ))))))
+  (for ([θ  (in-list θs)] [r-min  (in-list r-mins)] [r-max  (in-list r-maxs)])
+    (send area put-line
+          (vector (* r-min (cos θ)) (* r-min (sin θ)))
+          (vector (* r-max (cos θ)) (* r-max (sin θ)))))
   
-  (define ticks (remove-duplicates (map (λ (t) (abs (tick-p t)))
+  (when ticks?
-                                        (send area get-x-ticks))))
+    (define corner-rs
+      (list (vmag (vector x-min y-min)) (vmag (vector x-min y-max))
+            (vmag (vector x-max y-max)) (vmag (vector x-max y-min))))
+    (define r-min (if (and (<= x-min 0 x-max) (<= y-min 0 y-max)) 0 (apply min corner-rs)))
+    (define r-max (apply max corner-rs))
+    (define ts ((linear-ticks) r-min r-max (polar-axes-max-ticks) id-transform))
     
-  (send area set-minor-pen 'long-dash)
+    (send area set-alpha 1/2)
-  (for ([r  (in-list ticks)])
+    (for ([t  (in-list ts)])
-    (define pts (for/list ([θ  (in-list (linear-seq 0 (* 2 pi) 100))])
+      (match-define (tick r major? label) t)
-                  (vector (* r (cos θ)) (* r (sin θ)))))
+      (if major? (send area set-major-pen) (send area set-minor-pen 'long-dash))
-    (send area put-lines pts))
+      (define pts (for/list ([θ  (in-list (linear-seq 0 (* 2 pi) 100))])
+                    (vector (* r (cos θ)) (* r (sin θ)))))
+      (send area put-lines pts))
+    
+    (when (not (empty? θs))
+      ;; find the longest axis
+      (define mag (expt 10 (- (digits-for-range r-min r-max))))
+      (match-define (list mθ mr-min mr-max)
+        ;; find the longest, rounded to drown out floating-point error
+        (argmax (λ (lst) (* (round (/ (- (third lst) (second lst)) mag)) mag))
+                (map list θs r-mins r-maxs)))
+      
+      (send area set-alpha 1)
+      (for ([t  (in-list ts)])
+        (match-define (tick r major? label) t)
+        (when (and major? (<= mr-min r mr-max))
+          (send area put-text label (vector (* r (cos mθ)) (* r (sin mθ)))
+                'center 0 #:outline? #t)))))
   
   empty)
 
@@ -121,9 +179,10 @@
   (define y-max (send area get-y-max))
   (define x-ticks (send area get-x-ticks))
   
-  (send area set-pen (plot-foreground) (* 1/2 (plot-line-width)) 'long-dash)
+  (send area set-alpha 1/2)
   (for ([t  (in-list x-ticks)])
-    (match-define (tick x _ major?) t)
+    (match-define (tick x major? _) t)
+    (if major? (send area set-major-pen) (send area set-minor-pen 'long-dash))
     (send area put-line (vector x y-min) (vector x y-max)))
   
   empty)
@@ -133,9 +192,10 @@
   (define x-max (send area get-x-max))
   (define y-ticks (send area get-y-ticks))
   
-  (send area set-pen (plot-foreground) (* 1/2 (plot-line-width)) 'long-dash)
+  (send area set-alpha 1/2)
   (for ([t  (in-list y-ticks)])
-    (match-define (tick y _ major?) t)
+    (match-define (tick y major? _) t)
+    (if major? (send area set-major-pen) (send area set-minor-pen 'long-dash))
     (send area put-line (vector x-min y) (vector x-max y)))
   
   empty)

collects/plot/plot2d/interval.rkt

@@ -5,14 +5,14 @@
 (require racket/contract racket/class racket/match racket/math racket/list
          "../common/math.rkt"
          "../common/vector.rkt"
-         "../common/contract.rkt" "../common/contract-doc.rkt"
+         "../common/contract.rkt"
+         "../common/contract-doc.rkt"
          "../common/legend.rkt"
          "../common/draw.rkt"
          "../common/sample.rkt"
          "../common/parameters.rkt"
          "renderer.rkt"
-         "bounds.rkt"
+         "bounds.rkt")
-         "sample.rkt")
 
 (provide lines-interval parametric-interval polar-interval function-interval inverse-interval)
 

collects/plot/plot2d/kde.rkt

@@ -1,7 +1,8 @@
 #lang racket/base
 
 (require racket/flonum racket/list racket/promise racket/math racket/contract
-         "../common/contract.rkt" "../common/contract-doc.rkt"
+         "../common/contract.rkt"
+         "../common/contract-doc.rkt"
          "../common/math.rkt"
          "../common/utils.rkt"
          "../common/sample.rkt"

collects/plot/plot2d/line.rkt

@@ -6,13 +6,13 @@
          "../common/math.rkt"
          "../common/vector.rkt"
          "../common/ticks.rkt"
-         "../common/contract.rkt" "../common/contract-doc.rkt"
+         "../common/contract.rkt"
+         "../common/contract-doc.rkt"
          "../common/legend.rkt"
          "../common/sample.rkt"
          "../common/parameters.rkt"
          "renderer.rkt"
-         "bounds.rkt"
+         "bounds.rkt")
-         "sample.rkt")
 
 (provide lines parametric polar function inverse)
 

collects/plot/plot2d/plot.rkt

@@ -131,6 +131,9 @@
   (define x-transform (plot-x-transform))
   (define y-transform (plot-y-transform))
   (define z-transform (plot-z-transform))
+  (define x-ticks (plot-x-ticks))
+  (define y-ticks (plot-y-ticks))
+  (define z-ticks (plot-z-ticks))
   (define animating? (plot-animating?))
   
   (dc (λ (dc x y)
@@ -146,6 +149,9 @@
                        [plot-x-transform       x-transform]
                        [plot-y-transform       y-transform]
                        [plot-z-transform       z-transform]
+                       [plot-x-ticks           x-ticks]
+                       [plot-y-ticks           y-ticks]
+                       [plot-z-ticks           z-ticks]
                        [plot-animating?        animating?])
           (plot/dc renderer-tree dc x y width height
                    #:x-min x-min #:x-max x-max #:y-min y-min #:y-max y-max

collects/plot/plot2d/rectangle.rkt

@@ -101,8 +101,8 @@
 (define ((discrete-histogram-ticks-fun cats tick-xs) _x-min _x-max y-min y-max)
   (define x-ticks
     (for/list ([cat  (in-list cats)] [x  (in-list tick-xs)])
-      (tick x (->plot-label cat) #t)))
+      (tick x #t (->plot-label cat))))
-  (values x-ticks (default-ticks-fun y-min y-max)))
+  (values x-ticks (default-y-ticks y-min y-max)))
 
 (defproc (discrete-histogram
           [cat-vals (listof (vector/c any/c real?))]

collects/plot/plot2d/renderer.rkt

@@ -1,9 +1,11 @@
 #lang racket/base
 
 (require racket/list racket/match racket/contract
-         "../common/contract.rkt" "../common/contract-doc.rkt"
+         "../common/contract.rkt"
+         "../common/contract-doc.rkt"
          "../common/math.rkt"
-         "../common/ticks.rkt")
+         "../common/ticks.rkt"
+         "../common/parameters.rkt")
 
 (provide (all-defined-out))
 
@@ -52,5 +54,5 @@
 
 (defproc (default-2d-ticks-fun [x-min real?] [x-max real?] [y-min real?] [y-max real?]
            ) (values (listof tick?) (listof tick?))
-  (values (default-ticks-fun x-min x-max)
+  (values (default-x-ticks x-min x-max)
-          (default-ticks-fun y-min y-max)))
+          (default-y-ticks y-min y-max)))

collects/plot/plot2d/sample.rkt

@@ -1,12 +0,0 @@
-#lang racket/base
-
-(require racket/contract
-         "../common/contract.rkt"
-         "../common/sample.rkt"
-         "../common/parameters.rkt")
-
-(provide (all-defined-out))
-
-(define function->sampler (make-function->sampler plot-x-transform))
-(define inverse->sampler (make-function->sampler plot-y-transform))
-(define 2d-function->sampler (make-2d-function->sampler plot-x-transform plot-y-transform))

collects/plot/plot3d/area.rkt

@@ -11,14 +11,13 @@
          "../common/parameters.rkt"
          "matrix.rkt"
          "shape.rkt"
-         "clip.rkt"
+         "clip.rkt")
-         "sample.rkt")
 
 (provide 3d-plot-area%)
 
 (define 3d-plot-area%
   (class plot-area%
-    (init-field x-ticks y-ticks z-ticks x-min x-max y-min y-max z-min z-max)
+    (init-field rx-ticks ry-ticks rz-ticks x-min x-max y-min y-max z-min z-max)
     (init dc dc-x-min dc-y-min dc-x-size dc-y-size)
     (inherit
       set-alpha set-pen set-major-pen set-minor-pen set-brush set-background set-text-foreground
@@ -32,6 +31,10 @@
     
     (reset-drawing-params)
     
+    (define x-ticks (filter (λ (t) (<= x-min (pre-tick-value t) x-max)) rx-ticks))
+    (define y-ticks (filter (λ (t) (<= y-min (pre-tick-value t) y-max)) ry-ticks))
+    (define z-ticks (filter (λ (t) (<= z-min (pre-tick-value t) z-max)) rz-ticks))
+    
     (define char-height (get-char-height))
     
     (define clipping? #f)
@@ -104,19 +107,20 @@
            (equal? (plot-z-transform) id-transform)))
     
     (define center
-      (cond [identity-axis-transforms?
+      (cond
-             (λ (v)
+        [identity-axis-transforms?
-               (match-define (vector x y z) v)
+         (λ (v)
-               (vector (- x x-mid) (- y y-mid) (- z z-mid)))]
+           (match-define (vector x y z) v)
-            [else
+           (vector (- x x-mid) (- y y-mid) (- z z-mid)))]
-             (match-define (invertible-function fx _) ((plot-x-transform) x-min x-max))
+        [else
-             (match-define (invertible-function fy _) ((plot-y-transform) y-min y-max))
+         (match-define (invertible-function fx _) (apply-transform (plot-x-transform) x-min x-max))
-             (match-define (invertible-function fz _) ((plot-z-transform) z-min z-max))
+         (match-define (invertible-function fy _) (apply-transform (plot-y-transform) y-min y-max))
-             (λ (v)
+         (match-define (invertible-function fz _) (apply-transform (plot-z-transform) z-min z-max))
-               (match-define (vector x y z) v)
+         (λ (v)
-               (if do-axis-transforms?
+           (match-define (vector x y z) v)
-                   (vector (- (fx x) x-mid) (- (fy y) y-mid) (- (fz z) z-mid))
+           (if do-axis-transforms?
-                   (vector (- x x-mid) (- y y-mid) (- z z-mid))))]))
+               (vector (- (fx x) x-mid) (- (fy y) y-mid) (- (fz z) z-mid))
+               (vector (- x x-mid) (- y y-mid) (- z z-mid))))]))
     
     (define transform-matrix/no-rho
       (m3* (m3-rotate-z theta) (m3-scale (/ x-size) (/ y-size) (/ z-size))))
@@ -187,13 +191,12 @@
     (define x-labels-y-min? ((cos theta) . >= . 0))
     (define y-labels-x-min? ((sin theta) . >= . 0))
     
-    (define max-x-tick-label-width
+    (define (max-tick-label-width ts)
-      (cond [(empty? x-ticks)  0]
+      (apply max 0 (for/list ([t  (in-list ts)] #:when (pre-tick-major? t))
-            [else  (apply max (map (λ (t) (get-text-width (tick-label t))) x-ticks))]))
+                     (get-text-width (tick-label t)))))
     
-    (define max-y-tick-label-width
+    (define max-x-tick-label-width (max-tick-label-width x-ticks))
-      (cond [(empty? y-ticks)  0]
+    (define max-y-tick-label-width (max-tick-label-width y-ticks))
-            [else  (apply max (map (λ (t) (get-text-width (tick-label t))) y-ticks))]))
     
     ;; Label drawing parameters
     
@@ -242,10 +245,10 @@
               [(s . < . (sin (degrees->radians 67.5)))   (if x-labels-y-min? 'top-left 'top-right)]
               [else                                      (if x-labels-y-min? 'top-left 'top-right)]))
       
-      (define fx (invertible-function-f ((plot-x-transform) x-min x-max)))
+      (define fx (invertible-function-f (apply-transform (plot-x-transform) x-min x-max)))
-      (for/list ([t  (in-list (filter tick-major? x-ticks))])
+      (for/list ([t  (in-list x-ticks)] #:when (pre-tick-major? t))
-        (match-define (tick x x-str major?) t)
+        (match-define (tick x _ label) t)
-        (list x-str (v+ (plot->dc (vector (fx x) y z-min)) offset) anchor 0)))
+        (list label (v+ (plot->dc (vector (fx x) y z-min)) offset) anchor 0)))
     
     (define (get-y-tick-label-params)
       (define x-axis-angle (plot-dir->dc-angle (vector 1 0 0)))
@@ -261,10 +264,10 @@
               [(c . > . (cos (degrees->radians 157.5)))  (if y-labels-x-min? 'top-left 'top-right)]
               [else                                      (if y-labels-x-min? 'top-left 'top-right)]))
       
-      (define fy (invertible-function-f ((plot-y-transform) y-min y-max)))
+      (define fy (invertible-function-f (apply-transform (plot-y-transform) y-min y-max)))
-      (for/list ([t  (in-list (filter tick-major? y-ticks))])
+      (for/list ([t  (in-list y-ticks)] #:when (pre-tick-major? t))
-        (match-define (tick y y-str major?) t)
+        (match-define (tick y _ label) t)
-        (list y-str (v+ (plot->dc (vector x (fy y) z-min)) offset) anchor 0)))
+        (list label (v+ (plot->dc (vector x (fy y) z-min)) offset) anchor 0)))
     
     (define (get-z-tick-label-params)
       (define dist (+ (pen-gap) (* 1/2 (plot-tick-size))))
@@ -272,10 +275,10 @@
       (define x (if x-labels-y-min? x-min x-max))
       (define y (if y-labels-x-min? y-max y-min))
       
-      (define fz (invertible-function-f ((plot-z-transform) z-min z-max)))
+      (define fz (invertible-function-f (apply-transform (plot-z-transform) z-min z-max)))
-      (for/list ([t  (in-list (filter tick-major? z-ticks))])
+      (for/list ([t  (in-list z-ticks)] #:when (pre-tick-major? t))
-        (match-define (tick z z-str major?) t)
+        (match-define (tick z _ label) t)
-        (list z-str (v+ (plot->dc (vector x y (fz z))) offset) 'bottom-right 0)))
+        (list label (v+ (plot->dc (vector x y (fz z))) offset) 'bottom-right 0)))
     
     (define (get-label-params)
       (append (if (plot-x-label) (list (get-x-label-params)) empty)
@@ -351,37 +354,40 @@
     
     (define (put-x-ticks)
       (define radius (* 1/2 (plot-tick-size)))
+      (define 1/2radius (* 1/2 radius))
       (define angle (plot-dir->dc-angle (vector 0 1 0)))
-      (define fx (invertible-function-f ((plot-x-transform) x-min x-max)))
+      (define fx (invertible-function-f (apply-transform (plot-x-transform) x-min x-max)))
       (for ([t  (in-list x-ticks)])
-        (match-define (tick x x-str major?) t)
+        (match-define (tick x major? _) t)
         (if major? (put-major-pen) (put-minor-pen))
         ; x ticks on the y-min and y-max border
         (for ([y  (list y-min y-max)])
-          (put-tick (vector (fx x) y z-min) radius angle))))
+          (put-tick (vector (fx x) y z-min) (if major? radius 1/2radius) angle))))
     
     (define (put-y-ticks)
       (define radius (* 1/2 (plot-tick-size)))
+      (define 1/2radius (* 1/2 radius))
       (define angle (plot-dir->dc-angle (vector 1 0 0)))
-      (define fy (invertible-function-f ((plot-y-transform) y-min y-max)))
+      (define fy (invertible-function-f (apply-transform (plot-y-transform) y-min y-max)))
       (for ([t  (in-list y-ticks)])
-        (match-define (tick y y-str major?) t)
+        (match-define (tick y major? _) t)
         (if major? (put-major-pen) (put-minor-pen))
         ; y ticks on the x-min border
         (for ([x  (list x-min x-max)])
-          (put-tick (vector x (fy y) z-min) radius angle))))
+          (put-tick (vector x (fy y) z-min) (if major? radius 1/2radius) angle))))
     
     (define (put-z-ticks)
       (define radius (* 1/2 (plot-tick-size)))
+      (define 1/2radius (* 1/2 radius))
       (define angle 0)
-      (define fz (invertible-function-f ((plot-z-transform) z-min z-max)))
+      (define fz (invertible-function-f (apply-transform (plot-z-transform) z-min z-max)))
       (for ([t  (in-list z-ticks)])
-        (match-define (tick z z-str major?) t)
+        (match-define (tick z major? _) t)
         (if major? (put-major-pen) (put-minor-pen))
         ; z ticks on all four axes
         (for* ([x  (list x-min x-max)]
                [y  (list y-min y-max)])
-          (put-tick (vector x y (fz z)) radius angle))))
+          (put-tick (vector x y (fz z)) (if major? radius 1/2radius) angle))))
     
     (define (draw-labels)
       (for ([params  (in-list (get-label-params))])
@@ -656,7 +662,7 @@
           ;; Right
           (if ((sin theta) . < . 0)
               (list (vector x2 y1 z1) (vector x2 y2 z1) (vector x2 y2 z2) (vector x2 y1 z2))
-            empty))
+              empty))
          c)))
     
     (define/public (put-glyphs vs symbol size)

collects/plot/plot3d/contour.rkt

@@ -1,7 +1,8 @@
 #lang racket/base
 
 (require racket/class racket/match racket/list racket/flonum racket/contract
-         "../common/contract.rkt" "../common/contract-doc.rkt"
+         "../common/contract.rkt"
+         "../common/contract-doc.rkt"
          "../common/math.rkt"
          "../common/vector.rkt"
          "../common/marching-squares.rkt"
@@ -11,7 +12,6 @@
          "../common/sample.rkt"
          "../common/parameters.rkt"
          "renderer.rkt"
-         "sample.rkt"
          "bounds.rkt")
 
 (provide contours3d contour-intervals3d)
@@ -23,10 +23,8 @@
   (define-values (x-min x-max y-min y-max z-min z-max) (send area get-bounds))
   (match-define (list xs ys zss) (f x-min x-max (animated-samples samples)
                                     y-min y-max (animated-samples samples)))
-  (define zs
+  
-    (cond [(list? levels)      levels]
+  (match-define (list (tick zs _ labels) ...) (contour-ticks z-min z-max levels #f))
-          [(eq? levels 'auto)  (auto-contour-zs z-min z-max)]
-          [else  (linear-seq z-min z-max levels #:start? #f #:stop? #f)]))
   
   (define cs (maybe-apply/list colors zs))
   (define ws (maybe-apply/list widths zs))
@@ -61,7 +59,7 @@
               (center-coord (list (vector xa ya z1) (vector xb ya z2)
                                   (vector xa yb z3) (vector xb yb z4)))))))
   
-  (cond [label  (line-legend-entries label zs colors widths styles)]
+  (cond [label  (line-legend-entries label zs labels colors widths styles)]
         [else   empty]))
 
 (defproc (contours3d
@@ -94,12 +92,8 @@
   (match-define (list xs ys zss) (f x-min x-max (animated-samples samples)
                                     y-min y-max (animated-samples samples)))
   
-  (define contour-zs
+  (match-define (list (tick zs _ labels) ...) (contour-ticks z-min z-max levels #t))
-    (cond [(list? levels)      levels]
-          [(eq? levels 'auto)  (auto-contour-zs z-min z-max)]
-          [else  (linear-seq z-min z-max levels #:start? #f #:end? #f)]))
   
-  (define zs (append (list z-min) contour-zs (list z-max)))
   (define cs (maybe-apply/list colors zs))
   (define lcs (maybe-apply/list line-colors zs))
   (define lws (maybe-apply/list line-widths zs))
@@ -140,7 +134,7 @@
    area)
   
   (cond [label  (contour-intervals-legend-entries
-                 label z-min z-max contour-zs colors '(solid) line-colors line-widths line-styles
+                 label zs labels colors '(solid) line-colors line-widths line-styles
                  contour-colors contour-widths contour-styles)]
         [else  empty]))
 

collects/plot/plot3d/isosurface.rkt

@@ -4,13 +4,13 @@
          "../common/marching-cubes.rkt"
          "../common/math.rkt"
          "../common/vector.rkt"
-         "../common/contract.rkt" "../common/contract-doc.rkt"
+         "../common/contract.rkt"
+         "../common/contract-doc.rkt"
          "../common/draw.rkt"
          "../common/legend.rkt"
          "../common/sample.rkt"
          "../common/parameters.rkt"
-         "renderer.rkt"
+         "renderer.rkt")
-         "sample.rkt")
 
 (provide isosurface3d isosurfaces3d polar3d)
 

collects/plot/plot3d/line.rkt

@@ -3,12 +3,12 @@
 (require racket/class racket/match racket/list racket/contract
          "../common/math.rkt"
          "../common/vector.rkt"
-         "../common/contract.rkt" "../common/contract-doc.rkt"
+         "../common/contract.rkt"
+         "../common/contract-doc.rkt"
          "../common/legend.rkt"
          "../common/sample.rkt"
          "../common/parameters.rkt"
-         "renderer.rkt"
+         "renderer.rkt")
-         "sample.rkt")
 
 (provide lines3d parametric3d)
 

collects/plot/plot3d/plot.rkt

@@ -153,6 +153,9 @@
   (define x-transform (plot-x-transform))
   (define y-transform (plot-y-transform))
   (define z-transform (plot-z-transform))
+  (define x-ticks (plot-x-ticks))
+  (define y-ticks (plot-y-ticks))
+  (define z-ticks (plot-z-ticks))
   (define animating? (plot-animating?))
   (define samples (plot3d-samples))
   (define ambient-light (plot3d-ambient-light))
@@ -172,6 +175,9 @@
                        [plot-x-transform        x-transform]
                        [plot-y-transform        y-transform]
                        [plot-z-transform        z-transform]
+                       [plot-x-ticks            x-ticks]
+                       [plot-y-ticks            y-ticks]
+                       [plot-z-ticks            z-ticks]
                        [plot-animating?         animating?]
                        [plot3d-samples          samples]
                        [plot3d-ambient-light    ambient-light]

collects/plot/plot3d/rectangle.rkt

@@ -68,11 +68,11 @@
          _x-min _x-max _y-min _y-max z-min z-max)
   (define x-ticks
     (for/list ([cat  (in-list c1s)] [x  (in-list tick-xs)])
-      (tick x (->plot-label cat) #t)))
+      (tick x #t (->plot-label cat))))
   (define y-ticks
     (for/list ([cat  (in-list c2s)] [y  (in-list tick-ys)])
-      (tick y (->plot-label cat) #t)))
+      (tick y #t (->plot-label cat))))
-  (values x-ticks y-ticks (default-ticks-fun z-min z-max)))
+  (values x-ticks y-ticks (default-z-ticks z-min z-max)))
 
 (define (adjust/gap i gap)
   (match-define (ivl x1 x2) i)

collects/plot/plot3d/renderer.rkt

@@ -1,9 +1,11 @@
 #lang racket/base
 
 (require racket/list racket/match racket/contract
-         "../common/contract.rkt" "../common/contract-doc.rkt"
+         "../common/contract.rkt"
+         "../common/contract-doc.rkt"
          "../common/math.rkt"
-         "../common/ticks.rkt")
+         "../common/ticks.rkt"
+         "../common/parameters.rkt")
 
 (provide (all-defined-out))
 
@@ -63,6 +65,6 @@
            [y-min real?] [y-max real?]
            [z-min real?] [z-max real?]
            ) (values (listof tick?) (listof tick?) (listof tick?))
-  (values (default-ticks-fun x-min x-max)
+  (values (default-x-ticks x-min x-max)
-          (default-ticks-fun y-min y-max)
+          (default-y-ticks y-min y-max)
-          (default-ticks-fun z-min z-max)))
+          (default-z-ticks z-min z-max)))

collects/plot/plot3d/sample.rkt

@@ -1,12 +0,0 @@
-#lang racket/base
-
-(require racket/contract
-         "../common/contract.rkt"
-         "../common/sample.rkt"
-         "../common/parameters.rkt")
-
-(provide (all-defined-out))
-
-(define 2d-function->sampler (make-2d-function->sampler plot-x-transform plot-y-transform))
-(define 3d-function->sampler
-  (make-3d-function->sampler plot-x-transform plot-y-transform plot-z-transform))

collects/plot/plot3d/surface.rkt

@@ -1,7 +1,8 @@
 #lang racket/base
 
 (require racket/class racket/match racket/list racket/flonum racket/contract
-         "../common/contract.rkt" "../common/contract-doc.rkt"
+         "../common/contract.rkt"
+         "../common/contract-doc.rkt"
          "../common/math.rkt"
          "../common/vector.rkt"
          "../common/marching-squares.rkt"
@@ -12,7 +13,6 @@
          "../common/parameters.rkt"
          "area.rkt"
          "renderer.rkt"
-         "sample.rkt"
          "bounds.rkt")
 
 (provide surface3d)

collects/plot/tests/axis-transform-tests.rkt

@@ -0,0 +1,301 @@
+#lang racket
+
+(require racket/flonum
+         plot
+         plot/utils
+         plot/common/contract
+         plot/common/contract-doc
+         plot/common/axis-transform
+         )
+
+(x-axis-ticks? #f)
+(y-axis-ticks? #f)
+
+(values
+ (parameterize ([plot-x-transform  log-transform])
+   (plot (list (function values 1 5)
+               (function cos 1 5 #:color 3))))
+ (parameterize ([plot-x-transform  cbrt-transform])
+   (plot (list (function values -2 2)
+               (function cos -2 2 #:color 3))))
+ (parameterize ([plot-x-transform  log-transform]
+                [plot-y-transform  cbrt-transform])
+   (define xs (nonlinear-seq 1 5 20 log-transform))
+   (define ys (nonlinear-seq -1 5 20 cbrt-transform))
+   (plot (points (map vector xs ys)))))
+
+(let ()
+  (define trans1 (hand-drawn-transform 25))
+  (define trans2 (hand-drawn-transform 100))
+  (values
+   (parameterize ([plot-x-transform  trans1])
+     (plot (list (function values -2 2)
+                 (function cos -2 2 #:color 3))))
+   (parameterize ([plot-x-transform  trans2])
+     (plot (list (function values -2 2)
+                 (function cos -2 2 #:color 3))))
+   (parameterize ([plot-x-transform  trans1]
+                  [plot-y-transform  trans2])
+     (define xs (nonlinear-seq -2 2 20 trans1))
+     (define ys (nonlinear-seq -2 2 20 trans2))
+     (plot (points (map vector xs ys))))))
+
+(let ()
+  (define trans1 (stretch-transform -1/2 1/2 4))
+  (define trans2 (stretch-transform -1/2 1/2 1/4))
+  (values
+   (parameterize ([plot-x-transform  trans1]
+                  [plot-y-transform  trans2])
+     (plot (list (y-axis -1/2) (y-axis 1/2)
+                 (x-axis -1/2) (x-axis 1/2)
+                 (function values -2 2)
+                 (function cos -2 2 #:color 3))))
+   (parameterize ([plot-x-transform  trans1]
+                  [plot-y-transform  trans2])
+     (define xs (nonlinear-seq -2 2 20 trans1))
+     (define ys (nonlinear-seq -2 2 20 trans2))
+     (plot (points (map vector xs ys))))))
+
+(let ()
+  (define trans1 (axis-transform-compose id-transform (stretch-transform -1 1 1/4)))
+  (define trans2 (axis-transform-compose (stretch-transform -1 1 1/4) id-transform))
+  (values
+   (parameterize ([plot-x-transform  trans1])
+     (plot (list (y-axis -1) (y-axis 1)
+                 (function values -2 2)
+                 (function cos -2 2 #:color 3))))
+   (parameterize ([plot-x-transform  trans2])
+     (plot (list (y-axis -1) (y-axis 1)
+                 (function values -2 2)
+                 (function cos -2 2 #:color 3))))
+   (parameterize ([plot-x-transform  trans1]
+                  [plot-y-transform  trans2])
+     (define xs (nonlinear-seq -2 2 20 trans1))
+     (define ys (nonlinear-seq -2 2 20 trans2))
+     (plot (points (map vector xs ys))))))
+
+(let ()
+  (define t1 (stretch-transform -2 -1 4))
+  (define t2 (stretch-transform 1 2 4))
+  (values
+   (parameterize ([plot-x-transform  (axis-transform-compose t1 t2)])
+     (plot (list (y-axis -2) (y-axis -1 #t)
+                 (y-axis 1 #t) (y-axis 2)
+                 (function values -3 3)
+                 (function cos -3 3 #:color 3))))
+   (parameterize ([plot-x-transform  (axis-transform-compose t2 t1)])
+     (plot (list (y-axis -2) (y-axis -1 #t)
+                 (y-axis 1 #t) (y-axis 2)
+                 (function values -3 3)
+                 (function cos -3 3 #:color 3))))
+   (parameterize ([plot-x-transform  (axis-transform-compose t2 t1)]
+                  [plot-y-transform  (axis-transform-compose t1 t2)])
+     (define xs (nonlinear-seq -3 3 20 (axis-transform-compose t2 t1)))
+     (define ys (nonlinear-seq -3 3 20 (axis-transform-compose t1 t2)))
+     (plot (points (map vector xs ys))))))
+
+(let ()
+  (define t1 (stretch-transform -2 0 4))
+  (define t2 (stretch-transform -1 1 1/4))
+  (define t3 (stretch-transform 2 3 4))
+  (define trans1 (axis-transform-compose (axis-transform-compose t3 t2) t1))
+  (define trans2 (axis-transform-compose (axis-transform-compose t2 t1) t3))
+  (values
+   (parameterize ([plot-x-transform  trans1])
+     (plot (list (y-axis -2) (y-axis 0)
+                 (y-axis -1) (y-axis 1)
+                 (y-axis 2) (y-axis 3)
+                 (function values -3 4)
+                 (function cos -3 4 #:color 3))))
+   (parameterize ([plot-x-transform  trans2])
+     (plot (list (y-axis -2) (y-axis 0)
+                 (y-axis -1) (y-axis 1)
+                 (y-axis 2) (y-axis 3)
+                 (function values -3 4)
+                 (function cos -3 4 #:color 3))))
+   (parameterize ([plot-x-transform  trans1]
+                  [plot-y-transform  trans2])
+     (define xs (nonlinear-seq -3 4 20 trans1))
+     (define ys (nonlinear-seq -3 4 20 trans2))
+     (plot (points (map vector xs ys))))))
+
+(let ()
+  (define trans1 (axis-transform-compose (stretch-transform 2 3 4) log-transform))
+  (define trans2 (axis-transform-compose log-transform (stretch-transform 2 3 4)))
+  (values
+   (parameterize ([plot-x-transform  trans1])
+     (plot (list (y-axis 2) (y-axis 3)
+                 (function values 1 5)
+                 (function cos 1 5 #:color 3))))
+   (parameterize ([plot-x-transform  trans2])
+     (plot (list (y-axis 2) (y-axis 3)
+                 (function values 1 5)
+                 (function cos 1 5 #:color 3))))
+   (parameterize ([plot-x-transform  trans1]
+                  [plot-y-transform  trans2])
+     (define xs (nonlinear-seq 1 5 20 trans1))
+     (define ys (nonlinear-seq 1 5 20 trans2))
+     (plot (points (map vector xs ys))))))
+
+(let ()
+  (define trans (collapse-transform -1 1))
+  (values
+   (parameterize ([plot-x-transform  trans])
+     (plot (list (y-axis 1)
+                 (function values -2 2)
+                 (function cos -2 2 #:color 3))))
+   (parameterize ([plot-x-transform  trans]
+                  [plot-y-transform  trans])
+     (define xs (nonlinear-seq -2 2 20 trans))
+     (plot (points (map vector xs xs))))))
+
+(let ()
+  (define trans1 (axis-transform-compose (collapse-transform 2 3) log-transform))
+  (define trans2 (axis-transform-compose log-transform (collapse-transform 2 3)))
+  (values
+   (parameterize ([plot-x-transform  trans1])
+     (plot (list (y-axis 3)
+                 (function values 1 5)
+                 (function cos 1 5 #:color 3))))
+   (parameterize ([plot-x-transform  trans2])
+     (plot (list (y-axis 3)
+                 (function values 1 5)
+                 (function cos 1 5 #:color 3))))
+   (parameterize ([plot-x-transform  trans1]
+                  [plot-y-transform  trans2])
+     (define xs (nonlinear-seq 1 5 20 trans1))
+     (define ys (nonlinear-seq 1 5 20 trans2))
+     (plot (points (map vector xs ys))))))
+
+(let ()
+  (define trans1 (axis-transform-compose (stretch-transform -1 1 4)
+                                         (collapse-transform -1/2 1/2)))
+  (define trans2 (axis-transform-compose (collapse-transform -1/2 1/2)
+                                         (stretch-transform -1 1 4)))
+  (values
+   (parameterize ([plot-x-transform  trans1])
+     (plot (list (y-axis -1) (y-axis 1)
+                 (y-axis -1/2) (y-axis 1/2)
+                 (function values -2 2)
+                 (function cos -2 2 #:color 3))))
+   (parameterize ([plot-x-transform  trans2])
+     (plot (list (y-axis -1) (y-axis 1)
+                 (y-axis -1/2) (y-axis 1/2)
+                 (function values -2 2)
+                 (function cos -2 2 #:color 3))))
+   (parameterize ([plot-x-transform  trans1]
+                  [plot-y-transform  trans2])
+     (define xs (nonlinear-seq -2 2 20 trans1))
+     (define ys (nonlinear-seq -2 2 20 trans2))
+     (plot (points (map vector xs ys))))))
+
+(let ()
+  (define trans1 (axis-transform-compose (collapse-transform -1 1) (collapse-transform -1/2 1/2)))
+  (define trans2 (axis-transform-compose (collapse-transform -1/2 1/2) (collapse-transform -1 1)))
+  (values
+   (parameterize ([plot-x-transform  trans1])
+     (plot (list (y-axis 1) (y-axis 1/2)
+                 (function values -2 2)
+                 (function cos -2 2 #:color 3))))
+   (parameterize ([plot-x-transform  trans2])
+     (plot (list (y-axis 1) (y-axis 1/2)
+                 (function values -2 2)
+                 (function cos -2 2 #:color 3))))
+   (parameterize ([plot-x-transform  trans1]
+                  [plot-y-transform  trans2])
+     (define xs (nonlinear-seq -2 2 20 trans1))
+     (define ys (nonlinear-seq -2 2 20 trans2))
+     (plot (points (map vector xs ys))))))
+
+(parameterize ([plot-x-transform  (collapse-transform -1 1)])
+  (plot (function values 0 2)))
+
+(parameterize ([plot-x-transform  (collapse-transform -1 1)])
+  (plot (function values -2 0)))
+
+(parameterize ([plot-x-transform  (axis-transform-append id-transform log-transform 0.1)])
+  (plot (function sin -4 4)))
+
+(let ()
+  (define trans (axis-transform-append id-transform log-transform 2))
+  (define ticks (log-ticks #:base 10))
+  (values
+   (parameterize ([plot-x-transform  trans]
+                  [plot-x-ticks      ticks])
+     (plot (list (function values 1 15)
+                 (function cos 1 15 #:color 3))))
+   (parameterize ([plot-x-transform  trans]
+                  [plot-y-transform  trans])
+     (define xs (nonlinear-seq 1 15 20 trans))
+     (plot (points (map vector xs xs))))))
+
+(let ()
+  (define t1 (stretch-transform 2 3 4))
+  (define t2 (stretch-transform 7 8 4))
+  (define trans1 (axis-transform-compose (axis-transform-append t1 t2 5) log-transform))
+  (define trans2 (axis-transform-compose log-transform (axis-transform-append t1 t2 5)))
+  (values
+   (parameterize ([plot-x-transform  trans1])
+     (plot (list (for/list ([x  (in-list '(2 3 7 8))]) (y-axis x))
+                 (function values 1 9))))
+   (parameterize ([plot-x-transform  trans2])
+     (plot (list (for/list ([x  (in-list '(2 3 7 8))]) (y-axis x))
+                 (function values 1 9))))
+   (parameterize ([plot-x-transform  trans1]
+                  [plot-y-transform  trans2])
+     (define xs (nonlinear-seq 1 9 50 trans1))
+     (define ys (nonlinear-seq 1 9 50 trans2))
+     (plot (points (map vector xs ys))))))
+
+(let ()
+  (define trans1 (axis-transform-append log-transform id-transform 5))
+  (define trans2 (axis-transform-append id-transform log-transform 5))
+  (values
+   (parameterize ([plot-x-transform  trans1])
+     (plot (list (y-axis 5)
+                 (function values 6 10)
+                 (function cos 6 10 #:color 3))))
+   (parameterize ([plot-x-transform  trans2])
+     (plot (list (y-axis 5)
+                 (function values 6 10)
+                 (function cos 6 10 #:color 3))))
+   (parameterize ([plot-x-transform  trans1]
+                  [plot-y-transform  trans2])
+     (define xs (nonlinear-seq 6 10 20 trans1))
+     (define ys (nonlinear-seq 6 10 20 trans2))
+     (plot (points (map vector xs ys))))
+   (parameterize ([plot-x-transform  trans1])
+     (plot (list (y-axis 5)
+                 (function values 1 4)
+                 (function cos 1 4 #:color 3))))
+   (parameterize ([plot-x-transform  trans2])
+     (plot (list (y-axis 5)
+                 (function values 1 4)
+                 (function cos 1 4 #:color 3))))
+   (parameterize ([plot-x-transform  trans1]
+                  [plot-y-transform  trans2])
+     (define xs (nonlinear-seq 1 4 20 trans1))
+     (define ys (nonlinear-seq 1 4 20 trans2))
+     (plot (points (map vector xs ys))))))
+
+(parameterize ([plot-x-transform  (axis-transform-compose (collapse-transform 2 6)
+                                                          log-transform)]
+               [plot-x-ticks      (log-ticks)])
+  (plot (list (y-axis 2 #t) (y-axis 6 #t)
+              (function values 1 10))))
+
+(let ()
+  (define trans1 (axis-transform-bound log-transform 0.1 5))
+  (define trans2 (axis-transform-bound (stretch-transform 1 2 4) 1 2))
+  (values
+   (parameterize ([plot-x-transform  trans1])
+     (plot (list (y-axis 0.1) (y-axis 5)
+                 (function values -3 9))))
+   (parameterize ([plot-x-transform  trans2])
+     (plot (list (y-axis 1) (y-axis 2)
+                 (function values 0 3))))
+   (parameterize ([plot-x-transform  trans1]
+                  [plot-y-transform  trans2])
+     (define xs (nonlinear-seq -3 9 20 trans1))
+     (define ys (nonlinear-seq 0 3 20 trans2))
+     (plot (points (map vector xs ys))))))

collects/plot/tests/plot2d-tests.rkt

@@ -10,10 +10,17 @@
 
 (plot empty #:x-min -1 #:x-max 1 #:y-min -1 #:y-max 1)
 
-(plot (list (axes 1 2) (function values -4 4)))
+(plot (list (function values -4 4) (axes 1 2 #t #t)))
 
 (time (plot (function values 0 1000)))
 
+(parameterize ([plot-x-ticks      (log-ticks #:base 4)]
+               [plot-x-transform  log-transform]
+               [plot-y-max-ticks  10]
+               [plot-y-ticks      (linear-ticks)]
+               [plot-y-transform  log-transform])
+  (plot (function values 1 243)))
+
 (parameterize ([plot-background  "black"]
                [plot-foreground  "white"]
                [plot-background-alpha  1/2]
@@ -403,3 +410,14 @@
           13 (λ (n) (function (make-fun n) 0 2
                               #:color n #:width 2 #:style n))))
         #:x-min -2 #:x-max 2)))
+
+(let ()
+  (define (f x) (/ (sin x) x))
+  (parameterize ([plot-x-transform  (stretch-transform -1 1 10)]
+                 [plot-y-ticks      (fraction-ticks)])
+    (plot (list (y-axis -1 #t #:ticks? #f) (y-axis 1 #t #:ticks? #f)
+                (function f -1 1 #:width 2 #:color 4)
+                (function f -14 -1 #:color 4 #:label "y = sin(x)/x")
+                (function f 1 14 #:color 4)
+                (point-label (vector 0 1) "y → 1 as x → 0" #:anchor 'bottom-right))
+          #:y-max 1.2)))

collects/plot/tests/tick-tests.rkt

@@ -0,0 +1,82 @@
+#lang racket
+
+(require plot (only-in plot/common/math floor-log/base real-modulo))
+
+(plot-font-family 'swiss)
+
+(plot (function (λ (x) (count pre-tick-major? ((linear-ticks) 0 x 8 id-transform)))
+                0.1 10))
+
+(plot (function (λ (x) (count pre-tick-major? ((linear-ticks) 0 x 40 id-transform)))
+                1 100))
+
+(parameterize ([plot-x-ticks  (linear-ticks #:base 2 #:divisors '(1 2))]
+               #;[plot-y-ticks  (linear-ticks #:base (* 1 2 3 4 5) #:divisors '(1 2 3 4 5))])
+  (plot (function cos 0.013 2.1176)))
+
+(parameterize ([plot-x-transform  log-transform]
+               [plot-x-ticks  (ticks (log-ticks-layout)
+                                     (fraction-ticks-format))]
+               [plot-y-ticks  (fraction-ticks)])
+  (plot (function (λ (x) (+ 1 (cos x))) 0.0001 12)))
+
+(parameterize ([plot-x-ticks  (date-ticks)]
+               [plot-x-max-ticks  3]
+               [plot-y-ticks  (currency-ticks)])
+  (plot (function values -1 1)))
+
+(parameterize ([plot-x-ticks  (date-ticks)]
+               [currency-format-strings  uk-currency-format-strings]
+               [currency-scale-suffixes  uk-currency-scale-suffixes]
+               [plot-y-ticks  (currency-ticks #:kind 'GBP)])
+  (plot (function values 101232512 2321236192)))
+
+(parameterize ([currency-format-strings  eu-currency-format-strings]
+               [currency-scale-suffixes  eu-currency-scale-suffixes]
+               [plot-x-ticks  (currency-ticks #:kind 'EUR)]
+               [plot-y-ticks  (currency-ticks)])
+  (plot (function (λ (x) (* x 1.377)) 8000000 10000000)
+        #:title "EUR-USD Conversion, 2011-10-13"
+        #:x-label "Euros"
+        #:y-label "Dollars"))
+
+(parameterize ([plot-x-ticks  no-ticks])
+  (plot (function sin -1 4)))
+
+(parameterize ([plot-x-transform  log-transform]
+               [plot-y-transform  log-transform]
+               [plot-x-ticks      (log-ticks #:base 10)]
+               [plot-y-ticks      (log-ticks #:base 2)])
+  (plot (function values 0.1 10)))
+
+(parameterize ([plot-x-transform  log-transform]
+               [plot-y-transform  (stretch-transform -1 1 4)]
+               [plot-x-ticks      (ticks (uniform-ticks-layout)
+                                         (log-ticks-format #:base 10))]
+               [plot-y-ticks      (ticks (uniform-ticks-layout)
+                                         (currency-ticks-format #:kind 'USD))])
+  (plot (function log 0.1 10)))
+
+(parameterize ([plot-x-transform  log-transform]
+               [plot-x-ticks      (log-ticks #:base 10)])
+  (plot (function values 10000000000000 1000000000000000)))
+
+(plot (polar-axes) #:x-min -1 #:x-max 1 #:y-min -1 #:y-max 1)
+
+(plot (polar-axes) #:x-min 0 #:x-max 3 #:y-min 0 #:y-max 3)
+
+(plot (polar-axes) #:x-min 1 #:x-max 4 #:y-min 1 #:y-max 4)
+
+(plot (polar-axes #:number 12) #:x-min 10 #:x-max 12 #:y-min 10 #:y-max 12)
+
+(parameterize ([plot-z-transform  log-transform]
+               [plot-z-ticks      (log-ticks)]
+               [contour-samples   (plot3d-samples)])
+  (values
+   (plot (contours (λ (x y) (exp (- (+ (sqr x) (sqr y))))) -2 2 -2 2 #:label "z"))
+   (plot (contour-intervals (λ (x y) (exp (- (+ (sqr x) (sqr y))))) -2 2 -2 2 #:label "z"))
+   (plot3d (contours3d (λ (x y) (exp (- (+ (sqr x) (sqr y))))) -2 2 -2 2 #:label "z"))
+   (plot3d (contour-intervals3d (λ (x y) (exp (- (+ (sqr x) (sqr y))))) -2 2 -2 2 #:label "z"))))
+
+(plot (contours (λ (x y) (* 1/2 (+ (sqr x) (sqr y)))) -1 1 -1 1 #:label "z"))
+(plot3d (contours3d (λ (x y) (* 1/2 (+ (sqr x) (sqr y)))) -1 1 -1 1 #:label "z"))

collects/tests/plot/run-tests.rkt

@@ -4,7 +4,8 @@ exec gracket "$0" "$@"
 |#
 #lang racket
 
-(require rackunit plot plot/utils)
+(require rackunit racket/date
+         plot plot/utils plot/common/date-time)
 
 (check-equal? (linear-seq 0 1 2 #:start? #t #:end? #t) '(0 1))
 (check-equal? (linear-seq 0 1 2 #:start? #t #:end? #f) '(0 2/3))
@@ -14,3 +15,60 @@ exec gracket "$0" "$@"
 (check-exn exn:fail:contract?
            (λ () (vector-field (λ (v [z 0]) v) -4 4 -4 4))
            "Exception should be 'two of the clauses in the or/c might both match' or similar")
+
+;; ===================================================================================================
+;; Date rounding
+
+(check-equal? (utc-seconds-round-year (find-seconds 0 0 12 2 7 1970 #f))
+              (find-seconds 0 0 0 1 1 1970 #f))
+(check-equal? (utc-seconds-round-year (find-seconds 0 0 13 2 7 1970 #f))
+              (find-seconds 0 0 0 1 1 1971 #f))
+;; A leap year's middle is a half day earlier on the calendar:
+(check-equal? (utc-seconds-round-year (find-seconds 0 0 0 2 7 1976 #f))
+              (find-seconds 0 0 0 1 1 1976 #f))
+(check-equal? (utc-seconds-round-year (find-seconds 0 0 1 2 7 1976 #f))
+              (find-seconds 0 0 0 1 1 1977 #f))
+
+(check-equal? (utc-seconds-round-month (find-seconds 0 0 0 16 1 2010 #f))
+              (find-seconds 0 0 0 1 1 2010 #f))
+(check-equal? (utc-seconds-round-month (find-seconds 0 0 0 17 1 2010 #f))
+              (find-seconds 0 0 0 1 2 2010 #f))
+(check-equal? (utc-seconds-round-month (find-seconds 0 0 12 16 1 2010 #f))
+              (find-seconds 0 0 0 1 1 2010 #f))
+(check-equal? (utc-seconds-round-month (find-seconds 0 0 13 16 1 2010 #f))
+              (find-seconds 0 0 0 1 2 2010 #f))
+(check-equal? (utc-seconds-round-month (find-seconds 0 0 0 16 12 2010 #f))
+              (find-seconds 0 0 0 1 12 2010 #f))
+(check-equal? (utc-seconds-round-month (find-seconds 0 0 0 17 12 2010 #f))
+              (find-seconds 0 0 0 1 1 2011 #f))
+
+;; ===================================================================================================
+;; Time conversion
+
+(check-equal? (seconds->plot-time 0)                (plot-time 0 0 0 0))
+(check-equal? (seconds->plot-time #e59.999999)      (plot-time #e59.999999 0 0 0))
+(check-equal? (seconds->plot-time 60)               (plot-time 0 1 0 0))
+(check-equal? (seconds->plot-time #e60.000001)      (plot-time #e0.000001 1 0 0))
+(check-equal? (seconds->plot-time #e119.999999)     (plot-time #e59.999999 1 0 0))
+(check-equal? (seconds->plot-time 120)              (plot-time 0 2 0 0))
+(check-equal? (seconds->plot-time #e120.000001)     (plot-time #e0.000001 2 0 0))
+(check-equal? (seconds->plot-time 3599)             (plot-time 59 59 0 0))
+(check-equal? (seconds->plot-time 3600)             (plot-time 0 0 1 0))
+(check-equal? (seconds->plot-time 3601)             (plot-time 1 0 1 0))
+(check-equal? (seconds->plot-time (- seconds-per-day 1))         (plot-time 59 59 23 0))
+(check-equal? (seconds->plot-time seconds-per-day)               (plot-time 0 0 0 1))
+(check-equal? (seconds->plot-time (- seconds-per-day))           (plot-time 0 0 0 -1))
+(check-equal? (seconds->plot-time (- (- seconds-per-day) 1))     (plot-time 59 59 23 -2))
+
+(define sec-secs (sequence->list (in-range -60 61 #e0.571123)))
+(define min-secs (sequence->list (in-range (- seconds-per-hour) (+ seconds-per-hour 1)
+                                           (* #e0.571123 seconds-per-minute))))
+(define hour-secs (sequence->list (in-range (- seconds-per-day) (+ seconds-per-day 1)
+                                            (* #e0.571123 seconds-per-hour))))
+(define day-secs (sequence->list (in-range (- seconds-per-week) (+ seconds-per-week 1)
+                                           (* #e0.571123 seconds-per-day))))
+(check-equal? (map (compose plot-time->seconds seconds->plot-time) sec-secs) sec-secs)
+(check-equal? (map (compose plot-time->seconds seconds->plot-time) min-secs) min-secs)
+(check-equal? (map (compose plot-time->seconds seconds->plot-time) hour-secs) hour-secs)
+(check-equal? (map (compose plot-time->seconds seconds->plot-time) day-secs) day-secs)
+