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 / 2pt5d-lines.lisp < prev    next >
Lisp/Scheme  |  1996-03-06  |  6KB  |  156 lines
  1. ;;; 2pt5d-lines.lisp
  2. ;;; add height information to 2d lines to create a 2.5d line set.
  3. ;;;
  4. ;;; Author: Bob Collins  Date: 7/15/95
  5. ;;; Copyright: University of Massachusetts, 1995, all rights reserved
  6. ;;;
  7. ;;; 2/21/96: BobC - changed compute-2.5d-lines to use noting-progress macros
  8. ;;;
  9.  
  10. (in-package 'epi)
  11.  
  12.  
  13. (defun histogram-2.5d-line-heights (view1 x1 y1 x2 y2 view2 &rest keys)
  14.   (let ((window (view-window view2)))
  15.     (when (and *demo-mode* window)
  16.       (let ((bbox (epipolar-search-area-bbox view1 view2
  17.                          (list (list x1 y1 x2 y2)))))
  18.  
  19.     (activate-window window)
  20.     (cme::zoom-to-bounding-box window (car bbox) (second bbox)
  21.                    (third bbox) (fourth bbox) 10)))
  22.     (apply #'histogram-line-candidates 
  23.        view1 x1 y1 x2 y2 view2 
  24.        :zoom nil :peak-weight? t 
  25.        keys)
  26.     (when (and *demo-mode* window (eq *pause-mode* :lines))
  27.       (synch-epipolar-screen window)
  28.       (setf *pause-mode* 
  29.         (if (yes-or-no-p "Pause between lines?") :lines :views)))))
  30.  
  31.  
  32. (defvar *minimum-support-percentage* 0.4)
  33. (defvar *multiple-peak-relative-support-threshold* 0.5)
  34.  
  35. (defun find-height-histogram-next-peak (histogram reference-conf
  36.                     &optional (excluded-indices nil))
  37.   (multiple-value-bind (peak conf) 
  38.        (hist::find-highest-peak histogram excluded-indices)
  39.     (when (and peak
  40.            (> conf *minimum-support-percentage* )
  41.            (> (/ conf reference-conf)
  42.           *multiple-peak-relative-support-threshold*))
  43.        (multiple-value-list (interpolate-peak histogram peak)))))
  44.  
  45. (defun find-height-hypotheses (histogram)
  46.   (let ((height-hypotheses nil)
  47.     (indices nil))
  48.     (do ((peak-info (find-height-histogram-next-peak 
  49.               histogram 
  50.               *minimum-support-percentage*)
  51.             (find-height-histogram-next-peak
  52.               histogram
  53.               (second peak-info)
  54.               indices)))
  55.      ((null peak-info) (reverse height-hypotheses))
  56.        (setf indices (append indices (third peak-info)))
  57.        (push (list (car peak-info) (cadr peak-info)) height-hypotheses))))
  58.  
  59. (defun compute-2.5d-line-heights (reference-view x1 y1 x2 y2 other-view-list
  60.                       &key (endpoint-slop 1.0)(delta-theta .1))
  61.   (when *demo-mode*
  62.     (let ((window (view-window reference-view)))
  63.       (activate-window window)
  64.       (cme::zoom-to-bounding-box window (min x1 x2) (min y1 y2)
  65.                  (max x1 x2) (max y1 y2) 10)
  66.       (display-line window x1 y1 x2 y2 :color *match-color* 
  67.             :thickness *match-thickness*)))
  68.   (clear-height-histogram *accum-histogram*)
  69.   (dolist (other-view other-view-list)
  70.     (clear-height-histogram *current-histogram*)
  71.     (histogram-2.5d-line-heights
  72.        reference-view x1 y1 x2 y2 other-view
  73.        :histogram *current-histogram*
  74.        :deltatheta delta-theta
  75.        :endpoint-slop endpoint-slop)
  76.     (add-to-height-histogram *accum-histogram* *current-histogram*)
  77.     (when *demo-mode*
  78.        (synch-epipolar-screen (view-window other-view))))
  79.   (hist::scale-histogram *accum-histogram* (/ 1.0 (length other-view-list)))
  80.   (find-height-hypotheses *accum-histogram*))
  81.  
  82.  
  83. (defun compute-2.5d-lines (ref-view linelist other-views &key
  84.                  (endpoint-slop 1.0)(delta-theta .1)
  85.                  &aux save-pause-mode (count 0)(result-list nil))
  86.   (setf save-pause-mode *pause-mode*)
  87.   (when *topdown-line-finder*
  88.     (dolist (view2 other-views)
  89.        (let* ((coordlist (mapcan #'(lambda (line) 
  90.                      (multiple-value-list
  91.                       (apply #'epipolar-search-area 
  92.                          (view-projection ref-view)
  93.                          (view-projection view2)
  94.                          line)))
  95.                  linelist))
  96.           (minx (reduce #'min coordlist :key #'car))
  97.           (miny (reduce #'min coordlist :key #'cadr))
  98.           (maxx (reduce #'max coordlist :key #'car))
  99.           (maxy (reduce #'max coordlist :key #'cadr)))
  100.      (setf (view-topdown-edgels view2)
  101.            (cme::compute-2dworld-canny-edges 
  102.           (view-image view2)
  103.           minx miny maxx maxy)))))
  104.   (ic::noting-progress ("2.5D" (length linelist) :progress-var 2.5d-progress)
  105.    (dolist (line linelist)
  106.       (let ((heights (compute-2.5d-line-heights 
  107.               ref-view 
  108.               (car line) (cadr line) (third line) (fourth line)
  109.               other-views
  110.               :endpoint-slop endpoint-slop
  111.               :delta-theta delta-theta)))
  112.         (if heights
  113.       (dolist (height heights)
  114.          (push (append line height) result-list))
  115.           ;;otherwise include line anyways, but with zero confidence
  116.       (push (append line '(0.0 0.0)) result-list)))
  117.       (ic::note-progress (incf count) 2.5d-progress)))
  118.   (when *topdown-line-finder*
  119.     (dolist (view2 other-views)
  120.        (cme::free-edgeimg (view-topdown-edgels view2))))
  121.   (setf *pause-mode* save-pause-mode)
  122. ;;(setf *2pt5d-lines* result-list)
  123.   result-list)
  124.  
  125. (defun make-quad-from-bbox (x1 y1 x2 y2)
  126.   (list (list x1 y1) (list x1 y2) (list x2 y2) (list x2 y1)))
  127.  
  128. (defun compute-2.5d-lines-in-pane-bbox (pane bbox &key
  129.                  (endpoint-slop 1.0)(delta-theta .1)
  130.                  (min-support 0.5))
  131.   (setf *minimum-support-percentage* min-support)
  132.   (let* ((topview (cme::top-view pane))
  133.      (2dworld (cme::2d-world topview))
  134.      (pane-trans (cme::inverse-transform
  135.               (cme::2d-to-window-transform topview))) 
  136.      (refview (cme::find-epi-view-for-world 2dworld))
  137.      (otherviews (cme::find-the-other-epi-views 2dworld))
  138.      (2dlinelist nil))
  139.     (multiple-value-bind (minx miny maxx maxy)
  140.       (apply #'cme::transform-2d-bounding-box pane-trans bbox)
  141.       (multiple-value-bind (ignore tokenset)
  142.       (cme::get-or-make-ISR-tokenset (cme::find-fs-named 2dworld 
  143.                            cme::*2d-line-fsname*))
  144.       ignore
  145.       (isr2::for-every-token (tok tokenset (x1 y1 x2 y2))
  146.         (let ((vx1 (isr2::value x1))
  147.           (vy1 (isr2::value y1))
  148.           (vx2 (isr2::value x2))
  149.           (vy2 (isr2::value y2)))
  150.           (unless (cme::approx-line-not-visible-p minx miny maxx maxy
  151.                               vx1 vy1 vx2 vy2)
  152.           (push (list vx1 vy1 vx2 vy2) 2dlinelist))))))
  153.     (compute-2.5d-lines refview 2dlinelist otherviews
  154.             :endpoint-slop endpoint-slop
  155.             :delta-theta delta-theta)))
  156.