Hough transform/Racket

Racket

Translation of: C

This example splits the original image into 4 channels, and passes each of them to a Racket place. The places are implemented in modules, which are invoked by name; which allows for multiple implementations (and, to be honest, multiple transforms -- but we'll stick with Hough for now).

There are two modules:

• "Hough-transform-basic.rkt", which is easy to read, but runs with Racket's type-safety on (slowing it down)
• "Hough-transform-fast.rkt", which uses "unsafe-..." functions. These have been tested before being unleashed upon an unsuspecting public

The module implementations come first, followed by the code to split, delegate and remerge the image channels.

[The Transformed Image]

Hough-transform-basic.rkt

<lang racket>#lang racket

Note that types are not mentioned here at all in this package

(provide hough-transform-channel)

For these half-quadrants, it's better to iterate by 'y'

(define (iterate-quadrant θ)

 [cond
   [(< θ 45) 'y]
   [(< 315 θ) 'y]
   [(and (< 135 θ) (< θ 225)) 'y]
   [else 'x]])

(define (sub-hough-transform-channel w h trg-pxls trg-h deg-start deg-end chnl-pxls)

 ;; these constants appear repeatedly in the arithmetic
 (define w/2 (/ w 2))
 (define h/2 (/ h 2))
 (for ((deg (in-range deg-start deg-end)))
   ;; all these worth pre-computing...
   (define θ (degrees->radians deg))
   (define cθ (cos θ))
   (define sθ (sin θ))
   (define i-q (iterate-quadrant deg))
   (define (chnl-byte-idx x y) (+ (* y w) x))
   (for ((ρ (in-range 0 trg-h)))      
     ;; Sum the colors of the line with equation x*cos(θ) + y*sin(θ) = ρ
     (define-values (S P)
       (match i-q
         ['y ; else x quadrant
          (for*/fold ((S 0) (P 0))
            ((y (in-range 0 h))
             (x (in-value (+ w/2 (/ (- ρ (* (- h/2 y) sθ)) cθ))))
             #:unless (or (< x 0) (>= x w))
             (x (in-value (exact-round x)))
             #:unless (= x w))
            (values (+ S (bytes-ref chnl-pxls (chnl-byte-idx x y))) (+ P 1)))]
         ['x ; else x quadrant
          (for*/fold ((S 0) (P 0))
            ((x (in-range 0 w))
             (y (in-value (- h/2 (/ (- ρ (* (- x w/2) cθ)) sθ))))
             #:unless (or (< y 0) (>= y h))
             (y (in-value (exact-round y)))
             #:unless (= y h))
            (values (+ S (bytes-ref chnl-pxls (chnl-byte-idx x y))) (+ P 1)))]))
     
     (when (> P 0)
       (define idx (+ (* ρ 360) deg))
       (bytes-set! trg-pxls idx 255) ; make it opaque (α = 255)
       (bytes-set! trg-pxls idx (quotient S P))))))

does exception handling, and talking back to master process, leaving sub-hough-transform-channel to

do the biz.

(define (hough-transform-channel ch)

Message from on high is...

(list name s-w s-h t-chan t-h 0 360 s-chan)

 (match-define (list name w h trg-pxls trg-h deg-start deg-end chnl-pxls) (place-channel-get ch))
 (place-channel-put ch (cons name 'started))
 (with-handlers
     ;; "style" says to not handle the most general exception: but we're not expecting to generate
     ;; any, so wouldn't know any better would we?
     [(exn? (λ (x) (place-channel-put ch (cons name (exn-message x)))))]
   (sub-hough-transform-channel w h trg-pxls trg-h deg-start deg-end chnl-pxls)
   (place-channel-put ch (cons name #t))))</lang>

Hough-transform-fast.rkt

Note the block:

<lang racket>(require racket/require) (require (filtered-in

         (λ (name) (regexp-replace #rx"unsafe-" name ""))
         racket/unsafe/ops))

1. (require racket/flonum racket/fixnum)</lang>

This uses unsafe, but fast, versions of fx... and fl... functions. If (especially during development and testing), one of these functions receives a non-{fix,flo}num value, then you could lose your interpreter... even DrRacket won't save you. 'Unsafe' means 'unsafe'! So until you are confident use:

<lang racket>(require racket/require)

1. (require (filtered-in

         (λ (name) (regexp-replace #rx"unsafe-" name ""))
         racket/unsafe/ops))

(require racket/flonum racket/fixnum)</lang>

Racket type checks and raises exceptions against fx... and fl... functions. Once these are purged, you can remove your safety harness!

<lang racket>#lang racket

This module tries to be a little smarter about types. It *should* prove to be better performing

than "Hough-transform-basic.rkt"; which spends a lot of time shuffling between the integer-based

image coordinates and the floatier trignonmetric coordiantes. Here, we run two sets of coordinates

(and variables). When a variable has two parallel values they are suffixed with '-x', for fixnum

and suffixed with '-f' for float. As far as possible, they will be generated and manipulated as

closely as possible to each other.

At some point (after testing) we will require the unsafe versions of the fl... functions

(require racket/require) (require (filtered-in

         (λ (name) (regexp-replace #rx"unsafe-" name ""))
         racket/unsafe/ops))

1. (require racket/flonum racket/fixnum)

(provide hough-transform-channel)

For these half-quadrants, it's better to iterate by 'y'

(define (iterate-quadrant deg) ; degrees are fixnum

 [cond
   [(fx< deg 45) 'y]
   [(fx< 315 deg) 'y]
   [(and (fx< 135 deg) (fx< deg 225)) 'y]
   [else 'x]])

(define (sub-hough-transform-channel w h trg-pxls trg-h deg-start deg-end chnl-pxls)

 ;; these constants appear repeatedly in the arithmetic
 (define w-f (fx->fl w))
 (define h-f (fx->fl h))
 (define w/2 (fl/ w-f 2.))
 (define h/2 (fl/ h-f 2.))
 
 (for ((deg (in-range deg-start deg-end)))
   ;; all these worth pre-computing...
   (define i-q (iterate-quadrant deg))
   ;; the fx->fl below catches 0 (since degrees->radians can say, exactly, that pi*0/180 is 0)
   (define θ (degrees->radians (fx->fl deg)))
   (define cθ (flcos θ))
   (define sθ (flsin θ))
   (define (chnl-byte-idx x y) (fx+ (fx* y w) x))
   (for* ((ρ-x (in-range 0 trg-h)))
     (define ρ-f (fx->fl ρ-x))
     ;; Sum the colors of the line with equation x*cos(θ) + y*sin(θ) = ρ
     (define-values (S P)
       (match i-q
         ['y
          ;; in Hough-transform-basic, these two loops were for*/fold, which the racket documentation
          ;; itself confesses can be a little slow. We'll run out own named let loop to do the work
          ;; for us here
          (let inr ((S 0) (P 0) (y-f 0.))
            (cond
              [(fl>= y-f h-f) (values S P)]
              [else
               (define x-f (+ w/2 (fl/ (fl- ρ-f (fl* (fl- h/2 y-f) sθ)) cθ)))
               (define y+1 (fl+ y-f 1.))
               (cond [(or (fl< x-f 0.) (fl>= x-f w-f)) (inr S P y+1)]
                     [else
                      (define x-x (exact-round x-f))
                      (cond [(= x-x w) (inr S P y+1)]
                            [else
                             (define y-x (exact-round y-f))
                             (define idx (chnl-byte-idx x-x y-x))
                             (inr (fx+ S (bytes-ref chnl-pxls idx)) (fx+ P 1) y+1)])])]))]
         ['x ; else x quadrant
          (let inr ((S 0) (P 0) (x-f 0.))
            (cond
              [(fl>= x-f w-f) (values S P)]
              [else
               (define y-f (fl- h/2 (fl/ (fl- ρ-f (fl* (fl- x-f w/2) cθ)) sθ)))
               (define x+1 (fl+ x-f 1.))
               (cond [(or (fl< y-f 0.) (fl>= y-f h-f)) (inr S P x+1)]
                     [else
                      (define y-x (exact-round y-f))
                      (cond [(= y-x h) (inr S P x+1)]
                            [else
                             (define x-x (exact-round x-f))
                             (define idx (chnl-byte-idx x-x y-x))
                             (inr (fx+ S (bytes-ref chnl-pxls idx)) (fx+ P 1) x+1)])])]))]))
     
     (when (fx> P 0)
       (define idx (fx+ (fx* ρ-x 360) deg))
       (bytes-set! trg-pxls idx 255) ; make it opaque (α = 255)
       (bytes-set! trg-pxls idx (fxquotient S P))))))

does exception handling, and talking back to master process, leaving sub-hough-transform-channel to

do the biz.

Message from on high is...

(list name s-w s-h t-chan t-h 0 360 s-chan)

(define (hough-transform-channel ch)

 (match-define (list name w h trg-pxls trg-h deg-start deg-end chnl-pxls) (place-channel-get ch))
 (place-channel-put ch (cons name 'started))
 (with-handlers
     ;; "style" says to not handle the most general exception: but we're not expecting to generate
     ;; any, so wouldn't know any better would we?
     [(exn? (λ (x) (place-channel-put ch (cons name (exn-message x)))))]
   (sub-hough-transform-channel w h trg-pxls trg-h deg-start deg-end chnl-pxls)
   (place-channel-put ch (cons name #t))))</lang>

Hough-transform.rkt

This is the main program, delegating to the module above. Ignoring all of the the image processing for now, you should be able to use the (let wait-places ...) loop more generally.

Note that:

(place-channel-put plce (list c-name s-w s-h t-chan t-h 0 360 s-chan))

in this file, is reflected by:

 (match-define (list name w h trg-pxls trg-h deg-start deg-end chnl-pxls) (place-channel-get ch))

in the submodules, which in turn is matched by:

 (define (sub-hough-transform-channel w h trg-pxls trg-h deg-start deg-end chnl-pxls) ...)

<lang racket>#lang racket

Derived from a port of TCL (hence the colouring of the output)

This seems to be quite hard work for racket's number type pyramid, since we cast from coordinates

(integers) to polar coordinates (floats) and back to coordinates.

The three modules experiment with three implementations.

basic - the first is a transcription of the TCL module. I could understand that better than most

of the others!

fast - does manual type-casting and unleashes the unsafe-fx and unsafe-fl functionality.

But it's a bit seat of the pants!

In all three cases, we separate the image into channels. This simplifies the transformation

function to just one channel (and the alpha channel for aesthetics); but also allows for

parallelisation, maybe even distributon with "place"s.

--------------------------------------------------------------------------------------------------

GLOBALS

--------------------------------------------------------------------------------------------------

(define IMAGE-DEPTH 4) ; the image depth ARGB bytes in a byte array

the Python version works over only one channel; that's obviously three times faster than doing the

three colour channels... but works for the monochrome example in the task. Use this to transform

all channels independently.

(define USE-CHANNELS? (if #t #(#f #t #t #t) #(#f #t #f #f))) (define CHANNEL-NAMES #(α red green blue)) (define BACKGROUND-COLOUR (shared-bytes 255 192 255 192)); A colour to show the unmodified background

Function to transform an original image file name to it's "houghed" name

(define (hough-output-file-name source-filename)

 (path-replace-suffix (string->path source-filename) "-Hough.png"))

(define-logger hough-transform) (current-logger hough-transform-logger)

--------------------------------------------------------------------------------------------------

MAIN

Whatever happens, we'll need to read a file, transform it and write a file...

--------------------------------------------------------------------------------------------------

This module contains the necessary for bitmap handling, file handling and place-farming. So the

transformation functions will be handling "bytes", shared byte vectors of (A R G B ...) bytes.

(require racket/draw)

split the bitmap (and its bytes) into channels. As we do this, we generate some interesting data

which we will pass back to our caller.

(define (bitmap->channel-bytes&c bmp use-chnls?)

 (define w (send bmp get-width))  
 (define h (send bmp get-height))
 (define sz (* w h IMAGE-DEPTH))
 (define bmp-bytes (make-bytes sz))
 (define (extract-channel offset)
   (define chnl (make-shared-bytes (/ sz IMAGE-DEPTH)))
   (for ((i (in-naturals)) (b (in-bytes bmp-bytes offset sz IMAGE-DEPTH))) (bytes-set! chnl i b))
   (values offset chnl))
 (send bmp get-argb-pixels 0 0 w h bmp-bytes #f #f)
 (define-values (offsets channels)
   (for/lists (offsts chnls) ((offset (in-naturals)) (wanted? use-chnls?) #:when wanted?)
     (extract-channel offset)))
 (values w h sz offsets channels))

Prepare our source and destination byte arrays and bitmaps. Farm them out to channel-transforming

places

(define (hough-transform-image source-bitmap place-module xform-function-name)

 (define-values (s-w s-h s-sz channel-offsets s-channels)
   (bitmap->channel-bytes&c source-bitmap USE-CHANNELS?))
 (define t-h (round (/ (sqrt (+ (sqr s-w) (sqr s-h))) 2)))
 (define t-w 360) ; degrees
 (define t-sz (* t-h t-w))
 ; prepare the target channels...
 (define t-channels (for/list ((init BACKGROUND-COLOUR)) (make-shared-bytes t-sz init)))
 
 (define channel-xform-places-chs
   (for/list
       ((offset channel-offsets)
        (s-chan s-channels))
     (define c-name (vector-ref CHANNEL-NAMES offset))
     (define t-chan (list-ref t-channels    offset))
     (define plce (dynamic-place place-module xform-function-name))
     (place-channel-put plce (list c-name s-w s-h t-chan t-h 0 360 s-chan))
     (log-info "wait place start... ")
     (let ((go (place-channel-get plce))) (log-info "~a" go))
     plce))
 
 (let wait-places ((chs channel-xform-places-chs))
   (unless (null? chs)
     (log-info "Wait ~a places... " (length chs)) (flush-output)
     (define evt-wraps
       (for/list ((ch chs) (i (in-naturals)))
         (wrap-evt
          ch
          (λ (v)
            (log-info "place #~a: ~a" i v)
            (define-values (L R) (split-at chs i))             
            (wait-places (append L (cdr R)))))))
     (apply sync evt-wraps)))
 
 ;; put Humpty together again
 (define t-bytes (make-bytes (* t-sz IMAGE-DEPTH)))
 (for ((offset (in-naturals))
       (t-chan t-channels))
   (for ((t-idx (in-range t-sz))
         (b-idx (in-range offset (* t-sz IMAGE-DEPTH) IMAGE-DEPTH)))
     (bytes-set! t-bytes b-idx (bytes-ref t-chan t-idx))))
 (define target-bitmap (make-object bitmap% 360 t-h #f #t))
 (send target-bitmap set-argb-pixels 0 0 360 t-h t-bytes)
 target-bitmap)

(define (transform-image source-file-name place-module (xform-function-name 'hough-transform-channel))

 (define source-image (make-object bitmap% source-file-name))
 (define target-image (hough-transform-image source-image place-module xform-function-name))
 (send target-image save-file (hough-output-file-name source-file-name) 'png)
 target-image)

--------------------------------------------------------------------------------------------------

(module+ main

 (transform-image "180px-Pentagon.png" "Hough-transform-basic.rkt")
 (transform-image "180px-Pentagon.png" "Hough-transform-fast.rkt")
 )</lang>