suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fixed a bug with small (but not epsilon) flonum bounds

Browse Source
This commit is contained in:
Neil Toronto 2011-11-25 23:16:23 -07:00
parent 11994bd4f8
commit 918c4e97a6
5 changed files with 48 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
collects/plot/common/plot-element.rkt
View File

@ -84,41 +84,36 @@
;; (apply-bounds* elems), 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 (bounds-fixpoint elems given-bounds-rect [max-iters 4])
(define res
(let/ec break
;; Shortcut eval: if the plot bounds are all given, the code below just returns them anyway
(when (rect-known? given-bounds-rect) (break given-bounds-rect))
(let ([given-bounds-rect (rect-inexact->exact given-bounds-rect)])
;; Objective: find the fixpoint of F starting at given-bounds-rect
(define (F bounds-rect) (rect-meet given-bounds-rect (apply-bounds* elems bounds-rect)))
;; Iterate joint bounds to (hopefully) a fixpoint
(define-values (bounds-rect area delta-area)
(for/fold ([bounds-rect given-bounds-rect]
[area (rect-area given-bounds-rect)] [delta-area #f]
) ([n (in-range max-iters)])
;(printf "bounds-rect = ~v~n" bounds-rect)
;; Get new bounds from the elements' bounds functions
(define new-bounds-rect (F bounds-rect))
(define new-area (rect-area new-bounds-rect))
(define new-delta-area (and area new-area (- new-area area)))
(cond
;; Shortcut eval: if the bounds haven't changed, we have a fixpoint
[(equal? bounds-rect new-bounds-rect) (break bounds-rect)]
;; If the area grew more this iteration than last, it may not converge, so stop now
[(and delta-area new-delta-area (new-delta-area . > . delta-area)) (break bounds-rect)]
;; All good - one more iteration
[else (values new-bounds-rect new-area new-delta-area)])))
bounds-rect)))
;(printf "fixpoint bounds-rect = ~v~n" res)
res)
;; Objective: find the fixpoint of F starting at given-bounds-rect
(define (F bounds-rect) (rect-meet given-bounds-rect (apply-bounds* elems bounds-rect)))
;; Iterate joint bounds to (hopefully) a fixpoint
(define-values (bounds-rect area delta-area)
(for/fold ([bounds-rect given-bounds-rect]
[area (rect-area given-bounds-rect)] [delta-area #f]
) ([n (in-range max-iters)])
;(printf "bounds-rect = ~v~n" bounds-rect)
;; Get new bounds from the elements' bounds functions
(define new-bounds-rect (F bounds-rect))
(define new-area (rect-area new-bounds-rect))
(define new-delta-area (and area new-area (- new-area area)))
(cond
;; Shortcut eval: if the bounds haven't changed, we have a fixpoint
[(equal? bounds-rect new-bounds-rect) (break bounds-rect)]
;; If the area grew more this iteration than last, it may not converge, so stop now
[(and delta-area new-delta-area (new-delta-area . > . delta-area)) (break bounds-rect)]
;; All good - one more iteration
[else (values new-bounds-rect new-area new-delta-area)])))
bounds-rect))
;; Applies the bounds functions of multiple plot elements, in parallel, and returns the smallest
;; bounds containing all the new bounds. This function is monotone and increasing regardless of
;; whether any element's bounds function is. If iterating it is bounded, a fixpoint exists.
(define (apply-bounds* elems bounds-rect)
(rect-inexact->exact
(apply rect-join bounds-rect (for/list ([elem (in-list elems)])
(apply-bounds elem bounds-rect)))))
(apply rect-join bounds-rect (for/list ([elem (in-list elems)])
(apply-bounds elem bounds-rect))))
;; Applies the plot element's bounds function. Asks this question: If these are your allowed bounds,
;; what bounds will you try to use?

6
collects/plot/plot2d/plot-area.rkt
View File

@ -291,6 +291,7 @@
;; Fixpoint margin computation
(define (get-param-vs/set-view->dc! left right top bottom)
;(printf "margins = ~v ~v ~v ~v~n" left right top bottom)
(set! view->dc (make-view->dc left right top bottom))
(append (append* (map (λ (params) (send/apply pd get-text-corners params))
(get-all-label-params)))
@ -372,9 +373,10 @@
(draw-axes)
(draw-ticks)
(draw-labels)
(define lw (plot-line-width))
(send pd set-clipping-rect
(vector (ivl (+ 1/2 (- area-x-min (plot-line-width))) (+ area-x-max (plot-line-width)))
(ivl (+ 1/2 (- area-y-min (plot-line-width))) (+ area-y-max (plot-line-width))))))
(vector (ivl (+ 1/2 (- area-x-min lw)) (+ area-x-max lw))
(ivl (+ 1/2 (- area-y-min lw)) (+ area-y-max lw)))))
(define/public (start-renderer rend-bounds-rect)
(reset-drawing-params)

11
collects/plot/plot2d/plot.rkt
View File

@ -42,7 +42,7 @@
(match-define (vector x-ivl y-ivl) plot-bounds-rect)
(error 'plot "could not determine sensible plot bounds; got x ∈ ~a, y ∈ ~a"
(ivl->plot-label x-ivl) (ivl->plot-label y-ivl)))
plot-bounds-rect)
(rect-inexact->exact plot-bounds-rect))
(define (get-ticks renderer-list bounds-rect)
(define-values (all-x-ticks all-x-far-ticks all-y-ticks all-y-far-ticks)
@ -65,7 +65,9 @@
(define legend-entries
(flatten (for/list ([rend (in-list renderer-list)])
(match-define (renderer2d rend-bounds-rect _bf _tf render-proc) rend)
(send area start-renderer (if rend-bounds-rect rend-bounds-rect (empty-rect 2)))
(send area start-renderer (if rend-bounds-rect
(rect-inexact->exact rend-bounds-rect)
(unknown-rect 2)))
(if render-proc (render-proc area) empty))))
(send area end-renderers)
@ -176,8 +178,9 @@
(define legend-entries
(flatten (for/list ([rend (in-list renderer-list)])
(match-define (renderer2d rend-bounds-rect _bf _tf render-proc) rend)
(send area start-renderer
(if rend-bounds-rect rend-bounds-rect (empty-rect 2)))
(send area start-renderer (if rend-bounds-rect
(rect-inexact->exact rend-bounds-rect)
(unknown-rect 2)))
(if render-proc (render-proc area) empty))))
(send area end-renderers)

11
collects/plot/plot3d/plot.rkt
View File

@ -42,7 +42,7 @@
(match-define (vector x-ivl y-ivl z-ivl) plot-bounds-rect)
(error 'plot "could not determine sensible plot bounds; got x ∈ ~a, y ∈ ~a, z ∈ ~a"
(ivl->plot-label x-ivl) (ivl->plot-label y-ivl) (ivl->plot-label z-ivl)))
plot-bounds-rect)
(rect-inexact->exact plot-bounds-rect))
(define (get-ticks renderer-list bounds-rect)
(define-values (all-x-ticks all-x-far-ticks all-y-ticks all-y-far-ticks all-z-ticks all-z-far-ticks)
@ -73,7 +73,9 @@
(define legend-entries
(flatten (for/list ([rend (in-list renderer-list)])
(match-define (renderer3d rend-bounds-rect _bf _tf render-proc) rend)
(send area start-renderer (if rend-bounds-rect rend-bounds-rect (empty-rect 3)))
(send area start-renderer (if rend-bounds-rect
(rect-inexact->exact rend-bounds-rect)
(unknown-rect 3)))
(if render-proc (render-proc area) empty))))
(send area end-renderers)
@ -207,8 +209,9 @@
legend-entries-hash (plot-animating?)
(flatten (for/list ([rend (in-list renderer-list)])
(match-define (renderer3d rend-bounds-rect _bf _tf render-proc) rend)
(send area start-renderer (cond [rend-bounds-rect rend-bounds-rect]
[else (empty-rect 3)]))
(send area start-renderer (if rend-bounds-rect
(rect-inexact->exact rend-bounds-rect)
(unknown-rect 3)))
(if render-proc (render-proc area) empty))))
(hash-set! render-list-hash (plot-animating?) (send area get-render-list))]

8
collects/plot/tests/extreme-bounds-tests.rkt
View File

@ -2,6 +2,14 @@
(require plot plot/utils unstable/flonum)
(plot (points '(#(0 0)))
#:x-min +min.0 #:x-max (flstep +min.0 1000)
#:y-min 0 #:y-max 1)
(plot3d (points3d '(#(0 0 0)))
#:x-min +min.0 #:x-max (flstep +min.0 1000)
#:y-min 0 #:y-max 1 #:z-min 0 #:z-max 1)
(plot-x-label #f)
(plot-y-label #f)