#lang racket/base

;; Data structure that represents a tick, and functions that produce ticks.

(require racket/string racket/list racket/contract racket/pretty racket/match
         "math.rkt"
         "format.rkt"
         "utils.rkt"
         "contract.rkt"
         "contract-doc.rkt"
         "date-time.rkt"
         "axis-transform.rkt"
         "currency.rkt")

(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 pre-tick ([value real?] [major? boolean?]) #:transparent)
(define-struct/contract (tick pre-tick) ([label string?]) #:transparent)

(defcontract ticks-layout/c
  (real? real? exact-positive-integer? axis-transform/c . -> . (listof pre-tick?)))

(defcontract ticks-format/c
  (real? real? (listof pre-tick?) . -> . (listof string?)))

(define-struct/contract ticks ([layout ticks-layout/c] [format ticks-format/c]) #:transparent
  #: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))))

;; ===================================================================================================
;; Helpers

(define-syntax-rule (with-exact-bounds x-min x-max body ...)
  (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)))