home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
vis-ftp.cs.umass.edu
/
vis-ftp.cs.umass.edu.tar
/
vis-ftp.cs.umass.edu
/
pub
/
Software
/
ASCENDER
/
ascendMar8.tar
/
UMass
/
Epipolar
/
epiheight.lisp
< prev
next >
Wrap
Lisp/Scheme
|
1995-07-20
|
9KB
|
210 lines
;;; EPIHEIGHT.LISP
;;;
;;; Height computation based on cross ratio calculations
;;;
;;; Author: Robert T. Collins
;;; Date: Mar 1, 1995
;;; based on my earlier epipolar.lisp, written Dec 28, 1993
;;;
;-----------------------------------------------------------------
; (c) Copyright 1995 by The University of Massachusetts
;------------------------------------------------------------------
(in-package 'epipolar :nicknames '(epi))
;;;****************************************************************
;;; COMPUTING THE CROSS RATIO AND SOLVING FOR HEIGHT
;;;
;; The following is not a true projective invariant, since 'between' is
;; not a projective concept (i.e. this won't work for extreme projections
;; that cause the range zlow to zhigh to straddle infinity). It will work
;; for all practical applications, however.
(defun height-invariant (lowz midz highz zval)
" Returns an invariant height value in the range [0,1] for zval
between lowz and highz, in relation to an intermediate point midz."
(if (< highz lowz) ;;if range is backwards, negate coordinates
(height-invariant (- lowz) (- midz) (- highz) (- zval))
(cond
((< zval lowz) 0.0)
((< zval midz)
(* 0.5
(/ (- highz midz) (- midz lowz))
(/ (- zval lowz) (- highz zval))))
((< zval highz)
(- 1
(* 0.5
(/ (- midz lowz) (- highz midz))
(/ (- highz zval) (- zval lowz)))))
(t 1.0))))
;;the following function depends of the ordering and values of
;;the homogeneous line coordinates returned by clip-to-quad-init.
(defun cr-reference-line (lowline epi2line highline epi1line)
" Returns homogeneous coordinates of a 'good' reference line against
which other lines will be intersected to derive disparity values
for use in the cross-ratio-based height calculation."
(let* ((midline (la:normalize2 (la:v- lowline highline)))
(epimidline (la:normalize2 (la:v- epi2line epi1line)))
(center (line-intersection-pt midline epimidline)))
(list (- (second midline))
(first midline)
(- (* (second midline) (car center))
(* (first midline) (cadr center))))))
(defun cr-reference-coord (cr-reference-line line)
" Returns homogeneous coordinates of the intersection point of
the given line with the cross ratio reference line"
(let ((pt (la:unit-normal line cr-reference-line))
(cos (car cr-reference-line))
(sin (cadr cr-reference-line)))
(list (- (* cos (second pt)) (* sin (first pt)))
(third pt))))
(defun cr-reference-value (cr-reference-line line &key (reciprocal? nil))
" Returns a 1d value representing the disparity of the given line,
as determined by intersection with the cross ratio reference line."
(multiple-value-bind (x y)
(values-list (cr-reference-coord cr-reference-line line))
(if reciprocal?
(/ y x)
(/ x y))))
(defun solve-for-height-given-cr (crvalue lowz midz highz)
"Determine the height that yields a particular invariant value."
(if (<= crvalue 0.5)
(let ((tmp (* 2.0 crvalue (/ (- midz lowz) (- highz midz)))))
(/ (+ lowz (* highz tmp)) (+ 1.0 tmp)))
(let ((tmp (* 2.0 (- 1.0 crvalue) (/ (- highz midz) (- midz lowz)))))
(/ (+ highz (* lowz tmp)) (+ 1.0 tmp)))))
(defun solve-for-cr-given-height (heightvalue lowz midz highz)
"Determine the invariant cross ratio value for a given height."
(height-invariant lowz midz highz heightvalue))
;;;;****************************************************************
;;;; HISTOGRAMMING HEIGHT VALUES
(defun init-height-histogram (&optional (numbuckets *num-z-buckets*)
(lowvalue *lowz*) (highvalue *highz*))
(hist:make-histogram :num-buckets numbuckets
:min-value lowvalue
:max-value highvalue))
(defun clear-height-histogram (&optional (histogram *current-histogram*))
(hist:clear-histogram histogram :clear-value 0.0))
(defun add-to-height-histogram (hist1 hist2)
" Destructively add hist2 into hist1"
(hist::merge-histograms hist1 hist2))
(defsubst uniform-range-CDF (value min max)
(cond ((<= value min) 0.0)
((< value max) (/ (- value min) (- max min)))
(t 1.0)))
(defun probability-of-range (a b min max)
"Determine probability associated with the subrange (a,b) within (min,max)"
(abs (- (uniform-range-CDF b min max)
(uniform-range-CDF a min max))))
#|
(defun vote-for-height-range (cr1 cr2 lowz midz highz
&key (weight 1) (histogram *current-histogram*))
" Vote for a range of height values bounded by the cross ratios values
cr1 and cr2. The total vote weight is apportioned to individual
histogram buckets probabilistically, as determined by the function
probability-of-range."
(when (< cr2 cr1) (rotatef cr1 cr2))
(let ((height1 (solve-for-height-given-cr cr1 lowz midz highz))
(height2 (solve-for-height-given-cr cr2 lowz midz highz)))
(when (< height2 height1) (rotatef height1 height2))
(let ((lowindex (hist:value-to-index histogram height1))
(highindex (hist:value-to-index histogram height2)))
(do ((index lowindex (+ 1 index)))
((> index highindex) (values height1 height2))
(multiple-value-bind (rangelow rangehigh)
(values-list (hist:index-to-range histogram index))
(unless rangelow (setf rangelow lowz))
(unless rangehigh (setf rangehigh highz))
(let ((cra (solve-for-cr-given-height rangelow lowz midz highz))
(crb (solve-for-cr-given-height rangehigh lowz midz highz)))
(hist:accumulate-by-index histogram index
(* weight (probability-of-range
cra crb cr1 cr2)))))))))
|#
;;This is simpler - CDF (uniform distribution right now) is over height values.
;;The other version used a CDF over CR values.
;;Actually, neither is right, and I really want my CDF to
;;be computed over disparity (pixel) distances in the image.
#|
(defun vote-for-height-range (cr1 cr2 lowz midz highz
&key (weight 1)(histogram *current-histogram*))
" Vote for a range of height values bounded by the cross ratios values
cr1 and cr2. The weight of the vote is apportioned to individual
histogram buckets probabilistically, as determined by the function
probability-of-range."
(let ((height1 (solve-for-height-given-cr cr1 lowz midz highz))
(height2 (solve-for-height-given-cr cr2 lowz midz highz)))
(when (< height2 height1) (rotatef height1 height2))
(let ((lowindex (hist:value-to-index histogram height1))
(highindex (hist:value-to-index histogram height2)))
(do ((index lowindex (+ 1 index)))
((> index highindex) (values height1 height2))
(multiple-value-bind (rangelow rangehigh)
(values-list (hist:index-to-range histogram index))
(unless rangelow (setf rangelow lowz))
(unless rangehigh (setf rangehigh highz))
(hist:accumulate-by-index histogram index
(* weight (probability-of-range
rangelow rangehigh height1 height2))))))))
|#
;;Same as the last one - CDF (uniform distribution) is over height values.
;;Hwever, added the ability to scale weights so that the peak histogram
;;bucket gets a full vote of weight, with other buckets getting proportially
;;smaller values, rather than all vote values adding up to weight.
(defun vote-for-height-range (cr1 cr2 lowz midz highz
&key (weight 1) (peak-weight? nil)
(histogram *current-histogram*))
" Vote for a range of height values bounded by the cross ratios values
cr1 and cr2. The weight of the vote is apportioned to individual
histogram buckets probabilistically, as determined by the function
probability-of-range. By default, the sum of all votes given adds
up to value of weight, however, if peak-weight? is nonnil, then all
votes are scaled so that the histogram with the highest vote actually
gets the full vote of weight."
(let ((height1 (solve-for-height-given-cr cr1 lowz midz highz))
(height2 (solve-for-height-given-cr cr2 lowz midz highz)))
(when (< height2 height1) (rotatef height1 height2))
(let ((lowindex (hist:value-to-index histogram height1))
(highindex (hist:value-to-index histogram height2))
(voteinfo nil)(maxprob -999999.9))
(do ((index lowindex (+ 1 index)))
((> index highindex) (values height1 height2))
(multiple-value-bind (rangelow rangehigh)
(values-list (hist:index-to-range histogram index))
(unless rangelow (setf rangelow lowz))
(unless rangehigh (setf rangehigh highz))
(let ((p (probability-of-range rangelow rangehigh height1 height2)))
(when (> p maxprob) (setf maxprob p))
(push (list index p) voteinfo))))
;;adjust weight if necessary
(when peak-weight? (setf weight (/ weight maxprob)))
(dolist (index-prob-pair voteinfo)
(hist:accumulate-by-index
histogram
(car index-prob-pair)
(* weight (cadr index-prob-pair))))
(values height1 height2))))