Mercurial > hg > amuse

changeset 161:676283afe8fb

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
misc bug fixes darcs-hash:20071211150333-1f211-716a232fef6cf85127f8a2e52e71b813495a1cac.gz
author d.mullensiefen <d.mullensiefen@gold.ac.uk>
date Tue, 11 Dec 2007 15:03:33 +0000
parents 136ec5516cc4
children 110e957a7e3c
files amuse.asd tools/segmentation/methods.lisp
diffstat 2 files changed, 14 insertions(+), 8 deletions(-) [+]
line wrap: on
line diff
--- a/amuse.asd	Tue Dec 11 14:59:12 2007 +0000
+++ b/amuse.asd	Tue Dec 11 15:03:33 2007 +0000
@@ -18,7 +18,7 @@
             ((:file "package")
              (:file "utils" :depends-on ("package"))
 	     (:file "n-grams" :depends-on ("package"))
-	     (:file "meltools" :depends-on ("package")))
+	     (:file "meltools" :depends-on ("package"))))
    (:module tools
             :components
 	    ((:file "package")
--- a/tools/segmentation/methods.lisp	Tue Dec 11 14:59:12 2007 +0000
+++ b/tools/segmentation/methods.lisp	Tue Dec 11 15:03:33 2007 +0000
@@ -13,7 +13,11 @@
 (defun map-segmenters (composition &key (start-boundary-segmenter nil) (end-boundary-segmenter nil))
   (cond
     ((and start-boundary-segmenter end-boundary-segmenter)
-     (%map-non-contiguous-segmenters composition start-boundary-segmenter end-boundary-segmenter))
+     #+nil (%map-non-contiguous-segmenters composition start-boundary-segmenter end-boundary-segmenter)
+     ;; hacky fix for broken code
+     (remove-duplicates (nconc (%map-start-segmenter composition start-boundary-segmenter)
+			       (%map-end-segmenter composition end-boundary-segmenter))
+			:test #'period=))
     (start-boundary-segmenter
      (%map-start-segmenter composition start-boundary-segmenter))
     (end-boundary-segmenter
@@ -32,18 +36,18 @@
 	  (setf (duration (car segments))
 		(duration (time- (boundary-time segmenter event)
 				 (onset (car segments))))))
-	(push (make-instance 'anchored-period
+	(push (make-instance 'standard-anchored-period
 			     :time (timepoint (boundary-time segmenter event)))
 	      segments)))))
 
 (defun %map-end-segmenter (composition segmenter)
-  (let ((segments (list (make-instance 'anchored-period :time (timepoint composition)))))
+  (let ((segments (list (make-instance 'standard-anchored-period :time (timepoint composition)))))
     (sequence:dosequence (event composition (reverse (cdr segments)))
       (when (> (boundary-strength segmenter event composition) 0)
 	(setf (duration (car segments))
 	      (duration (time- (boundary-time segmenter event)
 			       (onset (car segments)))))
-	(push (make-instance 'anchored-period
+	(push (make-instance 'standard-anchored-period
 			     :time (timepoint (boundary-time segmenter event)))
 	      segments)))))
 
@@ -54,11 +58,13 @@
   (let ((segments) (starts))
     (sequence:dosequence (event composition (reverse segments))
       (when (> (boundary-strength start-boundary-segmenter event composition) 0)
-	(setf (cdr (last starts))
-	      (list (boundary-time start-boundary-segmenter event))))
+	(if starts
+	    (setf (cdr (last starts))
+		  (list (boundary-time start-boundary-segmenter event)))
+	    (setf starts (list (boundary-time start-boundary-segmenter event)))))
       (when (> (boundary-strength end-boundary-segmenter event composition) 0)
 	(when starts
-	  (push (make-instance 'anchored-period
+	  (push (make-instance 'standard-anchored-period
 			       :interval (amuse::duration (time- (boundary-time end-boundary-segmenter event)
 								 (car starts)))
 			       :time (timepoint (pop starts)))