#lang scheme/base (require "image-io.ss") (provide (all-defined-out)) ;; Create an image->votes list, given angle. This is the kernel ;; function of the Hough transform. (define (image->votes angle) (define ca (cos angle)) (define sa (sin angle)) (lambda (image) ((FM (lambda (state piksel x y) (if (zero? piksel) state (cons (+ (* x ca) (* y sa)) state)))) '() image))) ;; Given a votes list, and a voter, create a histogram. Split into 2 ;; level functions for ease of specialization. (define (histogram-builder vote! n min max) (lambda (numbers) (define (number->bin x) (inexact->exact (floor (* n (/ (- x min) (- max min)))))) (for ((num numbers)) (vote! (number->bin num))))) ;; Given an image and a column, create a voter that will update the ;; image column. (define (vector-inc! v i) (vector-set! v i (+ 1 (vector-ref v i)))) (define (image->vote! img row) (let ((w (image-width img)) (v (image-data img))) (lambda (bin) (vector-inc! v (+ row (* w bin)))))) ;; The complete hough transform, split into 2 levels for ;; specialization. (define (hough-transform #:r-bins r-bins #:angle-bins angle-bins #:max-r max-r #:max-angle max-angle) (lambda (image-in) (let ((img-out (new-image angle-bins r-bins))) (for ((ab (in-range angle-bins))) (let* ((vote! (image->vote! img-out ab)) (election! (histogram-builder vote! r-bins 0 max-r)) (angle (* ab (/ max-angle angle-bins)))) (election! ((image->votes angle) image-in)))) img-out))) ;; (define (vector->vote! v n [offset 0]) ;; (lambda (bin) ;; (let ((index ;; (+ offset ;; (cond ;; ((> bin n) (- n 1)) ;; ((< bin 0) 0) ;; (else bin))))) ;; (vector-set! v index ;; (+ 1 (vector-ref v index)))))) ;; (define ((make-list-voter! vote! n min max) numbers) ;; (define (number->bin x) ;; (inexact->exact ;; (floor ;; (* n (/ (- x min) (- max min)))))) ;; (for ((num numbers)) ;; (vote! (number->bin num)))) ;; (define (make-vote/vector n) ;; (let* ((vec (make-vector n 0)) ;; (vote (vector->vote! vec n))) ;; (values vote vec))) ;; (define (hough/histo angle bins) ;; (lambda (img) ;; (let-values (((vote v) (make-vote/vector bins))) ;; ((list->voter! vote bins ;; 0 ;; max = approx diagonal ;; (* (sqrt 2) ;; (image-width img))) ;; ((hough angle) img)))) ;; )