#+Title: Algorithmic Music #+AUTHOR: Sam Flint #+EMAIL: swflint@flintfam.org #+DATE: \today #+INFOJS_OPT: view:info toc:nil path:http://flintfam.org/org-info.js #+OPTIONS: toc:nil H:5 ':t *:t #+PROPERTY: header-args :noweb no-export :comments noweb #+LATEX_HEADER: \usepackage[color]{showkeys} #+LATEX_HEADER: \parskip=5pt #+LATEX_HEADER: \lstset{texcl=true,breaklines=true,columns=fullflexible,frame=lines,literate={lambda}{$\lambda$}{1} {set}{$\gets$}1 {setq}{$\gets$}1 {setf}{$\gets$}1 {<=}{$\leq$}1 {>=}{$\geq$}1} #+BEGIN_abstract 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. #+END_abstract #+TOC: headlines 3 #+TOC: listings * Create a Score :PROPERTIES: :ID: 87e383f5-5e4f-4f3e-a344-b4e921c25358 :END: 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 [[http://lilypond.org][GNU LilyPond]] syntax, and run the ~lilypond~ program to produce a PDF. #+Caption: Create a score #+Name: create-a-score #+BEGIN_SRC lisp (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)))) #+END_SRC * Create a note :PROPERTIES: :ID: a3b3368b-ebc0-44d2-a12d-6c401a9d9941 :END: 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: #+Caption: Durations #+Name: durations-table | | Duration | Beats | |---+----------+-------| | ! | dur | beats | | # | 0 | 1 | | # | 1 | 1:2 | | # | 2 | 1:4 | | # | 3 | 1:8 | | # | 4 | 1:16 | #+TBLFM: @3$3=1/(2^$dur);F::@4$3=1/(2^$dur);F::@5$3=1/(2^$dur);F::@6$3=1/(2^$dur);F::@7$3=1/(2^$dur);F #+Caption: Generate Note Output #+Name: generate-note #+BEGIN_SRC lisp (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))) #+END_SRC * Generate a set of notes :PROPERTIES: :ID: f347583d-1f7b-44ac-9acd-036feb428f69 :END: 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. #+Caption: Generate a set of notes #+Name: generate-set-of-notes #+BEGIN_SRC lisp (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))) #+END_SRC * Generate Durations :PROPERTIES: :ID: cd1b3240-a55e-49ec-b093-3d88452da527 :END: 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. #+Caption: Generate Durations #+Name: generate-durations #+BEGIN_SRC lisp (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))) #+END_SRC * Keys :PROPERTIES: :ID: 75e7db58-8b69-4955-a73d-6b168f57300b :END: 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. #+Caption: Keys and mappings #+Name: keys-and-mappings #+BEGIN_SRC lisp (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"))) #+END_SRC * Generate Permutations :PROPERTIES: :ID: 0924c151-0a4e-4545-8a8b-0cb051c76097 :END: 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]]. #+Caption: Steinhaus-Johnson-Trotter Algorithm #+Name: steinhaus-johnson-trotter #+BEGIN_SRC dot :file "steinhaus-johnson-trotter.png" :export results 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"]; } #+END_SRC #+Caption: Steinhaus-Johnson-Trotter Algorithm #+Name: steinhaus-johnson-trotter-img #+RESULTS: steinhaus-johnson-trotter [[file:steinhaus-johnson-trotter.png]] #+Caption: Generate Permutations (Steinhaus-Johnson-Trotter) #+Name: generate-permutations #+BEGIN_SRC lisp (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)) #+END_SRC * Helper Functions :PROPERTIES: :ID: 7382b9fa-4d86-4bfd-b8a9-c5865b3818b7 :END: 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~. #+Caption: Helper Functions #+Name: helper-functions #+BEGIN_SRC lisp (defun xrange (length &optional (reverse-p nil)) (let ((range (loop for i from 1 to length collect i))) (if reverse-p (reverse range) range))) #+END_SRC * Putting it together :PROPERTIES: :ID: 109a6bb3-dde3-45e6-a898-cc0df2750225 :END: The full logic of the music generation program is shown in Figure [[figure:overview]]. #+Caption: Overview #+Name: overview #+BEGIN_SRC dot :file "overview.png" :export results 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; } #+END_SRC #+Caption: General Overview #+Name: figure:overview #+RESULTS: overview [[file:overview.png]] #+Caption: Putting it Together #+Name: put-together #+BEGIN_SRC lisp :tangle "johnson-trotter.lisp" (defpackage #:muzic (:use #:cl #:uiop) (:export #:create-score)) (in-package #:muzic) <> <> <> <> <> <> <> #+END_SRC