Mercurial > hg > amuse
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))