changeset 75:6b2ac9eef629

Improved segmentation implementation (ta, MTP) darcs-hash:20070713112322-f76cc-42a6ead0d8822164af5554d11ca98f93a1f96359.gz
author David Lewis <d.lewis@gold.ac.uk>
date Fri, 13 Jul 2007 12:23:22 +0100
parents a98c2adfd420
children 4ad1427d46d8
files tools/segmentation/classes.lisp tools/segmentation/generics.lisp tools/segmentation/methods.lisp tools/segmentation/simple-example.lisp
diffstat 4 files changed, 22 insertions(+), 28 deletions(-) [+]
line wrap: on
line diff
--- a/tools/segmentation/classes.lisp	Fri Jul 13 11:07:51 2007 +0100
+++ b/tools/segmentation/classes.lisp	Fri Jul 13 12:23:22 2007 +0100
@@ -4,15 +4,6 @@
   (:documentation "Base class for identifying segment-boundary
   methods."))
 
-(defclass basic-segmenter (segmenter)
-  ((direction :initarg :direction
-	      :initform :after
-	      :accessor %segmenter-direction)
-   (ground-truthp :initarg :ground-truthp
-		  :initform nil
-		  :accessor %segmenter-ground-truthp)
-   (method :initarg :method
-	   :accessor %segmenter-method))
-  (:documentation "Simple class for giving common segmenter
-  info. Method takes a moment-designator and a composition and
-  returns a positive number"))
\ No newline at end of file
+(defclass before-segmenter (segmenter) ())
+(defclass after-segmenter (segmenter) ())
+(defclass ground-truth-segmenter (segmenter) ())
\ No newline at end of file
--- a/tools/segmentation/generics.lisp	Fri Jul 13 11:07:51 2007 +0100
+++ b/tools/segmentation/generics.lisp	Fri Jul 13 12:23:22 2007 +0100
@@ -11,7 +11,7 @@
   boundary-strength applies to if object is the second input to
   the method. Essentially, this distinguishes between segmenters
   that look to the beginning of a note and those that look at the
-  end.")
+  end."))
 
 (defgeneric ground-truth-segmenter-before (composition)
   (:documentation "Returns the segmenter that, when put into
@@ -27,7 +27,11 @@
   segmenter only, so in cases of multiple ground truths, this
   method must arbitrate."))
 
-(defgeneric ground-truth-segmenterp (segmenter)) ;; prob not necessary?
-(defgeneric segments-beforep (segmenter))
+(defgeneric ground-truth-segmenterp (segmenter)
+  (:method ((s ground-truth-segmenter)) t)
+  (:method (s) nil)) ;; prob not necessary?
+(defgeneric segments-beforep (segmenter)
+  (:method ((s before-segmenter)) t)
+  (:method ((s after-segmenter)) nil))
 (defgeneric segments-afterp (segmenter)
   (:method (s) (not (segments-beforep s))))
--- a/tools/segmentation/methods.lisp	Fri Jul 13 11:07:51 2007 +0100
+++ b/tools/segmentation/methods.lisp	Fri Jul 13 12:23:22 2007 +0100
@@ -1,21 +1,11 @@
 (in-package "AMUSE-SEGMENTATION")
 
-(defmethod boundary-strength ((segmenter basic-segmenter) object composition)
-  (funcall (%segmenter-method segmenter) object composition))
-
 (defmethod boundary-time ((segmenter basic-segmenter) (object anchored-period-designator))
   (if (segments-beforep segmenter)
       (onset object)
       (cut-off object)))
 (defmethod boundary-time (segmenter (object moment-designator))
   object)
-(defmethod ground-truth-segmenterp ((segmenter basic-segmenter))
-  (%segmenter-ground-truthp segmenter))
-(defmethod segments-beforep ((segmenter basic-segmenter))
-  (eq (%segmenter-direction segmenter) :before))
-
-(defun make-basic-segmenter (method &key (ground-truthp nil) (direction :after))
-  (make-instance 'basic-segmenter :method method :ground-truthp ground-truthp :direction direction))
 
 ;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Seriously made-up stuff (= dodgy)
--- a/tools/segmentation/simple-example.lisp	Fri Jul 13 11:07:51 2007 +0100
+++ b/tools/segmentation/simple-example.lisp	Fri Jul 13 12:23:22 2007 +0100
@@ -12,9 +12,18 @@
 ;; times that length. An absolute gap of 1.5 seconds is also used if
 ;; beats-to-seconds is available.
 
-(defparameter *simple-segmenter*
-  (make-basic-segmenter #'simple-segmentsp :ground-truthp nil
-			:direction :before))
+(defclass simple-segmenter (before-segmenter) ())
+
+(defmethod boundary-strength ((segmenter simple-segmenter) (event moment-designator) (composition composition))
+  (declare (ignore segmenter))
+  (multiple-value-bind (i-o-i mode i-o-i-rt)
+      (inter-onset-intervals-for-simple-segmenter-with-cache composition)
+    (if (or (eq event (elt composition 0))
+	    (> (cdr (assoc event i-o-i)) (* mode 3.9))
+	    (and i-o-i-rt (> (cdr (assoc event i-o-i-rt))
+			     1.5)))
+	1
+	0)))
 
 (defgeneric simple-segmentsp (event composition))
 (defmethod simple-segmentsp ((event moment-designator) (composition composition))