105 lines
4.9 KiB
Racket
105 lines
4.9 KiB
Racket
#lang racket/base
|
|
|
|
(require racket/list racket/contract racket/match
|
|
"math.rkt"
|
|
"vector.rkt"
|
|
"contract.rkt"
|
|
"contract-doc.rkt"
|
|
"parameters.rkt"
|
|
"sample.rkt")
|
|
|
|
(provide (all-defined-out))
|
|
|
|
(struct renderer (bounds-rect bounds-fun ticks-fun) #:transparent)
|
|
(struct renderer2d renderer (render-proc) #:transparent)
|
|
(struct renderer3d renderer (render-proc) #:transparent)
|
|
|
|
;; ===================================================================================================
|
|
;; Common field values
|
|
|
|
(define (default-ticks-fun r)
|
|
(apply values (for/list ([i (in-vector r)]
|
|
[f (in-list (list default-x-ticks default-y-ticks default-z-ticks))])
|
|
(match-define (ivl a b) i)
|
|
(f a b))))
|
|
|
|
(define ((function-bounds-fun f samples) r)
|
|
(match-define (vector xi yi) r)
|
|
(cond [(ivl-known? xi)
|
|
(match-define (ivl x-min x-max) xi)
|
|
(match-define (list xs ys) (f x-min x-max samples))
|
|
(define rys (filter regular? ys))
|
|
(cond [(not (empty? rys)) (vector xi (ivl (apply min* rys) (apply max* rys)))]
|
|
[else r])]
|
|
[else r]))
|
|
|
|
(define ((inverse-bounds-fun f samples) r)
|
|
(match-define (vector xi yi) r)
|
|
(cond [(ivl-known? yi)
|
|
(match-define (ivl y-min y-max) yi)
|
|
(match-define (list ys xs) (f y-min y-max samples))
|
|
(define rxs (filter regular? xs))
|
|
(cond [(not (empty? rxs)) (vector (ivl (apply min* rxs) (apply max* rxs)) yi)]
|
|
[else r])]
|
|
[else r]))
|
|
|
|
(define ((function-interval-bounds-fun f1 f2 samples) r)
|
|
(rect-join ((function-bounds-fun f1 samples) r)
|
|
((function-bounds-fun f2 samples) r)))
|
|
|
|
(define ((inverse-interval-bounds-fun f1 f2 samples) r)
|
|
(rect-join ((inverse-bounds-fun f1 samples) r)
|
|
((inverse-bounds-fun f2 samples) r)))
|
|
|
|
(define ((surface3d-bounds-fun f samples) r)
|
|
(match-define (vector xi yi zi) r)
|
|
(cond [(and (ivl-known? xi) (ivl-known? yi))
|
|
(match-define (ivl x-min x-max) xi)
|
|
(match-define (ivl y-min y-max) yi)
|
|
(match-define (list xs ys zss) (f x-min x-max samples y-min y-max samples))
|
|
(define zs (filter regular? (2d-sample->list zss)))
|
|
(cond [(not (empty? zs)) (vector xi yi (ivl (apply min* zs) (apply max* zs)))]
|
|
[else r])]
|
|
[else r]))
|
|
|
|
;; ===================================================================================================
|
|
;; Fixpoint computation of bounding rectangles
|
|
|
|
;; The reasoning in the following comments is in terms of a lattice comprised of rectangles,
|
|
;; rect-meet and rect-join. Think of rect-meet like a set intersection; rect-join like a set union.
|
|
|
|
;; Attempts to comptute a fixpoint of, roughly, the bounds functions for the given renderers.
|
|
;; More precisely, starting with the given plot bounds, it attempts to compute a fixpoint of
|
|
;; (renderer-apply-bounds* rs), overridden at every iteration by the plot bounds (if given).
|
|
;; Because a fixpoint doesn't always exist, or only exists in the limit, it stops after max-iters.
|
|
(define (renderer-bounds-fixpoint rends plot-bounds-rect [max-iters 4])
|
|
(let/ec break
|
|
;; Shortcut eval: if the plot bounds are all known, the code below just returns them anyway
|
|
(when (rect-known? plot-bounds-rect) (break plot-bounds-rect))
|
|
;; Objective: find the fixpoint of F (meeted with plot-bounds-rect) starting at plot-bounds-rect
|
|
(define F (renderer-apply-bounds* rends))
|
|
;; Iterate joint bounds to (hopefully) a fixpoint
|
|
(for/fold ([bounds-rect plot-bounds-rect]) ([n (in-range max-iters)])
|
|
;(printf "bounds-rect = ~v~n" bounds-rect)
|
|
;; Get new bounds from the renderers' bounds functions, limit them to plot bounds (when given)
|
|
(define new-bounds-rect (rect-meet plot-bounds-rect (F bounds-rect)))
|
|
;; Shortcut eval: if the bounds haven't changed, we have a fixpoint
|
|
(cond [(equal? bounds-rect new-bounds-rect) (break bounds-rect)]
|
|
[else new-bounds-rect]))))
|
|
|
|
;; Applies the bounds functions of multiple renderers, in parallel, and returns the smallest bounds
|
|
;; containing all the new bounds. This function is monotone and increasing regardless of whether any
|
|
;; renderer's bounds function is. If iterating it is bounded, a fixpoint exists.
|
|
(define ((renderer-apply-bounds* rends) bounds-rect)
|
|
(apply rect-join bounds-rect (for/list ([rend (in-list rends)])
|
|
(renderer-apply-bounds rend bounds-rect))))
|
|
|
|
;; Applies the renderer's bounds function. Asks this question: If these are your allowed bounds, what
|
|
;; bounds will you try to draw in?
|
|
(define (renderer-apply-bounds rend bounds-rect)
|
|
(match-define (renderer rend-bounds-rect rend-bounds-fun _) rend)
|
|
(let ([rend-bounds-rect (cond [rend-bounds-rect (rect-meet bounds-rect rend-bounds-rect)]
|
|
[else bounds-rect])])
|
|
(cond [rend-bounds-fun (rend-bounds-fun rend-bounds-rect)]
|
|
[else rend-bounds-rect])))
|