Mercurial > hg > amuse
changeset 250:b3260d1d2419
Add onset-in-bar-relative-to-tactus.
This depends on tactus-duration, which needs revisiting.
| author | Jamie Forth <j.forth@gold.ac.uk> |
|---|---|
| date | Thu, 24 Feb 2011 11:23:18 +0000 |
| parents | bba5e8571b92 |
| children | 6a3adca16910 |
| files | base/database/classes.lisp base/database/datasets-functions.lisp base/database/datasets-setup.lisp base/datasets/classes.lisp base/datasets/datasets-db/datasets-db-setup.lisp base/datasets/datasets-functions.lisp base/generics.lisp base/methods.lisp base/package.lisp |
| diffstat | 9 files changed, 188 insertions(+), 174 deletions(-) [+] |
line wrap: on
line diff
--- a/base/database/classes.lisp Thu Feb 24 11:23:18 2011 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,18 +0,0 @@ -(cl:in-package #:amuse-database-admin) - -(defclass amuse-dataset-identifier (identifier) - ((dataset-id :reader dataset-id - :initarg :dataset-id)) - (:documentation "A dataset is a set of pieces used for a particualar -analytical task. A dataset is not necessarily the same thing as a -corpus or collection (are these things different?). Corpus indicates -that a set of pieces have been curated in some way and in that sense -`belong together'. A dataset is just simply a set of pieces gathered -together to analyse, and the pieces can be from any corpus or -backend (hence the amuse- prefix")) - -(defclass amuse-dataset (list-slot-sequence) - ((identifier :initarg :identifier - :reader identifier) - (description :initarg :description - :reader description)))
--- a/base/database/datasets-functions.lisp Thu Feb 24 11:23:18 2011 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,105 +0,0 @@ -(cl:in-package #:amuse-database-admin) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Constructors - -(defun make-amuse-dataset-identifier (dataset-id) - (make-instance 'amuse-dataset-identifier - :dataset-id dataset-id)) - -(defun %make-amuse-dataset (dataset-identifier description - composition-identifiers) - (make-instance 'amuse-dataset - :%data composition-identifiers - :identifier dataset-identifier - :description description)) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Database functions - -(defun make-new-dataset (description &optional (database - *amuse-database*)) - "A dataset is a set of pieces used for a particualar analytical -task. A dataset is not necessarily the same thing as a corpus or -collection (are these things different?). Corpus indicates that a set -of pieces have been curated in some way and in that sense `belong -together'. A dataset is just simply a set of pieces gathered together -to analyse, and the pieces can be from any corpus or backend." - (let (dataset-id) - #.(clsql:locally-enable-sql-reader-syntax) - (clsql:insert-records :into "amuse_datasets" - :attributes '([description]) - :values (list description) - :database database) - #.(clsql:locally-disable-sql-reader-syntax) - (setf dataset-id (clsql-mysql::mysql-insert-id - (clsql-mysql::database-mysql-ptr - database))) - (make-amuse-dataset-identifier dataset-id))) - -(defun assign-composition-to-dataset (composition-identifier - dataset-identifier - &optional (database - *amuse-database*)) - (clsql:execute-command (format nil " -INSERT INTO amuse_datasets_join -SET dataset_id := ~S, -implementation_id := (SELECT get_impl_id('~A')), -composition_id := ~S;" - (dataset-id dataset-identifier) - (implementation-namestring - composition-identifier) - (composition-id - composition-identifier))) - :database database) - -(defun assign-compositions-to-dataset (composition-identifiers - dataset-identifier - &optional (database - *amuse-database*)) - "This should be done more sensibly." - (loop for identifier in composition-identifiers - do (assign-composition-to-dataset identifier - dataset-identifier - database))) - -(defun make-composition-identifiers-from-file (package pathname) - "This reads a file that contains one id per line, and returns a list -of composition-identifiers (specialised on package). It is useful for -reading files that have been exported from the database, for use with -the above functions." - (with-open-file (stream pathname :direction :input) - (loop for id = (read stream nil) - while id - collect (make-composition-identifier package id)))) - -(defun get-dataset (dataset-identifier &optional (database - *amuse-database*)) - (let ((dataset-header (clsql:query (format nil " -SELECT description -FROM amuse_datasets -WHERE dataset_id = ~S" (dataset-id dataset-identifier)) - :database database - :flatp t - :field-names nil)) - (dataset-rows (clsql:query (format nil " -SELECT implementation_name, composition_id -FROM amuse_datasets_join -LEFT JOIN amuse_implementations -USING (implementation_id) -WHERE dataset_id = ~S" - (dataset-id - dataset-identifier)) - :flatp t - :field-names nil - :database database))) - (%make-amuse-dataset dataset-identifier (car dataset-header) - (%init-dataset-rows dataset-rows)))) - -(defun %init-dataset-rows (dataset-rows) - (loop for row in dataset-rows - collect (make-composition-identifier (find-package - (first row)) (second row)) - into composition-identifiers - finally (return composition-identifiers)))
--- a/base/database/datasets-setup.lisp Thu Feb 24 11:23:18 2011 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,46 +0,0 @@ -(cl:in-package #:amuse-database-admin) - -(defun create-datasets-table (&optional (database *amuse-database*)) - (%create-datasets-table database) - (%create-datasets-join-table database)) - -(defun drop-datasets-table (&optional (database *amuse-database*)) - (%drop-datasets-table database) - (%drop-datasets-join-table database)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Helper functions - -(defun %create-datasets-table (database) - #.(clsql:locally-enable-sql-reader-syntax) - (clsql:create-table "amuse_datasets" - '(([|dataset-id|] clsql:smallint :unsigned - :not-null :auto-increment :primary-key) - ([|description|] (clsql:varchar 255) - :not-null)) - :database database - :transactions t) - #.(clsql:locally-disable-sql-reader-syntax)) - -(defun %create-datasets-join-table (database) - #.(clsql:locally-enable-sql-reader-syntax) - (clsql:create-table "amuse_datasets_join" - '(([|dataset-id|] clsql:smallint :unsigned - :not-null) - ([|implementation-id|] clsql:smallint - :unsigned :not-null) - ([|composition-id|] clsql:smallint :not-null)) - :constraints '("KEY (dataset_id)") - :database database - :transactions t) - #.(clsql:locally-disable-sql-reader-syntax)) - -(defun %drop-datasets-table (database) - (clsql:drop-table "amuse_datasets" - :database database - :if-does-not-exist :ignore)) - -(defun %drop-datasets-join-table (database) - (clsql:drop-table "amuse_datasets_join" - :database database - :if-does-not-exist :ignore))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/base/datasets/classes.lisp Thu Feb 24 11:23:18 2011 +0000 @@ -0,0 +1,18 @@ +(cl:in-package #:amuse-database-admin) + +(defclass amuse-dataset-identifier (identifier) + ((dataset-id :reader dataset-id + :initarg :dataset-id)) + (:documentation "A dataset is a set of pieces used for a particualar +analytical task. A dataset is not necessarily the same thing as a +corpus or collection (are these things different?). Corpus indicates +that a set of pieces have been curated in some way and in that sense +`belong together'. A dataset is just simply a set of pieces gathered +together to analyse, and the pieces can be from any corpus or +backend (hence the amuse- prefix")) + +(defclass amuse-dataset (list-slot-sequence) + ((identifier :initarg :identifier + :reader identifier) + (description :initarg :description + :reader description)))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/base/datasets/datasets-db/datasets-db-setup.lisp Thu Feb 24 11:23:18 2011 +0000 @@ -0,0 +1,46 @@ +(cl:in-package #:amuse-database-admin) + +(defun create-datasets-table (&optional (database *amuse-database*)) + (%create-datasets-table database) + (%create-datasets-join-table database)) + +(defun drop-datasets-table (&optional (database *amuse-database*)) + (%drop-datasets-table database) + (%drop-datasets-join-table database)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Helper functions + +(defun %create-datasets-table (database) + #.(clsql:locally-enable-sql-reader-syntax) + (clsql:create-table "amuse_datasets" + '(([|dataset-id|] clsql:smallint :unsigned + :not-null :auto-increment :primary-key) + ([|description|] (clsql:varchar 255) + :not-null)) + :database database + :transactions t) + #.(clsql:locally-disable-sql-reader-syntax)) + +(defun %create-datasets-join-table (database) + #.(clsql:locally-enable-sql-reader-syntax) + (clsql:create-table "amuse_datasets_join" + '(([|dataset-id|] clsql:smallint :unsigned + :not-null) + ([|implementation-id|] clsql:smallint + :unsigned :not-null) + ([|composition-id|] clsql:smallint :not-null)) + :constraints '("KEY (dataset_id)") + :database database + :transactions t) + #.(clsql:locally-disable-sql-reader-syntax)) + +(defun %drop-datasets-table (database) + (clsql:drop-table "amuse_datasets" + :database database + :if-does-not-exist :ignore)) + +(defun %drop-datasets-join-table (database) + (clsql:drop-table "amuse_datasets_join" + :database database + :if-does-not-exist :ignore))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/base/datasets/datasets-functions.lisp Thu Feb 24 11:23:18 2011 +0000 @@ -0,0 +1,105 @@ +(cl:in-package #:amuse-database-admin) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Constructors + +(defun make-amuse-dataset-identifier (dataset-id) + (make-instance 'amuse-dataset-identifier + :dataset-id dataset-id)) + +(defun %make-amuse-dataset (dataset-identifier description + composition-identifiers) + (make-instance 'amuse-dataset + :%data composition-identifiers + :identifier dataset-identifier + :description description)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Database functions + +(defun make-new-dataset (description &optional (database + *amuse-database*)) + "A dataset is a set of pieces used for a particualar analytical +task. A dataset is not necessarily the same thing as a corpus or +collection (are these things different?). Corpus indicates that a set +of pieces have been curated in some way and in that sense `belong +together'. A dataset is just simply a set of pieces gathered together +to analyse, and the pieces can be from any corpus or backend." + (let (dataset-id) + #.(clsql:locally-enable-sql-reader-syntax) + (clsql:insert-records :into "amuse_datasets" + :attributes '([description]) + :values (list description) + :database database) + #.(clsql:locally-disable-sql-reader-syntax) + (setf dataset-id (clsql-mysql::mysql-insert-id + (clsql-mysql::database-mysql-ptr + database))) + (make-amuse-dataset-identifier dataset-id))) + +(defun assign-composition-to-dataset (composition-identifier + dataset-identifier + &optional (database + *amuse-database*)) + (clsql:execute-command (format nil " +INSERT INTO amuse_datasets_join +SET dataset_id := ~S, +implementation_id := (SELECT get_impl_id('~A')), +composition_id := ~S;" + (dataset-id dataset-identifier) + (implementation-namestring + composition-identifier) + (composition-id + composition-identifier))) + :database database) + +(defun assign-compositions-to-dataset (composition-identifiers + dataset-identifier + &optional (database + *amuse-database*)) + "This should be done more sensibly." + (loop for identifier in composition-identifiers + do (assign-composition-to-dataset identifier + dataset-identifier + database))) + +(defun make-composition-identifiers-from-file (package pathname) + "This reads a file that contains one id per line, and returns a list +of composition-identifiers (specialised on package). It is useful for +reading files that have been exported from the database, for use with +the above functions." + (with-open-file (stream pathname :direction :input) + (loop for id = (read stream nil) + while id + collect (make-composition-identifier package id)))) + +(defun get-dataset (dataset-identifier &optional (database + *amuse-database*)) + (let ((dataset-header (clsql:query (format nil " +SELECT description +FROM amuse_datasets +WHERE dataset_id = ~S" (dataset-id dataset-identifier)) + :database database + :flatp t + :field-names nil)) + (dataset-rows (clsql:query (format nil " +SELECT implementation_name, composition_id +FROM amuse_datasets_join +LEFT JOIN amuse_implementations +USING (implementation_id) +WHERE dataset_id = ~S" + (dataset-id + dataset-identifier)) + :flatp t + :field-names nil + :database database))) + (%make-amuse-dataset dataset-identifier (car dataset-header) + (%init-dataset-rows dataset-rows)))) + +(defun %init-dataset-rows (dataset-rows) + (loop for row in dataset-rows + collect (make-composition-identifier (find-package + (first row)) (second row)) + into composition-identifiers + finally (return composition-identifiers)))
--- a/base/generics.lisp Thu Feb 24 11:23:18 2011 +0000 +++ b/base/generics.lisp Thu Feb 24 11:23:18 2011 +0000 @@ -160,10 +160,10 @@ (:documentation "Not obviously meaningful for non fraction-like time signatures")) (defgeneric tactus-duration (time-signature) - ;; basic, but should do? NO! This defines 6/4 as compound. We need - ;; proper simplep and compoundp predicates. + ;; basic, but should do? NO! FIXME. This defines 6/4 as compound. We + ;; need proper simplep and compoundp predicates. The below hack + ;; seems to work for me, but we need to revisit this. (:method (ts) - (warn "FIXME: tactus-duration is broken") (cond ;; ((and (not (= (beat-units-per-bar ts) 3)) ;; (= (rem (beat-units-per-bar ts) 3) 0)) @@ -465,8 +465,13 @@ bar line.")) (defgeneric onset-in-bar (moment) - (:documentation "The position of moment in the bar, measured in - beats.")) + (:documentation "The position of moment in the bar, measured in the + timebase of the composition (e.g. crochets regardless of the + prevailing time-signature.")) + +(defgeneric onset-in-bar-relative-to-tactus (moment) + (:documentation "The position of moment in the bar, measure in + tactus beats.")) ;;;;;;;;;;;;;; ;;
--- a/base/methods.lisp Thu Feb 24 11:23:18 2011 +0000 +++ b/base/methods.lisp Thu Feb 24 11:23:18 2011 +0000 @@ -553,8 +553,16 @@ (timepoint (current-bar constituent constituent)))) (defmethod onset-in-bar ((o moment)) + "FIXME: Won't actually work for standard-moments because they do not + have a composition slot! So either we allow for 'linked moments', or + change the method to have an optional composition parameter." (1+ (ioi-from-bar o))) +(defmethod onset-in-bar-relative-to-tactus ((o moment)) + (1+ (/ (ioi-from-bar o) + (tactus-duration + (car (get-applicable-time-signatures o (composition o))))))) + (defmethod beat-period ((moment standard-moment) (time-signature standard-time-signature) (composition composition))