⚠️ Warning: This is a draft ⚠️

This means it might contain formatting issues, incorrect code, conceptual problems, or other severe issues.

If you want to help to improve and eventually enable this page, please fork RosettaGit's repository and open a merge request on GitHub.

{{header|Racket}} {{trans|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.

[[http://timb.net/images/RC/Hough-transform/180px-Pentagon-Hough.png The Transformed Image]]

===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")
  )