# Example:Hough transform/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.

### Hough-transform-basic.rkt

`#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))))`

### Hough-transform-fast.rkt

Note the block:

`(require racket/require)(require (filtered-in          (λ (name) (regexp-replace #rx"unsafe-" name ""))          racket/unsafe/ops))#;(require racket/flonum racket/fixnum)`

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:

`(require racket/require)#;(require (filtered-in          (λ (name) (regexp-replace #rx"unsafe-" name ""))          racket/unsafe/ops))(require racket/flonum racket/fixnum)`

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

`#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))#;(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))))`

### 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;;; 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")  )`