Mercurial > hg > amuse
changeset 54:df1482ef96fe
utils.lisp: fix and extend krumhansl-key-finder
darcs-hash:20070621120851-c0ce4-bde38534beea40f71e8206f85583111fdfbe1fcd.gz
| author | Marcus Pearce <m.pearce@gold.ac.uk> |
|---|---|
| date | Thu, 21 Jun 2007 13:08:51 +0100 |
| parents | ce4a90427366 |
| children | ba65f66a713e |
| files | utils/utils.lisp |
| diffstat | 1 files changed, 18 insertions(+), 4 deletions(-) [+] |
line wrap: on
line diff
--- a/utils/utils.lisp Thu Jun 21 13:07:21 2007 +0100 +++ b/utils/utils.lisp Thu Jun 21 13:08:51 2007 +0100 @@ -126,10 +126,10 @@ (aref results-array i) (/ equation-t equation-b)))))) -(defparameter *krumhansl-schmuckler-major-key* +(defparameter *krumhansl-schmuckler-minor-key* (make-array 12 :initial-contents '(6.33 2.68 3.52 5.38 2.6 3.53 2.54 4.75 3.98 2.69 3.34 3.17))) -(defparameter *krumhansl-schmuckler-minor-key* +(defparameter *krumhansl-schmuckler-major-key* (make-array 12 :initial-contents '(6.35 2.23 3.48 2.33 4.38 4.09 2.52 5.19 2.39 3.66 2.29 2.88))) (defun krumhansl-key-finder (anchored-period composition @@ -147,7 +147,21 @@ do (when (> (aref minors i) best-score) (setf key (list i :minor) best-score (aref minors i)))) - key)) + (values key (key->midi-key-signature key anchored-period)))) + +(defvar *line-of-fifths* (list 5 10 3 8 1 0 7 2 9 4 11 6)) + +(defun key->midi-key-signature (key anchored-period) + (let* ((tonic (car key)) + (mode (cadr key)) + (sharps (- (ecase mode + (:major (position tonic *line-of-fifths*)) + (:minor (position (mod (- tonic 9) 12) *line-of-fifths*))) + 5)) + (mode (ecase mode (:major 0) (:minor 9)))) + (amuse:make-midi-key-signature sharps mode + (timepoint anchored-period) + (duration anchored-period)))) (defun levenshtein-distance (s1 s2 &key (insertion-cost 1) (insertion-function) (deletion-cost 1) @@ -402,4 +416,4 @@ (when previous-event (push (span (pitch- event previous-event)) intervals)) - (setf previous-event event)))) \ No newline at end of file + (setf previous-event event))))