From 9c740e1dc6b65a6b9467948f64584ea3c28856a7 Mon Sep 17 00:00:00 2001 From: Masaya Tojo Date: Sun, 17 Jun 2018 03:11:26 +0900 Subject: feat: Change interface --- canny.rkt | 92 ++++++++------------------------------------------------ flomap-canny.rkt | 82 ++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 94 insertions(+), 80 deletions(-) create mode 100644 flomap-canny.rkt diff --git a/canny.rkt b/canny.rkt index 1387130..41c7373 100644 --- a/canny.rkt +++ b/canny.rkt @@ -1,82 +1,14 @@ -#lang typed/racket +#lang racket +(require "flomap-canny.rkt") +(require pict) +(require racket/draw) (require images/flomap) -(require racket/flonum) -(require typed/racket/draw) -(require math/array) -(: flomap-grayscale (-> flomap flomap)) -(define (flomap-grayscale img) - (inline-build-flomap - 1 (flomap-width img) (flomap-height img) - (λ (k x y i) - (+ (* (flomap-ref img 1 x y) 0.299) - (* (flomap-ref img 2 x y) 0.587) - (* (flomap-ref img 3 x y) 0.114))))) -(provide flomap-grayscale) - -(: flomap-canny (-> flomap [#:heigh Flonum] [#:low Flonum] flomap)) -(define (flomap-canny img #:heigh [heigh 1.0] #:low [low 0.2]) - (let ([img - (case (flomap-components img) - [(4) (flomap-grayscale img)] - [(1) img] - [else (error "flomap-canny: invalid components")])]) - (canny img #:heigh heigh #:low low))) -(provide flomap-canny) - -(define-type Orient (Array (U 'horizontal 'positive-diagonal 'vertical 'negative-diagonal))) -(: tanθ->orient (-> flomap Orient)) -(define (tanθ->orient fm) - (build-array - `#[,(flomap-height fm) ,(flomap-width fm)] - (lambda ([v : Indexes]) - (let ([y : Index (vector-ref v 0)] - [x : Index (vector-ref v 1)]) - (let ([t : Flonum (flomap-ref fm 0 x y)]) - (cond - [(<= -0.4142 t 0.4142) 'horizontal] - [(<= -0.4142 t 2.4142) 'positive-diagonal] - [(>= (abs t) 2.4142) 'vertical] - [else 'negative-diagonal])))))) - -(define-syntax-rule (idx w x y) (+ (* w y) x)) - -(: trace! (-> FlVector flomap Orient Integer Integer Integer Integer Flonum Void)) -(define (trace! vec mag orient w h x y low) - (let loop ([x x] [y y]) - (when (and (<= 0 x (- w 1)) (<= 0 y (- h 1)) - (< (flvector-ref vec (idx w x y)) 0)) - (define s (flomap-ref mag 0 x y)) - (when (<= low s) - (flvector-set! vec (idx w x y) s) - (case (array-ref orient `#(,y ,x)) - [(horizontal) - (loop (+ x 1) y) - (loop (- x 1) y)] - [(positive-diagonal) - (loop (+ x 1) (+ y 1)) - (loop (- x 1) (- y 1))] - [(vertical) - (loop x (+ y 1)) - (loop x (- y 1))] - [(negative-diagonal) - (loop (+ x 1) (- y 1)) - (loop (- x 1) (+ y 1))] - [else - (error "error")]))))) - -(: canny (-> flomap [#:heigh Flonum] [#:low Flonum] flomap)) -(define canny - (lambda (fm #:heigh [heigh 1.0] #:low [low 0.2]) - (let* ([w (flomap-width fm)] - [h (flomap-height fm)] - [sx (flomap-gradient-x fm)] - [sy (flomap-gradient-y fm)] - [mag (fmsqrt (fm+ (fmsqr sx) (fmsqr sy)))] - [ori (tanθ->orient (fm/ sx sy))] - [vec (make-flvector (* w h) -1.0)]) - (for* ([y (in-range h)] - [x (in-range w)]) - (when (<= heigh (flomap-ref mag 0 x y)) - (trace! vec mag ori w h x y low))) - (flomap vec 1 w h)))) +(define (canny img #:sigma sigma #:heigh heigh #:low low) + (bitmap + (flomap->bitmap + (flomap-canny (bitmap->flomap (pict->bitmap img)) + #:sigma sigma + #:heigh heigh + #:low low)))) +(provide canny) diff --git a/flomap-canny.rkt b/flomap-canny.rkt new file mode 100644 index 0000000..636e819 --- /dev/null +++ b/flomap-canny.rkt @@ -0,0 +1,82 @@ +#lang typed/racket +(require images/flomap) +(require racket/flonum) +(require math/array) + +(: flomap-grayscale (-> flomap flomap)) +(define (flomap-grayscale img) + (inline-build-flomap + 1 (flomap-width img) (flomap-height img) + (λ (k x y i) + (+ (* (flomap-ref img 1 x y) 0.299) + (* (flomap-ref img 2 x y) 0.587) + (* (flomap-ref img 3 x y) 0.114))))) + +(: flomap-canny (-> flomap #:sigma Flonum #:heigh Flonum #:low Flonum flomap)) +(define flomap-canny + (λ (img #:sigma sigma #:heigh heigh #:low low) + (let ([img + (case (flomap-components img) + [(4) (flomap-grayscale img)] + [(1) img] + [else (error "flomap-canny: invalid components")])]) + (canny img sigma heigh low)))) +(provide flomap-canny) + +(define-type Orient (Array (U 'horizontal 'positive-diagonal 'vertical 'negative-diagonal))) +(: tanθ->orient (-> flomap Orient)) +(define (tanθ->orient fm) + (build-array + `#[,(flomap-height fm) ,(flomap-width fm)] + (λ ([v : Indexes]) + (let ([y : Index (vector-ref v 0)] + [x : Index (vector-ref v 1)]) + (let ([t : Flonum (flomap-ref fm 0 x y)]) + (cond + [(<= -0.4142 t 0.4142) 'horizontal] + [(<= -0.4142 t 2.4142) 'positive-diagonal] + [(>= (abs t) 2.4142) 'vertical] + [else 'negative-diagonal])))))) + +(define-syntax-rule (idx w x y) (+ (* w y) x)) + +(: trace! (-> FlVector flomap Orient Integer Integer Integer Integer Flonum Void)) +(define (trace! vec mag orient w h x y low) + (let loop ([x x] [y y]) + (when (and (<= 0 x (- w 1)) (<= 0 y (- h 1)) + (< (flvector-ref vec (idx w x y)) 0)) + (define s (flomap-ref mag 0 x y)) + (when (<= low s) + (flvector-set! vec (idx w x y) s) + (case (array-ref orient `#(,y ,x)) + [(horizontal) + (loop (+ x 1) y) + (loop (- x 1) y)] + [(positive-diagonal) + (loop (+ x 1) (+ y 1)) + (loop (- x 1) (- y 1))] + [(vertical) + (loop x (+ y 1)) + (loop x (- y 1))] + [(negative-diagonal) + (loop (+ x 1) (- y 1)) + (loop (- x 1) (+ y 1))] + [else + (error "error")]))))) + +(: canny (-> flomap Flonum Flonum Flonum flomap)) +(define canny + (lambda (fm sigma heigh low) + (let* ([w (flomap-width fm)] + [h (flomap-height fm)] + [b (flomap-gaussian-blur fm sigma)] + [sx (flomap-gradient-x b)] + [sy (flomap-gradient-y b)] + [mag (fmsqrt (fm+ (fmsqr sx) (fmsqr sy)))] + [ori (tanθ->orient (fm/ sx sy))] + [vec (make-flvector (* w h) -1.0)]) + (for* ([y (in-range h)] + [x (in-range w)]) + (when (<= heigh (flomap-ref mag 0 x y)) + (trace! vec mag ori w h x y low))) + (flomap vec 1 w h)))) -- cgit v1.2.3