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 >
Lisp/Scheme  |  1995-07-20  |  9KB  |  210 lines
  1. ;;; EPIHEIGHT.LISP
  2. ;;;
  3. ;;; Height computation based on cross ratio calculations
  4. ;;;
  5. ;;; Author: Robert T. Collins
  6. ;;; Date: Mar 1, 1995
  7. ;;; based on my earlier epipolar.lisp, written Dec 28, 1993
  8. ;;;
  9. ;-----------------------------------------------------------------
  10. ; (c) Copyright 1995 by The University of Massachusetts
  11. ;------------------------------------------------------------------
  12.  
  13. (in-package 'epipolar :nicknames '(epi))
  14.  
  15.  
  16. ;;;****************************************************************
  17. ;;; COMPUTING THE CROSS RATIO AND SOLVING FOR HEIGHT
  18. ;;;
  19.  
  20.  
  21. ;; The following is not a true projective invariant, since 'between' is
  22. ;; not a projective concept (i.e. this won't work for extreme projections
  23. ;; that cause the range zlow to zhigh to straddle infinity). It will work
  24. ;; for all practical applications, however.
  25.  
  26. (defun height-invariant (lowz midz highz zval)
  27.   "  Returns an invariant height value in the range [0,1] for zval
  28.   between lowz and highz, in relation to an intermediate point midz."
  29.   (if (< highz lowz)  ;;if range is backwards, negate coordinates
  30.      (height-invariant (- lowz) (- midz) (- highz) (- zval))
  31.      (cond
  32.         ((< zval lowz) 0.0)
  33.     ((< zval midz)
  34.         (* 0.5
  35.            (/ (- highz midz) (- midz lowz))
  36.            (/ (- zval lowz) (- highz zval))))
  37.     ((< zval highz)
  38.         (- 1
  39.            (* 0.5
  40.           (/ (- midz lowz) (- highz midz))
  41.           (/ (- highz zval) (- zval lowz)))))
  42.     (t 1.0))))
  43.  
  44.  
  45. ;;the following function depends of the ordering and values of
  46. ;;the homogeneous line coordinates returned by clip-to-quad-init.
  47.  
  48. (defun cr-reference-line (lowline epi2line highline epi1line)
  49.   "  Returns homogeneous coordinates of a 'good' reference line against
  50.   which other lines will be intersected to derive disparity values
  51.   for use in the cross-ratio-based height calculation."
  52.   (let* ((midline (la:normalize2 (la:v- lowline highline)))
  53.      (epimidline (la:normalize2 (la:v- epi2line epi1line)))
  54.      (center (line-intersection-pt midline epimidline)))
  55.     (list (- (second midline)) 
  56.       (first midline)
  57.       (- (* (second midline) (car center))
  58.          (* (first midline) (cadr center))))))
  59.  
  60. (defun cr-reference-coord (cr-reference-line line)
  61.   "  Returns homogeneous coordinates of the intersection point of
  62.   the given line with the cross ratio reference line"
  63.   (let ((pt (la:unit-normal line cr-reference-line))
  64.     (cos (car cr-reference-line))
  65.     (sin (cadr cr-reference-line)))
  66.     (list (- (* cos (second pt)) (* sin (first pt)))
  67.       (third pt))))
  68.  
  69. (defun cr-reference-value (cr-reference-line line &key (reciprocal? nil))
  70.   "  Returns a 1d value representing the disparity of the given line,
  71.   as determined by intersection with the cross ratio reference line."
  72.   (multiple-value-bind (x y)
  73.         (values-list (cr-reference-coord cr-reference-line line))
  74.     (if reciprocal?
  75.     (/ y x)
  76.         (/ x y))))
  77.  
  78. (defun solve-for-height-given-cr (crvalue lowz midz highz)
  79.   "Determine the height that yields a particular invariant value."
  80.   (if (<= crvalue 0.5)
  81.       (let ((tmp (* 2.0 crvalue (/ (- midz lowz) (- highz midz)))))
  82.     (/ (+ lowz (* highz tmp)) (+ 1.0 tmp)))
  83.       (let ((tmp (* 2.0 (- 1.0 crvalue) (/ (- highz midz) (- midz lowz)))))
  84.     (/ (+ highz (* lowz tmp)) (+ 1.0 tmp)))))
  85.  
  86. (defun solve-for-cr-given-height (heightvalue lowz midz highz)
  87.   "Determine the invariant cross ratio value for a given height."
  88.   (height-invariant lowz midz highz heightvalue))
  89.  
  90.  
  91.  
  92. ;;;;****************************************************************
  93. ;;;; HISTOGRAMMING HEIGHT VALUES
  94.  
  95. (defun init-height-histogram (&optional (numbuckets *num-z-buckets*)
  96.                       (lowvalue *lowz*) (highvalue *highz*))
  97.   (hist:make-histogram :num-buckets numbuckets
  98.                :min-value lowvalue
  99.                :max-value highvalue))
  100.  
  101. (defun clear-height-histogram (&optional (histogram *current-histogram*))
  102.   (hist:clear-histogram histogram :clear-value 0.0))
  103.  
  104. (defun add-to-height-histogram (hist1 hist2)
  105.   "  Destructively add hist2 into hist1"
  106.   (hist::merge-histograms hist1 hist2))
  107.  
  108. (defsubst uniform-range-CDF (value min max)
  109.   (cond ((<= value min) 0.0)
  110.     ((< value max) (/ (- value min) (- max min)))
  111.     (t 1.0)))
  112.  
  113. (defun probability-of-range  (a b min max)
  114.   "Determine probability associated with the subrange (a,b) within (min,max)"
  115.   (abs (- (uniform-range-CDF b min max)
  116.       (uniform-range-CDF a min max))))
  117.  
  118. #|
  119. (defun vote-for-height-range (cr1 cr2 lowz midz highz
  120.             &key (weight 1) (histogram *current-histogram*))
  121.   "  Vote for a range of height values bounded by the cross ratios values
  122.   cr1 and cr2.  The total vote weight is apportioned to individual
  123.   histogram buckets probabilistically, as determined by the function
  124.   probability-of-range."
  125.   (when (< cr2 cr1) (rotatef cr1 cr2))
  126.   (let ((height1 (solve-for-height-given-cr cr1 lowz midz highz))
  127.     (height2 (solve-for-height-given-cr cr2 lowz midz highz)))
  128.     (when (< height2 height1) (rotatef height1 height2))
  129.     (let ((lowindex (hist:value-to-index histogram height1))
  130.       (highindex (hist:value-to-index histogram height2)))
  131.       (do  ((index lowindex (+ 1 index)))
  132.        ((> index highindex) (values height1 height2))
  133.        (multiple-value-bind (rangelow rangehigh)
  134.             (values-list (hist:index-to-range histogram index))
  135.          (unless rangelow (setf rangelow lowz))
  136.          (unless rangehigh (setf rangehigh highz))
  137.          (let ((cra (solve-for-cr-given-height rangelow lowz midz highz))
  138.            (crb (solve-for-cr-given-height rangehigh lowz midz highz)))
  139.            (hist:accumulate-by-index histogram index
  140.            (* weight (probability-of-range
  141.                     cra crb cr1 cr2)))))))))
  142. |#
  143.  
  144. ;;This is simpler - CDF (uniform distribution right now) is over height values.
  145. ;;The other version used a CDF over CR values.
  146. ;;Actually, neither is right, and I really want my CDF to
  147. ;;be computed over disparity (pixel) distances in the image.
  148.  
  149. #|
  150. (defun vote-for-height-range (cr1 cr2 lowz midz highz
  151.             &key (weight 1)(histogram *current-histogram*))
  152.   "  Vote for a range of height values bounded by the cross ratios values
  153.   cr1 and cr2.  The weight of the vote is apportioned to individual
  154.   histogram buckets probabilistically, as determined by the function
  155.   probability-of-range."
  156.   (let ((height1 (solve-for-height-given-cr cr1 lowz midz highz))
  157.     (height2 (solve-for-height-given-cr cr2 lowz midz highz)))
  158.     (when (< height2 height1) (rotatef height1 height2))
  159.     (let ((lowindex (hist:value-to-index histogram height1))
  160.       (highindex (hist:value-to-index histogram height2)))
  161.       (do  ((index lowindex (+ 1 index)))
  162.        ((> index highindex) (values height1 height2))
  163.        (multiple-value-bind (rangelow rangehigh)
  164.             (values-list (hist:index-to-range histogram index))
  165.          (unless rangelow (setf rangelow lowz))
  166.          (unless rangehigh (setf rangehigh highz))
  167.          (hist:accumulate-by-index histogram index
  168.         (* weight (probability-of-range
  169.                     rangelow rangehigh height1 height2))))))))
  170. |#
  171.  
  172. ;;Same as the last one - CDF (uniform distribution) is over height values.
  173. ;;Hwever, added the ability to scale weights so that the peak histogram
  174. ;;bucket gets a full vote of weight, with other buckets getting proportially
  175. ;;smaller values, rather than all vote values adding up to weight.
  176.  
  177. (defun vote-for-height-range (cr1 cr2 lowz midz highz
  178.             &key (weight 1) (peak-weight? nil)
  179.             (histogram *current-histogram*))
  180.   "  Vote for a range of height values bounded by the cross ratios values
  181.   cr1 and cr2.  The weight of the vote is apportioned to individual
  182.   histogram buckets probabilistically, as determined by the function
  183.   probability-of-range.  By default, the sum of all votes given adds 
  184.   up to value of weight, however, if peak-weight? is nonnil, then all
  185.   votes are scaled so that the histogram with the highest vote actually
  186.   gets the full vote of weight."
  187.   (let ((height1 (solve-for-height-given-cr cr1 lowz midz highz))
  188.     (height2 (solve-for-height-given-cr cr2 lowz midz highz)))
  189.     (when (< height2 height1) (rotatef height1 height2))
  190.     (let ((lowindex (hist:value-to-index histogram height1))
  191.       (highindex (hist:value-to-index histogram height2))
  192.       (voteinfo nil)(maxprob -999999.9))
  193.       (do  ((index lowindex (+ 1 index)))
  194.        ((> index highindex) (values height1 height2))
  195.        (multiple-value-bind (rangelow rangehigh)
  196.             (values-list (hist:index-to-range histogram index))
  197.          (unless rangelow (setf rangelow lowz))
  198.          (unless rangehigh (setf rangehigh highz))
  199.          (let ((p (probability-of-range rangelow rangehigh height1 height2)))
  200.            (when (> p maxprob) (setf maxprob p))
  201.            (push (list index p) voteinfo))))
  202.       ;;adjust weight if necessary
  203.       (when peak-weight? (setf weight (/ weight maxprob)))
  204.       (dolist (index-prob-pair voteinfo)
  205.      (hist:accumulate-by-index 
  206.         histogram
  207.         (car index-prob-pair)
  208.         (* weight (cadr index-prob-pair))))
  209.       (values height1 height2))))
  210.