comparison methods.lisp @ 20:6eb54ad3b8b4

Bug fixes mostly, but also re-aliasing onset to moment rather than timepoint

darcs-hash:20061213162757-f76cc-39094b0c337efac30d8a957a9087436146ea2e82.gz

 
 ;; Allen
 
 (defmethod meets ((object1 anchored-period)
 		  (object2 anchored-period))
-  (or (time= (cut-off object1) (onset object2))
-      (time= (cut-off object2) (onset object1))))
+  (or (time= (cut-off object1) object2)
+      (time= (cut-off object2) object1)))
 
 (defmethod before ((object1 anchored-period)
 		   (object2 anchored-period))
-  (time< (cut-off object1) (onset object2)))
+  (time> object2 (cut-off object1)))
 
 (defmethod overlaps ((object1 anchored-period)
 		     (object2 anchored-period))
-  (or (and (time> (cut-off object1) (onset object2))
-	   (time< (onset object1) (onset object2)))
-      (and (time> (cut-off object1) (cut-off object2))
-	   (time< (onset object1) (cut-off object2)))))
+  ;; FIXME: Is there a tidier method?
+  (or (and (time> object2 object1) ; object1 starts before object2
+	   (time> (cut-off object1) object2) ; object1 ends after object2 starts
+	   (time> (cut-off object2) (cut-off object1))) ; object1 ends before object2 does
+      (and (time> object1 object2) ; object1 starts after object2
+	   (time> (cut-off object2) object1) ; object1 starts before object2 ends
+	   (time> (cut-off object1) (cut-off object2))))) ; object1 ends after object2 does
 
 (defmethod during ((object1 anchored-period)
 		   (object2 anchored-period))
-  (and (time> (onset object1) (onset object2))
+  (and (time> object1 object2)
        (time< (cut-off object2) (cut-off object2))))
 
 (defmethod starts ((object1 anchored-period)
 		   (object2 anchored-period))
-  (time= (onset object1) (onset object2)))
+  (time= object1 object2))
 
 (defmethod ends ((object1 anchored-period)
 		 (object2 anchored-period))
   (time= (cut-off object1) (cut-off object2)))
 

     ((disjoint object1 object2)
      ;; if they don't overlap, return nil, not a negative-valued
      ;; period
      nil)
     (t
-     (let ((new-onset (max (onset object1)
-			   (onset object2))))
+     (let ((new-onset (max (timepoint object1)
+			   (timepoint object2))))
        (make-anchored-period new-onset
 			     (time- (min (cut-off object1)
 					 (cut-off object2))
 				    new-onset))))))