72 lines
3.4 KiB
Racket
72 lines
3.4 KiB
Racket
#lang racket/base
|
|
|
|
;; Functions that sample from functions, and functions that create memoized samplers.
|
|
|
|
(require racket/match racket/flonum racket/math racket/contract racket/list
|
|
"parameters.rkt"
|
|
"sample.rkt"
|
|
"ticks.rkt"
|
|
"format.rkt"
|
|
"contract-doc.rkt")
|
|
|
|
(provide (all-defined-out))
|
|
|
|
(defthing function->sampler ((real? . -> . real?) . -> . sampler/c)
|
|
(make-function->sampler plot-x-transform))
|
|
|
|
(defthing inverse->sampler ((real? . -> . real?) . -> . sampler/c)
|
|
(make-function->sampler plot-y-transform))
|
|
|
|
(defthing 2d-function->sampler ((real? real? . -> . real?) . -> . 2d-sampler/c)
|
|
(make-2d-function->sampler plot-x-transform plot-y-transform))
|
|
|
|
(defthing 3d-function->sampler ((real? real? real? . -> . real?) . -> . 3d-sampler/c)
|
|
(make-3d-function->sampler plot-x-transform plot-y-transform plot-z-transform))
|
|
|
|
(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)))]
|
|
[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 (isosurface-ticks [d-min real?] [d-max real?]
|
|
[levels (or/c 'auto exact-positive-integer? (listof real?))]
|
|
) (listof tick?)
|
|
(define epsilon (expt 10 (- (digits-for-range d-min d-max))))
|
|
(match-define (ticks layout format) (plot-d-ticks))
|
|
(define ts
|
|
(cond [(eq? levels 'auto) (filter pre-tick-major? (layout d-min d-max (plot-d-max-ticks)))]
|
|
[else (define ds (cond [(list? levels) (filter (λ (d) (<= d-min d d-max)) levels)]
|
|
[else (linear-seq d-min d-max levels #:start? #f #:end? #f)]))
|
|
(map (λ (d) (pre-tick d #t)) ds)]))
|
|
(define all-ts
|
|
(let* ([ts (cond [((abs (- d-min (pre-tick-value (first ts)))) . >= . epsilon) ts]
|
|
[else (rest ts)])]
|
|
[ts (cond [((abs (- d-max (pre-tick-value (last ts)))) . >= . epsilon) ts]
|
|
[else (take ts (- (length ts) 1))])])
|
|
ts))
|
|
(match-define (list (pre-tick ds majors) ...) all-ts)
|
|
(define labels (format d-min d-max all-ts))
|
|
(map tick ds majors labels))
|