Mercurial > hg > amuse
comparison base/database/charm/constructors.lisp @ 318:c4e792b9b898
Add some ideas for charm constituents.
Not particularly useful in its own right, but contains some possibly
useful ideas related to the generalisation of db-compositions.
| author | Jamie Forth <j.forth@gold.ac.uk> |
|---|---|
| date | Thu, 30 Sep 2010 15:35:15 +0100 |
| parents | |
| children |
comparison
equal
deleted
inserted
replaced
| 317:46dd71ef9ab3 | 318:c4e792b9b898 |
|---|---|
| 1 (cl:in-package #:amuse-charm) | |
| 2 | |
| 3 (defun make-charm-property-list (properties) | |
| 4 (make-instance 'charm-property-list | |
| 5 :%data properties)) | |
| 6 | |
| 7 (defun make-charm-constituent-identifier (id) | |
| 8 (make-instance 'charm-constituent-identifier | |
| 9 :constituent-id id)) | |
| 10 | |
| 11 (defun make-standard-charm-constituent (particles parent | |
| 12 extrinsic-properties | |
| 13 intrinsic-properties &key | |
| 14 start duration | |
| 15 constituent-identifier owner | |
| 16 version creation-timestamp | |
| 17 deletion-timestamp) | |
| 18 "Properties should be charm-property-lists. FIXME: enforce this? | |
| 19 What about time? Should we be using implementation time data-types? | |
| 20 Particles by definition are identifiers - BUT this seemed to cause | |
| 21 unnecessary pain, so particales are now either events or | |
| 22 constituents. This could be make to call an backend specific | |
| 23 constructor specialised on the parent-identifier." | |
| 24 (make-instance 'standard-charm-constituent | |
| 25 :identifier constituent-identifier | |
| 26 :parent parent | |
| 27 :time start ; FIXME: naming conventions? | |
| 28 :interval duration | |
| 29 :extrinsic-properties extrinsic-properties | |
| 30 :intrinsic-properties intrinsic-properties | |
| 31 :%data particles | |
| 32 :owner owner | |
| 33 :version version | |
| 34 :creation-timestamp creation-timestamp | |
| 35 :deletion-timestamp deletion-timestamp)) | |
| 36 | |
| 37 (defun make-standard-charm-event-constituent (particles parent | |
| 38 extrinsic-properties | |
| 39 intrinsic-properties | |
| 40 &key start duration | |
| 41 constituent-identifier | |
| 42 owner version | |
| 43 creation-timestamp | |
| 44 deletion-timestamp) | |
| 45 "Properties should be charm-property-lists. FIXME: enforce this? | |
| 46 What about time? Should we be using implementation time data-types? | |
| 47 Particles by definition are identifiers - BUT this seemed to cause | |
| 48 unnecessary pain, so particales are now either events or | |
| 49 constituents. This could be make to call an backend specific | |
| 50 constructor specialised on the parent-identifier." | |
| 51 (make-instance 'standard-charm-event-constituent | |
| 52 :identifier constituent-identifier | |
| 53 :parent parent | |
| 54 :time start ; FIXME: naming conventions? | |
| 55 :interval duration | |
| 56 :extrinsic-properties extrinsic-properties | |
| 57 :intrinsic-properties intrinsic-properties | |
| 58 :%data (copy-list particles) | |
| 59 :owner owner | |
| 60 :version version | |
| 61 :creation-timestamp creation-timestamp | |
| 62 :deletion-timestamp deletion-timestamp)) | |
| 63 | |
| 64 (defun composition->charm-constituent (composition | |
| 65 extrinsic-properties | |
| 66 intrinsic-properties) | |
| 67 "This is currently the bridge that takes us from AMuSE compositions | |
| 68 to Charm constituents." | |
| 69 (make-standard-charm-event-constituent (%list-slot-sequence-data | |
| 70 composition) | |
| 71 composition | |
| 72 extrinsic-properties | |
| 73 intrinsic-properties | |
| 74 :start (timepoint | |
| 75 composition) | |
| 76 :duration (duration | |
| 77 composition))) | |
| 78 | |
| 79 (defun make-onset-segment-constituent (composition) | |
| 80 (let ((grouped-events (group-by-onset composition)) | |
| 81 (parent-constituent | |
| 82 (make-standard-charm-constituent nil composition | |
| 83 (make-charm-property-list | |
| 84 '("sequence-class")) | |
| 85 (make-charm-property-list | |
| 86 '("sequence-class")) | |
| 87 :start (timepoint | |
| 88 composition) | |
| 89 :duration (duration | |
| 90 composition)))) | |
| 91 (loop for beat-events in grouped-events | |
| 92 collect (make-standard-charm-event-constituent | |
| 93 beat-events | |
| 94 parent-constituent | |
| 95 (make-charm-property-list '("segment")) | |
| 96 (make-charm-property-list '("onset-segment"))) | |
| 97 into constituents | |
| 98 finally (progn | |
| 99 (setf (%list-slot-sequence-data parent-constituent) | |
| 100 constituents) | |
| 101 (return parent-constituent))))) | |
| 102 | |
| 103 (defun group-by-onset (composition) | |
| 104 (loop for event in (reverse (%list-slot-sequence-data composition)) | |
| 105 with grouped-events | |
| 106 do (if (and grouped-events | |
| 107 (time= (onset event) (onset (car (car grouped-events))))) | |
| 108 (push event (car grouped-events)) | |
| 109 (push (list event) grouped-events)) | |
| 110 finally (return grouped-events))) |