algorithmic-music.org 18 KB
Algorithmic Music
Music is absolutely fascinating. However, very few people are skilled in its composition. Computers may not produce the most pleasing music, but they can produce interesting music, using permutations of a scale, and random numbers.
Create a Score
The creation of a score is the primary feature of this program. To do this, it builds on other parts of the program, first, generating a score description, from (generate-score-notes), formatting the notes for output, and generating a header. After that, it will assemble a file in GNU LilyPond syntax, and run the lilypond program to produce a PDF.
(defun generate-score-contents (&optional (title "Algorithmic Composition") (composer "Common Lisp") (key :c-major) (measures 25))
(let* ((score (generate-score-notes measures))
(notes (format nil "~{~a~}"
(loop for note-pair in score
collect (generate-note (car note-pair) (cdr note-pair) key))))
(header (format nil "\\header {title = \"~a\" composer = \"~a\" tagline = \"\"}~&\\score {" title composer)))
(with-output-to-string (output-file)
(format output-file "\\version \"2.18.2\"~&#(set-default-paper-size \"letter\")~&")
(format output-file "~a~&" header)
(format output-file "\\new Staff {~a ~a\\bar \"|.\"}\\layout {}\\midi{}}" (getf *key-signature* key) notes))))
(defun create-score (file &key (title "Algorithmic Composition") (composer "Common Lisp") (key :c-major) (measures 25))
(with-open-file (output-file file
:direction :output
:if-exists :overwrite
:if-does-not-exist :create)
(format output-file "~a" (generate-score-contents title composer key measures))
(run-program (list "lilypond" file))))
Create a note
To generate proper syntax for a note from a note number and a duration, this function is used. It takes the note number, the duration and the key. It then looks up the note, based on the key, and raises 2 to the duration, and formats the note.
Durations are found using the following table:
| Duration | Beats | |
|---|---|---|
| ! | dur | beats |
| # | 0 | 1 |
| # | 1 | 1:2 |
| # | 2 | 1:4 |
| # | 3 | 1:8 |
| # | 4 | 1:16 |
(defun generate-note (number &optional (duration 2) (key :c-major))
(declare (type (integer 1 8) number)
(type (integer 0 4) duration)
(keyword key))
(let ((note (getf (getf *numbers-to-notes* key) number))
(true-duration (expt 2 duration)))
(format nil "~a~d " note true-duration)))
Generate a set of notes
Actually generating notes is perhaps one of the more difficult parts. To do so, the number of measures must first be known, and is used to generate a list of rhythms. After that, a set of changes is generated, which is used for the picking of notes. For each rhythm, a number, from 0 to 8 is chosen. If the number chosen is 0, then the system will go through a single permutation of the octave for the next 8 rhythms, otherwise, that note will be used for the next rhythm. Notes and rhythms are consed and pushed on to a list, which is the reversed and returned.
(defun generate-score-notes (number-of-measures)
(let ((score '())
(durations (generate-durations number-of-measures))
(changes (steinhous-johnson-trotter 8)))
(do ()
((null durations))
(let ((note-source (random 9)))
(if (= note-source 0)
(loop for note in (pop changes)
if (not (null durations))
do (push (cons note (pop durations)) score))
(push (cons note-source (pop durations)) score))))
(reverse score)))
Generate Durations
One of the more important parts of generating music is creating sensible rhythms. To do so, a number between 0 and 4 is chosen, and then checked to see if it makes sense, if it does, it is pushed on to a list of durations, and then the appropriate number of beats is deducted from the beats-left count. Finally, the duration list is reversed and returned.
(defun generate-durations (number-of-measures)
(let ((durations '())
(n-left (* 16 number-of-measures)))
(labels ((try-make-duration ()
(let ((dur (random 5)))
(case dur
(0
(if (= 0 (mod n-left 16))
(progn
(push dur durations)
(decf n-left 16))
(try-make-duration)))
(1
(if (= 0 (mod n-left 8))
(progn
(push dur durations)
(decf n-left 8))
(try-make-duration)))
(2
(decf n-left 4)
(push dur durations))
(3
(decf n-left 2)
(push dur durations))
(4
(decf n-left)
(push dur durations))))))
(do ()
((= 0 n-left))
(try-make-duration)))
(reverse durations)))
Keys
One of the more important parts of generating music is the ability to actually have correct note output, in key. To do this, I use a key lookup alist, and a note lookup alist.
(defvar *numbers-to-notes*
'(:a-major (1 "a" 2 "b" 3 "cis'" 4 "d'" 5 "e'" 6 "fis'" 7 "gis'" 8 "a'")
:b-major (1 "b" 2 "cis'" 3 "dis'" 4 "e'" 5 "fis'" 6 "gis'" 7 "ais'" 8 "b'")
:c-major (1 "c'" 2 "d'" 3 "e'" 4 "f'" 5 "g'" 6 "a'" 7 "b'" 8 "c''")
:d-major (1 "d'" 2 "e'" 3 "fis'" 4 "g'" 5 "a'" 6 "b'" 7 "cis''" 8 "d''")
:e-major (1 "e'" 2 "fis'" 3 "gis'" 4 "a'" 5 "b'" 6 "cis''" 7 "dis''" 8 "e''")
:f-major (1 "f'" 2 "g'" 3 "a'" 4 "bes'" 5 "c''" 6 "d''" 7 "e''" 8 "f''")
:g-major (1 "g'" 2 "a'" 3 "b'" 4 "c''" 5 "d''" 6 "e''" 7 "fis''" 8 "g''")
:a-minor (1 "a" 2 "b" 3 "c'" 4 "d'" 5 "e'" 6 "f'" 7 "g'" 8 "a'")
:b-minor (1 "b" 2 "cis'" 3 "d'" 4 "e'" 5 "fis'" 6 "g'" 7 "a'" 8 "b'")
:c-minor (1 "c'" 2 "d'" 3 "ees'" 4 "f'" 5 "g'" 6 "aes'" 7 "bes'" 8 "c''")
:d-minor (1 "d'" 2 "e'" 3 "f'" 4 "g'" 5 "a'" 6 "bes'" 7 "c''" 8 "d''")
:e-minor (1 "e'" 2 "fis'" 3 "g'" 4 "a'" 5 "b'" 6 "c''" 7 "d''" 8 "e''")
:f-minor (1 "f'" 2 "g'" 3 "aes'" 4 "bes'" 5 "c''" 6 "des''" 7 "ees''" 8 "f''")
:g-minor (1 "g'" 2 "a'" 3 "bes'" 4 "c''" 5 "d''" 6 "ees''" 7 "f''" 8 "g''")))
(defvar *key-signature*
'(:a-major "\\key a \\major"
:b-major "\\key b \\major"
:c-major "\\key c \\major"
:d-major "\\key d \\major"
:e-major "\\key e \\major"
:f-major "\\key f \\major"
:g-major "\\key g \\major"
:a-minor "\\key a \\minor"
:b-minor "\\key b \\minor"
:c-minor "\\key c \\minor"
:d-minor "\\key d \\minor"
:e-minor "\\key e \\minor"
:f-minor "\\key f \\minor"
:g-minor "\\key g \\minor"))
(defvar *chords*
(map 'list #'(lambda (chord)
(concatenate 'string
"<<"
chord
">>"))
'("c e g"
"cis eis gis"
"des f aes"
"d fis a"
"dis fisis ais"
"ees g bes"
"e gis b"
"f a c"
"fes aes ces")))
Generate Permutations
One of the more interesting ways this produces music is through the use of Plain Changes, a type of permutation based on single transpostions. To do this, I use the Steinhaus-Johnson-Trotter algorithm, explained in Figure steinhaus-johnson-trotter-img.
digraph {
start [label = "Start"];
stop [label = "End"];
swap [label = "Swap around change"];
swapdone [label = "Changes left?", shape = rectangle];
if_three [label = "Length == 3?", shape = rectangle];
subgraph cluster_generate_changes {
generate_changes_previous [label = "Generate Changes For Number - 1"];
subgraph cluster_inner_change_loop {
previous_left [label = "Previous changes left?", shape = rectangle];
loop_from_1_to_num [label = "Loop from 1 to Number"];
insert_from_previous_1_plus [label = "Insert from previous change plus 1"]
loop_from_1_minus_num_to_1 [label = "Loop from Number - 1 to 1"];
insert_from_previous [label = "Insert from previous change"];
previous_left -> loop_from_1_to_num [label = "True"];
loop_from_1_to_num -> insert_from_previous_1_plus;
insert_from_previous_1_plus -> loop_from_1_minus_num_to_1;
loop_from_1_minus_num_to_1 -> insert_from_previous;
insert_from_previous -> previous_left;
}
generate_changes_previous -> previous_left;
}
start -> if_three;
if_three -> stop [label = "True,\n(2 1 2 1 2)"];
if_three -> generate_changes_previous [label = "False"];
previous_left -> swap [label = "False"];
swap -> swapdone;
swapdone -> swap [label = "True"];
swapdone -> stop [label = "False"];
}
(defun plain-changes (n)
(if (= n 2)
'(1)
(if (= n 3)
'(2 1 2 1 2)
(let ((up (xrange (1- n)))
(down (xrange (- n 2) t))
(recur (remove-if #'null (plain-changes (1- n))))
(changes '()))
(do ()
((null recur))
(loop for x in down
do (push x changes))
(push (1+ (pop recur)) changes)
(loop for x in up
do (push x changes))
(push (pop recur) changes))
(remove-if #'null changes)))))
(defun steinhous-johnson-trotter (n)
(let ((permutations '()))
(push (xrange n) permutations)
(loop for i in (plain-changes n)
do (let* ((old-permutation (pop permutations))
(old-a (nth (1- i) old-permutation))
(old-b (nth i old-permutation))
(new-permutation (copy-list old-permutation)))
(push old-permutation permutations)
(setf (nth (1- i) new-permutation) old-b
(nth i new-permutation) old-a)
(push new-permutation permutations)))
permutations))
Helper Functions
To correctly generate the permutations, an xrange function is needed, similar to the one built into Python. It is implemented using the loop macro, although, I had originally planned on using iter.
(defun xrange (length &optional (reverse-p nil))
(let ((range (loop for i from 1 to length
collect i)))
(if reverse-p
(reverse range)
range)))
Putting it together
The full logic of the music generation program is shown in Figure figure:overview.
digraph {
entry [label = "Program Entry"];
exit [label = "Program Exit"];
subgraph cluster_generate_rhythms {
rank = same;
beat_count [label = "Multiply Measure number by 4"];
continue [label = "Beat Count = 0?", shape = rectangle]
reverse [label = "Reverse Rhythms"]
subgraph cluster_check_valid {
pick_random [label = "Pick Random number\n0 -- 4"];
case_0 [label = "Number is 0\n(Whole Note)"];
case_1 [label = "Number is 1\n(Half Note)"];
case_2 [label = "Number is 2\n(Quarter Note)"];
case_3 [label = "Number is 3\n(Eighth Note)"];
case_4 [label = "Number is 4\n(Sixteenth Note)"];
mod_4 [label = "Beats mod 4 == 0", shape = rectangle];
mod_2 [label = "Beats mod 2 == 0", shape = rectangle];
push_to_rhythm [label = "Push correct number to the rhythms list."];
decrement_beat_count [label = "Decrement number of beats."];
pick_random -> {case_0, case_1, case_2, case_3, case_4};
case_0 -> mod_4;
case_1 -> mod_2;
{mod_4, mod_2} -> pick_random [label = "False"];
{mod_4, mod_2} -> push_to_rhythm [label = "True"];
{case_2, case_3, case_4} -> push_to_rhythm;
push_to_rhythm -> decrement_beat_count;
}
beat_count -> pick_random;
decrement_beat_count -> continue;
continue -> pick_random [label = "False"];
continue -> reverse [label = "True"];
}
subgraph cluster_generate_notes {
rank = same;
for_rhythms [label = "For Each Rhythm", shape = rectangle, rank = top];
pick_random2 [label = "Pick a random number\n0--8"];
if_0 [label = "Number == 0", shape = rectangle];
reverse_notes [label = "Reverse Note Order"];
push_note [label = "Push Note"];
do_changes [label = "Push Set of Changes."];
rhythms_left [label = "Rhythms-Count == 0", shape = rectangle];
decrement_rhythms [label = "Decrement Rhythm Count"];
merge_rhythms_notes [label = "Merge Rhythms and Notes"];
for_rhythms -> pick_random2;
pick_random2 -> if_0;
if_0 -> do_changes [label = "True"];
if_0 -> push_note [label = "False"];
{do_changes, push_note} -> decrement_rhythms;
decrement_rhythms -> rhythms_left;
rhythms_left -> for_rhythms [label = "False"];
rhythms_left -> reverse_notes [label = "True"];
reverse_notes -> merge_rhythms_notes;
}
subgraph cluster_generate_score {
rank = same;
for_rhythm_note_pair [label = "For Each Rhythm", shape = rectangle];
format_header [label = "Format Header"];
format_note [label = "Format Note"];
process_lilypond [label = "Process Lilypond File"];
notes_left [label = "Notes-left == 0", shape = rectangle];
format_header -> for_rhythm_note_pair;
for_rhythm_note_pair -> format_note;
format_note -> notes_left;
notes_left -> for_rhythm_note_pair [label = "False"];
notes_left -> process_lilypond [label = "True"];
}
entry -> beat_count;
reverse -> for_rhythms;
merge_rhythms_notes -> format_header;
process_lilypond -> exit;
}
(defpackage #:muzic
(:use #:cl
#:uiop)
(:export #:create-score))
(in-package #:muzic)
<<keys-and-mappings>>
<<helper-functions>>
<<generate-permutations>>
<<generate-durations>>
<<generate-set-of-notes>>
<<generate-note>>
<<create-a-score>>