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

Added #:add-ticks? arguments to 2d histogram functions

Browse Source 
Added #:add-x-ticks? and #:add-y-ticks? arguments to 3d histogram functions
This commit is contained in:
Neil Toronto 2012-07-10 11:21:35 -07:00
parent ef2bd3fc0a
commit 3d1f2da3bc
4 changed files with 35 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
collects/plot/plot2d/rectangle.rkt
View File

@ -89,11 +89,12 @@
;; =================================================================================================== ;; ===================================================================================================
;; Discrete histograms ;; Discrete histograms
(define ((discrete-histogram-ticks-fun cats tick-xs far-ticks? maybe-invert) r) (define ((discrete-histogram-ticks-fun cats tick-xs add-ticks? far-ticks? maybe-invert) r)
(match-define (vector _ (ivl y-min y-max)) (apply maybe-invert (vector->list r))) (match-define (vector _ (ivl y-min y-max)) (apply maybe-invert (vector->list r)))
(define-values (x-ticks x-far-ticks) (define-values (x-ticks x-far-ticks)
(let ([ticks (for/list ([cat (in-list cats)] [x (in-list tick-xs)]) (let ([ticks (cond [add-ticks? (for/list ([cat (in-list cats)] [x (in-list tick-xs)])
(tick x #t (->plot-label cat)))]) (tick x #t (->plot-label cat)))]
[else empty])])
(if far-ticks? (values empty ticks) (values ticks empty)))) (if far-ticks? (values empty ticks) (values ticks empty))))
(match-let* (match-let*
([(vector plot-x-ticks plot-y-ticks) (maybe-invert (plot-x-ticks) ([(vector plot-x-ticks plot-y-ticks) (maybe-invert (plot-x-ticks)
@ -118,6 +119,7 @@
[#:line-style line-style plot-pen-style/c (rectangle-line-style)] [#:line-style line-style plot-pen-style/c (rectangle-line-style)]
[#:alpha alpha (real-in 0 1) (rectangle-alpha)] [#:alpha alpha (real-in 0 1) (rectangle-alpha)]
[#:label label (or/c string? #f) #f] [#:label label (or/c string? #f) #f]
[#:add-ticks? add-ticks? boolean? #t]
[#:far-ticks? far-ticks? boolean? #f] [#:far-ticks? far-ticks? boolean? #f]
) renderer2d? ) renderer2d?
(match-define (list (vector cats ys) ...) cat-vals) (match-define (list (vector cats ys) ...) cat-vals)
@ -141,7 +143,7 @@
(define maybe-invert (if invert? (λ (x y) (vector y x)) vector)) (define maybe-invert (if invert? (λ (x y) (vector y x)) vector))
(renderer2d (renderer2d
(maybe-invert (ivl x-min x-max) (ivl y-min y-max)) #f (maybe-invert (ivl x-min x-max) (ivl y-min y-max)) #f
(discrete-histogram-ticks-fun cats tick-xs far-ticks? maybe-invert) (discrete-histogram-ticks-fun cats tick-xs add-ticks? far-ticks? maybe-invert)
(rectangles-render-proc (map maybe-invert x-ivls y-ivls) (rectangles-render-proc (map maybe-invert x-ivls y-ivls)
color style line-color line-width line-style alpha label)))])) color style line-color line-width line-style alpha label)))]))
@ -159,6 +161,7 @@
[#:line-styles line-styles (plot-pen-styles/c nat/c) (stacked-histogram-line-styles)] [#:line-styles line-styles (plot-pen-styles/c nat/c) (stacked-histogram-line-styles)]
[#:alphas alphas (alphas/c nat/c) (stacked-histogram-alphas)] [#:alphas alphas (alphas/c nat/c) (stacked-histogram-alphas)]
[#:labels labels (labels/c nat/c) '(#f)] [#:labels labels (labels/c nat/c) '(#f)]
[#:add-ticks? add-ticks? boolean? #t]
[#:far-ticks? far-ticks? boolean? #f] [#:far-ticks? far-ticks? boolean? #f]
) (listof renderer2d?) ) (listof renderer2d?)
(match-define (list (vector cats ys) ...) cat-vals) (match-define (list (vector cats ys) ...) cat-vals)
@ -180,4 +183,5 @@
#:x-min x-min #:x-max x-max #:y-min y-min #:y-max y-max #:x-min x-min #:x-max x-max #:y-min y-min #:y-max y-max
#:gap gap #:skip skip #:invert? invert? #:gap gap #:skip skip #:invert? invert?
#:color color #:style style #:line-color line-color #:line-width line-width #:color color #:style style #:line-color line-color #:line-width line-width
#:line-style line-style #:alpha alpha #:label label #:far-ticks? far-ticks?))) #:line-style line-style #:alpha alpha #:label label
#:add-ticks? add-ticks? #:far-ticks? far-ticks?)))

28
collects/plot/plot3d/rectangle.rkt
View File

@ -56,15 +56,18 @@
;; =================================================================================================== ;; ===================================================================================================
;; Discrete histograms ;; Discrete histograms
(define ((discrete-histogram3d-ticks-fun c1s c2s tick-xs tick-ys x-far-ticks? y-far-ticks?) r) (define ((discrete-histogram3d-ticks-fun
c1s c2s tick-xs tick-ys add-x-ticks? add-y-ticks? x-far-ticks? y-far-ticks?) r)
(match-define (vector _xi _yi (ivl z-min z-max)) r) (match-define (vector _xi _yi (ivl z-min z-max)) r)
(define-values (x-ticks x-far-ticks) (define-values (x-ticks x-far-ticks)
(let ([ts (for/list ([cat (in-list c1s)] [x (in-list tick-xs)]) (let ([ts (cond [add-x-ticks? (for/list ([cat (in-list c1s)] [x (in-list tick-xs)])
(tick x #t (->plot-label cat)))]) (tick x #t (->plot-label cat)))]
[else empty])])
(if x-far-ticks? (values empty ts) (values ts empty)))) (if x-far-ticks? (values empty ts) (values ts empty))))
(define-values (y-ticks y-far-ticks) (define-values (y-ticks y-far-ticks)
(let ([ts (for/list ([cat (in-list c2s)] [y (in-list tick-ys)]) (let ([ts (cond [add-y-ticks? (for/list ([cat (in-list c2s)] [y (in-list tick-ys)])
(tick y #t (->plot-label cat)))]) (tick y #t (->plot-label cat)))]
[else empty])])
(if y-far-ticks? (values empty ts) (values ts empty)))) (if y-far-ticks? (values empty ts) (values ts empty))))
(values x-ticks x-far-ticks (values x-ticks x-far-ticks
y-ticks y-far-ticks y-ticks y-far-ticks
@ -88,6 +91,8 @@
[#:line-style line-style plot-pen-style/c (rectangle-line-style)] [#:line-style line-style plot-pen-style/c (rectangle-line-style)]
[#:alpha alpha (real-in 0 1) (rectangle-alpha)] [#:alpha alpha (real-in 0 1) (rectangle-alpha)]
[#:label label (or/c string? #f) #f] [#:label label (or/c string? #f) #f]
[#:add-x-ticks? add-x-ticks? boolean? #t]
[#:add-y-ticks? add-y-ticks? boolean? #t]
[#:x-far-ticks? x-far-ticks? boolean? #f] [#:x-far-ticks? x-far-ticks? boolean? #f]
[#:y-far-ticks? y-far-ticks? boolean? #f] [#:y-far-ticks? y-far-ticks? boolean? #f]
) renderer3d? ) renderer3d?
@ -129,10 +134,12 @@
(adjust/gap (ivl y1 y2) gap) (adjust/gap (ivl y1 y2) gap)
(if (ivl? z) z (ivl 0 z)))) (if (ivl? z) z (ivl 0 z))))
x1s x2s y1s y2s all-zs)) x1s x2s y1s y2s all-zs))
(renderer3d (vector (ivl x-min x-max) (ivl y-min y-max) (ivl z-min z-max)) #f (renderer3d
(discrete-histogram3d-ticks-fun c1s c2s tick-xs tick-ys x-far-ticks? y-far-ticks?) (vector (ivl x-min x-max) (ivl y-min y-max) (ivl z-min z-max)) #f
(rectangles3d-render-proc rects color style line-color line-width line-style (discrete-histogram3d-ticks-fun c1s c2s tick-xs tick-ys
alpha label)))])) add-x-ticks? add-y-ticks? x-far-ticks? y-far-ticks?)
(rectangles3d-render-proc rects color style line-color line-width line-style
alpha label)))]))
(defproc (stacked-histogram3d (defproc (stacked-histogram3d
[cat-vals (listof (vector/c any/c any/c (listof real?)))] [cat-vals (listof (vector/c any/c any/c (listof real?)))]
@ -147,6 +154,8 @@
[#:line-styles line-styles (plot-pen-styles/c nat/c) (stacked-histogram-line-styles)] [#:line-styles line-styles (plot-pen-styles/c nat/c) (stacked-histogram-line-styles)]
[#:alphas alphas (alphas/c nat/c) (stacked-histogram-alphas)] [#:alphas alphas (alphas/c nat/c) (stacked-histogram-alphas)]
[#:labels labels (labels/c nat/c) '(#f)] [#:labels labels (labels/c nat/c) '(#f)]
[#:add-x-ticks? add-x-ticks? boolean? #t]
[#:add-y-ticks? add-y-ticks? boolean? #t]
[#:x-far-ticks? x-far-ticks? boolean? #f] [#:x-far-ticks? x-far-ticks? boolean? #f]
[#:y-far-ticks? y-far-ticks? boolean? #f] [#:y-far-ticks? y-far-ticks? boolean? #f]
) (listof renderer3d?) ) (listof renderer3d?)
@ -169,4 +178,5 @@
#:x-min x-min #:x-max x-max #:y-min y-min #:y-max y-max #:z-min z-min #:z-max z-max #:gap gap #:x-min x-min #:x-max x-max #:y-min y-min #:y-max y-max #:z-min z-min #:z-max z-max #:gap gap
#:color color #:style style #:line-color line-color #:line-width line-width #:color color #:style style #:line-color line-color #:line-width line-width
#:line-style line-style #:alpha alpha #:label label #:line-style line-style #:alpha alpha #:label label
#:add-x-ticks? add-x-ticks? #:add-y-ticks? add-y-ticks?
#:x-far-ticks? x-far-ticks? #:y-far-ticks? y-far-ticks?))) #:x-far-ticks? x-far-ticks? #:y-far-ticks? y-far-ticks?)))

4
collects/plot/tests/plot2d-tests.rkt
View File

@ -223,13 +223,13 @@
(parameterize ([plot-x-ticks (currency-ticks)]) (parameterize ([plot-x-ticks (currency-ticks)])
(plot (discrete-histogram (list (vector '(a . a) 1) (vector '(a . b) 2) (plot (discrete-histogram (list (vector '(a . a) 1) (vector '(a . b) 2)
(vector '(b . b) 3) (vector '(b . a) 4)) (vector '(b . b) 3) (vector '(b . a) 4))
#:invert? #t)))) #:invert? #t #:add-ticks? #f))))
(time (time
(parameterize ([plot-x-ticks (currency-ticks)]) (parameterize ([plot-x-ticks (currency-ticks)])
(plot (stacked-histogram (list (vector '(a . a) '(1 2 1)) (vector '(a . b) '(2 1 3)) (plot (stacked-histogram (list (vector '(a . a) '(1 2 1)) (vector '(a . b) '(2 1 3))
(vector '(b . b) '()) (vector '(b . a) '(4 4 2))) (vector '(b . b) '()) (vector '(b . a) '(4 4 2)))
#:invert? #t)))) #:invert? #t #:add-ticks? #f))))
(time (time
(plot (rectangles (plot (rectangles

5
collects/plot/tests/plot3d-tests.rkt
View File

@ -55,6 +55,11 @@
(plot3d (stacked-histogram3d '(#(a a (1 1 1)) #(a b (1.5 3)) #(b b ()) #(b a (1/2))) (plot3d (stacked-histogram3d '(#(a a (1 1 1)) #(a b (1.5 3)) #(b b ()) #(b a (1/2)))
#:labels '("Red" #f "Blue") #:alphas '(2/3)))) #:labels '("Red" #f "Blue") #:alphas '(2/3))))
(time
(plot3d (stacked-histogram3d '(#(a a (1 1 1)) #(a b (1.5 3)) #(b b ()) #(b a (1/2)))
#:labels '("Red" #f "Blue") #:alphas '(2/3)
#:add-x-ticks? #f #:add-y-ticks? #f)))
(time (time
(plot3d (surface3d + 0 10 0 1) (plot3d (surface3d + 0 10 0 1)
#:angle 10 #:z-label "z axis")) #:angle 10 #:z-label "z axis"))