Last active
January 2, 2023 00:54
-
-
Save leftaroundabout/6570039 to your computer and use it in GitHub Desktop.
An automatic accompaniment generator for infinite melodies, applied to a simple mapping of the decimal digits of π to an A–harmonic-minor scale.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module PiMelody where | |
import Data.List | |
data MelodyNote = Gs | A | B | C' | D' | E' | F' | Gs' | A' | B' | |
deriving (Eq, Show, Enum) | |
type Melody = [MelodyNote] -- Assume simple all-quavers rythm. | |
piMelody :: Melody | |
piMelody = map toEnum piDigits | |
data Chord = Am | Dm | C | G7 | E | |
deriving (Eq, Show, Enum) | |
type Composition = [(Melody, Chord)] | |
-- (Infinite) list of pairs: a melody chunk, and what chord to go with it. | |
chordMNotes :: Chord -> [MelodyNote] -- Without suspensions. | |
chordMNotes Am = [A , C', E', A'] | |
chordMNotes Dm = [A , D', F', A'] | |
chordMNotes E = [Gs, B , D', E', Gs', B', F'] -- Minor dominant may also be diminished-7th. | |
chordMNotes C = [C', E'] | |
chordMNotes G7 = [B , D', F', B'] | |
resolves :: Chord -> [Chord] | |
resolves E = [Am, E] -- Dominants should resolve to their tonic, if at all. | |
resolves G7 = [C, G7, Am, E] -- For major dominant, allow also resolving to minor parallels. | |
resolves _ = [Am .. E] -- Non-dominant chord can resolve to anything. | |
accompany :: Melody -> Composition -- Choose suitable chords for a melody. | |
accompany melody = acc Am melody | |
where acc :: Chord -> Melody -> Composition | |
acc lastChord (n1:n2:ml) -- Try to find a chord that fits over two melody notes | |
| (Just nextChord) -- and works with the previous (possibly dominant) chord. | |
<- find (\ch -> all(`elem` chordMNotes ch) [n1,n2]) $ resolves lastChord | |
= ([n1,n2], nextChord) : acc nextChord ml | |
-- If two melody notes don't fit in one chord, use two. | |
| (Just c1) <- find ((n1`elem`) . chordMNotes) $ resolves lastChord | |
, (Just c2) <- find ((n2`elem`) . chordMNotes) $ resolves c1 | |
= ([n1] , c1) : ([n2] , c2) : acc c2 ml | |
piDigits :: [Int] -- Infinite list of decimal digits of π. Algorithm taken from: | |
-- Jeremy Gibbons, "Unbounded Spigot Algorithms for the Digits of Pi"; | |
-- The Mathematical Association of America 2005. | |
piDigits = map fromInteger $ g(1,0,1,1,3,3) | |
where g(q,r,t,k,n,l) = if 4*q+r-t<n*t | |
then n : g(10*q,10*(r-n*t),t,k,div(10*(3*q+r))t-10*n,l) | |
else g(q*k,(2*q+r)*l,t*l,k+1,div(q*(7*k+2)+r*l)(t*l),l+2) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Generate a sequence of melody tones from the decimal digits of π by mapping them onto a range of notes from the A–harmonic-major scale; then create an accompaniment for this melody, by way of dominants resolving in the usual way.
This being a reply to this question on music.stackexchange.com.