;;; -*- Mode: Lisp; Syntax: Common-lisp; Package: MU; Base: 10. -*- ;;; Copyright (c) 1987, Massachusetts Institute of Technology ;;; Authors: Mike Drumheller, Walter E. Gillett (in-package :mu) ;;; ;;; MIKE: YOU MIGHT WANT TO CHANGE THE DEFINITION OF DISPARITY SO IT'S MORE CONSISTENT WITH ;;; THE LITERATURE, I.E., R+D = L, INSTEAD OF THE ASS-BACKWARDS WAY YOU HAVE IT NOW. ;;; --MIKE ;;; ;;; DIAGRAMS OF THE STEREO COORDINATE SYSTEM ;;; ;;; In my opinion, you will understand this code only if you understand these diagrams. That ;;; may take a little research on your part, and a good amount of careful thought. I am more ;;; than happy to talk to anyone who finds this stuff confusing, because I found it very ;;; confusing myself. --Mike ;;; ;;; ------------------------------------------------------------------------------------- ;;; DIAGRAM (1): ;;; ;;; This diagram is more or less consistent with the literature, see Marr's book VISION, for ;;; example. ;;; ;;; LLOS = Left-eye Line Of Sight, a line projecting from the animal's left eye out into the ;;; scene. ;;; ;;; NLOS = Nose Line Of Sight, i.e., a line projecting from the bridge of the ;;; animal's nose out into the scene. ;;; RLOS = Right-eye Line Of Sight, a line projecting from the animal's right eye out into ;;; the scene. ;;; ;;; /n <= this is the 0-disparity isodisparity line, Do. ;;; LLOS id / | ;;; ^ ////// | ;;; | //////// | The start-position for the sliding process is this: ;;; NLOS | //////////fd | ;;; \-- |////////// | <- image L (neg x) image R (pos x) -> ;;; | \ /|//////// | o____________________________n <--R ;;; \ ///|////// | | ;;; //\//|//// | | o___________________________n <-- L ;;; RLOS //////\|// |Rx | | ;;; <---------------------------------| |<--|id|-->| ;;; ////////// | \ | (The term id appears throughout the code; ;;; ////////// | \ | it means "initial disparity.") ;;; ////////// | \ | Isodisparity lines in the direction of A ;;; /////// | \ | away from Do mean that the image R must be ;;; ///// | \ | shifted to the left (neg. x) relative to a ;;; /________________|_______________|o stationary image L in order for ;;; o Lx n correspondence to occur. ;;; Such planes have low indices. ;;; ;;; Here the line labeled "0" (the vertical one) is a typical left eye line-of-sight. The ;;; line labeled "90" is a right eye line-of-sight. The line labeled "45" is a line ;;; extending from the bridge of the viewer's nose out into the world. ;;; ;;; -------------------------------------------------------------------------------------- ;;; ;;; DIAGRAM (2): ;;; ;;; This is another way of drawing Diagram 1. This is the way the stereomatching data ;;; structure actually sits in the CM memory. Each plane is a pvar containing potential ;;; matches. Notice how this diagram has the same basic topology as the above diagram, it is ;;; just "skewed." It is important to understand why this skewing takes place. Talk to me ;;; if this diagram is unclear. ;;; ;;; The P's are processors, and the word "memory" represents the memory "hanging ;;; underneath" each processor. Notice how the left-eye line of sight, labeled "0," is ;;; lined up with the memory dimension, so it is easy to searc for maxima across that ;;; line, but a pain to search for maxima across the right eye's line of sight. ;;; ;;; P P P P P P P P P P P P P P P P P P P ;;; m m m m m m m m m m m m m m m m m m m ;;; e e e e e e e e e e e e e e e e e e e ;;; m m m m m m m m m m m m m m m m m m m ;;; o o o o o o o o o o o o o o o o o o o ;;; r r r r r r r r r r r r r r r r r r r ;;; y y y y y y y y y y y y y y y y y y y ;;; ;;; RLOS NLOS LLOS ;;; \ \ | ;;; ------------------\---|---|--------------- <--The "initial disparity" plane, ;;; | ------------------\--\--|----------------- is slid by an amount id relative to L ;;; | ------------------\-|-|-------------------- ;;; | ------------------\\|---------------------- ;;; | ------------------\------------------------ <-- The zero-disparity plane still ;;; | | ----------------||\------------------------ image sits directly over L ;;; | | --------------|-\-\------------------------ ;;; | | ------------|--|--\------------------------ ;;; | | ----------|---\---\------------------------ <-- The "final disparity" ;;; | | | | | \ /n plane is slid |fd| ;;; | | | | \ \ / pixels to the right ;;; |<-|id|-> | | | \ / of L. ;;; | |<-|fd|-> | \ \ / ;;; | | | | | \ / ;;; | | | | \ \ / ;;; | | | | | / Rx ;;; | | | | \ / ;;; | o-------|---------|----------------/-----n ;;; Lx / ;;; / ;;; / ;;; / o ;;; ;;;----------------------------------------------------------------------------------- ;;; ;;; DIAGRAM (3): ;;; ;;; This diagram depicts the transformation that the main data structure undergoes when ;;; *SKEW-PLANES is applied to diagram 2, i.e., (*SKEW-PLANES -45 ). ;;; Now the line from the bridge of the viewer's nose out into the world is lined up with the ;;; memory dimension, so it would be easy to search for maxima across it. Note that doing so ;;; would be implementing the algorithm that Marr criticizes rather strongly in his book. I ;;; tried it once, and it did not work so hot. ;;; ;;; This is rarely used; it is implemented only out of scientific curiosity (i.e., to ;;; investigate the "wrong" algorithm). ;;; ;;; RLOS NLOS LLOS ;;; | | | ;;; ------------------\---|---/---------------------- <-- (car *pm*) see ;;; -------------------|--|--|----------------------- TERMINOLOGY below ;;; --------------------\-|-/------------------------ ;;; ---------------------|||------------------------- ;;; ----------------------X-------------------------- ;;; ---------------------/|\------------------------- ;;; --------------------|-|-|------------------------ ;;; -------------------/--|--\----------------------- ;;; ------------------|---|---|---------------------- ;;; -----------------/----|----\--------------------- <-- (car (last *pm*)) ;;; o \__ | | | __/ n see TERMINOLOGY below ;;; \__ / | \ __/ ;;; \__ | | | __/ ;;; \__ / | \ __/ ;;; \__ | | | __/ ;;; Lx \_/ | _\/ Rx ;;; \__ __/ ;;; \__ __/ ;;; \__ __/ ;;; _\/_ ;;; __/ \__ ;;; __/ \__ ;;; o n ;;; ---------------------------------------------------------------------------------- ;;; ;;; DIAGRAM (4): ;;; ;;; This diagram depicts the transformation that the main data structure undergoes when ;;; *SKEW-PLANES is applied to Diagram 2, i.e., (*SKEW-PLANES -90 ). ;;; ;;; This is used to bring the right eye line-of-sight (labeled "90") into alignment with each ;;; processors's memory, to make it easy to search for maxima along the right eye ;;; line-of-sight. ;;; ;;; RLOS NLOS LLOS ;;; | | / ;;; --------------|---/---/------------------------- ;;; ----------------|--|--/------------------------- ;;; ------------------|-/-/------------------------- ;;; --------------------||/------------------------- ;;; ----------------------/------------------------- ;;; -----------------------/|----------------------- ;;; -----------------------/-||--------------------- ;;; -----------------------/--/-|------------------- ;;; -----------------------/---|--|----------------- ;;; -----------------------/----/---|--------------- ;;; o\ / | | ;;; \ / / | ;;; \ / | | ;;; \ / / | ;;; \ / | | ;;; Lx \ / / | ;;; \ | | ;;; \ | ;;; \ | ;;; o-----\--------------|----------------------n ;;; \ Rx ;;; \ ;;; \n ;;; ;;; ------------------------------------------------------------------------------------ ;;; ;;; TERMINOLOGY ;;; ;;; ;;; POTENTIAL MATCHES or *pm*: a list of boolean pvars containing potential matches. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (proclaim '(special *ac* *pm* *sp* *entire-forbidden-zone?*)) ;(*proclaim '(*defun ; *stereo-on-edge-images ; *skew-planes ; select-maximal-support ; left-and-right-lines-of-sight-nms)) ;;; Top-level user-interface functions. (*defunc *STEREO-ON-EDGE-IMAGES (&key l-features!! r-features!! (angles '(0 90)) (iters 1) (support-region-width *support-region-width*) i-d f-d (ivd *ivd*) (fvd *fvd*) (support-region-height support-region-width) (weak-compat? *weak-compat?*) (match-gradients? *match-gradients?*) margin clear-accums-where-no-match? *clear-accums-where-no-match?* user-close-winners-dest!!) ;; if we are allowing unrestricted edge matching, get rid of edge polarities (if weak-compat? (*set l-features!! (boolean-to-bit!! (nzerop!! l-features!!)) r-features!! (boolean-to-bit!! (nzerop!! r-features!!)))) (format t "~%Making potential match planes (~A)..." (cond (*match-grey?* "grey level correlation") (match-gradients? "using gradient direction") (weak-compat? "unrestricted edge matching") (t "using edge polarity"))) (setq *pm* (make-potential-matches l-features!! r-features!! i-d f-d :ivd ivd :fvd fvd :match-gradients? match-gradients? :zeros-are-features? nil) *sp* (make-field-version-of-potential-matches *pm*)) ;; If *dense-disparity?* is true, edge-based matching allows matches anywhere, not just at edges. (if (and (not *match-grey?*) *dense-disparity?*) (loop for pm in *pm* do (*set pm t!!))) (iterative-stereo *pm* *sp* l-features!! r-features!! angles i-d f-d ivd fvd iters support-region-width support-region-height *blank-out-support?* margin clear-accums-where-no-match? user-close-winners-dest!!) *pm*) ;;; ASSUMES that ID is negative and F-D is positive. This function is used to bring ;;; any across-disparity-line into alignment with the left line of sight. For ;;; example, by default, the right line of sight is oriented at +90 degrees according ;;; to Diagram 2 at the top of this file. (Angles are measured ;;; positive-anticlockwise.) In order to bring it into alignment with the left line ;;; of sight (so we can easily search for maxima across it), we would call this ;;; function on it, with angle = -90. To bring it back to its normal alignment, we ;;; call this function with angle = 90. (*defunc *SKEW-PLANES (planes angle i-d f-d) (case angle (0 planes) (90 (loop for d from i-d to f-d for plane in planes do (*slide-pvar plane d 0))) (-90 (loop for d from i-d to f-d for plane in planes do (*slide-pvar plane (- d) 0))) (45 (loop for d from i-d to f-d for plane in planes do (*slide-pvar plane (floor d 2) 0))) (-45 (loop for d from i-d to f-d for plane in planes do (*slide-pvar plane (- (floor d 2)) 0))) (22.5 (loop for d from i-d to f-d for plane in planes do (*slide-pvar plane (floor d 3) 0))) (-22.5 (loop for d from i-d to f-d for plane in planes do (*slide-pvar plane (- (floor d 3)) 0))) (67.5 (loop for d from i-d to f-d for plane in planes do (*slide-pvar plane (67.5-skew d) 0))) (-67.5 (loop for d from i-d to f-d for plane in planes do (*slide-pvar plane (- (67.5-skew d)) 0))) (otherwise (error "~d degrees is not an admissible angle for skewing (must be 90, -90, 45, -45, 22.5, -22.5, 67.5, -67.5, or 0)" angle))) planes) (defun 67.5-SKEW (num) (- num (floor num 3))) (defun TEST-67.5-SKEW (&optional (i-d -20) (f-d 20)) (loop for i from i-d to f-d do (format t "~%~d -> ~d" i (67.5-skew i)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Functions for implementing non-maximum suppression in XYD-space. ;;; ;;; The meaning of the term "non-maximum suppression" is very different between here and John ;;; Canny's edge-finding thesis. In his stuff, non-maximum suppression was used to help find ;;; edges, by killing pixels that were not higher than their 2-D neighbors. Here, however, ;;; non-maximum suppression kills points in XYD-space who do not have greater support-scores ;;; than certain sets of neighbors. The "certain sets of neighbors" might be the left- and ;;; right- lines of sight, the nose-line-of-sight, or even the entire forbidden zone. (*defunc LEFT-AND-RIGHT-LINES-OF-SIGHT-NMS-NO-MARGIN (matches accums) (*let ((max!! (!! 0))) (declare (type (field-pvar (pvar-length (car accums))) max!!)) ;; Notice that all accums are getting counted, none is cleared, that means ;; that the potential matches are being treated symetrically even when ;; serially cycling through lines of sight.... (loop for accum in accums do (*set max!! (max!! max!! accum))) (loop for match in matches for accum in accums do (*set match (and!! match (=!! accum max!!))) ))) (*defunc LEFT-AND-RIGHT-LINES-OF-SIGHT-NMS (across-angle matches accums i-d f-d margin &optional edges) (ignore margin) ;not currently used (format t "~%Nonmaximum suppression along") (case across-angle (0 (format t " left line of sight...")) (90 (format t " right line of sight...")) (t (format t " line of sight with angle = ~D..." across-angle))) (ignore edges) (*skew-planes matches (- across-angle) i-d f-d) (*skew-planes accums (- across-angle) i-d f-d) ;;; Removed support for nms with margin, since it's not very useful. See the file ;;; old-stereo for the old code. (WEG 11/16/87) ; (if (equal margin 0) (left-and-right-lines-of-sight-nms-no-margin matches accums) ; (left-and-right-lines-of-sight-nms-with-margin matches accums margin)) (*skew-planes accums across-angle i-d f-d) (*skew-planes matches across-angle i-d f-d)) ;;; SELECT-MAXIMAL-SUPPORT, the Standard version. ;;; ;;; This functions assumes that ACCUMS already contain local support scores. ;;; ;;; The abbreviation NMS stands for NON-MAXIMUM-SUPPRESSION. (*defunc SELECT-MAXIMAL-SUPPORT (current-matches accums i-d f-d list-of-angles margin) ; (tv:noting-progress ((if *entire-forbidden-zone?* ; "Applying ordering and uniqueness constraints" ; "Applying uniqueness constraint")) (cond (*entire-forbidden-zone?* (full-forbidden-zone-nms current-matches accums)) (t ;; currently used for left and right lines of sight only, although ;; list-of-angles could be larger (cond ((equalp list-of-angles '(0 90)) (format t "~%(Left and right lines of sight only)")) ((equalp list-of-angles '(0)) (format t "~%(Left line of sight only)")) ((equalp list-of-angles '(90)) (format t "~%(Right line of sight only)")) (t (format t "~%Lines of sight: ~S" list-of-angles))) (loop for angle in list-of-angles do (left-and-right-lines-of-sight-nms angle current-matches accums i-d f-d margin)))) current-matches) ;) ;;; The abbreviation NMS stands for NON-MAXIMUM-SUPPRESSION. ;;; Support for nms with margin has been removed since it is not very useful. ;;; See the file old-stereo for the old code. (WEG 11/16/87) ;(defun FULL-FORBIDDEN-ZONE-NMS (matches accums margin) ; (if (equal 0 margin) ; (full-forbidden-zone-nms-no-margin matches accums) ; (full-forbidden-zone-nms-with-margin matches accums margin))) ;;; Non-maximum suppression over the entire forbidden zone. ;;; ;;; time ---> ;;; ----*-------*-x-----*-x-x----*-x-x-x ;;; ----|---------*-------*-x------*-x-x ;;; ----|---------|---------*--------*-x ;;; ----|---------|---------|----------* ;;; (defun FULL-FORBIDDEN-ZONE-NMS (matches accums) (format t "~%Using full forbidden zone...") ;;; first go from i-d to f-d... (half-forbidden-zone-nms matches accums :east) ;; restore accums to original x-positions... (loop for i from 0 for a in (reverse accums) do (*slide-pvar-from a i 0)) ;; then go from f-d to i-d... (let ((rev-matches (reverse matches)) (rev-accums (reverse accums))) (half-forbidden-zone-nms rev-matches rev-accums :west)) (loop for i from 0 ; Restore accums to original x-positions... for a in accums do (*slide-pvar-from a (- i) 0)) matches) ;;; Note that CURR-MAX!! must be reset to 0 on each pass. Otherwise you propagate the max ;;; for the left-hand triangles of the forbidden zone right back up through the disparity ;;; planes, mistakenly requiring some matches to have higher scores than other matches NOT in ;;; their forbidden zone. Vague, I know, but it's just plain hard to explain. (defun HALF-FORBIDDEN-ZONE-NMS (matches accums direction) (*let ((curr-max!! (!! 0))) (declare (type (field-pvar (pvar-length (car accums))) curr-max!!)) (loop for i from 0 for match!! in matches for acc!! in accums do (*set curr-max!! (max!! curr-max!! acc!!)) (loop for j from 0 below i do (if (equal direction :east) (*slide-pvar (nth j accums) 1 0) ;move east 1 (*slide-pvar (nth j accums) -1 0)) ;move west 1 (*set curr-max!! (max!! curr-max!! (nth j accums)))) (*if ( ;;; and is more than the tolerance, i.e., if the vectors point in approximately ;;; the same direction. (defmacro SAME-DIRECTION?!! (x0!! y0!! x1!! y1!! tolerance) `(>!! (+!! (*!! ,x0!! ,x1!!) (*!! ,y0!! ,y1!!)) (*!! (isqrt!! (+!! (square!! ,x0!!) (square!! ,y0!!))) (isqrt!! (+!! (square!! ,x1!!) (square!! ,y1!!))) (!! ,tolerance)))) ;;; Make potential match planes. In order for two edges to match, the dot product of their ;;; gradient directions must exceed *match-gradients-tolerance* (see above). (*defun *MAKE-POTENTIAL-MATCHES-USING-GRADIENTS (stationary-features!! moving-features!! i-d f-d &optional (ivd *ivd*) (fvd *fvd*)) (let* ((disp-vals (1+ (- f-d i-d))) (matches (make-planes disp-vals :boolean)) (stationary-ddx!! (first *left-gradients*)) (stationary-ddy!! (second *left-gradients*)) (moving-ddx!! (first *right-gradients*)) (moving-ddy!! (second *right-gradients*))) (*let ((mf!! (get-grid!! moving-features!! (- i-d) 0)) (stationary-pvar-nzerop!! (nzerop!! stationary-features!!))) (*set moving-ddx!! (get-grid!! moving-ddx!! (- i-d) 0) moving-ddy!! (get-grid!! moving-ddy!! (- i-d) 0)) (loop for d from 0 below disp-vals for plane!! in matches do (*set plane!! nil!!) (loop for vd from ivd to fvd do (*set plane!! (or!! plane!! (and!! stationary-pvar-nzerop!! (nzerop!! (get-grid!! mf!! 0 vd)) (same-direction?!! stationary-ddx!! stationary-ddy!! moving-ddx!! moving-ddy!! *match-gradients-tolerance*))))) (*slide-pvar mf!! 1 0) (*slide-pvar moving-ddx!! 1 0) (*slide-pvar moving-ddy!! 1 0))) ;; deallocate gradients since we no longer need them (*deallocate stationary-ddx!!) (*deallocate stationary-ddy!!) (*deallocate moving-ddx!!) (*deallocate moving-ddy!!) ;; make it clear that the gradients are no longer available (setq *left-gradients* nil *right-gradients* nil) matches)) ;;; Make potential match planes: for a given disparity, the plane contains t at locations ;;; where there could be a match and nil otherwise. (defun MAKE-POTENTIAL-MATCHES (stationary-features!! moving-features!! i-d f-d &key (ivd *ivd*) (fvd *fvd*) match-gradients? zeros-are-features?) ;; sanity check (if (>= i-d f-d) (error "Bad disparity range. You have selected an initial disparity of ~D and a final disparity of ~D.~%The initial disparity must be less than the final disparity.~%Change parameters *id* and *fd* accordingly." *id* *fd*)) (cond (*match-grey?* (*make-potential-grey-level-matches i-d f-d)) ((and match-gradients? *left-gradients*) (*make-potential-matches-using-gradients stationary-features!! moving-features!! i-d f-d ivd fvd)) (t (*make-potential-matches-no-gradients stationary-features!! moving-features!! i-d f-d ivd fvd zeros-are-features?)))) #+*lisp-hardware (defun MAKE-FIELD-VERSION-OF-POTENTIAL-MATCHES (potential-matches) (let* ((field-support-planes (make-planes (length potential-matches) :field :length 1))) ;;; length is specified (loop for d from 0 below (length field-support-planes) for field-plane in field-support-planes for potential-match-plane in potential-matches do (*set field-plane (if!! potential-match-plane (!! 1) (!! 0)))) field-support-planes)) #+*lisp-simulator (defun MAKE-FIELD-VERSION-OF-POTENTIAL-MATCHES (potential-matches) (let* ((field-support-planes (make-planes (length potential-matches) (planes-type potential-matches)))) ; No length specified. (loop for d from 0 below (length field-support-planes) for field-plane in field-support-planes for potential-match-plane in potential-matches do (*set field-plane (if!! potential-match-plane (!! 1) (!! 0)))) field-support-planes)) (defun MAKE-DISP-MAP!! (disps i-d) (*let ((disp-map!! (!! 0))) (loop for plane!! in disps for d from 0 do (*if plane!! (*set disp-map!! (!! (+ i-d d))))) disp-map!!)) (defun MAKE-BOOLEAN-OF-FOUND-DISPARITIES!! (disps) (*let ((boolean!! (!! nil))) (loop for plane!! in disps for d from 0 do (*if plane!! (*set boolean!! t!!))) boolean!!)) (*defunc WINNING-SCORES!! (angle accums i-d f-d) (*let ((ws!! (!! 0))) (declare (type (field-pvar 16) ws!!)) (*skew-planes accums angle i-d f-d) (loop for accum!! in accums do (*set ws!! (max!! ws!! accum!!))) ws!!)) (defun KILL-NON-UNIQUE-MATCHES (disps angles i-d f-d) ; (tv:noting-progress ("Eliminating non-unique matches") (let ((to-be-killed-for-each-angle nil) (count-bits (1+ (floor (log (length disps) 2))))) (loop for angle in angles do (*let ((count!! (!! 0))) (declare (type (field-pvar count-bits) count!!)) (*skew-planes disps (- angle) i-d f-d) (loop for d!! in disps do (*if d!! (*incf count!!))) (push (allocate!! (>!! count!! (!! 1)) 'temp-killing-pvar 'boolean-pvar) to-be-killed-for-each-angle) (*skew-planes disps angle i-d f-d))) (loop for angle in angles for kill!! in (reverse to-be-killed-for-each-angle) do (cond ((not (eql angle 45)) (*skew-planes disps (- angle) i-d f-d) (loop for d!! in disps do (*if kill!! (*set d!! nil!!))) (*skew-planes disps angle i-d f-d)))) (loop for kill!! in to-be-killed-for-each-angle do (*deallocate kill!!))) disps) ;) ;;; A crude attempt to deal with bad results at boundaries. Provides a context within which the ;;; stereo results are likely to be good. This context should depend on the fusional range but ;;; I'm too lazy to deal with that. (*defun STEREO-CONTEXT!! (&optional (top-edges-clip *top-edges-clip*) (left-edges-clip *left-edges-clip*) (right-edges-clip *right-edges-clip*) (bottom-edges-clip *bottom-edges-clip*)) (context-rectangle!! top-edges-clip left-edges-clip right-edges-clip bottom-edges-clip)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Locating depth discontinuities by looking for close winners. (WEG 11/87) ;;; Try to locate depth discontinuities by looking for close winners. Consider only local ;;; maxima. We don't want to consider the value immediately next to the global maximum to be ;;; a close winner. The value next to the global max may be quite large if the peak is not ;;; sharp. (*defunc *FIND-CLOSE-WINNERS (accums i-d f-d margin across-angle user-close-winners-dest!! &aux last-accum!!) (declare (special *close-margins*)) (ignore i-d f-d) ;not currently used (*let ((max!! (!! 0)) (accum-where-max-was-found!! (!! 0)) (marg!! (!! 0)) (close-winners!! nil!!) (increasing?!! nil!!)) (declare (type (field-pvar (pvar-length (car accums))) max!! marg!!) (type (field-pvar (integer-length (length accums))) accum-where-max-was-found!!) (type boolean-pvar close-winners!! increasing?!!)) ;; Determine the largest score and the disparity corresponding to the largest ;; score. (There may be more than one such disparity, in which case we arbitrarily ;; choose the largest disparity.) (loop for accum in accums for i from 0 do (*set max!! (max!! max!! accum)) (*if (=!! max!! accum) (*set accum-where-max-was-found!! (!! i)))) ;; Now find close winners - pixels where there is a local maximum score close to the ;; overall maximum score. (if (plusp margin) (*set marg!! (floor!! (*!! max!! (!! margin)))) ; (error "Close winners margin must be positive, but margin = ~D" margin)) (*set marg!! max!!)) (*set user-close-winners-dest!! nil!!) ;clear record of close winners (if (boundp '*close-margins*) (*set *close-margins* (!! 255))) (format t "~%Looking for close winners, margin = ~D." margin) (*set increasing?!! (>!! (second accums) (first accums))) (setq last-accum!! (second accums)) (loop for accum!! in (cddr accums) for i from 1 do (*cond ((and!! increasing?!! (!! accum!! last-accum!!)) (setq last-accum!! accum!!)) ;; Add close winners to the global record. ;; Across-angle is assumed to be either 0 or 90. If across-angle is 90, then we are ;; working with the right line of sight and must transform to the left line of sight. (cond ((= across-angle 0) (*when close-winners!! (*set user-close-winners-dest!! t!!))) ((= across-angle 90) (*pset-grid-relative-clipped :or close-winners!! user-close-winners-dest!! (+!! accum-where-max-was-found!! (!! i-d)) (!! 0))) (t (format t "~%Error: *find-close-winners expects to be called only with across-angle = 0 or 90, not across-angle = ~D" across-angle))) (if (boundp '*close-margins*) (let ((max (*when user-close-winners-dest!! (*max *close-margins*)))) (*when (not!! user-close-winners-dest!!) (*set *close-margins* (!! (1+ max)))))) ;; get rid of bad boundary results (*when (not!! (context-rectangle!! *top-edges-clip* *left-edges-clip* *right-edges-clip* *bottom-edges-clip*)) (*set user-close-winners-dest!! nil!!)) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Control functions ;;; Allow enough bits to add up a square neighborhood of edges, assuming edge density = 0.5. This approach ;;; is valid for unnormalized edge matching, but not for normalized edge matching or grey scale matching. ;;; If *bits-per-accum* has been set, use it - this is a hack to control the accum size manually. ;;; ;;; Called from iterative-stereo. (defun BITS-PER-ACCUM (support-region-width support-region-height max-support-value) "Returns the number of bits to allocate for matching scores. If this parameter is too large, we run out of memory. If this parameter is too small, the scores will be heavily truncated and the stereo results will be inaccurate." (cond (*bits-per-accum* (format t "~%Forcing the number of bits per score (*bits-per-accum*) to ~D." *bits-per-accum*) *bits-per-accum*) (t (let ((bits-per-accum (integer-length (floor (* support-region-width support-region-height max-support-value) 2)))) (format t "~%Allocating ~D bits per score." bits-per-accum) bits-per-accum)))) ;;; If requested, clear the scores at locations where there is no potential match. This means that only scores ;;; at potential match locations participate in nonmaximum suppression along lines of sight. I think that it is ;;; better to allow all scores to participate in nonmaximum suppression; this is a conservative strategy. ;;; (WEG 2/18/88). ;;; ;;; Called from iterative-stereo. (*defun CLEAR-ACCUMS-AT-NO-MATCH-SITES (clear-accums-at-no-match-sites? potential-match-planes accums) (cond (clear-accums-at-no-match-sites? (format t "~%Only support scores associated with potential matches will be involved in nonmaximum suppression.") (loop for pm in potential-match-planes for ac in accums do (*if (not!! pm) (*set ac (!! 0))))) (t (format t "~%All scores will be involved in nonmaximum suppression.")))) ;;; called from *stereo-on-edge-images (defun ITERATIVE-STEREO (potential-match-planes support-planes l-features!! r-features!! angles i-d f-d ivd fvd iters support-region-width support-region-height blank-out-support? margin clear-accums-at-no-match-sites? user-close-winners-dest!!) ;; If requested, don't allow matches where the right image is undefined. As a nice side effect of the ;; warping procedure, those are exactly the locations of zero intensity. (cond (*suppress-matches-outside-of-right-image-boundary?* (format t "~%Suppressing matches outside of the boundary of the warped right image.") (*when (zerop!! *right-image*) (loop for pm in potential-match-planes do (*set pm nil!!))))) ;; If we're not matching grey levels, then we don't need the images any longer. Free some space. (if (not *match-grey?*) (mapcar #'*deallocate (list *left-image* *right-image*))) (let* ((disp-vals (1+ (- f-d i-d))) (max-support-value (1- (expt 2 (pvar-length (first support-planes))))) ;; how many bits to allocate for matching scores (bits-per-accum (bits-per-accum support-region-width support-region-height max-support-value)) (accums (make-planes disp-vals :field :length bits-per-accum))) (setq *ac* accums) (dotimes (i iters) (if blank-out-support? (loop for pm in potential-match-planes for sp in support-planes do (*if (not!! pm) (*set sp (!! 0)))) (format t "~%Warning: *blank-out-support?* is NIL~%")) (gather-local-support support-planes accums l-features!! r-features!! support-region-width support-region-height i-d f-d ivd fvd) ;; If we're matching grey levels, now is the time to get rid of the images. (if *match-grey?* (mapcar #'*deallocate (list *left-image* *right-image*))) ;; experimental: use close winners to locate depth discontinuities (WEG 11/17/87) (if user-close-winners-dest!! (*find-close-winners accums i-d f-d margin 0 user-close-winners-dest!!)) (clear-accums-at-no-match-sites clear-accums-at-no-match-sites? potential-match-planes accums) (*set-planes potential-match-planes (select-maximal-support potential-match-planes accums i-d f-d angles margin)) ) (if *kill-non-unique-matches?* (kill-non-unique-matches potential-match-planes '(0) i-d f-d)) ;; If requested, kill matches with low scores (WEG 12/29/87). (cond (*min-score-for-match* (format t "~%Suppressing matches with scores below ~D..." *min-score-for-match*) (*when (!! (second accums) (first accums))) ; (setq last-accum!! (second accums)) ; (loop for accum!! in (cddr accums) ; for accum-index from 1 do ; (*cond ((and!! increasing?!! ; (!! accum!! last-accum!!)) ; (setq last-accum!! accum!!)) ; ;; ;; Add close winners to the global record. ;; ;; Across-angle is assumed to be either 0 or 90. If across-angle is 90, then we are ;; ;; working with the right line of sight and must transform to the left line of sight. ;; (cond ((= across-angle 0) ;; (*when close-winners!! (*set user-close-winners-dest!! t!!))) ;; ((= across-angle 90) ;; (*pset-grid-relative-clipped :or close-winners!! user-close-winners-dest!! ;; (+!! accum-where-max-was-found!! (!! i-d)) (!! 0))) ;; (t (format t "~%Error: *find-close-winners expects to be called only with across-angle = 0 or 90, not across-angle = ~D" across-angle))) ; ; (*set user-close-winners-dest!! nil!!) ;clear close winner result ; (*when (not!! (stereo-context!!)) (*set close-winners!! nil!!)) ;clean up boundaries ; ;; transform to left image coords, using the score peak with max left-to-right disparity ; (*pset-grid-relative-clipped :or close-winners!! user-close-winners-dest!! ; (-!! (+!! accum-of-peak-with-max-disp!! (!! i-d))) (!! 0)) ; ; (if (boundp '*close-margins*) ; (let ((max (*when user-close-winners-dest!! (*max *close-margins*)))) ; (*when (not!! user-close-winners-dest!!) ; (*set *close-margins* (!! (1+ max)))))) ; ))