Kulitta (empty) → 2.2.1
raw patch · 42 files changed
+9479/−0 lines, 42 filesdep +Euterpeadep +UISFdep +arraybuild-type:Customsetup-changed
Dependencies added: Euterpea, UISF, array, base, deepseq, parallel, random
Files
- Examples/Examples.lhs +85/−0
- Examples/GUI/GUI.lhs +324/−0
- Examples/GUI/GUIBackend.lhs +335/−0
- Examples/GUI/IOWidgets.lhs +42/−0
- Examples/GUI/OldGUI.lhs +313/−0
- Examples/GUI/PlayK.lhs +115/−0
- Examples/GUI/majorProbs.txt +10/−0
- Examples/GUI/majorProbs2.txt +10/−0
- Examples/GUI/minorProbs.txt +10/−0
- Examples/GUI/minorProbs2.txt +10/−0
- Examples/GUI/pcfg.txt +13/−0
- Examples/GUI/term.txt +1/−0
- Kulitta.cabal +50/−0
- Kulitta.lhs +14/−0
- Kulitta/ChordSpaces.lhs +9/−0
- Kulitta/ChordSpaces/ModeSpace.lhs +55/−0
- Kulitta/ChordSpaces/OPTIC.lhs +125/−0
- Kulitta/Constraints.lhs +211/−0
- Kulitta/EuterpeaSpecial.lhs +10/−0
- Kulitta/Foregrounds.lhs +9/−0
- Kulitta/Foregrounds/ClassicalFG.lhs +261/−0
- Kulitta/Foregrounds/JazzFG.lhs +217/−0
- Kulitta/Foregrounds/SimplePianoFG.lhs +309/−0
- Kulitta/Grammars/MusicGrammars.lhs +293/−0
- Kulitta/Learning/CykParser.lhs +273/−0
- Kulitta/Learning/InsideOutside.lhs +555/−0
- Kulitta/Learning/Learning.lhs +562/−0
- Kulitta/Learning/LearningMain.lhs +23/−0
- Kulitta/Learning/PCFGtoPTGG.lhs +67/−0
- Kulitta/Learning/Parser.lhs +150/−0
- Kulitta/Learning/TemporalGen.lhs +97/−0
- Kulitta/Learning/sampleConfig/BachChordsTSD.txt +4100/−0
- Kulitta/Learning/sampleConfig/Learning.exe too large to diff
- Kulitta/Learning/sampleConfig/configTSDx3.txt +17/−0
- Kulitta/Learning/sampleConfig/configTSDx5.txt +17/−0
- Kulitta/PTGG.lhs +133/−0
- Kulitta/PostProc.lhs +151/−0
- Kulitta/QuotientSpaces.lhs +42/−0
- Kulitta/Search.lhs +398/−0
- LICENSE +2/−0
- README.txt +58/−0
- Setup.hs +3/−0
+ Examples/Examples.lhs view
@@ -0,0 +1,85 @@+> module Examples where+> import Kulitta+> import Kulitta.Foregrounds+> import Kulitta.Grammars.MusicGrammars+> import Kulitta.EuterpeaSpecial+> import System.Random+++Let's start by creating a very simple musical grammar. Kulitta comes with a few built-in, but it is possible to define new ones. We'll use some of the datatypes defined in MusicGrammars.lhs for Roman numeral symbols. ++data CType = I | II | III | IV | V | VI | VII+ deriving (Eq, Show, Ord, Enum, Read)+++We'll encode just a few simple rules and give them probabilities by hand, assuming that duration is divided in half for rules with two symbols on the right:++1. (0.3) I -> V I+2. (0.6) I -> I I+3. (0.1) I -> I+4. (0.5) V -> IV V+5. (0.4) V -> V V+6. (0.1) V -> V+7. (0.8) IV -> IV IV+8. (0.2) IV -> IV++We'll also use the MP type ("music parameter") from MusicGrammars.lhs to store the duration for each symbol. We can now write these rules in Haskell as follows. ++> r1, r2, r3, r4, r5, r6, r7, r8 :: Rule CType MP+> r1 = (I, 0.3) :-> \p -> [v (h p), i (h p)]+> r2 = (I, 0.6) :-> \p -> [i (h p), i (h p)]+> r3 = (I, 0.1) :-> \p -> [i p] +> r4 = (V, 0.5) :-> \p -> [iv (h p), v (h p)]+> r5 = (V, 0.4) :-> \p -> [v (h p), v (h p)]+> r6 = (V, 0.1) :-> \p -> [v p] +> r7 = (IV, 0.8) :-> \p -> [iv (h p), iv (h p)]+> r8 = (IV, 0.2) :-> \p -> [iv p] +++The argument "p" to the anonymous function ("\p -> ...", read as "given some value, p, do ... to it") in the code below refers to the parameter associated with the rules. In MusicGrammars.lhs, the function "h" divides the duration of the symbol in half. The file also provides lower-case versions of the Roman numerals that are functions to create appropriately-typed data structures for the grammar.++Now, one problem with using the rules as-is above is that they will exhibit L-System like behavior of unbalanced durations. Kulitta fixes this by allowing conditional rules, such as:++I -> if not enough duration then do nothing, otherwise (normal righthand side)++This results in a more even distribution of durations, since they cannot become infinitely small as generation progresses. We can convert all the rules to this format as follows.++> rules :: [Rule CType MP]+> rules = map (toRelDur2 (<qn)) [r1, r2, r3, r4, r5, r6, r7, r8]++Now we can generate some music with the grammar. First, we will create a start symbol and a random generator to work with. The start symbol will be a 4-measure long I-chord (4 times a wholenote, wn) in C-major (written below as "Major" with root pitch class 0, or C).+++> startSym = [i (MP (4*wn) Major 0 0 (4*wn))]+> g1 = mkStdGen 42++The "gen" function creates an infinite list of sequential generative iterations. We will call it on the start symbol with a random number seed and then take the 5th generative iteration. This step returns a new random generator, g2, in addition to the abstract structure of the music.++> (g2, absStruct) = gen rules (g1, startSym) !! 5++Now we can map pitches to these chords with a classical chord space. We will impose no additional search constraints and just use Kulitta's defaults. This step also returns a new generator, g3, that we can use for the final step.++> (g3, chords) = classicalCS2 g2 (toAbsChords absStruct) [] ++And finally, we put a simple foreground on top.++> (g4, (justChords, finalMusic)) = classicalFG' g3 chords++Note: the foreground function used above actually returns two things in addition to the generator: a Music value of the chords and a Music value with melodies added. This allows one to see the before/after difference if desired.++Now we can hear the music!++> hearIt = playC defParams{strict=True} finalMusic+++============================================++Supplemental code for generating figures used online:++> abstractChordMusic = transpose 60 $ tChordsToMusic $ toAbsChords absStruct+> justChordsMusic = tChordsToMusic chords++> writeEverything = do+> writeMidi "examples\\absStruct.mid" abstractChordMusic+> writeMidi "examples\\chords.mid" justChordsMusic +> writeMidi "examples\\finalMusic.mid" finalMusic
+ Examples/GUI/GUI.lhs view
@@ -0,0 +1,324 @@+Kulitta Graphical Interface +Donya Quick +Last modified: 22-Jan-2016 + +NOTE: this version of the code uses: +- Euterpea 2.0 +- UISF 0.4 +- HSoM 1.0 + +See euterpea.com for information on installing +Euterpea and HSoM. UISF will be installed automatically +in the process of installing those two libraries. + +------------------------------------------- + +This module provides examples of Kulitta's output using an +interactive interface. The program can be compiled by: + +ghc -O2 Kulitta.lhs + +Running "Kulitta" will start the program in GUI/MUI mode. +The program will also respond to different arguments: + +Kulitta help Explains how to use the program. +Kulitta about More information about the program. +Kulitta basic Interactive, command-line version. + +To run Kulitta in GHCI, you can load this file and run the +"main" function directly, starting the progam in GUI mode. +However, you will not be able to use the argument-based +methods of interaction through GHCI. If you would like to +use enter the parameters using a text-based series of +prompts in GHCI, change the contents of "settings.txt" to +be "basic" instead of "mui" (which is the default). + +------------------------------------------- + +> {-# LANGUAGE Arrows #-} + +> module Main where +> import GUIBackend +> import Kulitta.EuterpeaSpecial +> import Kulitta.Foregrounds +> import Kulitta +> import Kulitta.Grammars.MusicGrammars +> import System.Random +> import Kulitta.Learning.Learning +> import Kulitta.Learning.PCFGtoPTGG +> import Data.List +> import System.Environment +> import System.IO +> import System.Directory +> import PlayK +> import FRP.UISF.UISF +> import HSoM +> import FRP.UISF.AuxFunctions +> import FRP.UISF.Widget (scrollable) +> import FRP.UISF.UITypes +> import IOWidgets + + +> programTitle = "Kulitta 2.0.1" + +> channelOffset = 0 -- this is useful for some synthesizers + +Data type definitions to allow the user to specify Kulitta's behavior. + + + +======================= + +MAIN PROGRAM DEFINITION + +Main program description. There are two modes: interacive and automated with arugments. + +> main = do +> hSetBuffering stdout NoBuffering -- required to make things print in the right order +> putStrLn ("\n\n===== "++ programTitle ++ "=====\n") +> args <- getArgs +> if length args == 0 then putStrLn "\nHello! The graphical interface is now active. \n" >> +> runDefault else +> if args !! 0 == "basic" then runBasicVersion else +> if args !! 0 == "help" then printDirections else +> if args !! 0 == "about" then printAbout else +> if length args < 7 then putStrLn "\nSorry, I couldn't understand those arguments.\n" >> +> printDirections +> else processArgs args + +> runDefault = do +> files <- getDirectoryContents "" +> if not (elem "settings.txt" files) then putStrLn "File settings.txt not found." >> runMuiVersion else do +> startMode <- readFile "settings.txt" +> if take 5 startMode == "basic" then runBasicVersion else runMuiVersion + +> runMuiVersion = mui >> putStrLn "\nGraphical interface closed. Goodbye!\n\n" +> runBasicVersion = interactive >> putStrLn "\nGoodbye!\n\n" + +======================= + +MUI DEFINITION + +> styles = [Chorale, PianoChorale, JazzChorale, WeirdChorale, JazzChords, BossaNova, PianoEtude1, PianoEtude2] +> forms = [Phrase, AABA] +> grams = [HandBuilt, Learned] +> modes = [Major, Minor] + +> settingsPanel = rightLeft $ proc _ -> do +> (form',gram',mode', instr', let', key') <- inputPaneB -< () +> (style', mo) <- inputPaneA -< () +> returnA -< (style', mo, form', gram', mode', instr', let', key') + +> mui = runMUI defaultMUIParams{uiSize=(500,570), uiTitle=(programTitle++" - Graphical Interface")} $ proc _ -> do +> label "Select composition parameters, then generate and play." -< () +> --label "The command prompt will show the generation/playback status." -< () +> --label "" -< () +> --(style', mo, form', gram', mode', instr', let', key') <- settingsPanel -< () +> (style', mo) <- inputPaneA -< () +> (form',gram',mode', instr', let', key') <- inputPaneB -< () +> probsFile <- leftRight $ label "Prob. file: " >>> textbox "" -< Nothing +> seed <- leftRight $ seedPanel -< () +> let fileName = "output\\" ++ show (styles !! style') ++ "_" ++ show seed ++ ".mid" +> fileName' <- unique -< fileName +> outFile <- leftRight $ label "Output File: " >>> textbox "test.mid" -< fileName' +> volStr<- leftRight $ label "Playback volume (0.0 to 1.0): " >>> textbox "1.0" -< Nothing +> spdStr<- leftRight $ label "Playback speed (>0)): " >>> textbox "1.0" -< Nothing +> let s = styles !! style' +> f = forms !! form' +> g = grams !! gram' +> m = modes !! mode' +> iMIDI = instr'==0 +> iLet = let'==0 +> iKey = key'==0 +> iVal = Info s f g m iLet iKey probsFile +> vol0 = reads volStr +> vol = if null vol0 then 0.8 else fst $ head vol0 +> spd0 = reads spdStr +> spd = if null spd0 then 1.0 else fst $ head spd0 +> (g,p) <- buttons -< () +> let g' = fmap (const (iVal, seed, outFile, iMIDI)) g +> p' = fmap (const (outFile, mo, vol, spd)) p +> basicIOWidget genWrap -< g' +> basicIOWidget playWrap -< p' +> returnA -< () + +> seedPanel :: UISF () Int +> seedPanel = proc _ -> do +> rec seedT <- leftRight $ label "Random seed: " >>> textbox "" -< x +> b <- edge <<< button "Random!" -< () -- button to automatically get a random number +> x <- ioWidget2 Nothing (const rFun) -< b +> let seed = let x = reads seedT :: [(Int, String)] -- parse the string +> in if null x then 0 else fst $ head x +> returnA -< seed where +> rFun :: IO (Maybe String) +> rFun = do +> x <- randomIO :: IO Int -- fetch a random number +> return (Just $ show $ abs x) -- convert it to SEvent String format + +> genWrap (i, seed, outFile, inst) = automated i seed outFile inst +> playWrap (fname, devID, vol, spd) = do +> putStrLn "\nPlaying...(please wait)\n" +> playXS fname devID channelOffset vol spd +> putStrLn "\nDone!\n\n" + +> buttons = leftRight $ proc _ -> do +> genButton <- edge <<< button "Generate MIDI File" -< () +> playButton <- edge <<< button "Play MIDI File" -< () +> returnA -< (genButton, playButton) + +> inputPaneA = leftRight $ proc _ -> do +> style <- topDown $ title "Style" $ radio (map show styles) 0 -< () +> mo <- topDown $ selectOutput -< () +> returnA -< (style, mo) + +> inputPaneB = leftRight $ proc _ -> do +> (form, gram, lets) <- inputPane2 -< () +> (mode, instr, key) <- inputPane3 -< () +> returnA -< (form, gram, mode, instr, lets, key) where +> inputPane2 = topDown $ proc _ -> do +> form <- topDown $ title "Form" $ radio (map show forms) 0 -< () +> gram <- topDown $ title "Harmony Model" $ radio (map show grams) 0 -< () +> lets <- topDown $ title "Use Lets" $ radio ["Yes", "No"] 1 -< () +> returnA -< (form, gram, lets) +> inputPane3 = topDown $ proc _ -> do +> mode <- topDown $ title "Mode" $ radio ["Major", "Minor"] 0 -< () +> instr <- topDown $ title "Assign instruments?" $ radio ["Yes", "No"] 0 -< () +> key <- topDown $ title "Random key?" $ radio ["Yes", "No"] 0 -< () +> returnA -< (mode, instr, key) + +> basicIOWidget :: (a -> IO ()) -> UISF (SEvent a) () +> basicIOWidget = (>>> arr (const ())) . uisfSinkE + + + +======================= + +CONSOLE PROGRAM DEFINITION + +> printAbout = do +> putStrLn "Created by Donya Quick at Yale University (donya.quick@yale.edu)" +> putStrLn "For more information, go to http://www.donyaquick.com and click on " +> putStrLn "Current Research. Relevant publications can be found on the " +> putStrLn "Yale Haskell Group's website, http://haskell.cs.yale.edu." + +> printDirections = do +> putStrLn "To call Kulitta with a graphical interface, just run 'Kulitta' (no arguments)." +> putStrLn "To use Kulitta from the command prompt, run 'Kulitta basic' and follow the prompts.\n" +> putStrLn "To provide arguments, use 'Kulitta s f m g i b x' where" +> putStrLn " s = Chorale | JazzChorale | WeirdChorale | JazzChords | BossaNova | PianoEtude" +> putStrLn " f = Phrase | AABA" +> putStrLn " m = Major | Minor" +> putStrLn " g = HandBuilt | Learned" +> putStrLn " i = an integer, like 392" +> putStrLn " b (assign MIDI instruments) = Yes | No" +> putStrLn " x = a file path, like 'foo.mid'\n" +> putStrLn "Run 'Kulitta about' for more information on the program." +> putStrLn "You can use Ctrl+C to exit at any time while Kulitta is running.\n\n" + +> processArgs strs = do +> let style = read (strs !! 0) +> form = read (strs !! 1) +> mode = read (strs !! 2) +> gram = read (strs !! 3) +> seed = read (strs !! 4) :: Int +> inst = strs !! 5 == "Yes" || strs !! 5 == "yes" +> outFile = strs !! 6 +> automated (Info style form gram mode False True "") seed outFile inst + +> interactive = do +> style <- getStyle +> form <- getForm +> mode <- getMode +> gram <- getGram +> seed <- getSeed +> inst <- getInstr +> useLets <- getLets (gram == HandBuilt) +> randomKey <- getKey +> outFile <- getFilePath +> automated (Info style form gram mode useLets True "") seed outFile inst + +> automated (Info style form gram mode lets key pfile) seed outFile inst = do +> putStrLn ("\nI will now write a "++ show mode ++ " "++ show style ++ +> " in "++show form++" form with random seed "++ show seed ++ +> " and a "++show gram++" grammar, and I will "++ +> " and write it to the file '"++ outFile ++"'.\n") +> putStrLn "Please be patient - some styles can take a while to write!\n" +> putStrLn "Working...\n" +> (m,abst) <- makePiece (mkStdGen seed) (Info style form gram mode lets key pfile) inst +> writeMidi outFile m +> let outFile2 = take (length outFile - 3) outFile ++ "txt" +> writeFile outFile2 (show abst) +> putStrLn ("Done! Please check "++outFile++" to hear what I wrote.\n") + +> getStyle = do +> putStrLn ("I can write the following styles:\n Chorale \t JazzChorale "++ +> "\t WeirdChorale \n JazzChords \t BossaNova ") +> putStrLn "\nWhat would you like me to write?\n" +> putStr "Style: " +> styleStr <- getLine +> let style = reads styleStr :: [(Style, String)] +> if null style then putStrLn ("\nSorry, I don't understand. "++ +> "Please type the style exactly. ") >> getStyle +> else return (fst $ head $ style) + +> getForm = getOne [Phrase, AABA] +> "\nI can write two forms: Phrase or AABA. Which would you like?\n" +> "Form: " + +> getMode = getOne [Major, Minor] +> "\nShould this be a Major or a Minor piece?\n" +> "Mode: " + +> getSeed = do +> putStr "\nGive me a random number seed to use: " +> seedStr <- getLine +> let seed = reads seedStr :: [(Int, String)] +> if null seed then putStr ("\nSorry, I don't understand. "++ +> "Please enter an integer (Int) value. ") >> getSeed +> else return (fst $ head $ seed) + +> getGram = getOne [HandBuilt, Learned] +> "\nShould I use the HandBuilt or Learned grammar for harmony? " +> "Grammar: " + +> getFilePath = do +> putStrLn "\nWhere would you like me to write the MIDI file and what should I call it?\n" +> putStr "Output file path: " +> filePath <- getLine +> return $ stripQuotes filePath + +> getInstr = getYesNo "\nShould I assign MIDI instruments?\n" + +> getLets hb = if not hb then return False else +> getYesNo "\nShould I use Let statements?\n" + +> getKey = getYesNo "\nShould I pick a random key? (C is the default)\n" + +> getYesNo :: String -> IO Bool +> getYesNo q = do +> putStrLn q +> putStr "Yes or No: " +> ansStr <- getLine +> let ans = if ansStr=="Yes" || ansStr=="yes" then [True] else +> if ansStr=="No" || ansStr=="no" then [False] else [] +> if null ans then putStr ("\nSorry, I don't understand. "++ +> "Please type only 'Yes' or 'No'. ") >> getYesNo q +> else return (head ans) + +> getOne :: (Show a) => [a] -> String -> String -> IO a +> getOne opts q s = do +> putStrLn q +> putStr s +> ansStr <- getLine +> let ansInd = findIndices ((==ansStr).show) opts +> if null ansInd then putStr ("\nSorry, I don't understand. "++ +> "Please type only "++optsStr opts++". ") >> getOne opts q s +> else return (opts !! head ansInd) where +> optsStr :: (Show a) => [a] -> String +> optsStr [] = "" +> optsStr [x] = " or "++show x +> optsStr (x:xs) = show x ++", "++optsStr xs + + +> stripQuotes = filter (not . (`elem` "\"'")) +
+ Examples/GUI/GUIBackend.lhs view
@@ -0,0 +1,335 @@+Generative backend for Kulitta.lhs (the GUI/console program) + +> module GUIBackend where +> import Kulitta.EuterpeaSpecial +> import Kulitta.Foregrounds +> import Kulitta +> import Kulitta.Grammars.MusicGrammars +> import System.Random +> import Kulitta.Learning.Learning +> import Kulitta.Learning.PCFGtoPTGG +> import Data.List +> import System.Environment +> import System.IO +> import System.Directory + +Data type definitions to allow the user to specify Kulitta's behavior. + +> data Style = Chorale | -- in style of JS Bach +> PianoChorale | +> JazzChorale | -- grammar, jazz chords, chorale foreground +> WeirdChorale | -- grammar through OPT-space +> JazzChords | -- grammar with jazz foreground +> BossaNova | -- grammar with bossa foreground +> PianoEtude1 | +> PianoEtude2 +> deriving (Eq, Show, Ord, Read) +> data Form = Phrase | AABA +> deriving (Eq, Show, Ord, Read) +> data GramType = HandBuilt | Learned +> deriving (Eq, Show, Ord, Read) +> data Info = Info { +> style :: Style, +> form :: Form, +> gram :: GramType, +> mode :: Mode, +> lets :: Bool, +> randKey :: Bool, +> probs :: FilePath} + + +ABSTRACT PHRASE GENERATION + +This function creates chorale phrases using a hand-built grammar. + +> makeRPhraseH :: StdGen -> Mode -> (Dur,Dur) -> Bool -> Int -> Dur -> Bool -> IO (Constraints, [RChord]) +> makeRPhraseH g m (minD,maxD) lets iters len partB= +> let tSeed = [NT (I, MP len m 0 0 4)] +> tVal = doGen (rRules1 minD lets) iters g m tSeed maxD +> kVal = findInds [] tVal +> in return (kVal, toChords (expand [] tVal)) + +This files store the results of training Kulitta on a Bach chorale corpus. + +> minorProbsFile = "minorProbs.txt" +> majorProbsFile = "majorProbs.txt" +> pcfgFile = "pcfg.txt" + +These production probabilities can be used to make other phrases. Since we +require that phrases end on one, phrases will be searched until one is found +that does end on I (ending on I is not guaranteed by the learned grammar). + +> makeRPhraseB :: StdGen -> Mode ->(Dur,Dur) -> Int -> Dur -> Bool -> FilePath -> IO (Constraints, [RChord]) +> makeRPhraseB g m (minD,maxD) iters len partB pfile = do +> let [g1, g2, g'] = take 3 $ splitN g +> (startSym, rulesPCFG) <- readPCFG pcfgFile +> let theFile = if null pfile then +> if m==Major then majorProbsFile else minorProbsFile +> else pfile +> probs <- readProbsFinal theFile +> let avgProbs = map average probs +> prules = zip avgProbs rulesPCFG +> rules = toPTGG3 (<minD) prules +> tSeed = [NT (I, MP len m 0 0 4)] +> tPhrase = doGen rules iters g1 m tSeed maxD +> endsOnI = endingType tPhrase +> rPhrase = toChords (expand [] $ tPhrase) +> rPhrase' = expandTSD2 (tsdSpace' m) (okRTrans m) g2 rPhrase +> --putStrLn ("Probabilities: "++show avgProbs) +> if endsOnI then return ([], rPhrase') else makeRPhraseB g' m (minD,maxD) iters len partB pfile where +> endingType = (==I) . last . map (\(a,b,c) -> c) . toChords . expand [] + +> average xs = sum xs / fromIntegral (length xs) + + +The doGen function adds a maximum duration constraint to get a more consistent +distribution of durations. No more than searchLimit generative steps will be tried +to avoid infinite loops caused by generative fixed points. + +> searchLimit = 1000 + +> doGen :: (Eq a) => [Rule a MP] -> Int -> StdGen -> Mode -> Sentence a MP -> Dur -> Sentence a MP +> doGen theRules i g ctxt t maxDur = recCheck i (map snd $ gen theRules (g,t)) where +> recCheck i ts = let tc = ts !! i in +> if (goodDurs tc && goodDurs' tc) || i>searchLimit then tc else recCheck (i+1) ts +> goodDurs [] = True +> goodDurs (Let x a e : ts) = goodDurs a && goodDurs e && goodDurs ts +> goodDurs (Var x : ts) = True -- can't tell duration here, so assume ok +> goodDurs (NT (c,p) : ts) = dur p <= maxDur && goodDurs ts + +> goodDurs' :: Predicate (Sentence a MP) +> goodDurs' t = let x = getDurs t in +> length (filter (>=hn) x) < length x `div` 2 + +> getDurs :: Sentence a MP -> [Dur] +> getDurs [] = [] +> getDurs (t@(Let x a e):ts) = getDurs (expand [] [t]) ++ getDurs ts +> getDurs (Var x : ts) = error "getDurs can't handle variables." +> getDurs (NT (x,p) :ts) = dur p : getDurs ts + +This version of TSD-space is altered from the originally-learned statistics to +improve Kulitta's performance (the analysis had some known problems). + +> tsdSpace' :: Mode -> QSpace CType +> tsdSpace' m = [f I 0 ++ f III 2 ++ f VI 5, +> f IV 3 ++ f II 1, +> f V 4 ++ f VII 6] where +> -- I II III IV V VI VII +> rCounts = if m==Major then [34, 13, 4, 11, 25, 7, 3] +> else [47, 2, 4, 18, 20, 3, 3] +> f x i = take (rCounts !! i) $ repeat x + + +=============================== + +FOREGROUND GENERATION + +The following code configures Kulitta in different ways to generate different +styles of music according to the user's specifications. + +> makePiece g i@(Info s f gr m l k pfile) b = do +> let [gStruct, gFG] = take 2 $ splitN g +> genVals = if elem s [BossaNova, PianoEtude1] then (5, wn, wn, 8) else (5, qn, hn, 4) +> --if chorale s then (5, qn, hn, 4) else (5, wn, wn, 8) +> absStructs <- makeStructure gStruct i genVals +> theMusic <- makeMusic gFG i absStructs +> return (procInstrs b theMusic, absStructs) + +> procInstrs :: Bool -> Music a -> Music a +> procInstrs True m = m +> procInstrs False (m1 :=: m2) = procInstrs False m1 :=: procInstrs False m2 +> procInstrs False (m1 :+: m2) = procInstrs False m1 :+: procInstrs False m2 +> procInstrs False (Modify (Instrument i) m) = procInstrs False m +> procInstrs False m = m + +> makeSubStruct gAbs i@(Info s f gr m l k pfile) (iters, minD, maxD, len) partB = do +> (cons, abs) <- if gr==HandBuilt then makeRPhraseH gAbs m (minD,maxD) l iters len partB else +> makeRPhraseB gAbs m (minD,maxD) (iters+1) len partB pfile +> return (cons, abs) + +> makeStructure gStruct i@(Info s f gr m l k pfile) genVals = do +> let (g1, g2) = split gStruct +> structs <- if f==Phrase then sequence [makeSubStruct g1 i genVals False] +> else sequence [makeSubStruct g1 i genVals False, +> makeSubStruct g2 i genVals True] +> return structs + +> chorale s = elem s [Chorale, JazzChorale, WeirdChorale, PianoChorale] + +> makeMusic g i@(Info s f gr m l k1 pfile) absStructs = do +> let (k2, gFG) = randomR (0,11::Int) g +> k = if k1 then k2 else 0 +> let fg = case s of +> Chorale -> addVolume 127 $ buildChorale gFG absStructs (k,m) +> JazzChorale -> addVolume 127 $ buildJChorale gFG absStructs (k,m) +> WeirdChorale -> addVolume 127 $ buildWChorale gFG absStructs (k,m) +> JazzChords -> addVolume 127 $ buildJazzChords gFG absStructs (k,m) +> BossaNova -> buildBossaNova gFG absStructs (k,m) +> PianoChorale -> addVolume 127 $ buildPianoChorale gFG absStructs (k,m) +> PianoEtude1 -> addVolume 127 $ buildPianoEtude1 gFG absStructs (k,m) +> PianoEtude2 -> addVolume 127 $ buildPianoEtude2 gFG absStructs (k,m) +> putStrLn ("Key of piece: "++ showKey k m ++"\n") +> writeFile "term.txt" (show absStructs) +> return fg where +> showKey k m = (["C","C-sharp","D","E-flat","E","F","F-sharp","G", +> "A-flat","A","B-flat","B"] !! k) ++ " " ++ show m + +A chorale is pretty straightforward, using the ClassicalFG.lhs implementation. + +> +> buildChorale g [(cons, x)] (k,m) = +> snd $ snd $ classicalFGR g (ctTrans k x) cons +> buildChorale g [(cons1, a), (cons2, b)] (k,m) = +> let [g1, g2, g3, g4, g5] = take 5 $ splitN g +> aChords = snd $ classicalCS g1 (ctTrans k a) cons1 +> bChords = snd $ classicalCS g2 (ctTrans k b) cons2 +> partA = snd $ snd $ classicalFG' g3 aChords +> partA' = snd $ snd $ classicalFG' g4 aChords +> partB = snd $ snd $ classicalFG' g5 bChords +> in partA :+: partA' :+: partB :+: partA + + +> buildPianoChorale g [(cons, x)] (k,m) = +> let (lh, rh) = simplePianoFG1x (map toAbsChord $ ctTrans k x) g cons +> in lh :=: rh +> buildPianoChorale g [(cons1, a), (cons2, b)] (k,m) = +> let [g1, g2, g3] = take 3 $ splitN g +> (lhA, rhA) = simplePianoFG1x (map toAbsChord $ ctTrans k a) g1 cons1 +> (lhA', rhA') = simplePianoFG1x (map toAbsChord $ ctTrans k a) g2 cons1 +> (lhB, rhB) = simplePianoFG1x (map toAbsChord $ ctTrans k b) g3 cons2 +> partA = lhA :=: rhA +> partA' = lhA' :=: rhA' +> partB = lhB :=: rhB +> in partA :+: partA' :+: partB :+: partA + +> buildPianoEtude1 g [(cons, x)] (k,m) = +> let (lh, rh) = snd $ simplePianoFGMelx (map toAbsChord $ ctTrans k x) g cons +> in lh :=: rh +> buildPianoEtude1 g [(cons1, a), (cons2, b)] (k,m) = +> let [g1, g2, g3] = take 3 $ splitN g +> (lhA, rhA) = snd $ simplePianoFGMelx (map toAbsChord $ ctTrans k a) g1 cons1 +> (lhA', rhA') = snd $ simplePianoFGMelx (map toAbsChord $ ctTrans k a) g2 cons1 +> (lhB, rhB) = snd $ simplePianoFGMelx (map toAbsChord $ ctTrans k b) g3 cons2 +> partA = lhA :=: rhA +> partA' = lhA' :=: rhA' +> partB = lhB :=: rhB +> in partA :+: partA' :+: partB :+: partA + +> buildPianoEtude2 g [(cons, x)] (k,m) = +> let (lh, rh) = snd $ simplePianoFGArpx (map toAbsChord $ ctTrans k x) g cons +> in lh :=: rh +> buildPianoEtude2 g [(cons1, a), (cons2, b)] (k,m) = +> let [g1, g2, g3] = take 3 $ splitN g +> (lhA, rhA) = snd $ simplePianoFGArpx (map toAbsChord $ ctTrans k a) g1 cons1 +> (lhA', rhA') = snd $ simplePianoFGArpx (map toAbsChord $ ctTrans k a) g2 cons1 +> (lhB, rhB) = snd $ simplePianoFGArpx (map toAbsChord $ ctTrans k b) g3 cons2 +> partA = lhA :=: rhA +> partA' = lhA' :=: rhA' +> partB = lhB :=: rhB +> in partA :+: partA' :+: partB :+: partA + +A "jazz chorale" ads an extra step in the foreground generation, converting +numerals to jazz chords before running the classical algorithms. + +> buildJChorale g [(cons, x)] (k,m) = +> let (g1,g2) = split g +> jChords = atTrans k $ snd $ jazzChords g1 x cons +> in snd $ snd $ classicalFG' g2 jChords +> buildJChorale g [(cons1, a), (cons2, b)] (k,m) = +> let [g1, g2, g3, g4, g5] = take 5 $ splitN g +> aChords = atTrans k $ snd $ jazzChords g1 a cons1 +> bChords = atTrans k $ snd $ jazzChords g2 b cons2 +> partA = snd $ snd $ classicalFG' g3 aChords +> partA' = snd $ snd $ classicalFG' g4 aChords +> partB = snd $ snd $ classicalFG' g5 bChords +> in partA :+: partA' :+: partB :+: partA + + +A "weird chorale" is one where numerals are run through OPTC-space before +applying a classical foreground. + +> qOPTC = satbR (mkStdGen 123) satbFilter2 optcEq + +Note: the key will not affect weird chorales due to the use +of OPTC-equivalence. + +> buildWChorale g [(cons, x)] km = +> let (g1, g2) = split g +> optChords = toOPTC g1 x km +> in snd $ snd $ classicalFG' g2 optChords +> buildWChorale g [(cons1, a), (cons2, b)] km = +> let [g1, g2, g3, g4, g5] = take 5 $ splitN g +> aChords = toOPTC g1 a km +> bChords = toOPTC g2 b km +> partA = snd $ snd $ classicalFG' g3 aChords +> partA' = snd $ snd $ classicalFG' g4 aChords +> partB = snd $ snd $ classicalFG' g5 bChords +> in partA :+: partA' :+: partB :+: partA + +> toOPTC g x (k,m) = +> let aChords = atTrans k $ map toAbsChord x +> es = map (eqClass qOPTC optcEq) $ map thd aChords +> in zipWith newP aChords $ greedyProg' vl7 nearFall g es + +Jazz foregrounds are created using the two algorithms in JazzFG.lhs. + +> buildJazzChords = buildJazz jazzFG1 +> buildBossaNova = buildJazz jazzFG2 + +> buildJazz f g [(cons, x)] (k,m) = snd $ f g (ctTrans k x) [] +> buildJazz f g [(cons1, a), (cons2, b)] (k,m) = +> let [g1,g2,g3] = take 3 $ splitN g +> jA = snd $ f g1 (ctTrans k a) [] +> jA' = snd $ f g2 (ctTrans k a) [] +> jB = snd $ f g3 (ctTrans k b) [] +> in jA :+: jA' :+: jB :+: jA + + + +======================================= + +======================== + +The following filters out chord transitions that were relatively rare +in the data set, based on the suspicion that they might have been due +to noise (mis-labeled chords) or improper identification of phrase +boundaries in the corpus. + +> okRTrans :: Mode -> Predicate (CType, CType) +> okRTrans m x = not $ elem x $ vals m where +> vals Minor = [(II,VI), (II,VII), (III,II), (III,V), +> (III,VI), (III,VII), (IV,III), (IV,VI), +> (V,III), (V,VII), (VI,III), (VI,IV), +> (VI,V), (VI,VII), (VII,II), (VII,IV), +> (VII,VI)] +> vals Major = [(III,II), (III,VII), (IV,III), (IV,VI), +> (V,VII), (VI,III), (VI,VII), (VII,III), +> (VII,IV), (VII,V), (VII,VI), (VII,VII)] + + +> tsdSpace :: Mode -> QSpace CType +> tsdSpace m = [f I 0 ++ f III 2 ++ f VI 5, +> f IV 3 ++ f II 1, +> f V 4 ++ f VII 6] where +> rCounts = if m==Major then [7833, 3018, 947, 2576, 5723, 1619, 791] +> else [4925, 1425, 504, 1113, 2726, 442, 418] +> f x i = take (rCounts !! i) $ repeat x + + I II III IV V VI VII +Major: 7833, 3018, 947, 2576, 5723, 1619, 791 +Minor: 4925, 1425, 504, 1113, 2726, 442, 418 + + +> expandTSD2 :: QSpace CType -> Predicate (CType, CType) -> StdGen -> [(Key, Dur, CType)] -> +> [(Key, Dur, CType)] +> expandTSD2 tsdSpace' p g xs = +> let xs' = map thd xs +> n = length xs +> es = (map (eqClass tsdSpace' tsdEq) $ take (n-1) xs') ++ [[last xs']] +> in zipWith (\(a,b,c) d -> (a,b,d)) xs $ greedyProg' p tsdFall g es + +> tsdEq :: EqRel CType +> tsdEq a b = or $ map (\e -> elem a e && elem b e) (tsdSpace Major) + +> tsdFall :: Fallback CType +> tsdFall es g x = (g,x)
+ Examples/GUI/IOWidgets.lhs view
@@ -0,0 +1,42 @@+Basic IO Widgets +Donya Quick +Last modified 26-Mar-2015 + +> module IOWidgets where +> import Kulitta.EuterpeaSpecial +> import HSoM +> import FRP.UISF.UISF +> import FRP.UISF.AuxFunctions + +An ioWidget1 takes an IO operation over a value and +creates a UISF widget that will call that IO operation +whenever Just is encountered in an event stream. For +example, you can use this to save a file on a button +press. + +> ioWidget1 :: (a -> IO ()) -> UISF (SEvent a) () +> ioWidget1 = (>>> arr (const ())) . uisfSinkE + +An example of saving a text file using this widget: + +fileSaver :: UISF (SEvent (FilePath, String)) () +fileSaver = ioWidget1 (uncurry writeFile) + +An ioWidget2 has more functionality and allows input +from IO into a stream value in addition to the output. +It takes a default output (which can be Nothing if the +desired output is an event stream) and an IO operation +to perform triggered on an event stream. The result of +that IO operation is returned as a stream. + +> ioWidget2 :: b -> (a -> IO b) -> UISF (SEvent a) b +> ioWidget2 def = (>>> arr (maybe def id)) . uisfPipeE + +An example of using this to read from a file: + +fileReader :: UISF (SEvent FilePath) (SEvent String) +fileReader = ioWidget2 Nothing readIt where + readIt filePath = do + x <- readFile filePath + return (Just x) +
+ Examples/GUI/OldGUI.lhs view
@@ -0,0 +1,313 @@+Kulitta Graphical Interface +Donya Quick +Last modified: 22-Jan-2016 + +NOTE: this version of the code uses: +- Euterpea 2.0 +- UISF 0.4 +- HSoM 1.0 + +See euterpea.com for information on installing +Euterpea and HSoM. UISF will be installed automatically +in the process of installing those two libraries. + +------------------------------------------- + +This module provides examples of Kulitta's output using an +interactive interface. The program can be compiled by: + +ghc -O2 Kulitta.lhs + +Running "Kulitta" will start the program in GUI/MUI mode. +The program will also respond to different arguments: + +Kulitta help Explains how to use the program. +Kulitta about More information about the program. +Kulitta basic Interactive, command-line version. + +To run Kulitta in GHCI, you can load this file and run the +"main" function directly, starting the progam in GUI mode. +However, you will not be able to use the argument-based +methods of interaction through GHCI. If you would like to +use enter the parameters using a text-based series of +prompts in GHCI, change the contents of "settings.txt" to +be "basic" instead of "mui" (which is the default). + +------------------------------------------- + +> {-# LANGUAGE Arrows #-} + +> module Main where +> import GUIBackend +> import Kulitta.EuterpeaSpecial +> import Kulitta.Foregrounds +> import Kulitta +> import Kulitta.Grammars.MusicGrammars +> import System.Random +> import Kulitta.Learning.Learning +> import Kulitta.Learning.PCFGtoPTGG +> import Data.List +> import System.Environment +> import System.IO +> import System.Directory +> import PlayK +> import FRP.UISF.UISF +> import HSoM +> import FRP.UISF.AuxFunctions +> import IOWidgets + + +> programTitle = "Kulitta 2.0.1" + +> channelOffset = 0 -- this is useful for some synthesizers + +Data type definitions to allow the user to specify Kulitta's behavior. + + + +======================= + +MAIN PROGRAM DEFINITION + +Main program description. There are two modes: interacive and automated with arugments. + +> main = do +> hSetBuffering stdout NoBuffering -- required to make things print in the right order +> putStrLn ("\n\n===== "++ programTitle ++ "=====\n") +> args <- getArgs +> if length args == 0 then putStrLn "\nHello! The graphical interface is now active. \n" >> +> runDefault else +> if args !! 0 == "basic" then runBasicVersion else +> if args !! 0 == "help" then printDirections else +> if args !! 0 == "about" then printAbout else +> if length args < 7 then putStrLn "\nSorry, I couldn't understand those arguments.\n" >> +> printDirections +> else processArgs args + +> runDefault = do +> files <- getDirectoryContents "" +> if not (elem "settings.txt" files) then putStrLn "File settings.txt not found." >> runMuiVersion else do +> startMode <- readFile "settings.txt" +> if take 5 startMode == "basic" then runBasicVersion else runMuiVersion + +> runMuiVersion = mui >> putStrLn "\nGraphical interface closed. Goodbye!\n\n" +> runBasicVersion = interactive >> putStrLn "\nGoodbye!\n\n" + +======================= + +MUI DEFINITION + +> styles = [Chorale, JazzChorale, WeirdChorale, JazzChords, BossaNova] +> forms = [Phrase, AABA] +> grams = [HandBuilt, Learned] +> modes = [Major, Minor] + +> mui = runMUI defaultMUIParams{uiSize=(500,570), uiTitle=(programTitle++" - Graphical Interface")} $ proc _ -> do +> label "Please specifty composition parameters for Kulitta." -< () +> label "The command prompt will show the generation/playback status." -< () +> label "" -< () +> (style', mo) <- inputPaneA -< () +> (form',gram',mode', instr', let', key') <- inputPaneB -< () +> probsFile <- leftRight $ label "Prob. file: " >>> textbox "" -< Nothing +> seed <- leftRight $ seedPanel -< () +> let fileName = "output\\" ++ show (styles !! style') ++ "_" ++ show seed ++ ".mid" +> fileName' <- unique -< fileName +> outFile <- leftRight $ label "Output File: " >>> textbox "test.mid" -< fileName' +> volStr<- leftRight $ label "Playback volume (0.0 to 1.0): " >>> textbox "1.0" -< Nothing +> let s = styles !! style' +> f = forms !! form' +> g = grams !! gram' +> m = modes !! mode' +> iMIDI = instr'==0 +> iLet = let'==0 +> iKey = key'==0 +> iVal = Info s f g m iLet iKey probsFile +> vol0 = reads volStr +> vol = if null vol0 then 1.0 else fst $ head vol0 +> (g,p) <- buttons -< () +> let g' = fmap (const (iVal, seed, outFile, iMIDI)) g +> p' = fmap (const (outFile, mo, vol)) p +> basicIOWidget genWrap -< g' +> basicIOWidget playWrap -< p' +> returnA -< () + +> seedPanel :: UISF () Int +> seedPanel = proc _ -> do +> rec seedT <- leftRight $ label "Random seed: " >>> textbox "" -< x +> b <- edge <<< button "Random!" -< () -- button to automatically get a random number +> x <- ioWidget2 Nothing (const rFun) -< b +> let seed = let x = reads seedT :: [(Int, String)] -- parse the string +> in if null x then 0 else fst $ head x +> returnA -< seed where +> rFun :: IO (Maybe String) +> rFun = do +> x <- randomIO :: IO Int -- fetch a random number +> return (Just $ show $ abs x) -- convert it to SEvent String format + +> genWrap (i, seed, outFile, inst) = automated i seed outFile inst +> playWrap (fname, devID, vol) = do +> putStrLn "\nPlaying...(please wait)\n" +> playX fname devID channelOffset vol +> putStrLn "\nDone!\n\n" + +> buttons = leftRight $ proc _ -> do +> genButton <- edge <<< button "Generate MIDI File" -< () +> playButton <- edge <<< button "Play MIDI File" -< () +> returnA -< (genButton, playButton) + +> inputPaneA = leftRight $ proc _ -> do +> style <- topDown $ title "Style" $ radio (map show styles) 0 -< () +> mo <- topDown $ selectOutput -< () +> returnA -< (style, mo) + +> inputPaneB = leftRight $ proc _ -> do +> (form, gram, lets) <- inputPane2 -< () +> (mode, instr, key) <- inputPane3 -< () +> returnA -< (form, gram, mode, instr, lets, key) where +> inputPane2 = topDown $ proc _ -> do +> form <- topDown $ title "Form" $ radio (map show forms) 0 -< () +> gram <- topDown $ title "Harmony Model" $ radio (map show grams) 0 -< () +> lets <- topDown $ title "Use Lets" $ radio ["Yes", "No"] 1 -< () +> returnA -< (form, gram, lets) +> inputPane3 = topDown $ proc _ -> do +> mode <- topDown $ title "Mode" $ radio ["Major", "Minor"] 0 -< () +> instr <- topDown $ title "Assign MIDI instruments?" $ radio ["Yes", "No"] 0 -< () +> key <- topDown $ title "Random key?" $ radio ["Yes", "No"] 0 -< () +> returnA -< (mode, instr, key) + +> basicIOWidget :: (a -> IO ()) -> UISF (SEvent a) () +> basicIOWidget = (>>> arr (const ())) . uisfSinkE + + + +======================= + +CONSOLE PROGRAM DEFINITION + +> printAbout = do +> putStrLn "Created by Donya Quick at Yale University (donya.quick@yale.edu)" +> putStrLn "For more information, go to http://www.donyaquick.com and click on " +> putStrLn "Current Research. Relevant publications can be found on the " +> putStrLn "Yale Haskell Group's website, http://haskell.cs.yale.edu." + +> printDirections = do +> putStrLn "To call Kulitta with a graphical interface, just run 'Kulitta' (no arguments)." +> putStrLn "To use Kulitta from the command prompt, run 'Kulitta basic' and follow the prompts.\n" +> putStrLn "To provide arguments, use 'Kulitta s f m g i b x' where" +> putStrLn " s = Chorale | JazzChorale | WeirdChorale | JazzChords | BossaNova" +> putStrLn " f = Phrase | AABA" +> putStrLn " m = Major | Minor" +> putStrLn " g = HandBuilt | Learned" +> putStrLn " i = an integer, like 392" +> putStrLn " b (assign MIDI instruments) = Yes | No" +> putStrLn " x = a file path, like 'foo.mid'\n" +> putStrLn "Run 'Kulitta about' for more information on the program." +> putStrLn "You can use Ctrl+C to exit at any time while Kulitta is running.\n\n" + +> processArgs strs = do +> let style = read (strs !! 0) +> form = read (strs !! 1) +> mode = read (strs !! 2) +> gram = read (strs !! 3) +> seed = read (strs !! 4) :: Int +> inst = strs !! 5 == "Yes" || strs !! 5 == "yes" +> outFile = strs !! 6 +> automated (Info style form gram mode False True "") seed outFile inst + +> interactive = do +> style <- getStyle +> form <- getForm +> mode <- getMode +> gram <- getGram +> seed <- getSeed +> inst <- getInstr +> useLets <- getLets (gram == HandBuilt) +> randomKey <- getKey +> outFile <- getFilePath +> automated (Info style form gram mode useLets True "") seed outFile inst + +> automated (Info style form gram mode lets key pfile) seed outFile inst = do +> putStrLn ("\nI will now write a "++ show mode ++ " "++ show style ++ +> " in "++show form++" form with random seed "++ show seed ++ +> " and a "++show gram++" grammar, and I will "++ +> " and write it to the file '"++ outFile ++"'.\n") +> putStrLn "Please be patient - some styles can take a while to write!\n" +> putStrLn "Working...\n" +> (m,abst) <- makePiece (mkStdGen seed) (Info style form gram mode lets key pfile) inst +> writeMidi outFile m +> let outFile2 = take (length outFile - 3) outFile ++ "txt" +> writeFile outFile2 (show abst) +> putStrLn ("Done! Please check "++outFile++" to hear what I wrote.\n") + +> getStyle = do +> putStrLn ("I can write the following styles:\n Chorale \t JazzChorale "++ +> "\t WeirdChorale \n JazzChords \t BossaNova ") +> putStrLn "\nWhat would you like me to write?\n" +> putStr "Style: " +> styleStr <- getLine +> let style = reads styleStr :: [(Style, String)] +> if null style then putStrLn ("\nSorry, I don't understand. "++ +> "Please type the style exactly. ") >> getStyle +> else return (fst $ head $ style) + +> getForm = getOne [Phrase, AABA] +> "\nI can write two forms: Phrase or AABA. Which would you like?\n" +> "Form: " + +> getMode = getOne [Major, Minor] +> "\nShould this be a Major or a Minor piece?\n" +> "Mode: " + +> getSeed = do +> putStr "\nGive me a random number seed to use: " +> seedStr <- getLine +> let seed = reads seedStr :: [(Int, String)] +> if null seed then putStr ("\nSorry, I don't understand. "++ +> "Please enter an integer (Int) value. ") >> getSeed +> else return (fst $ head $ seed) + +> getGram = getOne [HandBuilt, Learned] +> "\nShould I use the HandBuilt or Learned grammar for harmony? " +> "Grammar: " + +> getFilePath = do +> putStrLn "\nWhere would you like me to write the MIDI file and what should I call it?\n" +> putStr "Output file path: " +> filePath <- getLine +> return $ stripQuotes filePath + +> getInstr = getYesNo "\nShould I assign MIDI instruments?\n" + +> getLets hb = if not hb then return False else +> getYesNo "\nShould I use Let statements?\n" + +> getKey = getYesNo "\nShould I pick a random key? (C is the default)\n" + +> getYesNo :: String -> IO Bool +> getYesNo q = do +> putStrLn q +> putStr "Yes or No: " +> ansStr <- getLine +> let ans = if ansStr=="Yes" || ansStr=="yes" then [True] else +> if ansStr=="No" || ansStr=="no" then [False] else [] +> if null ans then putStr ("\nSorry, I don't understand. "++ +> "Please type only 'Yes' or 'No'. ") >> getYesNo q +> else return (head ans) + +> getOne :: (Show a) => [a] -> String -> String -> IO a +> getOne opts q s = do +> putStrLn q +> putStr s +> ansStr <- getLine +> let ansInd = findIndices ((==ansStr).show) opts +> if null ansInd then putStr ("\nSorry, I don't understand. "++ +> "Please type only "++optsStr opts++". ") >> getOne opts q s +> else return (opts !! head ansInd) where +> optsStr :: (Show a) => [a] -> String +> optsStr [] = "" +> optsStr [x] = " or "++show x +> optsStr (x:xs) = show x ++", "++optsStr xs + + +> stripQuotes = filter (not . (`elem` "\"'")) +
+ Examples/GUI/PlayK.lhs view
@@ -0,0 +1,115 @@+Special playback functions +Donya Quick +Last modified: 01-July-2015 + +Kulitta-specific playback functions. + +Most of these functions are slight modifications of Euterpea's +functions in ExperimentalPlay and MidiIO. + +> module PlayK where +> import Euterpea +> import Codec.Midi +> import Sound.PortMidi +> import System.IO.Unsafe (unsafePerformIO) +> import Euterpea.IO.MIDI.MidiIO +> import System.Directory + + +Play a MIDI file to a user-specified device. Unlike the regular play function, +this version also checks whether the file exists to avoid crashing the calling +program. If the file doesn't exist, an error message will be printed. + +> play' fp devID = do +> x <- tryImportFile fp +> seq x $ case x of Left err -> putStrLn ("Error: "++err) >> return () +> Right m -> playM' devID m + +> playX fp devID chanOffset vol = do +> x <- tryImportFile fp +> seq x $ case x of Left err -> putStrLn ("Error: "++err) >> return () +> Right m -> playM' devID (trackMod chanOffset vol m) + +> playXS fp devID chanOffset vol speed = do +> x <- tryImportFile fp +> seq x $ case x of Left err -> putStrLn ("Error: "++err) >> return () +> Right m -> do +> let mx = fromMidi m +> putStrLn ("Playback speed: "++show speed) +> putStrLn ("Playback volume: "++show vol) +> playM' devID (trackMod chanOffset vol $ toMidi $ perform $ tempo (toRational speed) mx) + +> writeX fp m chanOffset = +> let x = trackMod 0 (-1) $ toMidi m +> in exportMidiFile fp x + + +The trackMod function takes a channel offset, x, and a list of tick-stamped messages +and offsets the track numbers by x amount. The purpose of this was really a single +use case: running the Kulitta GUI alongside other programs that used tracks 1 through +(x-1) so that Kulitta's playback would not "step on the toes" of the other programs' +playback. + +> trackMod x vol m = +> let t = tracks m +> t' = map (map (trackMod' x vol)) t +> in m{tracks = t'} + +> trackMod' :: Channel -> Double -> (Ticks, Message) -> (Ticks, Message) +> trackMod' x vol (a, NoteOff c k v) = (a, NoteOff (c+x) k (if vol <0 then v else volMod v vol)) +> trackMod' x vol (a, NoteOn c k v) = (a, NoteOn (c+x) k (if vol <0 then v else volMod v vol)) +> trackMod' x vol (a, ProgramChange c p) = (a, ProgramChange (c+x) p) +> trackMod' x vol (a, ControlChange c v1 v2) = (a, ControlChange (c+x) v1 v2) +> trackMod' x vol (a,v) = (a,v) + +> volMod v vol = floor(fromIntegral v * vol) + +> playF fp fmid devID = do +> x <- tryImportFile fp +> seq x $ case x of Left err -> putStrLn ("Error: "++err) >> return () +> Right m -> playM' devID (fmid m) + +Code to check whether the file exists: + +> tryImportFile fp = do +> let theDir = getDir fp +> theFile = getFile fp +> files <- getDirectoryContents theDir +> if elem theFile files then importFile fp >>= return +> else return $ Left ("File "++fp ++ " does not exist, so it cannot be played!") where +> getDir fp = reverse $ dropWhile (not.(`elem` "/\\")) $ reverse fp +> getFile fp = drop (length $ getDir fp) fp + +===================== + +DATA MANIPULATION FUNCTIONS + +For playback, it's useful to be able to set the volume on some systems. + +> setVol :: Int -> Music Pitch -> Music1 +> setVol v = mMap (\p -> (p, [Volume v])) + +> setVol1 :: Int -> Music1 -> Music1 +> setVol1 v = mMap (\(p,nas) -> (p, Volume v : filter f nas)) where +> f (Volume v) = False +> f _ = True + +Sometimes it is also useful to play to devices with instrument +information stripped (i.e. sending to a single synth such that +only one channel can be used). + +> stripInstrs :: Music a -> Music a +> stripInstrs (a :+: b) = stripInstrs a :+: stripInstrs b +> stripInstrs (a :=: b) = stripInstrs a :=: stripInstrs b +> stripInstrs (Prim p) = Prim p +> stripInstrs (Modify (Instrument i) m) = stripInstrs m +> stripInstrs (Modify c m) = Modify c $ stripInstrs m + +> m2m :: (Music1 -> Music1) -> Midi -> Midi +> m2m fm1 midi = +> let m1 = fromMidi midi +> in toMidi $ perform $ fm1 m1 + +> ch1 :: Int -> Midi -> Midi +> ch1 v = if v <=0 then m2m stripInstrs +> else m2m (setVol1 v . stripInstrs)
+ Examples/GUI/majorProbs.txt view
@@ -0,0 +1,10 @@+Rule 0 1 2 3 4 +T -> T 0.4078644942835788 0.41328289970406196 0.40870410354567954 0.4119436005238449 0.4187712204084978 +T -> T T 0.30599872504245995 0.2997572810365725 0.29819979137106495 0.2978711657036685 0.3029808546499098 +T -> D T 0.1552316743974623 0.16572277618806222 0.18026101376311032 0.15537173178272456 0.16767400957005318 +T -> T D 0.1309051062764989 0.1212370430713034 0.11283509132014523 0.1348135019897621 0.11057391537153924 +D -> D 0.6233017245807817 0.6253368888563653 0.6592110726640223 0.6431038361696341 0.6483760503844281 +D -> D D 9.249122590492824e-2 0.11188557269801935 7.543077199551113e-2 8.568892551045199e-2 7.886534386888609e-2 +D -> S D 0.28420704951429004 0.26277753844561547 0.2653581553404666 0.271207238319914 0.2727586057466857 +S -> S 0.9347580005750789 0.9519471948474868 0.9399495353659783 0.9737396523396717 0.9412390070207418 +S -> S S 6.524199942492118e-2 4.8052805152513305e-2 6.005046463402174e-2 2.62603476603282e-2 5.8760992979258166e-2
+ Examples/GUI/majorProbs2.txt view
@@ -0,0 +1,10 @@+Rule 0 1 2 3 4 +T -> T 0.39292836454925917 0.3918143802883459 0.3989160004416933 0.3985716292120994 0.4030466080388522 +T -> T T 0.3025625815653664 0.29995308545485505 0.30454252468364823 0.30941728743396457 0.3130341212576525 +T -> D T 0.17370867384345734 0.1733613533384522 0.1599541715589955 0.16523251237854147 0.17195982614242927 +T -> T D 0.1308003800419171 0.13487118091834668 0.13658730331566293 0.12677857097539458 0.11195944456106607 +D -> D 0.6299566946453984 0.6211223145933816 0.6211025190909858 0.6162574184626104 0.626371896984274 +D -> D D 9.183562527766467e-2 8.575619245599846e-2 9.405801596840914e-2 8.521588906201656e-2 8.985531666293045e-2 +D -> S D 0.27820768007693697 0.29312149295061996 0.284839464940605 0.298526692475373 0.28377278635279546 +S -> S 0.9251614568830213 0.9473478396235692 0.9416456332906863 0.9447180984259408 0.9621642893030287 +S -> S S 7.483854311697873e-2 5.265216037643073e-2 5.835436670931378e-2 5.528190157405913e-2 3.783571069697136e-2
+ Examples/GUI/minorProbs.txt view
@@ -0,0 +1,10 @@+Rule 0 1 2 3 4 +T -> T 0.4303472649053824 0.43434352461772063 0.4381551844065275 0.42488914483608897 0.42555108217072823 +T -> T T 0.30545159799407384 0.32571919565252877 0.32046572912943055 0.3204273462916922 0.31368823609264523 +T -> D T 0.12459385800312707 0.10447028304608945 0.11014041704606777 0.11504517677856607 0.11992037293024925 +T -> T D 0.1396072790974167 0.1354669966836613 0.13123866941797432 0.13963833209365276 0.14084030880637724 +D -> D 0.7112254366141529 0.6991888058328881 0.7143663304480617 0.7239116478874241 0.6995021451504793 +D -> D D 9.125126969643599e-2 8.228964007529986e-2 6.466463653388398e-2 8.209930489697462e-2 8.115516072540577e-2 +D -> S D 0.19752329368941113 0.21852155409181206 0.22096903301805432 0.19398904721560128 0.21934269412411506 +S -> S 0.8277368959861198 0.8513794617491494 0.8112759787382702 0.822537477955415 0.823203621318863 +S -> S S 0.17226310401388026 0.14862053825085061 0.1887240212617299 0.17746252204458507 0.17679637868113698
+ Examples/GUI/minorProbs2.txt view
@@ -0,0 +1,10 @@+Rule 0 1 2 3 4 +T -> T 0.41711339176792905 0.4178156538714502 0.416658466620383 0.4186935372055371 0.41921778343229943 +T -> T T 0.3355897519349536 0.3388859889060679 0.33698941853975395 0.3414111613664872 0.3395895558066667 +T -> D T 0.10846732992188404 9.207035917431602e-2 9.437671628620667e-2 9.523457609028431e-2 9.145336234662903e-2 +T -> T D 0.13882952637523321 0.15122799804816583 0.15197539855365655 0.14466072533769142 0.14973929841440473 +D -> D 0.6987098908264877 0.7035174102776297 0.6985733127442174 0.7094032159540127 0.7086200178789149 +D -> D D 0.10123471818409877 8.188699292701027e-2 6.154026586443632e-2 7.301843078012875e-2 8.818103552299318e-2 +D -> S D 0.20005539098941355 0.21459559679536017 0.2398864213913463 0.21757835326585856 0.20319894659809204 +S -> S 0.8358625210145516 0.8340348008628068 0.8237205420079606 0.807594627837403 0.832023661680363 +S -> S S 0.16413747898544837 0.1659651991371933 0.1762794579920393 0.19240537216259695 0.16797633831963701
+ Examples/GUI/pcfg.txt view
@@ -0,0 +1,13 @@+T + +T -> T +T -> T, T +T -> D, T +T -> T, D + +D -> D +D -> D, D +D -> S, D + +S -> S +S -> S, S
+ Examples/GUI/term.txt view
@@ -0,0 +1,1 @@+[([],[((0,Major),1 % 4,V),((0,Major),1 % 4,I),((0,Major),1 % 2,III),((9,Minor),1 % 2,I),((0,Major),1 % 4,III),((9,Minor),1 % 4,I),((0,Major),1 % 2,II),((0,Major),1 % 4,III),((0,Major),1 % 4,V),((5,Major),1 % 4,I),((0,Major),1 % 4,III),((0,Major),1 % 4,V),((0,Major),1 % 4,I)])]
+ Kulitta.cabal view
@@ -0,0 +1,50 @@+name: Kulitta +version: 2.2.1 +Cabal-Version: >= 1.8 +license: OtherLicense +license-file: LICENSE +copyright: Copyright (c) 2016 Donya Quick +category: Sound +stability: experimental +build-type: Custom +author: Donya Quick <donya.quick@yale.edu> +maintainer: Donya Quick <donya.quick@yale.edu> +bug-reports: https://github.com/donya/Kulitta/issues +homepage: http://www.donyaquick.com/kulitta +synopsis: Library for automated composition and musical learning +description: + Kulitta is a framework for automated composition that can also + be configured to run as a standalone AI for generating music + in a particular style. +extra-source-files: + readme.txt + +Library + hs-source-dirs: . + ghc-options: -O2 + extensions: CPP + exposed-modules: + Kulitta, + Kulitta.ChordSpaces.OPTIC, + Kulitta.ChordSpaces.ModeSpace, + Kulitta.ChordSpaces, + Kulitta.PTGG, + Kulitta.Search, + Kulitta.PostProc, + Kulitta.Constraints, + Kulitta.QuotientSpaces, + Kulitta.Foregrounds.ClassicalFG, + Kulitta.Foregrounds.JazzFG, + Kulitta.Foregrounds.SimplePianoFG, + Kulitta.Foregrounds, + Kulitta.EuterpeaSpecial, + Kulitta.Grammars.MusicGrammars, + Kulitta.Learning.CykParser, + Kulitta.Learning.InsideOutside, + Kulitta.Learning.Learning, + Kulitta.Learning.Parser, + Kulitta.Learning.PCFGtoPTGG, + Kulitta.Learning.TemporalGen + other-modules: + build-depends: + base >= 3 && < 5, array, deepseq, random, Euterpea >= 2.0.4, UISF >= 0.4, parallel
+ Kulitta.lhs view
@@ -0,0 +1,14 @@+> module Kulitta( +> module Kulitta.PTGG, +> module Kulitta.ChordSpaces, +> module Kulitta.PostProc, +> module Kulitta.Search, +> module Kulitta.Constraints +> ) where + + +> import Kulitta.PTGG +> import Kulitta.ChordSpaces +> import Kulitta.PostProc +> import Kulitta.Search +> import Kulitta.Constraints
+ Kulitta/ChordSpaces.lhs view
@@ -0,0 +1,9 @@+> module Kulitta.ChordSpaces( +> module Kulitta.QuotientSpaces, +> module Kulitta.ChordSpaces.OPTIC, +> module Kulitta.ChordSpaces.ModeSpace, +> ) where + +> import Kulitta.QuotientSpaces +> import Kulitta.ChordSpaces.OPTIC +> import Kulitta.ChordSpaces.ModeSpace
+ Kulitta/ChordSpaces/ModeSpace.lhs view
@@ -0,0 +1,55 @@+Mode Space Implementation +Donya Quick +Last modified: 19-August-2014 + +Based on mode space implementation for doctoral thesis. + +Major changes since last version: +- Changed occurrences of AbsPitch to PitchNum to avoid conflict with Euterpea's AbsPitch + +> module Kulitta.ChordSpaces.ModeSpace where +> import Kulitta.ChordSpaces.OPTIC +> import Kulitta.QuotientSpaces +> import Data.List +> import System.Random + +> type AbsMode = [PitchNum] +> type JChord = (AbsChord, AbsMode) + +> modeEq :: EqRel JChord +> modeEq a b = normO(snd a) == normO(snd b) + +The set of all modes rooted at 0 + +> allModes :: [AbsMode] +> allModes = allRots [0,2,4,5,7,9,11] where +> allRots x = take 7 $ iterate doRot x +> doRot x = normO $ normT (tail x ++ [head x + 12]) + +> allKModes = map (normO . uncurry t) [(k,m) | k<-[0..11], m<-allModes] + +> allJChords :: [JChord] +> allJChords = +> let masks = makeRange (take 7 $ repeat (0,1)) +> applyMask (f, m) = (map snd $ filter ((>0).fst) $ zip f m, m) +> in map applyMask [(f,m) | f<-masks, m<-allKModes] + +> modeSpace :: QSpace JChord +> modeSpace = allJChords // modeEq + +This version allows more efficient specification of modal space +involving only chords fitting certain templates. + +> modeSpace' :: [[Int]] -> QSpace JChord +> modeSpace' temps = filter (f temps) allJChords // modeEq where +> f temps (c,m) = elem c $ map (toTemp m) temps +> toTemp m t = map (m!!) t + +For example, to get only triads with the root, third, and fifth, +one would use: modeSpace' [[0,2,4]]. + + + + + +
+ Kulitta/ChordSpaces/OPTIC.lhs view
@@ -0,0 +1,125 @@+Chord Spaces Implementation +Donya Quick and Paul Hudak +Last modified: 13-Jan-2016 + + +> module Kulitta.ChordSpaces.OPTIC where +> import Kulitta.QuotientSpaces +> import Data.List +> import System.Random +> import Control.DeepSeq +> import Data.Maybe + +Type definitions: + +> type PitchNum = Int -- same as Euterpea's AbsPitch +> type AbsChord = [Int] +> type Prog = [AbsChord] -- Chord progression + +The makeRange function will generate Z^n for user-specified ranges. + +> makeRange :: [(PitchNum, PitchNum)] -> [AbsChord] +> makeRange = foldr (\(l,u) xs -> [(a:b) | a<-[l..u], b<-xs]) [[]] + + +A version of makeRange for use with sorted spaces: + +> makeRange' :: [(PitchNum, PitchNum)] -> [AbsChord] +> makeRange' = foldr (\(l,u) xs -> [(a:b) | a<-[l..u], b<-xs, psort (a:b)]) [[]] where +> psort (a:b:t) = a<b +> psort _ = True + + +========= O, P, & T IMPLEMENTATION ========= + +First we will define the octave and transposition operations. +For f(x)=y with f in {o, t, p}, x~y for the corresponding +equivalence relation (O, T, and P respectively). + +> o,p :: [Int] -> AbsChord -> AbsChord +> o = zipWith (\i x -> x + 12 * i) +> p s xs = map (xs !!) s + +> t :: Int -> AbsChord -> AbsChord +> t c = map (+c) + +Note: "inv" below is just called "i" in the dissertation. It +is called "inv" here for clarity. + +> inv :: Bool -> AbsChord -> AbsChord +> inv neg = if neg then map (*(-1)) else id + +We define normalizations for O, P, T, OP, OT, and PT. +We also add a new definition, OPC. + +> normO, normT, normP, normOP, normPT, normPC, normOPC :: Norm AbsChord +> normO = map (`mod` 12) +> normT x = map (subtract $ head x) x +> normP = sort +> normOP = sort . normO +> normPT = normT . sort +> normOT = normO . normT +> normPC = nub . normP +> normOPC = nub . normOP +> normOC = normC . normO + +> normC :: AbsChord -> AbsChord +> normC (x1:x2:xs) = +> if x1 == x2 then normC (x2:xs) else x1 : normC (x2:xs) +> normC x = x + +Given a normalization, it can be turned into an +equivalence relation. + +> normToEqRel :: (Eq a) => Norm a -> EqRel a +> normToEqRel f a b = f a == f b + +> oEq, pEq, tEq, opEq, ptEq, opcEq :: EqRel AbsChord +> [oEq, pEq, tEq, opEq, ptEq, otEq, opcEq] = +> map normToEqRel [normO, normT, normP, normOP, normPT, normOT, normOPC] + +Old version of optEq that checks all octave stacks: + +> optEq' :: EqRel AbsChord +> optEq' a b = +> let (a', b') = (normT $ normOP a, normT $ normOP b) +> s = map (normT . normP) $ octStacks b' +> in or (map (==a') s) + +New version that only checks rotations: + +> optEq :: EqRel AbsChord +> optEq a b = +> let n = length b +> (a', b') = (normT $ normOP a, normT $ normOP b) +> is = map (\k -> take k (repeat 1) ++ take (n - k) (repeat 0)) [0..n] +> s = map (normT . normP) $ map (\i -> o i b') is +> in or (map (==a') s) + +> octStacks :: AbsChord -> [AbsChord] +> octStacks x = zipWith o (makeRange $ take (length x) $ repeat (0,1)) (repeat x) + +> normOPT :: Norm AbsChord +> normOPT x = +> let x' = normT $ normOP x +> s = map (normT . normP) $ octStacks x' +> in head $ sort s + +The above can also use "sortBy optComp" instead of "sort" to achieve a +slightly different normalization approach that is more similar to +the fundamental domain for OPT given by Callender et al. + +> optComp a b = +> let (a',b') = (toIntervals a, toIntervals b) +> in if a' == b' then compare a b else compare a' b' + +> toIntervals x = zipWith subtract x (tail x) + +OPTC-equivalence can be implemented similarly to OPT-equivalence. + +> optcEq :: EqRel AbsChord +> optcEq a b = optEq (normOPC a) (normOPC b) + +> normOPTC :: AbsChord -> AbsChord +> normOPTC = normOPT . normOPC +
+ Kulitta/Constraints.lhs view
@@ -0,0 +1,211 @@+Module for musical constraints +Donya Quick +Last modified: 18-Aug-2014 + +> module Kulitta.Constraints where +> import Kulitta.ChordSpaces +> import Data.List +> import System.Random +> import Data.Maybe + +Musical constraints are modeled as predicates over some number of +chords. These are "hard" constraints such that a piece of music +either does or does not satisfy the constraints. + +======== PREDICATES ========= + +First we defint the hProg function that turns a pairwise predicate +into a progression predicate. + +> hProg :: Predicate (a,a) -> Predicate [a] +> hProg f xs = and $ map f $ zip xs $ tail xs + +> foldPreds :: [Predicate a] -> Predicate a +> foldPreds fs xs = and $ map ($xs) fs + +Here we define the notion of voices not crossing to mean that if there +is a permutation that sorts both chords, the voices do not cross. This +allows for voices that may be in unison. + + hNotCross :: Predicate (AbsChord, AbsChord) + hNotCross (c1,c2) = + let ps1 = findAllP c1 (sort c1) -- find permutation, p1, to sort c1 + ps2 = findAllP c2 (sort c2) -- find permutation, p2, to sort c2 + in not $ null [p | p<-ps1, elem p ps2] + +> hNotCross :: Predicate (AbsChord, AbsChord) +> hNotCross (c1,c2) = +> let sn = permutations [0..length c1-1] +> ps1 = filter (\s -> p s c1 == sort c1) sn -- find permutation, p1, to sort c1 +> ps2 = filter (\s -> p s c2 == sort c2) sn -- find permutation, p2, to sort c2 +> in not $ null [p | p<-ps1, elem p ps2] + +Alternatively, we may wish to not allow voices to touch either. If +we know the chords are both sets (no duplicated pitches), then ranks +can be compared. + +> hNotCross' :: Predicate (AbsChord, AbsChord) +> hNotCross' (c1,c2) = rank c1 == rank c2 + + +The function above needs to generate all permutations (as indices) +of a chord. + +> findAllP :: AbsChord -> AbsChord -> [[Int]] +> findAllP c1 c2 = +> let n = length c1 +> f i = filter (\j -> c2 !! j == c1 !! i) [0..n - 1] +> g [] = [[]] +> g (is:t) = [(a:b) | a<-is, b<-g t] +> in filter (\x -> x == nub x) (g $ map f [0..n - 1]) + +> hNotCrossP :: Predicate Prog +> hNotCrossP = hProg hNotCross + +Now we define a predicate for avoiding parallel motion (all voices +moving in the same direction). We will consider parallel motion in +the context of vectors, so this is not the strictest possible case. +We don't care about intervals of 0, since that does not constitute +voice movement. + +> hNotPar1 :: Predicate (AbsChord, AbsChord) +> hNotPar1 (c1, c2) = +> let diffs = zipWith subtract c1 c2 +> in not $ hasDups $ filter (/= 0) diffs + +> hasDups :: (Eq a) => [a] -> Bool +> hasDups [] = False +> hasDups (a:as) = elem a as || hasDups as + +Now we define a stricter version that considers parallel motion +in MULTISETS rather than vectors. On more than 2 voices, this +will become rather hard to satisfy unless the chords are +quite strange. + +> hNotParStrict1 :: Predicate (AbsChord, AbsChord) +> hNotParStrict1 (c1,c2) = hNotPar1 (sort c1, sort c2) + +And finally, progression level predicates of each. + +> hNotPar2, hNotParStrict2 :: Predicate Prog +> hNotPar2 = hProg hNotPar1 +> hNotParStrict2 = hProg hNotParStrict1 + + +And now a "fill in the blanks" predicate. With this predicate, +we can set start and end points, middle points, etc. if we +want them. Of course, there will be no valid solutions unless we +pick points within the intended quotient space. + +> fillBlanks :: [Maybe AbsChord] -> Predicate Prog +> fillBlanks (m:ms) (p:ps) = +> case m of Just c -> p == c && fillBlanks ms ps +> Nothing -> fillBlanks ms ps +> fillBlanks [] [] = True +> fillBlanks _ _ = False + + +Now some distance metric-type approaches. + +> type DistMeasure = AbsChord -> AbsChord -> Double +> type Threshold = Double + +> simpleDist, eucDist, maxDist :: DistMeasure +> simpleDist a b = fromIntegral $ sum $ map abs $ zipWith subtract a b +> eucDist a b = sqrt $ sum $ map fromIntegral $ zipWith subtract a b +> maxDist a b = fromIntegral $ maximum $ map abs $ zipWith subtract a b + +> distClass :: DistMeasure -> Predicate Double -> Predicate (AbsChord, AbsChord) +> distClass d ft (x,y) = ft $ d x y + +> simpleClass t = distClass simpleDist (<=t) +> eucClass t = distClass eucDist (<=t) +> maxClass t = distClass maxDist (<=t) + +> noCPL :: Double -> Predicate (AbsChord, AbsChord) +> noCPL i x = maxClass i x && hNotPar1 x && hNotCross x + +> noCL :: Double -> Predicate (AbsChord, AbsChord) +> noCL i x = maxClass i x && hNotCross x + +> progL t = hProg (maxClass t) + + +=========================== + +Contour equivalence + +> rank :: [PitchNum] -> [Int] +> rank xs = +> let vals = sort $ nub xs +> ranks = zip vals [0..length vals - 1] +> in map (\x -> fromJust $ lookup x ranks) xs + + + +============================ + +ADDITIONAL THESIS PREDICATES + +--- Single chords --- + +> sorted :: Predicate AbsChord +> sorted x = x == sort x + +> spaced :: [(Int, Int)] -> Predicate AbsChord +> spaced lims x = and $ +> zipWith (\(l,u) diff -> l <= diff && diff <= u) lims $ +> zipWith subtract x (tail x) + +> triads :: [AbsChord] +> triads = [[0,0,4,7], [0,4,7,7], [0,0,3,7], [0,3,7,7], [0,0,3,6]] + +> doubled :: [AbsChord] -> Predicate AbsChord +> doubled templates x = elem (normOP x) allTriads where +> allTriads = concatMap (\c -> map (normOP . t c) templates) [0..11] + +> satbFilter x = and $ map ($x) [sorted, spaced satbLimits, doubled triads] +> satbFilter2 x = and $ map ($x) [sorted, spaced satbLimits] +> satbLimits = repeat (3,12) +> satbRanges = [(40,60), (47,67), (52,76), (60,81)] +> satbChords = filter satbFilter (makeRange satbRanges) + +> satbOP :: QSpace AbsChord +> satbOP = satbChords // opEq where + +> satbOP' :: StdGen -> QSpace AbsChord +> satbOP' g = randomize g satbChords // opEq where + +> satbR :: StdGen -> Predicate AbsChord -> EqRel AbsChord -> QSpace AbsChord +> satbR g f r = randomize g (filter f $ makeRange satbRanges) // r + +> pianoChord :: Predicate AbsChord +> pianoChord x = length x <= 5 && maximum x - minimum x <= 12 + +--- Pairs --- + +> notParallel :: Predicate (AbsChord, AbsChord) +> notParallel (x,y) = let diff = zipWith subtract x y in nub diff == diff + +> voiceLeading :: [Predicate (PitchNum, PitchNum)] -> Predicate (AbsChord, AbsChord) +> voiceLeading preds (x,y) = and $ zipWith ($) preds $ zip x y + + +> vl7 :: Predicate (AbsChord, AbsChord) +> vl7 = voiceLeading (repeat f) where f (a,b) = abs(a - b) <= 7 + +Note: the version of noCrossing below assumes that voices cannot overlap. +In other words, the pitches must all be unique. + +> noCrossing :: Predicate (AbsChord, AbsChord) +> noCrossing (x,y) = rank x == rank y + +> pairProg2 :: (Eq a, Show a) => QSpace a -> EqRel a -> Predicate (a,a) -> [a] -> [[a]] +> pairProg2 qs r c [] = [[]] +> pairProg2 qs r c (x:xs) = +> let newSolns = [(y:ys) | y<-eqClass qs r x, ys<-pairProg2 qs r c xs, c (y, head ys)] +> in if not $ null newSolns then newSolns +> else error "No solutions that satisfy the consraints!" + + +===============
+ Kulitta/EuterpeaSpecial.lhs view
@@ -0,0 +1,10 @@+Euterpea import module +No new definitions - just to avoid naming conflicts with Kulitta +for small features like type synonyms that do not warrant importing +Euterpea to use. + +> module Kulitta.EuterpeaSpecial (module Euterpea) where +> import Euterpea hiding (C, D, P, Phrase, wn, hn, qn, en, sn, tn, +> Major, Minor, Mode, Ionian, Dorian, Phrygian, Lydian, Mixolydian, Minor, Locrian, +> Dur, dur, MP, key, mode, +> AbsPitch)
+ Kulitta/Foregrounds.lhs view
@@ -0,0 +1,9 @@+> module Kulitta.Foregrounds( +> module Kulitta.Foregrounds.ClassicalFG, +> module Kulitta.Foregrounds.JazzFG, +> module Kulitta.Foregrounds.SimplePianoFG +> ) where + +> import Kulitta.Foregrounds.ClassicalFG +> import Kulitta.Foregrounds.JazzFG +> import Kulitta.Foregrounds.SimplePianoFG
+ Kulitta/Foregrounds/ClassicalFG.lhs view
@@ -0,0 +1,261 @@+Classical Foreground Module +Donya Quick + +For doctoral thesis. Based on work from 690/691 (Master's thesis): +http://haskell.cs.yale.edu/?post_type=publication&p=260 + +Last modified 19-Dec-2014 + + +> module Kulitta.Foregrounds.ClassicalFG where +> import Kulitta.PTGG +> import Kulitta.Grammars.MusicGrammars +> import System.Random +> import Kulitta.EuterpeaSpecial +> import Kulitta.ChordSpaces hiding (i) +> import Kulitta.PostProc +> import Data.List +> import Kulitta.Search +> import Kulitta.Constraints + + +> data CConstants = CConstants { +> ntLimC :: Int, -- limit for neighboring tone distance +> ptLimC :: Int, -- limit for passing tone distance +> pHalfC :: Double, -- probability of dividing a note's duration in half (alternative is x-en and en) +> pTieC :: Double, -- probability of tying two identical notes +> rootBassThreshC :: Double, -- probability of enforcing that the bass be the root +> noCPLThreshC :: Int } -- voice-leading maximum, setting to 0 forces nearest neighbor fallback + +A set of default constants that work pretty well in most cases. + +> defConsts = CConstants 2 3 0.5 0.5 0.8 7 + + + +Get all pitches shared between the scales of two TNotes + +> allPs :: TNote -> TNote -> [AbsPitch] +> allPs t1 t2 = +> let (o1, o2) = (tnP t1 `div` 12, tnP t2 `div` 12) +> [oMin, oMax] = sort [o1, o2] +> offs = map (12*) [oMin-1, oMin, oMax, oMax+1] +> (s1, s2) = (baseScale $ tnK t1, baseScale $ tnK t2) +> in nub $ concatMap (\o -> t o [s | s<-s1, elem s s2]) offs where +> baseScale :: Key -> [AbsPitch] +> baseScale (k,m) = normOP $ t k (getScale m) + +A foreground function, ForeFun, is a stochastic operation on two notes that +may or may not add an additional pitch between them. Duration selection +happens as a second step later since it involves altering the durations of +the surrounding notes. + +> type ForeFun = StdGen -> TNote -> TNote -> (StdGen, Maybe AbsPitch) + +A passing tone is a note between two chodal tones. Here, the definition is a +litle broader than what would be assumed in standard music theory since the +chordal tones need not be close together. As a result, the "passing tones" +chosen by pickPT below may end up being other categories of non-chordal +tones in music theory. + +> pickPT :: AbsPitch -> ForeFun +> pickPT lim g t1 t2 = +> let [pMin, pMax] = sort [tnP t1, tnP t2] +> f x = x>pMin && x<pMax && (x - pMin <=lim || pMax - x <=lim) +> ps' = [x | x<-allPs t1 t2, f x] +> (iNew, g') = randomR (0, length ps' - 1) g +> in if pMin == pMax || null ps' then (g, Nothing) +> else (g', Just $ ps' !! iNew) + +Neighboring tones are handled similarly to passing tones. Again, the +definition here is fairly broad and may produce other categorie of non- +chordal tones as a result. + +> pickNT :: AbsPitch -> ForeFun +> pickNT lim g t1 t2 = +> let [pMin, pMax] = sort [tnP t1, tnP t2] +> f x = (x < pMin && pMin - x <= lim) || (x > pMax && x - pMax <= lim) +> ps' = [x | x<-allPs t1 t2, f x] +> (iNew, g') = randomR (0, length ps' - 1) g +> in if pMin == pMax || null ps' then (g, Nothing) +> else (g', Just $ ps' !! iNew) + +Functions for adding anticipations and repetitions are simple to define. +A "do nothing" operations is also a useful option to have. + +> anticip, rept, doNothing :: ForeFun +> anticip g t1 t2 = (g, Just $ tnP t2) +> rept g t1 t2 = (g, Just $ tnP t1) +> doNothing g t1 t2 = (g, Nothing) + +Some of the functions above need access to constants. We use the +CConstants type for this, yielding a collection of functions of +type CConstants -> ForeFun. Finally, these are each bundled with +a probability of application for each voice. + +> f1 = pickPT . ptLimC +> f2 = pickNT . ntLimC +> [f3, f4, f5] = map const [anticip, rept, doNothing] + +> allFFs :: CConstants -> [[(Double, ForeFun)]] +> allFFs c = +> [[(0.3, f1 c), (0.1, f2 c), (0.6, f5 c)], -- S (sopranno) +> [(0.3, f1 c), (0.7, f5 c)], -- A (alto) +> [(0.1, f1 c), (0.9, f5 c)]] -- T (tennor) +> ++ repeat [(1.0, f5 c)] -- B (bass) and lower + +> splitP :: CConstants -> StdGen -> AbsPitch -> TNote -> (StdGen, [TNote]) +> splitP consts g newP t = +> let (r, g') = randomR (0,1.0::Double) g +> dNew = if r < pHalfC consts then tnD t / 2 else en +> in (g', [(tnK t, tnD t - dNew, tnP t), (tnK t, dNew, newP)]) + +Here we assume that the contexts include the voice in question. The |i| argument is the voice number. +The function only returns modifications of the first chord. + +> addFgToVoice :: CConstants -> [(Double, ForeFun)] -> StdGen -> [TNote] -> (StdGen, [TNote]) +> addFgToVoice c foreFuns g (t1:t2:ts) = +> let (j, g1) = randomR (0, 1.0) g +> fFun = chooseFF j foreFuns +> (g2, t1') = applyForeFun c g1 t1 t2 fFun +> (g3, tRest) = addFgToVoice c foreFuns g2 (t2:ts) +> in (g3, t1' ++ tRest) where +> chooseFF j [x] = snd x +> chooseFF j ((p,x):t) = if j<p then x else chooseFF (j-p) t +> chooseFF j [] = error "(chooseFF) Nothing to choose from!" +> applyForeFun c g t1 t2 fFun = +> let (g1, newP) = fFun g t1 t2 +> in case newP of Nothing -> (g1, [t1]) +> Just x -> splitP c g1 x t1 +> addFgToVoice c foreFuns g x = (g, x) + +After adding foreground elements, ties can be considered. The following |stochTie| +function stochastically ties notes in a voice. + +> stochTie :: CConstants -> StdGen -> [TNote] -> (StdGen, [TNote]) +> stochTie consts g (t1:t2:ts) = +> let (r, g1) = randomR (0, 1.0::Double) g +> (g2, (t2':ts')) = stochTie consts g1 (t2:ts) +> (d1,d2') = (tnD t1, tnD t2') +> in if tnP t1 == tnP t2' && r < pTieC consts +> then (g2, (tnK t1, d1+d2', tnP t1):ts') +> else (g2, t1 : t2' : ts') +> stochTie consts g ts = (g, ts) + +Finally, the |addFG| function puts all of these elements together. + +> addFG :: CConstants -> StdGen -> [[TNote]] -> (StdGen, [[TNote]]) +> addFG c g vs = let (g', vs') = fgRec c g 0 vs in tieRec c g' vs' where +> fgRec c g i vs = if i >= length vs || i<0 then (g, vs) else +> let (g', v') = addFgToVoice c (allFFs c !! i) g (vs !! i) +> vs' = take i vs ++ [v'] ++ drop (i+1) vs +> in fgRec c g' (i+1) vs' +> tieRec c g [] = (g, []) +> tieRec c g (v:vs) = +> let (g1,v') = stochTie c g v +> (g2,vs') = tieRec c g1 vs +> in (g2, v':vs') + +============================================= + +There are two steps to adding a classical foreground: +1. Traversing an appropriate chord space. +2. Adding foreground elements. + +These steps are separated and presented with different type interfaces. +From a Term CType, a classical foreground can be added by using just the +classicalFG function. + +> classicalFG :: StdGen -> Sentence CType MP -> (StdGen, (Music Pitch, Music Pitch)) +> classicalFG g t = +> let consts = sort $ findInds [] t +> rChords = toChords (expand [] t) +> in classicalFGR g rChords consts + +However, there are some instances where more control is desirable, such as +if we are working with Let statments or perhaps want to supply a progression +manually rather than using Term. The following functions allow adding a +foreground to different intermediate types. + +> classicalFGR :: StdGen -> [RChord] -> Constraints -> (StdGen, (Music Pitch, Music Pitch)) +> classicalFGR g rcs consts = +> let (g1, csChords) = classicalCS g rcs consts +> in classicalFG' g1 csChords + +> classicalFG' :: StdGen -> [TChord] -> (StdGen, (Music Pitch, Music Pitch)) +> classicalFG' g aChords' = +> let (g4,csFG) = addFG defConsts g $ reverse $ toVoices aChords' +> is = [Bassoon, EnglishHorn, Clarinet, Oboe, SopranoSax] +> fgM = vsToMusicI is $ reverse csFG +> csM = vsToMusicI is $ toVoices aChords' +> in (g4, (csM, fgM)) + +Similarly, there are instances when we may want to use a classical chord space, but +not add a classical foreground. This can be useful for mixing styles. + +> classicalCS :: StdGen -> [RChord] -> Constraints -> (StdGen, [TChord]) +> classicalCS g rcs consts = +> classicalCS2 g (map toAbsChord rcs) consts + +> classicalCS2 :: StdGen -> [TChord] -> Constraints -> (StdGen, [TChord]) +> classicalCS2 g aChords consts = +> let justChords = map (\(a,b,c) -> c) aChords +> (g1,g2) = split g +> (g3, eqs) = classBass 0.8 g2 $ map (eqClass satbOP opcEq) justChords +> csChords = greedyLet (noCPL 7) nearFall consts eqs g3 +> aChords' = zipWith (\(a,b,c) d -> (a,b,d)) aChords csChords +> in (g3, aChords') + +> classicalCS2' :: Predicate AbsChord -> [(AbsPitch, AbsPitch)] -> StdGen -> [TChord] -> Constraints -> (StdGen, [TChord]) +> classicalCS2' fFilter ranges g aChords consts = +> let justChords = map (\(a,b,c) -> c) aChords +> (g1,g2) = split g +> satbOPx = filter fFilter (makeRange ranges) // opcEq +> (g3, eqs) = classBass 0.8 g2 $ map (eqClass satbOPx opcEq) justChords +> csChords = greedyLet (noCPL 7) nearFall consts eqs g3 +> aChords' = zipWith (\(a,b,c) d -> (a,b,d)) aChords csChords +> in (g3, aChords') + + +The classicalCS2 function uses a stochastic filter over equivalence classes. +This filter enforces that the bass holds the root with a certain probability +(the "thresh" value). If the constraints can't be met, the bass is allowed +to deviate from this rule for the sake of producing a result. + +> classBass :: Double -> StdGen -> [EqClass AbsChord] -> (StdGen, [EqClass AbsChord]) +> classBass thresh g [] = (g, []) +> classBass thresh g (e:es) = +> let (r,g') = randomR (0,1.0::Double) g +> e' = if r > thresh then e else filter rootFilter e +> e'' = if null e' then e else e' +> (g'', es') = classBass thresh g es +> in (g'', e'':es') where +> rootFilter :: Predicate AbsChord +> rootFilter x = or $ map (opcEq x) [[0,0,4,7], [0,0,3,7], [0,0,3,6]] + + +The code so far has only made use of the greedy approaches to constraint +satisfaction. As an alternative, the following version handles constraint +satisfaction differently. Two MIDI files are produced, one without melodic +elements and one with them. There are definite pros and cons to this +constraint satisfaction approach. + Pros: all constraints will be 100% satisfied if a solution is found. + Cons: existence of a solution is not guaranteed and the runtime will be + quite long if solutions are sparse. + +> classicalFG2 :: StdGen -> Sentence CType MP -> FilePath -> FilePath -> IO () +> classicalFG2 g t fn1 fn2 = do +> let aChords = toAbsChords (expand [] t) +> justChords = map (\(a,b,c) -> c) aChords +> (g1,g2) = split g +> qSpace = satbOP' g1 +> ecs = map (eqClass qSpace opcEq) justChords +> cons = findInds [] t +> (x, csChords) <- findSoln2 cons (progL 10) ecs +> let aChords' = zipWith (\(a,b,c) d -> (a,b,d)) aChords csChords +> (g4,csFG) = addFG defConsts g2 $ reverse $ toVoices aChords' +> is = [Bassoon, EnglishHorn, Clarinet, Oboe] +> fgM = vsToMusicI is $ reverse csFG +> csM = vsToMusicI is $ toVoices aChords' +> writeMidi fn1 fgM +> writeMidi fn2 csM
+ Kulitta/Foregrounds/JazzFG.lhs view
@@ -0,0 +1,217 @@+Simple Jazz Foreground Algorithms +Donya Quick + +Last Modified: 15-Oct-2015 + +Last updates: +- added support for more modes + +> module Kulitta.Foregrounds.JazzFG where +> import Kulitta.PTGG +> import Kulitta.Grammars.MusicGrammars +> import System.Random +> import Kulitta.EuterpeaSpecial +> import Kulitta.ChordSpaces +> import Kulitta.PostProc +> import Data.List +> import Control.Parallel.Strategies +> import Kulitta.Foregrounds.ClassicalFG +> import Kulitta.Search +> import Kulitta.Constraints + + + +First, we need to find the modes for Roman numerals interpreted +in a particular key/mode. The type JTriple is actually a synonym +for TChord, but it is used for clarity to indicate that the pitch +information represents a mode rather than a chord. + +> rotateModes i = drop i allModes ++ (take i allModes) + +> majorModes = allModes +> ionianModes = majorModes -- synonym +> dorianModes = rotateModes 1 +> phrygianModes = rotateModes 2 +> lydianModes = rotateModes 3 +> mixolydianModes = rotateModes 4 +> minorModes = rotateModes 5 +> aoleanModes = minorModes -- synonym +> locrianModes = rotateModes 6 + +> modeLookup Major = majorModes +> modeLookup Dorian = dorianModes +> modeLookup Phrygian = phrygianModes +> modeLookup Lydian = lydianModes +> modeLookup Mixolydian = mixolydianModes +> modeLookup Minor = minorModes +> modeLookup Locrian = locrianModes + +> chordMode :: CType -> Key -> AbsMode +> chordMode ct (k,m) = +> let pModes = modeLookup m -- what pattern of modes for each scale degree? +> ctMode = pModes !! fromEnum ct -- pick the mode for the Roman numeral +> ck = pModes !! 0 !! fromEnum ct -- pick the pitch offset for the Roman numeral +> in t (k+ck) ctMode -- transposition op and convert numeral to modal pitches + +> toJTriple :: (Key, Dur, CType) -> (Key, Dur, AbsMode) +> toJTriple (km,d,c) = (km, d, chordMode c km) + +============================ + +> jazzChords :: StdGen -> [(Key, Dur, CType)] -> Constraints -> (StdGen, [(Key, Dur, AbsChord)]) +> jazzChords g chords consts = +> let [gJ, gOPC, g'] = take 3 $ splitN g +> jts = map toJTriple chords +> ms = map (\(a,b,c) -> ([],c)) jts -- get just modes as JChords +> qJ = modeSpace' alg1Temps -- subset of ModeSpace desired +> chordsJ = greedyLet (const True) nearFallJ consts (map (eqClass qJ modeEq) ms) gJ -- random walk through qj +> qOPC = makeRange' alg1Rans // opcEq -- subset of OPC-space desired +> es = map (convOPC qOPC bassRoot) chordsJ -- OPC equivalence classes for chords +> chordsOPC = greedyProg' (const True) nearFall gOPC es -- random walk through OPC-space +> chordsOPC' = zipWith newP jts chordsOPC -- tag with dur & mode +> in (g', chordsOPC') + +============================ + +Algorithm 1: chords and a stochastic bass. Let instantiation only takes +place at the level of Roman numerals. + +> -- r t f 7 r 2 t f 7 r=root, r=third, f=fifth +> alg1Temps = [[0,2,4,6], [0,1,2,4,6]] + +> -- bass chords +> alg1Rans = (34,45) : take 4 (repeat (50,64)) + +> bassRoot (chrd, m) = (minimum chrd `mod` 12) == head (normO m) + +> jazzFG1 :: StdGen -> [(Key, Dur, CType)] -> Constraints -> (StdGen, Music Pitch) +> jazzFG1 g chords consts = +> let [gJ, gR, gOPC, gB] = take 4 $ splitN g +> jts = map toJTriple chords +> ms = map (\(a,b,c) -> ([],c)) jts -- get just modes as JChords +> qJ = modeSpace' alg1Temps -- subset of ModeSpace desired +> chordsJ = greedyLet (const True) nearFallJ consts (map (eqClass qJ modeEq) ms) gJ +> -- greedyProg qJ modeEq (const True) nearFallJ gJ ms -- random walk through qj +> qOPC = makeRange' alg1Rans // opcEq -- subset of OPC-space desired +> es = map (convOPC qOPC bassRoot) chordsJ -- OPC equivalence classes for chords +> chordsOPC = greedyProg' (const True) nearFall gOPC es -- random walk through OPC-space +> chordsOPC' = zipWith newP jts chordsOPC -- tag with dur & mode +> voices = toVoices chordsOPC' -- place in voice format +> (gRet, bassLine) = stochBass gB $ head voices -- stochastic bassline +> in (gRet, instrument AcousticBass bassLine :=: +> vsToMusicI (repeat AcousticGrandPiano) (tail voices)) + +> splitN g = let (g1,g2) = split g in g1 : splitN g2 + +Direct interface to grammar monad: + +> jazzFG1T :: StdGen -> Sentence CType MP -> Constraints -> (StdGen, Music Pitch) +> jazzFG1T g t consts = jazzFG1 g (toChords $ expand [] t) consts + +> convOPC :: QSpace AbsChord -> Predicate JChord -> JChord -> EqClass AbsChord +> convOPC q pj (c,m) = filter (\x -> pj (x,m)) $ eqClass q opcEq c + +> stochBass :: StdGen -> [TNote] -> (StdGen, Music Pitch) +> stochBass g [] = (g, rest 0) +> stochBass g ((km,d,p):t) = +> let (g', pat) = pickPattern g d p +> (g'', t') = stochBass g' t +> in (g'', pat :+: t') + +> pickPattern g d p = +> let (r,g') = randomR (0,length pats - 1) g +> f d p = note d (pitch p) +> pats = [f d p, +> if d>=hn then f qn p :+: f (d-qn) p else f d p, +> if d>=hn then f (d-en) p :+: f en p else f d p] +> in (g', pats !! r) + + +============================= + +Algorithm 2: simple bossa nova + +This approach interprets Roman numerals through three separate +chord spaces in order to cut down the task's combinatorics. + +> alg2TempsC = [[0,2,4,6], [1,2,4,6]] -- for chords +> alg2TempsB = [[0,4]] -- for bass +> alg2TempsL = [[0],[2],[4]] -- for lead + +> alg2RansB = [(34,49), (34,49)] +> alg2RansC = take 4 $ repeat (50,64) +> alg2RansL = [(65,80)] + +> bassRoot2 ([b1,b2], m) = normO [b1,b2] == normO [m !! 0, m!! 4] +> bassRoot2 _ = error "(bassRoot2) Bad arguments." + +> alg2FilterC x = sorted x && pianoChord x + +> jazzFG2 :: StdGen -> [(Key, Dur, CType)] -> Constraints -> (StdGen, Music (Pitch, Volume)) +> jazzFG2 g chords consts = +> let gs@[gJC, gJB, gJL, gRC, gRB, gRL, gOPC_C, gOPC_B, gOPC_L, gL] = take 10 $ splitN g +> jts = map toJTriple chords +> ms = map (\(a,b,c) -> ([],c)) jts +> qs@[qJC, qJB, qJL] = map modeSpace' [alg2TempsC, alg2TempsB, alg2TempsL] -- jazz spaces +> [chordsJ, bassJ, leadJ] = -- random walk for chords +> zipWith (\q gx -> greedyProg q modeEq (const True) nearFallJ gx ms) qs $ +> take 3 gs +> qOPC_C = filter alg2FilterC (makeRange' alg2RansC) // opcEq +> qOPC_B = makeRange alg2RansB // opcEq +> qOPC_L = makeRange' alg2RansL // opcEq +> esC = map (convOPC qOPC_C (const True)) chordsJ -- OPC equivalence classes for chords +> esB = map (convOPC qOPC_B bassRoot2) bassJ +> esL = map (convOPC qOPC_L (const True)) leadJ +> chordsOPC = greedyLet (const True) nearFall consts esC gOPC_C -- random walk through OPC-space +> bassOPC = greedyLet (noCPL 7) nearFall consts esB gOPC_B -- random walk for bass +> leadOPC = greedyLet (noCPL 7) nearFall consts esL gOPC_L -- random walk for lead +> [cc, bc, lc] = map (zipWith newP jts) [chordsOPC, bassOPC, leadOPC] -- tag with dur & mode +> cm = bossaChords cc +> bm = bossaBass bc +> (gRet, lm) = bossaLead gL lc +> in (gRet, chord [addVolume 127 $ instrument AcousticBass bm, +> addVolume 75 $ instrument AcousticGrandPiano cm, +> addVolume 127 $ instrument Flute lm]) + +> jazzFG2T :: StdGen -> Sentence CType MP -> Constraints -> (StdGen, Music (Pitch, Volume)) +> jazzFG2T g t consts = jazzFG2 g (toChords $ expand [] t) consts + +> bossaBass :: [TChord] -> Music Pitch +> bossaBass [] = rest 0 +> bossaBass ((km,d,c@[p1,p2]):t) = +> if d > wn then bossaBass ((km,wn,c):(km,d-wn,c):t) else +> if d == wn then f1 p1 p2 :+: bossaBass t else +> if d == hn then f2 p1 p2 :+: bossaBass t else f3 p1 d :+: bossaBass t where +> f1 b1 b2 = f2 b1 b2 :+: f2 b2 b1 +> f2 b1 b2 = f3 b1 (qn+en) :+: f3 b2 en +> f3 b1 d = note d (pitch b1) +> bossaBass _ = error "(bossaBass) Bad input" + +> bossaChords :: [TChord] -> Music Pitch +> bossaChords [] = rest 0 +> bossaChords ((km,d,c):t) = +> if d > wn then bossaChords ((km,wn,c):(km,d-wn,c):t) else +> if d==wn then f1 c :+: bossaChords t else f2 d c :+: bossaChords t where +> f1 c = let c' = f2 en c in rest qn :+: c' :+: rest qn :+: c' :+: rest qn +> f2 d c = chord $ map (\p -> note d $ pitch p) c + +> bossaLead :: StdGen -> [TChord] -> (StdGen, Music Pitch) +> bossaLead g ts = +> let ls = take (length ts - 1) (repeat False) ++ [True] +> v = head $ toVoices ts +> (g', v') = addFgToVoice jConsts (foreFunsJ defConsts) g v +> in (g', vsToMusic [v']) where +> foreFunsJ c = [(0.5, f1 c), (0.5, f2 c)] :: [(Double, ForeFun)] +> jConsts = CConstants 2 3 0.3 0.5 0.8 7 + + +====================== + +Redefinition of nearest neighbor for modal chords: + +> nearFallJ :: EqClass JChord -> StdGen -> JChord -> (StdGen, JChord) +> nearFallJ e g (x,m) = +> let ds = map (simpleDist x) (map fst e) :: [Double] +> y = e !! (head $ findIndices (==minimum ds) ds) +> in (g, y) +
+ Kulitta/Foregrounds/SimplePianoFG.lhs view
@@ -0,0 +1,309 @@+> module Kulitta.Foregrounds.SimplePianoFG( +> simplePianoFG1, +> simplePianoFG1x, +> simplePianoFGMel, +> simplePianoFGMelx, +> simplePianoFGArp, +> simplePianoFGArpx +> ) where +> import Kulitta + +> import Data.List +> import System.Random +> import Kulitta.EuterpeaSpecial +> import Kulitta.Grammars.MusicGrammars +> import Kulitta.Foregrounds.ClassicalFG +> import Kulitta.ChordSpaces + +First, a chorale-like style, but playable on piano. + +> smallRange = [absPitch (G,2)..absPitch (G,5)] + + + +> smallSpace = makeRange2' $ take 4 $ repeat smallRange + +> okSpacing1 [l1,l2,r1,r2] = l2 - l1 <= 12 && r2-r1 <= 12 + +> makeRange2' :: [[PitchNum]] -> [AbsChord] +> makeRange2' = foldr (\lu xs -> [(a:b) | a<-lu, b<-xs, psort (a:b)]) [[]] where +> psort (a:b:t) = a<b +> psort _ = True + +> isDim = optcEq [0,3,6] -- for locating diminished triads + +> lhTemps = [[0,2,4], [0,4]] +> rhTemps = [[0,2,4], [0,3], [0,5]] + +classicalCS2 :: StdGen -> [TChord] -> Constraints -> (StdGen, [TChord]) +classicalCS2' fFilter ranges g aChords consts + +> simplePianoFG1 :: Sentence CType MP -> StdGen -> (Music Pitch, Music Pitch) +> simplePianoFG1 terms g0 = +> let k = findInds [] terms -- determine what Let constraints exist +> triads = toAbsChords terms +> lr = (43, 60) -- where the left hand can play +> rr = (60, 79) -- where the right hand can play +> rans = [lr, lr, rr, rr] -- ranges for each of 4 voices +> pianoFilter [a,b,c,d] = b-a <= 12 && d - c <= 8 +> (g1, newChords) = classicalCS2x pianoFilter rans g0 triads k +> (g2, (lhM, rhM)) = classicalFGx g1 newChords +> in (lhM, rhM) + +> simplePianoFG1x :: [TChord] -> StdGen -> Constraints -> (Music Pitch, Music Pitch) +> simplePianoFG1x triads g0 k = +> let lr = (43, 60) -- where the left hand can play +> rr = (60, 79) -- where the right hand can play +> rans = [lr, lr, rr, rr] -- ranges for each of 4 voices +> pianoFilter [a,b,c,d] = b-a <= 12 && d - c <= 8 +> (g1, newChords) = classicalCS2x pianoFilter rans g0 triads k +> (g2, (lhM, rhM)) = classicalFGx g1 newChords +> in (lhM, rhM) + +Modification of the classical foreground code to address piano playability. + +> classicalCS2x :: Predicate AbsChord -> [(AbsPitch, AbsPitch)] -> StdGen -> [TChord] -> Constraints -> (StdGen, [TChord]) +> classicalCS2x fFilter ranges g aChords consts = +> let justChords = map (\(a,b,c) -> c) aChords +> (g1,g2) = split g +> satbOPx = filter fFilter (makeRange' ranges) // opcEq +> (g3, eqs) = classBass 1.0 g2 $ map (eqClass satbOPx opcEq) justChords +> csChords = greedyLet (noCPL 7) nearFall consts eqs g3 +> aChords' = zipWith (\(a,b,c) d -> (a,b,d)) aChords csChords +> in (g3, aChords') + +> classicalFGx :: StdGen -> [TChord] -> (StdGen, (Music Pitch, Music Pitch)) +> classicalFGx g aChords' = +> let vs = toVoices aChords' +> (g1,csFG) = addFG defConsts{rootBassThreshC=1.0} g [vs !! 3] +> (g2,csFG2) = addFG defConsts{rootBassThreshC=1.0} g1 [vs !! 0] +> rh = csFG ++ [vs !! 2] +> lh = [vs !! 1] ++ csFG2 +> in if length vs == 4 then (g2, (vsToMusic lh, vsToMusic rh)) +> else error "classicalFGx only works on chords with 4 voices" + +> tieLast2 xs@(v1:v2:v3) = +> let ((k,d,a):(k',d',a'):t) = reverse xs +> in if a==a' then reverse ((k,d+d',a):t) else xs +> tieLast2 xs = xs + + +=================================== + +Scale-based piano pieces with a simple right and left hand. + +> simplePianoFGMel :: Sentence CType MP -> StdGen -> (StdGen, (Music Pitch, Music Pitch)) +> simplePianoFGMel terms g0 = +> let aChords = toAbsChords terms -- convert to basic triads +> k = findInds [] terms -- find let constraints +> (g1, lhPCs) = simpleLH g0 aChords -- simplify lefthand pitch classes +> lhSpace = filter (\[a,b] -> b-a <= 12 && a<=b) (makeRange [(40,59),(40,59)]) // opcEq +> eqsL = map (eqClass lhSpace opcEq) lhPCs -- locate lefthand equivalence classes +> (g2,g3) = split g1 -- get new generators +> lhChords = greedyLet (const True) defFall k eqsL g2 -- lefthand chords in OPC space +> lhTChords = zipWith (\(k,d,_) x -> (k,d,x)) aChords lhChords -- reattach durations +> (g4, lh) = lhFG g3 lhTChords -- create lefthand foreground +> ---- +> (g5, rhPCs) = simpleRH g4 aChords -- simplify righthand pitch classes +> rhSpace = (filter (\xs -> maximum xs - minimum xs <= 9) (makeRange [(60,80),(60,80)]) // opcEq) ++ +> (map (\x -> [[x]]) [60..80]) +> eqsR = map (eqClass rhSpace opEq) rhPCs -- locate righthand equivalence classes +> (g6,g7) = split g5 -- split generator again +> rhChords = greedyLet (smoothMel 4) nearestMel k eqsR g6 -- pick righthand chords in OPC space +> rhTChords = zipWith (\(k,d,_) x -> (k,d,x)) aChords rhChords -- reattach durations +> (g8, rh) = rhFG g7 rhTChords -- create scale patterns with passing/neighboring tones +> in (g8, (lh, rh)) -- return each hand's part as a separate music value + +> simplePianoFGMelx :: [TChord] -> StdGen -> Constraints -> (StdGen, (Music Pitch, Music Pitch)) +> simplePianoFGMelx aChords g0 k = +> let (g1, lhPCs) = simpleLH g0 aChords -- simplify lefthand pitch classes +> lhSpace = filter (\[a,b] -> b-a <= 12 && a<=b) (makeRange [(40,59),(40,59)]) // opcEq +> eqsL = map (eqClass lhSpace opcEq) lhPCs -- locate lefthand equivalence classes +> (g2,g3) = split g1 -- get new generators +> lhChords = greedyLet (const True) defFall k eqsL g2 -- lefthand chords in OPC space +> lhTChords = zipWith (\(k,d,_) x -> (k,d,x)) aChords lhChords -- reattach durations +> (g4, lh) = lhFG g3 lhTChords -- create lefthand foreground +> ---- +> (g5, rhPCs) = simpleRH g4 aChords -- simplify righthand pitch classes +> rhSpace = (filter (\xs -> maximum xs - minimum xs <= 9) (makeRange [(60,80),(60,80)]) // opcEq) ++ +> (map (\x -> [[x]]) [60..80]) +> eqsR = map (eqClass rhSpace opEq) rhPCs -- locate righthand equivalence classes +> (g6,g7) = split g5 -- split generator again +> rhChords = greedyLet (smoothMel 4) nearestMel k eqsR g6 -- pick righthand chords in OPC space +> rhTChords = zipWith (\(k,d,_) x -> (k,d,x)) aChords rhChords -- reattach durations +> (g8, rh) = rhFG g7 rhTChords -- create scale patterns with passing/neighboring tones +> in (g8, (lh, rh)) -- return each hand's part as a separate music value + +> simpleLH :: StdGen -> [TChord] -> (StdGen, [AbsChord]) +> simpleLH g [] = (g, []) +> simpleLH g [(k,d,[r,t,f])] = +> let (g', x) = choose g [[r,f]] -- , [r,f]] +> in (g', [x]) +> simpleLH g ((k,d,[r,t,f]):xs) = +> let (g', x') = choose g [[r,t], [r,f]] -- [r,t], [r,f]] +> (g'', xs') = simpleLH g' xs +> in (g'', x':xs') +> simpleLH g _ = error "simpleLH only works on 3 note combinations" + +> simpleRH :: StdGen -> [TChord] -> (StdGen, [AbsChord]) +> simpleRH g [] = (g, []) +> simpleRH g [(k,d,[r,t,f])] = -- last one, pick either a root or third +> let (g', x') = choose g [[r], [t]] +> in (g', [x']) +> simpleRH g ((k,d,[r,t,f]):xs) = +> let (g', x') = choose g [[r,t], [t,f]] +> (g'', xs') = simpleRH g' xs +> in (g'', x':xs') +> simpleRH g _ = error "simpleRH only works on 3 note combinations" + +> lhFG :: StdGen -> [TChord] -> (StdGen, Music Pitch) +> lhFG g [] = (g, rest 0) +> lhFG g [(k,d,c)] = (g, chord $ map (note d . pitch) c) +> lhFG g ((k,d,c):t) = +> let (g', t') = lhFG g t +> (g'', x) = pickPat d c g' +> in (g'', x :+: t') where +> pickPat d [a1,a2] g = +> let [p1,p2] = map pitch [a1,a2] +> (g', x) = choose g [--note d p1 :=: note d p2] --, +> note (d/2) p1 :+: note (d/2) p2, +> note (d/2) p2 :+: note (d/2) p1] +> in (g', x) +> pickPat d x g = error "lhFG only works on 2 note combinations" + + +> rhFG :: StdGen -> [TChord] -> (StdGen, Music Pitch) +> rhFG g chords = +> let v = makeVoice chords +> (g', v') = makeMel g v +> --(g', vs) = addFG defConsts g [v] -- REGULAR CHORALE FG +> -- =================== TO DO: PUT PASSING TONE STUFF HERE ================== +> in (g', vsToMusic [v']) where +> makeVoice [] = [] +> makeVoice ((k,d,[x1]):t) = (k,d,x1) : makeVoice t +> makeVoice ((k,d,[x1,x2]):t) = (k,d/2,x1) : (k,d/2,x2) : makeVoice t +> makeVoice (x:t) = error ("Unsupported structure: "++show x) + +Given a voice, add passing and neighboring tones. + +> makeMel :: StdGen -> Voice -> (StdGen, Voice) +> makeMel g [] = (g, []) +> makeMel g [x] = (g, [x]) +> makeMel g (x1@((k1,m1),d1,p1):x2@((k2,m2),d2,p2):xs) = +> let (g',pt) = pickPT 4 g x1 x2 -- next stochastic choice +> (g'', rest) = makeMel g' (x2:xs) --- rest of melody +> in case pt of Nothing -> makeMelNT g'' (x1 : rest) -- passing tone not possible +> Just v -> (g'', ((k1,m1),d1/2,p1) : ((k1,m1),d1/2,v) : rest) +> where +> makeMelNT :: StdGen -> Voice -> (StdGen, Voice) +> makeMelNT g [] = (g, []) +> makeMelNT g [x] = (g, [x]) +> makeMelNT g (x1@((k1,m1),d1,p1):x2@((k2,m2),d2,p2):xs) = +> let (g',pt) = pickNT 4 g x1 x2 -- next stochastic choice +> in case pt of Nothing -> (g', (x1 : x2: xs)) -- passing tone not possible +> Just v -> (g', ((k1,m1),d1/2,p1) : ((k1,m1),d1/2,v) : x2 :xs) + + +Smoth melody constraint and earest-neighbor fallback for melody construction. + +> smoothMel :: AbsPitch -> Predicate (AbsChord, AbsChord) +> smoothMel thresh ([], c2) = error "Empty chord" +> smoothMel thresh (c1, []) = error "Empty chord" +> smoothMel thresh (c1, c2) = abs(last c1-head c2) < thresh + +> nearestMel :: Fallback AbsChord +> nearestMel [] g c = error ("Empty equivalence class for: "++show c) +> nearestMel e g c = +> let p = last c -- this is the current pitch +> ps = map head e -- these are all possible next pitches +> dists = map (\x -> abs(p-x)) ps -- all distances +> minDist = minimum dists +> (g', i) = choose g (findIndices (\x -> x == minimum dists) dists) +> in (g', e !! i) + +============================================== + +Arpeggio-based pieces, playable on piano with pedal. They may not +always be best played with the indicated split of right and left hands. +Sometimes the lowest note of the right-hand part may be better played +by the left-hand, although it can difficult to automatically represent +on a score this way with software such as MuseScore. + +> simplePianoFGArp :: Sentence CType MP -> StdGen -> (StdGen, (Music Pitch, Music Pitch)) +> simplePianoFGArp terms g0 = +> let aChords = toAbsChords terms +> k = findInds [] terms +> (g1, tcs) = classicalCS2x' g0 aChords k +> (tLH, tRH) = splitTChords 1 tcs +> rhM = toArpMusic tRH +> lhM = vsToMusic $ toVoices tLH +> in (g1, (lhM, rhM)) + +> simplePianoFGArpx :: [TChord] -> StdGen -> Constraints -> (StdGen, (Music Pitch, Music Pitch)) +> simplePianoFGArpx aChords g0 k = +> let (g1, tcs) = classicalCS2x' g0 aChords k +> (tLH, tRH) = splitTChords 1 tcs +> rhM = toArpMusic tRH +> lhM = vsToMusic $ toVoices tLH +> in (g1, (lhM, rhM)) + + +Another redoing of the chorale-inspired chord spaces. + +> classicalCS2x' :: StdGen -> [TChord] -> Constraints -> (StdGen, [TChord]) +> classicalCS2x' g aChords consts = +> let justChords = map (\(a,b,c) -> c) aChords +> (g1,g2) = split g +> (g3, eqs) = classBass2 0.8 g2 $ map (eqClass satbOPx opcEq) justChords +> csChords = greedyLet myClass nearFall consts eqs g3 +> aChords' = zipWith (\(a,b,c) d -> (a,b,d)) aChords csChords +> in (g3, aChords') where +> satbOPx = satbChordsx // opEq +> satbChordsx = filter (\x -> arpFilter x && satbFilter x) (makeRange satbRangesx) +> satbRangesx = [(30,60), (47,67), (52,76), (60,81)] + +> classBass2 :: Double -> StdGen -> [EqClass AbsChord] -> (StdGen, [EqClass AbsChord]) +> classBass2 thresh g [] = (g, []) +> classBass2 thresh g [e] = classBass 1.0 g [e] +> classBass2 thresh g (e:es) = +> let (g',e') = classBass thresh g [e] +> (g'', es') = classBass2 thresh g' es +> in (g'', e' ++ es') + +Constraint for appropriate spacings between voices (treated as 4-note chords, +not yet arpeggiated). + +> arpFilter :: Predicate AbsChord +> arpFilter = arpFilterSub . tail where +> arpFilterSub (p1:p2:ps) = p1-p2 <= 6 && arpFilterSub (p2:ps) +> arpFilterSub x = True + +> myClass (c1,c2) = c1 /= c2 && noCPL 7 (c1,c2) + +For splitting a TChord into lefthand and righthand sections by voice +count. For example, if amt = 1, a single voice will end up in the +left hand portion. + +> splitTChords :: Int -> [TChord] -> ([TChord], [TChord]) +> splitTChords amt chords = unzip $ map (f amt) chords where +> f amt (km, d, x) = ((km, d, take amt x), (km, d, drop amt x)) + +Arpeggiate a bunch of TChords. + +> toArpMusic :: [TChord] -> Music Pitch +> toArpMusic [] = rest 0 +> toArpMusic [(k,d,aps)] = chord $ map (note d . pitch) aps +> toArpMusic (x:t) = (rest sn :+: vsToMusic [toArp x]) :+: toArpMusic t + +> toArp :: TChord -> [TNote] +> toArp (km@(k,m), d, aps) = +> let scale = t k (if m==Major then majScale else minScale) +> arpNotes = takeDur (d-sn) $ concat $ repeat $ map (\x -> (km,sn,x)) aps +> in if d <= sn then [(km, d, head aps)] +> else arpNotes where +> takeDur :: Dur -> [TNote] -> [TNote] +> takeDur d [] = [] +> takeDur 0 xs = [] +> takeDur d (h@(k, d', x):t) = +> if d >= d' then h : takeDur (d-d') t else [(k, d, x)] +
+ Kulitta/Grammars/MusicGrammars.lhs view
@@ -0,0 +1,293 @@+Musical Grammars +Donya Quick +Last modified: 13-Jan-2016 + +> module Kulitta.Grammars.MusicGrammars where +> import Kulitta.PTGG +> import System.Random +> import Data.List + +================================== +TYPE SYNONYMS & CONSTANTS + +> type Dur = Rational +> type AbsPitch = Int +> wn = 1 :: Dur +> hn = 1/2 :: Dur +> qn = 1/4 :: Dur +> en = 1/8 :: Dur +> sn = 1/16 :: Dur +> tn = 1/32 :: Dur + +================================== +ALPHABETS FOR BASE SYMBOLS + +Alphabet 1: Roman numerals for chords + +> data CType = I | II | III | IV | V | VI | VII +> deriving (Eq, Show, Ord, Enum, Read) + +Alphabet 1: from Rohrmeier's paper "Towards a generative syntax of tonal harmony" + +> data RTerm = Piece | P | -- piece/phrase (or P=Plagal for Kulitta's reuse of P) +> TR | DR | SR | -- regions +> T | D | S | TP | TCP | SP | DP | -- chord functions +> C CType -- Roman numerals +> deriving (Eq, Read) + +Show function for alphabets with duration: + +> showDur :: (Show a) => (a,MP) -> String +> showDur (a,MP d m k o sd) = show a ++ "(" ++ show d ++ ")" + + +================================== +ALPHABETS FOR PARAMETERS + +Many finite base symbol alphabets can use the same potentially infinite +alphabet of parameter symbols. Here we define a general "music parameter" +or MP for many tonal applications. It will store the current duration +of a symbol, and the symbol's tonal context as a mode and scale root. +Finally, there is allowance for keeping track of the onset of the symbol +as well as the total duration of the sentence to which it belongs. This +allows for checking things like whether the symbols is the LAST in a +sentence, at the midpoint, etc. + +> data MP = MP {dur :: Dur, mode :: Mode, key :: Int, onset :: Dur, sDur :: Dur} +> deriving (Eq, Show) + +Modes include the seven usual derivatives of the C-major scale along with +chromatic and custom options. Note that Major=Ionian and Minor=Aeoloean. + +> -- I II III IV V VI VII +> data Mode = Major | Dorian | Phrygian | Lydian | Mixolydian | Minor | Locrian | +> Chromatic | Custom [AbsPitch] +> deriving (Eq, Show, Ord, Read) + + +A partial Enum instance is supplied for the modes with seven-note scales. +The enumFrom function is defined to loop around. For example: + + enumFrom Dorian ==> [Dorian, Phrygian, ..., Locrian, Major] + +> allEnumModes = [Major, Dorian, Phrygian, Lydian, Mixolydian, Minor, Locrian] + +> instance Enum Mode where +> toEnum i = if i>=0 && i<=6 then allEnumModes !! i +> else error "Only modes 0-6 are enumerable." +> fromEnum Chromatic = error "Chromatic mode is not part of Enum instance." +> fromEnum (Custom x) = error "Cannot enumerate a Custom mode." +> fromEnum x = case findIndex (==x) allEnumModes of +> Nothing -> error ("Cannot enumerate unknown mode: "++show x) +> Just i -> i +> enumFrom x = case findIndex (==x) allEnumModes of +> Nothing -> error ("Cannot enumerate from unknown mode: "++show x) +> Just i -> take 7 $ drop i (allEnumModes++allEnumModes) + +A default MP value is one measure long (in 4/4) in the key of C-major. + +> defMP = MP 1 Major 0 0 1 + +It is also useful to have tests for MP values and modifiers for them. + +> isMaj = (==Major) . mode +> isMin = (==Minor) . mode + +Modifiers on duration can be used to succinctly write transformations. +For example, to halve the duration of a parameter p::MP, one need only +write (h p) rather than something like p{dur=(dur p)/2} + +> dFac x p = p{dur = dur p * x} +> h = dFac 0.5 -- half of the original duration +> q = dFac 0.25 -- a quarter of the original duration +> e = dFac 0.125 + +Similarly, we have some shorthands for adjusting the onsets and +durations at the same time. NOTE: offsets should be changed +before the duration is changed. + +> q2 p = p{onset = onset p + (dur p / 4)} -- "beat" 2 (second quarter) +> q3 p = p{onset = onset p + (dur p / 2)} -- "beat" 3 (third quarter) +> q4 p = p{onset = onset p + 3*(dur p / 4)} -- "beat" 4 (fourth quarter) + +We can also do shorthands that do both things. + +> ho = h . q3 +> qo2 = q . q2 +> qo3 = q . q3 +> qo4 = q . q4 + +The following alter Rules to do a duration test. Each has a +"rejection condition" that will be the condition for an ID rule. + +The rejection condition in this case tests the left-hand-side +symbol's duration. + +> toRelDur :: (Dur -> Bool) -> Rule a MP -> Rule a MP +> toRelDur f ((l,d):-> rf) = +> (l,d) :-> \p -> if f $ dur p then [NT (l,p)] else rf p + +This one is pickier - it will check whether applying the rule will +produce symbols that satisfy the rejection condition. So, if there +is ANY bad symbol on the right-hand-side, an ID rule will be applied +instead. + +> toRelDur2 :: (Dur -> Bool) -> Rule a MP -> Rule a MP +> toRelDur2 f ((l,d):-> rf) = (l, d) :-> \p -> +> let xs = map (dur.snd) $ toPairs $ expand [] $ rf p +> in if or (map f xs) then [NT (l,p)] else rf p + +Similarly, we can do this for ends of phrases. A symbol must be +the last in its setence if the sentence duration minus the onset +equals the symbol's duration. + +Note: this hinges on the fact that time is hangled with the +Rational type in Haskell. Otherwise, we would have to compare +with an error-tollerant threshold. + +> isLast :: MP -> Bool +> isLast p = (sDur p - onset p) == dur p + +> toMinLast :: Dur -> Rule a MP -> Rule a MP +> toMinLast minLastDur ((l,d):-> rf) = +> (l, d) :-> \p -> if isLast p && dur p <= minLastDur then [NT (l,p)] else rf p + +For mode/key changes: + +> -- C D E F G A B +> majModes = [Major, Minor, Minor, Major, Major, Minor, Minor] +> minModes = [Minor, Minor, Major, Minor, Minor, Major, Major] +> modalPats = enumFrom Major :: [Mode] + +> majScale = [0,2,4,5,7,9,11] +> minScale = [0,2,3,5,7,8,10] +> dorScale = [0, 2, 3, 5, 7, 9, 10] +> phrScale = [0, 1, 3, 5, 7, 8, 10] +> lydScale = [0, 2, 4, 6, 7, 9, 11] +> mixScale = [0, 2, 4, 5, 7, 9, 10] +> locScale = [0, 1, 3, 5, 6, 8, 10] + +> getScale :: Mode -> [AbsPitch] +> getScale Major = majScale +> getScale Minor = minScale +> getScale Dorian = dorScale +> getScale Phrygian = phrScale +> getScale Lydian = lydScale +> getScale Mixolydian = mixScale +> getScale Locrian = locScale +> getScale m = error ("(getScale) Scale not defined for mode" ++ show m) + +> modMajMin i p = let k0 = key p in +> if mode p == Major then p{mode=majModes!!i, key=(k0+(majScale!!i)) `mod` 12} +> else p{mode=minModes!!i, key=(k0+(minScale!!i)) `mod` 12} + +Basic modulations on scale degrees for Major and Minor systems + +> [m2, m3, m4, m5, m6, m7] = map modMajMin [1..6] + + +[TO-DO: MODAL VERSION OF MODULATIONS] + + +================================== + +P = {piece, P} +R = {TR, SR, DR} functional region symbols +K = {Cmaj, Cmin, ...} key symbols +F = {t, s, d, tp, sp, dp, tcp} functional term symbols +S = {I, II, ...} scale degree chord representations +O = {Cmaj, ...} surface chord symbols (e.g. I in K=Cmaj) + +> allRTerms = [Piece, P, TR, DR, SR, T, D, S, TP, TCP, SP, DP, +> C I, C II, C III, C IV, C V, C VI, C VII] + +> instance Show RTerm where +> show Piece = "Piece" +> show P = "P" +> show TR = "TR" +> show DR = "DR" +> show SR = "SR" +> show T = "T" +> show D = "D" +> show S = "S" +> show TP = "TP" +> show TCP = "TCP" +> show SP = "SP" +> show DP = "DP" +> show (C x) = show x + + +> showRTerms :: [RTerm] -> String +> showRTerms [] = "" +> showRTerms [t] = show t +> showRTerms (t1:ts) = show t1 ++ " " ++ showRTerms (ts) + + +TSD Grammar Base + +> tsdRules :: [Rule RTerm MP] +> tsdRules = [ +> (T, 0.25) :-> \p -> [NT (T, p)], +> (T, 0.25) :-> \p -> [NT (T, h p), NT (T, h p)], +> (T, 0.25) :-> \p -> [NT (T, h p), NT (D, h p)], +> (T, 0.25) :-> \p -> [NT (D, h p), NT (T, h p)], +> (D, 0.33) :-> \p -> [NT (D, p)], +> (D, 0.33) :-> \p -> [NT (D, h p), NT (D, h p)], +> (D, 0.34) :-> \p -> [NT (S, h p), NT (D, h p)], +> (S, 0.5) :-> \p -> [NT (S, p)], +> (S, 0.5) :-> \p -> [NT (S, h p), NT (S, h p)] +> ] + +================================== + +Roman Numeral Grammar Base + +> [i, ii, iii, iv, v, vi, vii] = map fc $ enumFrom I where +> fc ct p = NT (ct,p) + +Grammar from dissertation chapter 4, table 4.2 with optional let +statements added. + +> rRules1 :: Dur -> Bool -> [Rule CType MP] +> rRules1 minDur useLets = normalize $ map (toRelDur2 (<minDur)) ([ +> -- Rules for I -- +> (I, 0.187) :-> \p -> [(if isMaj p then ii else iv) (q p), v (q p), i (h p)], +> (I, 0.187) :-> \p -> map ($ q p) [i, iv, v, i], +> (I, 0.187) :-> \p -> [v (h p), i (h p)], +> (I, 0.187) :-> \p -> map ($ q p) $ [i, if isMaj p then ii else iv, v, i], +> (I, 0.252) :-> \p -> [i p], +> -- Rules for II -- +> (II, 0.40) :-> \p -> if isMaj p then [ii p] else [iv p], +> (II, 0.40) :-> \p -> if isMaj p then (if dur p > qn then [ii p] else [i (m2 p)]) else [ii p], +> (II, 0.20) :-> \p -> map ($ h p) $ if isMaj p then [vi, ii] else [vi, iv], +> -- Rules for III-- +> (III, 0.90) :-> \p -> [iii p], +> (III, 0.10) :-> \p -> [i $ m3 p], +> -- Rules for IV -- +> (IV, 0.90) :-> \p -> [iv p], +> (IV, 0.10) :-> \p -> [i $ m4 p], +> -- Rules for V -- +> (V, 0.10) :-> \p -> [v p], +> (V, 0.15) :-> \p -> [iv (h p), v (h p)], +> (V, 0.10) :-> \p -> [iii (h p), vi (h p)], +> (V, 0.10) :-> \p -> map ($ q p) [i, iii, vi, v], +> (V, 0.10) :-> \p -> map ($ q p) [v, vi, vii, v], +> (V, 0.10) :-> \p -> [v (h p), vi (h p)], +> (V, 0.10) :-> \p -> [iii p], +> (V, 0.05) :-> \p -> [v (h p), v (h p)], +> (V, 0.10) :-> \p -> [vii (h p), v (h p)], +> (V, 0.10) :-> \p -> [i $ m5 p], +> -- Rules for VI -- +> (VI, 0.70) :-> \p -> [vi p], +> (VI, 0.30) :-> \p -> [i $ m6 p], +> -- Rules for VII -- +> (VII, 0.50) :-> \p -> if dur p > qn then [vii p] else [i $ m7 p], +> (VII, 0.50) :-> \p -> [i (h p), iii (h p)] +> ] ++ if useLets then letRules else []) where +> letRules = concatMap (\ct -> [letRule1 ct, letRule2 ct]) (enumFrom I) +> letRule1 ct = (ct, 0.1) :-> \p -> [Let "x" [NT(ct, h p)] [Var "x", Var "x"]] +> letRule2 ct = (ct, 0.1) :-> \p -> [Let "x" [NT(ct, q p)] [Var "x", v (h p), Var "x"]] + + + +
+ Kulitta/Learning/CykParser.lhs view
@@ -0,0 +1,273 @@+> module Kulitta.Learning.CykParser where +> import Data.List +> import Kulitta.Learning.Parser + +CYK Implementation +Donya Quick +Last modified: 22-Jan-2016 + + + +type Rule a = (a, [a]) + +> findProducers :: (Eq a) => [Rule a] -> [a] -> [Rule a] +> findProducers rs str = filter (\(l,r) -> r==str) rs + +> cat :: [a] -> [a] -> [[a]] +> cat xs ys = [[x,y] | x<-xs, y<-ys] + + +> nextRow :: (Eq a) => [Rule a] -> [[[a]]] -> [[a]] +> nextRow rs rows = +> let n = length rows + 1 -- we assume terminal level is not included +> segs = map (\i -> (i,n-i)) [1..n-1] +> strs offset (i,j) = cat +> (rows !! (i-1) !! offset) +> (rows !! (j-1) !! (offset + i)) +> rules offset (i,j) = concatMap (map fst. findProducers rs) +> (strs offset (i,j)) +> f offset = nub $ concatMap (rules offset) segs +> in map f [0..length (rows !! 0) - n] + + +> mkSegs' :: Int -> Int -> [[Int]] +> mkSegs' n m = filter (\s -> sum s == n) $ +> makeRange $ take m $ repeat (0,n) where +> makeRange = foldr (\(l,u) xs -> [(a:b) | a<-[l..u], b<-xs]) [[]] + +> mkSegs :: Int -> Int -> [[Int]] +> mkSegs n m = filter (\s -> length s > 1) $ map (filter (>0)) $ mkSegs' n m + +mkSegs must be called with: +n = the maximum length of the string in question. +m = the maximum possible number of substrings + +n needs to be controlled by both the level (row+1) and +the offset. The formula should be: + +n = min (length rows) (length (rows !! 0) - offset) + +> toInds :: Int -> [Int] -> [(Int, Int)] +> toInds offset [] = [] +> toInds offset (l:ls) = +> let row = l - 1 +> col = offset +> in if l <= 0 then toInds offset ls +> else (row, col) : toInds (offset+l) ls + +> toStrs :: [[[a]]] -> [(Int, Int)] -> [[a]] +> toStrs rows [] = [[]] +> toStrs rows ((i,j):cs) = +> let strs = toStrs rows cs +> theCell = if i < length rows && j < length (rows !! i) +> then rows !! i !! j +> else error ("(toStr) Bad box: ("++show i++", "++show j++")") +> in [(x:y) | x<-theCell, y<-strs] + +> nextRowM m rs rows = -- m is the # of subdivisions +> let n = length rows +1 -- the "level" +> m' = min n m -- the number of substrings (or nonterms) +> segs = mkSegs n m' -- this is ok +> offsets = [0..length (rows !! 0) - n] -- all offsets +> nts o s = concatMap (map fst . findProducers rs) (toStrs rows (toInds o s)) +> f o = concatMap (nts o) segs +> in map f offsets + +> nextRowM2 m rs rows = -- m is the # of subdivisions +> let n = length rows +1 -- the "level" +> m' = min n m -- the number of substrings (or nonterms) +> segs = mkSegs n m' -- this is ok +> offsets = [0..length (rows !! 0) - n] -- all offsets +> nts o s = concatMap (map fst . findProducers rs) (toStrs rows (toInds o s)) +> f o = concatMap (nts o) segs +> in map f offsets + +> allRowsMS :: (Eq a) => Int -> [Rule a] -> [a] -> [[[a]]] +> allRowsMS m rs str = allRows' rs [fixRow rs $ firstRow' rs str] where +> allRows' rs rows = if length rows == length (head rows) then rows +> else allRows' rs (rows ++ [fixRow rs $ nextRowM m rs rows]) + +> allRows :: (Eq a) => [Rule a] -> [a] -> [[[a]]] +> allRows rs str = allRows' rs [firstRow rs str] where +> allRows' rs rows = if length rows == length (head rows) then rows +> else allRows' rs (rows ++ [nextRow rs rows]) + + +> showRows :: (Show a) => [[[a]]] -> String +> showRows rs = +> let f line = concatMap g line ++ "\n" +> g bucket = show bucket ++ "\t" +> in concatMap f (reverse rs) + +> printRows :: (Show a) => [[[a]]] -> IO () +> printRows = putStr . showRows + +============== + +SYNONYM EXTENION + +> findSynonyms :: (Eq a) => [Rule a] -> a -> [a] +> findSynonyms rules x = map fst $ filter (\(l,r) -> r==[x]) rules + +> findSynRec :: (Eq a) => [Rule a] -> [a] -> [a] +> findSynRec rules syns = +> let s = nub (syns ++ concatMap (findSynonyms rules) syns) +> in if s == syns then syns else findSynRec rules s + + + findSynRec :: (Eq a) => [Rule a] -> a -> [a] + findSynRec rules x = + let s = findSynonyms rules x + s' = nub (s ++ concatMap (findSynonyms rules) s) + in if s == s' then s else nub $ s ++ concatMap (findSynRec rules) s' + +> fixSyns :: (Eq a) => [Rule a] -> [a] -> [a] +> fixSyns rules bucket = nub (bucket ++ concatMap (findSynonyms rules) bucket) + +> fixRow :: (Eq a) => [Rule a] -> [[a]] -> [[a]] +> fixRow rules row = map (findSynRec rules) row + +> allRowsS :: (Eq a) => [Rule a] -> [a] -> [[[a]]] +> allRowsS rs str = allRows' rs [fixRow rs $ firstRow rs str] where +> allRows' rs rows = if length rows == length (head rows) then rows +> else allRows' rs (rows ++ [fixRow rs $ nextRow rs rows]) + +> firstRowOld rs cs = map (nub . map fst . findProducers rs . \a -> [a]) cs + +> firstRow rs cs = map (\c -> [c]) cs + +> firstRow' rs [] = [] +> firstRow' rs (c:cs) = +> let fr0 = nub $ c : (map fst $ findProducers rs [c]) +> in (if null fr0 then [c] else fr0) : firstRow' rs cs + + + +============== + + +GENERATING ALL PARSES + + allParses :: [Rule a] -> [[[a]]] -> Int -> Int [[Rule a]] + allParses rules rows i j = -- i is the row, j is the column + let f :: a -> [Rule a] + f x = filter (\(l,r) -> l==x) rules + in undefined + +mkSegs :: Int -> Int -> [[Int]] +mkSegs n m = filter (\s -> length s > 1) $ map (filter (>0)) $ mkSegs' n m + +mkSegs must be called with: +n = the maximum length of the string in question. +m = the maximum possible number of substrings + +Given a rule that we know can be applied, pick the cells it generates. + +> getCells :: (Eq a) => [[[a]]] -> Rule a -> Int -> Int -> [[(Int, Int)]] +> getCells rows (lhs, rhs) level offset = +> let n = level + 1 +> m = length rhs -- number of syms to genererate +> segs = mkSegs n m -- get all possible ways to chunk the string +> inds = map (toInds offset) segs -- :: [[(Int, Int]] turn these into cells +> -- need to filter the cells now! -- +> in filter (goodCells rows rhs) inds + +> goodCells :: (Eq a) => [[[a]]] -> [a] -> [(Int, Int)] -> Bool +> goodCells rows [] [] = True +> goodCells rows (x:xs) ((i,j):is) = +> elem x (rows !! i !! j) && goodCells rows xs is + +> appendTo :: (Eq a) => [[[a]]] -> (Int, Int) -> a -> [[[a]]] +> appendTo [] (i,j) x = [] +> appendTo xs (i,j) x = +> let (preRs, theRow, postRs) = (take i xs, xs !! i, drop (i+1) xs) +> (preCs, theCell, postCs) = (take j theRow, theRow !! j, drop (j+1) theRow) +> newCell = nub (x : theCell) -- ensure no duplicates +> in preRs ++ (preCs ++ newCell : postCs) : postRs + +> appendTo2 :: (Eq a) => [[[a]]] -> (Int, Int) -> [a] -> [[[a]]] +> appendTo2 [] (i,j) x = [] +> appendTo2 xs (i,j) x = +> let (preRs, theRow, postRs) = (take i xs, xs !! i, drop (i+1) xs) +> (preCs, theCell, postCs) = (take j theRow, theRow !! j, drop (j+1) theRow) +> newCell = nub (x ++ theCell) -- ensure no duplicates +> in preRs ++ (preCs ++ newCell : postCs) : postRs + + +The parseDown1 function completes a parse from a particular cell and symbol. We +assume the symbol is a member of the cell in question. + +> doAll = True + +> parseDown1 :: (Eq a) => [[[a]]] -> [Rule a] -> [[[a]]] -> ((Int, Int), a) -> [[[[a]]]] +> parseDown1 rows rules newRows ((0,j),x) = [appendTo newRows (0,j) x] +> parseDown1 rows rules newRows ((i,j),x) = +> let newRows' = appendTo newRows (i,j) x -- put x in the current table +> pRules = filter (\(l,r) -> l==x && length r > 0) rules -- rules of form A->BC...N +> sRules = filter (\(l,r) -> l==x && length r == 1) rules -- rules of form A->B +> f r = getCells rows r i j -- get a rule's target cells (CAN BE >1 LIST!) +> f2 r@(lhs,rhs) = map (zipWith (\a (b,c) -> ((b,c),a)) rhs) (f r) -- group with coords +> --pCells type is [[[((Int, Int), a)]]] +> pCells = filter (\l -> not $ null l) $ map f2 pRules -- get cells according to pRules +> recCall pCell = parseDown1 rows rules newRows' pCell -- recurse on rule expansions +> pTabs = map (map (map recCall)) pCells -- gives one SET of tables per pCell +> pTabs' = map (map combineSets) pTabs -- gives one SET of tables per inner pCell list (can be >1) +> pTabs'' = concat $ concat pTabs' -- flatten lists, the parses are done +> syns = filter (/=x) $ map (\(l,r) -> head r) $ sRules -- what synonym symbols are there? +> synResults = concatMap (\a -> parseDown1 rows rules newRows' ((i,j),a)) syns -- recurse on syns +> in synResults ++ pTabs'' + + +The parseDown function takes the cyk rows, the grammar's rules, and the start symbol. + +> parseDown rows rules s = +> let n = length $ head rows +> in map (map (map reverse)) $ parseDown1 rows rules (emptyRows n) ((n-1,0),s) + + xtrs = [(1,[1,1]), (1,[1,2]), (2,[2,2]), (3, [1]), (1, [1])] :: [Rule Int] + xstr = [1,1,1,1] :: [Int] + xp = allRowsMS 2 xtrs xstr + xtest1 = parseDown xp xtrs 3 + +> emptyRows n = +> if n <= 0 then [] else take n (repeat []) : emptyRows (n-1) + +2 x +1 x x +0 x x x + 0 1 2 + +The combineSets function takes a bunch of table sets, one set per +cell that has been parsed, and finds every combination of them. + +> combineSets :: (Eq a) => [[[[[a]]]]] -> [[[[a]]]] +> combineSets [] = error "(combineSets) No sets to combine!" +> combineSets [tset] = tset +> combineSets (tset:moreSets) = +> let pairs = [(a,b) | a<-tset, b<-combineSets moreSets] +> in map (\(a,b) -> combine1 a b) pairs + + +> -- merges N tables +> combineN :: (Eq a) => [[[[a]]]] -> [[[a]]] +> combineN [] = error "(combineN) No tables to combine!" +> combineN [t] = t +> combineN (t:ts) = combine1 t (combineN ts) + +> -- merges two tables +> combine1 :: (Eq a) => [[[a]]] -> [[[a]]] -> [[[a]]] +> combine1 tab1 tab2 = +> let n = length $ head tab1 +> is = [(i,j) | i<-[0..n-1], j<-[0..n-1], j<=n-i-1] +> xs = map (\(i,j) -> tab2 !! i !! j) is +> in foldUpdate2 tab1 (zip is xs) + +> foldUpdate :: (Eq a) => [[[a]]] -> [((Int, Int), a)] -> [[[a]]] +> foldUpdate table [] = table +> foldUpdate table ((c,x):xs) = foldUpdate (appendTo table c x) xs + + +> foldUpdate2 :: (Eq a) => [[[a]]] -> [((Int, Int), [a])] -> [[[a]]] +> foldUpdate2 table [] = table +> foldUpdate2 table ((c,x):xs) = foldUpdate2 (appendTo2 table c x) xs +
+ Kulitta/Learning/InsideOutside.lhs view
@@ -0,0 +1,555 @@+Extended Inside-Outside Algorithm Implementation +Donya Quick +donyavq@netscape.net +Last modified: 22-Jan-2016 + +This module is an implementation of the inside-outside algorithm using +the notations described in the following document by Michael Collins: +http://www.cs.columbia.edu/~mcollins/io.pdf + +The learnProbs function will take a set of starting conditions, +iteratively learn production probabilities, and return them. The +qNew function will calculate a new production probability for a +single rule. + +The implementation here also contains several EXTENSIONS to the original +inside-outside algorithm, although it will perform normally given a +CFG in Chomsky normal form. + +Modifications to original algorithm: +1. Supports rules of rank 1, A->B where A=/=B in alpha, beta, and mu +2. Supports rules of rank 3, A->BCD +3. Supports rrules of the form A->A in mu function (heuristic) +4. Supports abstract rules via an oracle to answer certain things about + the grammar. + +The first two extensions follow directly from the equations for alpha +and beta in the standard inside-outside algorithm. Extensions 2 will cause +a larger worst-case runtime if rules of the form A->BCD are present in the +grammar, being O(n^4) instead of O(n^3) for the CKY/CYK parsing step. + +Extension 3 is a HEURISTIC to allow the presence of self-productions in +the rule set. It makes the assumption that self-productions can happen but +are unlikely. In fact, it is not possible to know exactly how self- +productions should be handled without knowing the details of the generative +algorithm that produced the data set. + +Extension 4 means that rules can have any form you want as long as you +can define a function to find suitable left-hand sides given a candidate +right-hand side. The rules still need to be context-free in the sense that +you cannot account for things like AB->ACD this way. However, you can learn +parameterized grammars over infinite alphabets and rules with conditional +behavior using this approach. This is further described in my forthcoming +doctoral thesis. + +The ORACLE in extension four is accounted for by the data structure TOracle. +A TOracle allows the algorithm to interact with a rule set without knowing +its exact structure. It requires four things: + +1. A list of production probabilities. It is assumed that they are ordered + by "rule ID" or "rule index." In other words, rule 0 will have probability + phis !! 0. + +2. The start symbol. + +3. A list of "rule IDs" or "rule indices" grouped by matching left-hand sides. + So, if we had the rules A->AA, A->B, and B->C listed in that order, then + the grouping would be [[0,1],[2]]. + +4. The main part of the oracle: a function to reverse rule production. If the + rule set has the rules A->AA, A->B, and B->C, the function findByRHS should + return the INSTANCE (TRuleInst 0 A [A,A]) when given [A,A] as input. For + parameterized grammars, the rule instance must have the particular parameters + that were involved in the production. + +NOTE: This implementation is parallelized! To compile a program using the +learnProbs function in parallel, use: + +ghc -O2 Main.lhs -rtsopts -threaded + +and then run the program by: + +Main [arguments] +RTS -Nx + +where x is the number of threads you want. For example, if you have 2 cores, +you will want to use -N2. If you have a quad core i7 with hyperthreading, +you will get the best performance using -N8. + +> module Kulitta.Learning.InsideOutside (RuleIndex, TStr, TCell, TParse, +> TRuleInst(TRuleInst), rule, lhs, rhs, +> TOracle(TOracle), phis, startSym, ruleGroups, findByRHS, +> makeAlphas, makeBetas, learnProbs, qNew, +> uniQs, randQs, printTable) where +> import Data.List +> import Kulitta.Learning.CykParser -- for mkSegs' function +> import System.Random -- for random initialization of production probs +> import Control.Parallel.Strategies + +================================ +CONSTANTS + +> parCounts = True -- set to True to perform inner parallelization + + +================================ +TYPE DEFINITIONS + +> type RuleIndex = Int -- index into a list of rules +> type TStr a = [a] -- a string of parameterized symbols + +> -- A rule "instance." There can be many instances per abstract rule. +> data TRuleInst a = TRuleInst { +> rule :: RuleIndex, -- index to which this instance belongs +> lhs :: a, -- the left-hand side +> rhs :: TStr a} -- the right-hand side +> deriving(Eq, Show) + +> type TCell a = [TRuleInst a] -- one cell in a parse table +> type TParse a = [[TCell a]] -- a full parse +> type Row = Int -- row of a parse table. Row 0 is assumed to be "terminal"-level. +> type Col = Int -- col of a parse table +> type Coord = (Row, Col) -- a particular point in a table, corresponding to one cell. + +> -- A learning "environment:" acts as an oracle to describe the grammar +> data TOracle a = TOracle { +> phis :: [Double], -- production probabilities sorted by rule index +> startSym :: a, -- start symbol +> ruleGroups :: [[RuleIndex]], -- which rule indexes have the same left-hand side? +> findByRHS :: [a] -> [TRuleInst a]} -- which rules have a particular right-hand side? + +> type Alpha a = ((a, Int, Int), Double) -- a single alpha value tagged with its symbol and span +> type Beta a = ((a, Int, Int), Double) -- a single beta value tagged with its symbol and span + +Controlled product function that stops when a zero is encountered to +avoid evaluating unnecessary terms. The prod function will terminate on +on infinite list if it contains a zero, whereas product will not. + +> prod :: (Num a, Eq a) => [a] -> a +> prod [] = error "(prod) Nothing to multiply." +> prod [x] = x +> prod (x:xs) = if x==0 then 0 else x * prod xs + +Conversions in an out of row/column vs. span representation to +determine what span a cell in a parse table has and visa versa. + +> toRC, toIJ :: (Int,Int) -> (Int, Int) +> toRC (i, j) = (j-i, i) +> toIJ (row,col) = (col,col+row) + +For backward compatibility: + +> getParse :: (Eq a) => TOracle a -> TStr a -> TParse a +> getParse = buildTable + +> idRule :: (Eq a) => TRuleInst a -> Bool +> idRule (TRuleInst id lhs [rhs]) = rhs==lhs +> idRule _ = False + +=========== +ALPHA CALC + +Symbol enumeration function. Symbols are ordered for most efficient +computation of alpha values. + +> symEnum :: (Eq a) => TOracle a -> TStr a -> [(a, Int, Int)] +> symEnum env xs = +> let p = getParse env xs -- get the parse of the string +> n = length xs +> f (r,c) = map (toAIJ (r,c)) $ p !! r !! c -- synonyms are originally stacked higher to left +> rcs = [(r,c) | r<-[0..n-1], c<-[0..n-1], r+c<n] +> in concatMap f rcs where +> toAIJ :: Coord -> TRuleInst a -> (a, Int, Int) +> toAIJ coord t = +> let (i,j) = toIJ coord +> in (lhs t, i, j) + +Function for initial generation of alpha values. Values that are +calculated are then stored in a list for use in recursive calls. + +> makeAlphas :: (Eq a) => TOracle a -> TStr a -> [Alpha a] +> makeAlphas env xs = +> let syms = symEnum env xs -- (symEnum env) xs +> in filter ((>0).snd) $ makeRec env [] xs syms where +> makeRec env as xs [] = as +> makeRec env as xs (v@(a,i,j):vs) = +> let aNew = alpha env as xs a i j +> in makeRec env ((v,aNew):as) xs vs + +Helper function to determine what a symbol can produce. + +> traceDown :: (Eq a) => TOracle a -> TStr a -> a -> Int -> Int -> [TRuleInst a] +> traceDown env xs a i j = +> let p = getParse env xs +> (row,col) = toRC (i, j) +> in filter (\r -> lhs r == a) $ p !! row !! col + +Generating a single alpha value. + +> alpha :: (Eq a) => TOracle a -> [Alpha a] -> TStr a -> a -> Int -> Int -> Double +> alpha env as xs a i j = case (lookup (a,i,j) as) of +> Just v -> v +> Nothing -> +> let rInsts = filter (not.idRule) $ -- cases of A->A are not allowed (but A->B is ok) +> traceDown env xs a i j -- get possible children of A as rule instances +> subAs = sum $ map (alphaRec env as xs i j) rInsts +> in if i==j && a == (xs !! i) then 1.0 -- check for found terminal +> else if null rInsts then 0.0 -- check for dead end on wrong terminal +> else subAs where -- recursive case + +> alphaRec :: (Eq a) => TOracle a -> [Alpha a] -> TStr a -> Int -> Int -> TRuleInst a -> Double +> alphaRec env as xs i j (TRuleInst id lhs [rhs]) = +> prod [phis env !! id, alpha env as xs rhs i j] +> alphaRec env as xs i j (TRuleInst id lhs [s1, s2]) = +> let ks = [i..j-1] +> f k = prod [alpha env as xs s1 i k, alpha env as xs s2 (k+1) j] +> in if i == j then 0.0 -- dead end, no way to split +> else prod [phis env !! id, sum $ map f ks] -- phi multiplication moved here for efficiency +> alphaRec env as xs i j (TRuleInst id lhs [s1, s2, s3]) = +> let ks = [(k,l) | k<-[i..j-2], l<-[i+1..j-1], k<l] +> f (k,l) = prod [alpha env as xs s1 i k, alpha env as xs s2 (k+1) l, alpha env as xs s3 (l+1) j] +> in if j - i < 2 then 0.0 -- dead end, no way to split +> else prod [phis env !! id, sum $ map f ks] +> alphaRec env as xs i j tr = error +> ("(alphaRec) Unable to handle rule of rank "++show (length $ rhs tr)) + + +Function to lookup a value after they've been calculated. Only values >0 are stored +to avoid storing lots of garbage values. + +> alpha' :: (Eq a) => [Alpha a] -> a -> Int -> Int -> Double +> alpha' as a i j = case (lookup (a,i,j) as) of +> Just v -> v +> Nothing -> 0.0 + +=========== +BETA CALC + +Function for initial generation of beta values. Values that are +calculated are then stored in a list for use in recursive calls. + +> makeBetas :: (Eq a) => TOracle a -> [Alpha a] -> TStr a -> [Beta a] +> makeBetas env as xs = +> let syms = reverse $ symEnum env xs -- reverse of alpha's order +> in filter ((>0).snd) $ makeRec' env [] as xs syms where +> makeRec' env bs as xs [] = bs +> makeRec' env bs as xs (v@(a,i,j):vs) = +> let bNew = beta env bs as xs a i j +> in makeRec' env ((v,bNew):bs) as xs vs + +Helper function to determine what rule instances could have produced a +particular symbol. + +> traceUp :: (Eq a) => TOracle a -> TStr a -> a -> Int -> Int -> [TRuleInst a] +> traceUp env xs a i j = +> let p = getParse env xs +> n = length xs +> otherSpans = [toRC (i, j) | i<-[0..i], j<-[j..n-1]] +> cands = concatMap (\(r',c') -> p !! r' !! c') otherSpans +> in nub $ filter (\ru -> elem a (rhs ru)) $ cands + +Calculate a single beta value. + +> beta :: (Eq a) => TOracle a -> [Beta a] -> [Alpha a] -> TStr a -> a -> Int -> Int -> Double +> beta env bs as xs a i j = case (lookup (a,i,j) bs) of +> Just v -> v +> Nothing -> if alpha' as a i j <= 0 then 0.0 else -- added for optimization purposes +> let rInsts = filter (not.idRule) $ -- cases of A->A are not allowed (but A->B is ok) +> traceUp env xs a i j -- get possible parents of A as rule instances +> subBs = sum $ map (betaRec env bs as xs a i j) rInsts +> in if i==0 && j==(length xs - 1) && a == startSym env then 1.0 -- check for found terminal +> else if null rInsts then 0.0 -- check for dead end on wrong terminal +> else subBs where -- recursive case + +Recursive beta calculation. + +> betaRec :: (Eq a) => TOracle a -> [Beta a] -> [Alpha a] -> TStr a -> +> a -> Int -> Int -> TRuleInst a -> Double +> betaRec env bs as xs a i j (TRuleInst id lhs [rhs]) = +> prod [phis env !! id, beta env bs as xs lhs i j] -- travel up to a synonym +> betaRec env bs as xs a i j (TRuleInst id lhs [s1, s2]) = -- a is s1, s2, or both +> let ks1 = [j+1..length xs-1] -- for B -> AC +> ks2 = [0..i-1] -- for B -> CA +> f1 k = prod [beta env bs as xs lhs i k, alpha' as s2 (j+1) k] -- for B -> AC +> f2 k = prod [beta env bs as xs lhs k j, alpha' as s1 k (i-1)] -- for B -> CA +> parts = sum $ map snd $filter (fst) $ zip [a==s1, a==s2] +> [sum $ map f1 ks1, sum $ map f2 ks2] +> in prod [phis env !! id, parts] +> betaRec env bs as xs a i j (TRuleInst id lhs [s1, s2, s3]) = +> let ks1 = [(k,l) | k<-[j+1..length xs-2], +> l<-[j+2..length xs-1], k<l] -- for B -> ACD +> f1 (k,l) = prod [beta env bs as xs lhs i l, alpha' as s2 (j+1) k, +> alpha' as s3 (k+1) l] -- for B -> ACD +> ks2 = [(k,l) | k<-[0..i-1], l<-[j+1..length xs-1]] -- for B -> CAD +> f2 (k,l) = prod [beta env bs as xs lhs k l, alpha' as s1 k (i-1), +> alpha' as s3 (j+1) l] -- for B -> CAD +> ks3 = [(k,l) | k<-[0..i-2], l<-[1..i-1], k<l] -- for B -> CDA +> f3 (k,l) = prod [beta env bs as xs lhs k j, alpha' as s1 k (l-1), +> alpha' as s2 l (i-1)] -- for B -> CDA +> parts = sum $ map snd $filter (fst) $ zip [a==s1, a==s2, a==s3] +> [sum $ map f1 ks1, sum $ map f2 ks2, sum $ map f3 ks3] +> in prod [phis env !! id, parts] +> betaRec env bs as xs a i j tr = error +> ("(betaec) Unable to handle rule of rank "++show (length $ rhs tr)) + +Function for lookup of calculated beta values. Only non-zero values are stored. + +> beta' :: (Eq a) => [Beta a] -> a -> Int -> Int -> Double +> beta' bs a i j = case (lookup (a,i,j) bs) of +> Just v -> v +> Nothing -> 0.0 + + +=========== +MU CALC + +Calculate mu for a particular rule with a particular span. +NOTE: mu allows for ONE instance of A->A in the parse tree. This is a heuristic +to account for the presence of such rules but avoids over-abundance (otherwise +they could occur infinitely often). + +> mu :: (Eq a) => TOracle a -> [Alpha a] -> [Beta a] -> TStr a -> +> TRuleInst a -> [Int] -> Double +> mu env as bs xs (TRuleInst id a [b]) [i,j] = prod[phis env !! id, beta' bs a i j, alpha' as b i j] +> mu env as bs xs (TRuleInst id a [b,c]) [i,k,j] = +> prod[phis env !! id, beta' bs a i j, alpha' as b i k, alpha' as c (k+1) j] +> mu env as bs xs (TRuleInst id a [b,c,d]) [i,k,l,j] = +> prod[phis env !! id, beta' bs a i j, alpha' as b i k, alpha' as c (k+1) l, alpha' as d (l+1) j] +> mu env as bs xs _ _ = error "(mu) Bad TRuleInst or index list." + +Calculate z, the probability of the entire tree for normalization. + +> z :: (Eq a) => TOracle a -> [Alpha a] -> TStr a -> Double +> z env as xs = alpha' as (startSym env) 0 (length xs - 1) + + +=========== +NEW Q CALC + +Count algorithm implementation that uses the parse tree for efficiency. + +> count env as bs xs rID = +> let p = getParse env xs +> n = length xs +> f (i,j) = map (\r -> (r,i,j)) $ p !! i !! j -- get all rules out of a cell +> coords = [(i,j) | i<-[0..n-1], j<-[0..n-1], i+j<n] -- find cells with the right span +> -- find only rules with the right ID (and span) +> insts = map toIJs $ filter (\(r,i,j) -> rule r == rID) $ concatMap f coords +> result = sum (map (countB env as bs xs) insts) / denom +> denom = z env as xs +> in if denom<=0 then error "(count) z value of <=0" else result where +> toIJs (r, row,col) = (r, col, col+row) + +> countB :: (Eq a) => TOracle a -> [Alpha a] -> [Beta a] -> TStr a -> (TRuleInst a, Int, Int) -> Double +> countB env as bs xs (r@(TRuleInst id a [b]), i, j) = sum $ map (mu env as bs xs r) [[i,j]] +> countB env as bs xs (r@(TRuleInst id a [b,c]), i, j) = sum $ +> map (mu env as bs xs r) [[i,k,j] | k<-[i..j-1]] +> countB env as bs xs (r@(TRuleInst id a [b,c,d]), i, j) = sum $ +> map (mu env as bs xs r) [[i,k,l,j] | k<-[i..j-2], l<-[i+1..j-1], k<l, l<j] +> countB env as bs xs _ = error "(countB) Bad TRuleInst or mismatched index list." + +Sum counts over all strings in the data set. If usePar==True, then +the parallelized version is used. + +> f usePar env triples rID = +> let exprs = map (\(xs,as,bs) -> count env as bs xs rID) triples +> in if usePar then sum $ seq (triples) (exprs `using` parList rdeepseq) +> else sum $ exprs + +Find the normalization factor for a given rule. + +> qNorm :: (Eq a) => TOracle a -> [(TStr a, [Alpha a], [Beta a])] -> RuleIndex -> Double +> qNorm env triples rID = sum $ map (f parCounts env triples) $ +> findGroup (ruleGroups env) rID where +> findGroup [] rID = error ("(qNorm) Uknown rule: "++show rID) +> findGroup (g:gs) rID = if elem rID g then g else findGroup gs rID + +Re-estimate the probability of a rule. It is possible that a rule will not occurr +anywhere in the data set, and that can cause a zero denominator that would give +NaN as a result instead of 0.0, hence the check on the denominator below. + +> qNew :: (Eq a) => TOracle a -> [(TStr a, [Alpha a], [Beta a])] -> RuleIndex -> Double +> qNew env triples rID = +> let denom = qNorm env triples rID -- if this is zero then the rule hasn't occurred +> result = f parCounts env triples rID / denom +> in if denom <= 0 then 0.0 else result + +Iteratively compute the production probabilities over a data set given a +maximum number of iterations to run, aminimum probability (in case a rule +doesn't appear) and a threshold of change between two iterations' +distributions under which to stop. + +NOTE: this version does NOT check for cycles, such as a rule set that has +both A->B and B->A. Rule sets with cycles will spin infinitely. + +> learnProbs :: (Eq a, Show a) => TOracle a -> [TStr a] -> Int -> Double -> Double -> IO [[Double]] +> learnProbs env strs i minP dThresh = if i<=0 then return [] else do +> let as = map (makeAlphas env) strs +> bs = zipWith (\a s -> makeBetas env a s) as strs +> xab = zip3 strs as bs +> putStrLn "Calculating production probs..." +> let qs0 = phis env -- starting probabilities +> qs1s = map (qNew env xab) [0..length qs0 - 1] -- new probabilities +> qs1 = seq (as, bs, env) (qs1s `using` parList rdeepseq) -- parallelize computation of qs1 +> qf' = if minP > 0.0 then normalize2 (ruleGroups env) minP qs1 -- adjust minimum probs +> else normalize (ruleGroups env) qs1 +> env' = env{phis = qf'} -- environment for the next iteration (updated probs) +> diff = totalDiff qs0 qf' -- total change in probability mass +> putStrLn ("Total probability mass changed: "++show diff) +> putStrLn $ concat $ intersperse ", " $ map show qf' +> let badInds = findIndices (\x -> x<=0) qs1 -- are there any rules with prob <= 0? +> badStr = if null badInds then "ok" -- all are ok +> else "Zero-prob rules: "++show badInds -- some rules are prob <=0 +> (iNext, skipping) = if diff <= dThresh then (0, True) -- check for convergence +> else (i-1, False) +> itrStr = if skipping then ("Q has converged with "++show (i-1)++" iterations left.") +> else ("Iterations left: "++show (i-1)) +> putStrLn itrStr +> qNext <- learnProbs env' strs iNext minP dThresh -- compute next iteration +> return (qf' : qNext) -- return all iterations' probability distributions + + +Helper function to correct probabilities that are too small. It performs +normalization at the same time. + +> normalize2 :: [[Int]] -> Double -> [Double] -> [Double] +> normalize2 gs minP qs = +> let gqs = map (map (qs !!)) gs -- collect probabilities by rule group +> gqs' = map (fixMins minP) gqs -- correct for non-zero values +> gqsi = zip (concat gs) (concat gqs') -- flatten the list +> in map snd $ sort gqsi -- place the list back in its original order + +> fixMins minP xs = +> let isOk = findIndices (>=minP) xs +> isZ = findIndices (<minP) xs +> okVals = map (xs !!) isOk -- collect all of the values that are ok +> newSum = sum okVals + (fromIntegral (length isZ) * minP) -- adjust the normalization factor +> in map (\x -> if x<=0 then minP else x/newSum) xs -- normalize everything + +Produce uniform initial probabilities. + +> uniQs :: [[RuleIndex]] -> [Double] +> uniQs gs = normalize gs $ take (length $ concat gs) $ repeat 1.0 + +Produce random initial probabilities. + +> randQs :: [[RuleIndex]] -> StdGen -> [Double] +> randQs gs g = normalize gs $ take (length $ concat gs) $ vals g where +> vals g = let (d,g') = randomR (0.0, 1.0) g in d : vals g' + +Normalization function for production probabilities. + +> normalize :: [[RuleIndex]] -> [Double] -> [Double] +> normalize gs qs = concatMap (\g -> map (/sum g) g) $ map (map (qs !!)) gs + +Compute the total difference in two distributions of production probabilities. +The result is the total change in probability mass (NOT a percentage). + +> totalDiff :: [Double] -> [Double] -> Double +> totalDiff d1 d2 = sum $ map abs $ zipWith subtract d1 d2 + + +============================ + +PARAM-BASED PARSING + +The following is an implementation of standard CKY/CYK parsing +with extensions to allow rules of the form A->BCD, A->B, and +self productions of the form A->A. It uses the same oracle approach +as the code above to parse using rule instances rather than the +rule set itself. + +The updateTable function will take a partially filled parse table and +update the particular cell in question with any rules that will fit. + +> blankTable :: Int -> TParse a +> blankTable i = if i<=0 then [] else +> take i (repeat []) : blankTable (i-1) + +The startTable function builds an initial table. The rest is blank. + +> startTable :: TStr a -> TParse a +> startTable xs = +> let row0 = map (\x -> [TRuleInst (-1) x []]) xs +> in row0 : blankTable (length xs - 1) + +Given an environment and a string, buid a parse table. + +> buildTable :: (Eq a) => TOracle a -> TStr a -> TParse a +> buildTable env xs = +> let st = startTable xs +> n = length xs +> rowCols = [(r,c) | r<-[0..n-1], c<-[0..n-1], c<=n-(r+1)] +> in foldl' (\pt rc -> updateTable' env pt xs rc) st rowCols + +Iteratively update the table. Individual cells must be checked at least +twice each to ensure that all synonyms get added. + +> updateTable' env pTable xs (row,col) = +> let pTable' = updateTable env pTable xs (row,col) +> in if pTable == pTable' then pTable else updateTable' env pTable' xs (row, col) + +> updateTable :: (Eq a) => TOracle a -> TParse a -> TStr a -> Coord -> TParse a +> updateTable env pTable xs (row,col) = +> let cellPats = getCellCombos (row,col) 3 :: [[Coord]] +> cellStrs = concatMap (toStr pTable) cellPats -- :: [TStr a] +> newRules = concatMap (findByRHS env) cellStrs -- :: [TRuleInst a] +> in updateCell pTable (row,col) newRules + +Function to update an individual cell in a table with a new value. + +> updateCell :: (Eq a) => TParse a -> (Int, Col) -> [TRuleInst a] -> TParse a +> updateCell pTable (row,col) v = +> let preRows = take row pTable +> postRows = drop (row+1) pTable +> preCols = take col (pTable !! row) +> postCols = drop (col+1) (pTable !! row) +> newVal = nub (v ++ (pTable !! row !! col)) -- concat vals onto existing cell +> in preRows ++ [preCols ++ [newVal] ++ postCols] ++ postRows + + +Given a starting cell and a maximum number of segments to which it can +belong (this will be the rank of the grammar), return a series of other +coordinates to investigate. The starting cell is presumed to be the +"generator" of the other segments. + +> getCellCombos :: Coord -> Int -> [[Coord]] +> getCellCombos (row,col) maxSegs = if maxSegs <=0 then [] else +> let symCount = row+1 -- total number of symbols +> maxSegs' = min symCount maxSegs -- maximum number of segments +> segs = mkSegs' symCount maxSegs' -- symbol divisions +> in nub $ map (toInds col) segs + +Turn a series of coordinates into a string of symbols. For grammars with a +terminal/nonterminal division, this will be a potentially mixed string of +terminals and nonterminals. + +> toStr :: TParse a -> [Coord] -> [TStr a] +> toStr pTable coords = +> let f (r,c) = if r < length pTable && c < length (pTable !! r) +> then pTable !! r !! c else error ("(toStr) Bad coord: "++show (r,c)) +> cells = allCombos $ map f coords +> in map (map lhs) cells + +Given a set of collections of items (e:es), find all combinations +with one item from each collection in sequence. + +> allCombos :: [[a]] -> [[a]] +> allCombos [] = [[]] +> allCombos (e:es) = [(e':es') | e'<-e, es'<-allCombos es] + +Display functions for the parts of a parse table. When printing the +parse table, although rules are stored in each cell, only the lefthand +side of each rule will be printed to correspond to the more standard +CKY/CYK representation. + +> showCell :: (Show a) => TCell a -> String +> showCell trs = show $ map lhs trs + +> showRow :: (Show a) => [TCell a] -> String +> showRow trs = concat (intersperse " " $ map showCell trs) + +> showTable :: (Show a) => TParse a -> String +> showTable rs = concat $ intersperse "\n" $ map showRow rs + +> printTable ::(Show a) => TParse a -> IO() +> printTable = putStrLn . showTable
+ Kulitta/Learning/Learning.lhs view
@@ -0,0 +1,562 @@+Main module for learning PCFGs and PTGGs from data sets +Donya Quick + +Last modified: 22-Jan-2016 + +Implementation for learning chapter in doctoral thesis. + +> module Kulitta.Learning.Learning where +> import Kulitta.Learning.InsideOutside +> import Kulitta.Grammars.MusicGrammars +> import Kulitta.Learning.CykParser +> import System.Random +> import Data.List +> import Kulitta.ChordSpaces +> import Kulitta.Learning.Parser +> import System.Environment +> import System.IO.Unsafe +> import Kulitta.PTGG +> import Kulitta.Learning.TemporalGen + + +Modifications: +- Added support for temporal rules forking decision process + +Datatype definitions + +> version = "9g17c" + +CONSTANTS + +> logData = True -- whether to log command prompt output + +DISAMBIGUATIONS + +> type RRule a = Kulitta.Learning.Parser.Rule a +> type PRule a = (Double, (a, [a])) + +DATA TYPES + +> data GramMode = PCFG | Temporal +> deriving (Eq, Show, Ord, Read) + +> data Grammar = GramPCFG (RTerm, [RRule RTerm]) | GramOther + +> data DataSet = DataPCFG [(Int, Mode, [CType])] | DataOther + +> data DistMode = Uniform | Random Int +> deriving (Eq, Show, Ord, Read) + +> data Params = Params { +> confFile :: String, -- name of configuration file +> dataFile :: String, -- name of data file +> gramFile :: String, -- name of grammar definition file +> gramMode :: GramMode, -- grammar mode, PCFG or Temporal +> runIters :: Int, -- number of learning iterations +> convThresh :: Double, -- convergence threshold +> dataSeeds :: [Int], -- data sets to use during testing (one or more) +> initDist :: DistMode, -- initial probability distribution for rule set +> dataMode :: [Mode], -- what modes are in the data? (some combination of Major and Minor) +> maxLength :: Int, -- maximum length strings to select from data set +> sampleSize :: Int, -- sample size to choose from the data set +> filterData :: Bool, -- True if filtering data points based on length +> outNamePre :: String, -- optional additional prefix for output files +> minProb :: Double, -- minimum probability to allow for rules +> logFile :: String -- name of log file (to be set automatically) +> } + + + +======================================== +Code for writing output file of results + +STUFF TO REDEFINE EVENTUALLY: + +startSym = TR +rules = iotr + + +> mainL = do +> a <- getArgs +> let fname = if null a then error "No config file!" else a !! 0 +> pf <- readFile fname +> let p = parseCFile fname pf +> case (gramMode p) of PCFG -> mainPCFG p +> Temporal -> mainTemporal p + +> fixLHS (a,bs) = ((a,1.0::Rational), bs) + +> putLogLn logfile str = do +> putStrLn str +> if logData then appendFile logfile (str++"\n") else return () + +> putLog logfile str = do +> putStr str +> if logData then appendFile logfile str else return () + +> errorLog logfile str = do +> if logData then appendFile logfile str else return () +> error str + +> mainTemporal p = do +> (startSym, rules0) <- readTemporalRules $ gramFile p +> chords <- readTemporalData $ dataFile p +> let rules = map (snd) rules0 +> rules' = map fixLHS rules :: [RRule (CType, Rational)] +> printTemporal (startSym, rules) +> let ds = dataSeeds p +> putLogLn (logFile p) "Initializing production probs..." +> let initQs = makeQsT p rules' +> env = TOracle initQs startSym (ruleGroups2 rules') (findByRHS2 rules') +> chords' = if filterData p then filter ((<=maxLength p).length) chords else chords +> fRun = mainSub2 p rules' startSym chords' initQs env +> putLogLn (logFile p) "Running..." +> putLogLn (logFile p) ("Total data points: "++show (length chords)) +> putLogLn (logFile p) ("Average progression length: "++show(averageLength chords)) +> allQs <- seq chords (sequence $ map fRun $ [0..length ds-1]) +> putLogLn (logFile p) "\n\nSummarizing results..." +> writeFile (makePre (confFile p) ++ outNamePre p ++ "final.txt") $ mkQTableT ds rules' allQs +> putLogLn (logFile p) "Done.\n" + +> durAlph = recSum minDur maxDur where +> recSum x m = if x >= m then [m] else x : recSum (2*x) m + +> -- for temporal grammars +> mainSub2 p theRules startSymb allData initQs theEnv num = do +> let theSeed = (dataSeeds p !! num) +> putLogLn (logFile p) "===================" +> putLogLn (logFile p) ("Seed: " ++ show theSeed) +> putLogLn (logFile p) "Starting..." +> let chordsTaken = randomData (sampleSize p) theSeed allData +> writeFile (sampleFile p theSeed) $ show chordsTaken +> putLogLn (logFile p) ("Randomly taken data points: "++show (length chordsTaken)) +> putLogLn (logFile p) ("Average progression length: "++show(averageLength chordsTaken)) +> putLogLn (logFile p) ("Maximum progression length: "++show(maximum $ map length chordsTaken)) +> putLogLn (logFile p) ("Minimum progression length: "++show(minimum $ map length chordsTaken)) +> qs <- learnProbs theEnv allData (runIters p) (minProb p) (convThresh p) +> let qsAll = phis theEnv : qs +> prsAll = map (\q -> zip q theRules) qsAll +> prs = last prsAll +> resultFile = makePre (confFile p) ++ outNamePre p ++ "s"++show theSeed ++".txt" +> ruleStrs = mkQStrT prs +> putLogLn (logFile p) "Writing results..." +> writeFile resultFile (stats theSeed p +> ++ "Results: \n"++ruleStrs ++ +> "\n=============\n\n" ++ mkQTableT [0..(runIters p)] theRules qsAll) -- allQs prsAll) +> putLogLn (logFile p) "Done." +> return $ last qs + +> sampleFile p s = reverse (drop 4 $ reverse $ confFile p) ++ "_data" ++ +> show s ++ ".txt" + + +> mainPCFG p = do +> (startSym, rules) <- readPCFG $ gramFile p +> chords <- readData2 $ dataFile p +> printPCFG (startSym, rules) +> let ds = dataSeeds p +> putLogLn (logFile p) "Initializing production probs..." +> let initQs = makeQs p rules +> bachChords = procChords2 chords p rules startSym +> env = TOracle initQs startSym (ruleGroups1 rules) (findByRHS1 rules) +> fRun = mainSub1 p rules startSym bachChords initQs env +> putLogLn (logFile p) ("Total data points: "++show (length bachChords)) +> putLogLn (logFile p) ("Average progression length: "++show(averageLength bachChords)) +> putLogLn (logFile p) ("Maximum progression length: "++show(maximum $ map length bachChords)) +> putLogLn (logFile p) ("Minimum progression length: "++show(minimum $ map length bachChords)) +> putLogLn (logFile p) "Running..." +> allQs <- seq bachChords (sequence $ map fRun $ [0..length ds-1]) +> putLogLn (logFile p) "\n\nSummarizing results..." +> writeFile (makePre (confFile p) ++ outNamePre p ++ "final.txt") $ mkQTable ds rules allQs +> putLogLn (logFile p) "Done.\n" + +> averageLength lists = +> let lens = map (fromIntegral.length) lists +> in sum lens / fromIntegral (length lists) + +> getGrammar p = case (gramMode p) of +> PCFG -> do +> g <- readPCFG $ gramFile p +> return $ GramPCFG g +> _ -> errorLog (logFile p) "Only PCFGs are handled for now." + +> getData p = case (gramMode p) of +> PCFG -> do +> g <- readData $ dataFile p +> return $ DataPCFG g +> _ -> errorLog (logFile p) "Only PCFGs are handled for now." + + +> makeQs p rules = case initDist p of +> Uniform -> uniQs (ruleGroups1 rules) +> Random rSeed -> randQs (ruleGroups1 rules) (mkStdGen rSeed) + +> makeQsT p rules = case initDist p of +> Uniform -> uniQs (ruleGroups2 rules) +> Random rSeed -> randQs (ruleGroups2 rules) (mkStdGen rSeed) + + +> mainSub1 p rules startSym allData initQs bachEnv num = do +> let theSeed = (dataSeeds p !! num) +> putLogLn (logFile p) "===================" +> putLogLn (logFile p) ("Seed: " ++ show theSeed) +> putLogLn (logFile p) "Starting..." +> let bachChordsTaken = randomData (sampleSize p) theSeed allData +> writeFile (sampleFile p theSeed) $ show bachChordsTaken +> putLogLn (logFile p) ("Randomly taken data points: "++show (length bachChordsTaken)) +> putLogLn (logFile p) ("Average progression length: "++show(averageLength bachChordsTaken)) +> putLogLn (logFile p) ("Maximum progression length: "++show(maximum $ map length bachChordsTaken)) +> putLogLn (logFile p) ("Minimum progression length: "++show(minimum $ map length bachChordsTaken)) +> qs <- learnProbs bachEnv bachChordsTaken (runIters p) (minProb p) (convThresh p) +> let qsAll = phis bachEnv : qs +> prsAll = map (\q -> zip q rules) qsAll +> prs = last prsAll +> resultFile = makePre (confFile p) ++ outNamePre p ++ "s"++show theSeed ++".txt" +> ruleStrs = mkQStr prs +> putLogLn (logFile p) "Writing results..." +> writeFile resultFile (stats theSeed p +> ++ "Results: \n"++ruleStrs ++ +> "\n=============\n\n" ++ mkQTable [0..(runIters p)] rules qsAll) -- allQs prsAll) +> putLogLn (logFile p) "Done." +> return $ last qs + +> getPhi (a,b,c,d) = d + +> makePre fname = +> let toks = splitBy '.' fname +> in concat $ intersperse "." $ take (length toks - 1) toks + + +> stats rs p = "Program version: "++show version++ +> "\nRandom seed for data selection: "++show rs ++ +> "\nIterations (re-estimation): "++ show (runIters p) ++ +> "\nData points: "++show (sampleSize p)++" ("++show (dataMode p)++")\n\n" + + +CHECKSUM + +> sameLHS :: (Eq a) => PRule a -> PRule a -> Bool +> sameLHS (d,(l,r)) (d',(l',r')) = l==l' + +> ecOp :: (Eq a, Show a) => [PRule a] -> String +> ecOp [] = [] +> ecOp es@((d,(l,r)):rest) = +> let check = sum $ map fst es +> in show l ++"'s sum: "++show check++"\n" + +> checkProbs :: (Eq a, Show a) => [PRule a] -> String +> checkProbs rs = "\n\n"++concatMap ecOp (rs // sameLHS) + + +> showRule' :: (Show a) => (a, [a]) -> String +> showRule' (a,xs) = show a ++ " -> "++ concat (intersperse " " $ map show xs) + +> showInter:: (Show a) => String -> [a] -> String +> showInter x xs = concat $ intersperse x $ map show xs + +> mkQTable :: [Int] -> [RRule RTerm] -> [[Double]] -> String +> mkQTable seeds rs [] = error "(mkQTable) empty table!" +> mkQTable seeds rs qs = +> let qRows = Data.List.transpose qs +> f r qr = showRule' r ++ "\t" ++ showInter "\t" qr ++ "\n" +> in "Rule\t" ++ showInter "\t" seeds ++ "\n" ++ +> concat (zipWith f rs qRows) + +> mkQTableT :: [Int] -> [RRule (CType, Rational)] -> [[Double]] -> String +> mkQTableT seeds rs [] = error "(mkQTable) empty table!" +> mkQTableT seeds rs qs = +> let qRows = Data.List.transpose qs +> f r qr = showRuleT2 r ++ "\t" ++ showInter "\t" qr ++ "\n" +> in "Rule\t" ++ showInter "\t" seeds ++ "\n" ++ +> concat (zipWith f rs qRows) + +> showRohrStr = drop 1 . concatMap ((" "++).show) + +> mkQStr = concat . zipWith (\i s -> show i ++ ".\t" ++s) [0..] . map showRule + +> mkQStrT = concat . zipWith (\i s -> show i ++ ".\t" ++s) [0..] . map showRuleT1 + +> allQs = concat . zipWith (\i prs -> "Iteration "++show i++"\n"++mkQStr prs++"\n\n") [0..] + +> showRule :: PRule RTerm -> String +> showRule (d, (l,r)) = show d ++ "\t" ++ show l ++ " -> " ++ showRohrStr r ++ "\n" + +> showRuleT1 :: (Double, RRule (CType, Rational)) -> String +> showRuleT1 (d, (l,r)) = show d ++ " \t" ++ showRuleT2 (l,r) + +> showRuleT2 :: RRule (CType, Rational) -> String +> showRuleT2 (l,r) = show l ++ " -> " ++ showIt r where +> showIt = concat . intersperse " " . map show + +> randomData :: Int -> Int -> [[a]] -> [[a]] +> randomData amt seed dataIn = +> let f = randomR (0, length dataIn - 1) . snd +> inds = take amt $ tail $ nub $ map fst $ iterate f (0, mkStdGen seed) +> in if amt <= 0 || amt >= length dataIn then dataIn +> else map (dataIn !!) inds + + +======================================== +Code for parsing configuration files + +> testCFile f = readFile f >>= (printParams . parseCFile f) + +> splitBy :: (Eq a) => a -> [a] -> [[a]] +> splitBy a [] = [] +> splitBy a str = let xs = takeWhile (/=a) str in xs : splitBy a (drop (length xs + 1) str) + +> parseCFile :: String -> String -> Params +> parseCFile fname cstr = +> let plines = map (splitBy '\t') $ filter ((/="#").take 1) $ lines cstr +> goodData = and $ map ((>=2).length) plines +> in if not goodData then error "Badly formed configuration file!" +> else Params { +> confFile = fname, +> dataFile = plines !! 0 !! 1, +> gramFile = plines !! 1 !! 1, +> gramMode = read (plines !! 2 !! 1), +> runIters = read (plines !! 3 !! 1), +> convThresh = read (plines !! 4 !! 1), +> dataSeeds = read (plines !! 5 !! 1), +> initDist = read (plines !! 6 !! 1), +> dataMode = readMode (plines !! 7 !! 1), +> maxLength = read (plines !! 8 !! 1), +> sampleSize = read (plines !! 9 !! 1), +> filterData = read (plines !! 10 !! 1), +> outNamePre = plines !! 11 !! 1, +> minProb = read (plines !! 12 !! 1), +> logFile = makeLogFN fname } + +> printParams p = +> putLogLn (logFile p) (show $ confFile p) >> +> putLogLn (logFile p) (show $ dataFile p) >> +> putLogLn (logFile p) (show $ gramFile p) >> +> putLogLn (logFile p) (show $ gramMode p) >> +> putLogLn (logFile p) (show $ runIters p) >> +> putLogLn (logFile p) (show $ convThresh p) >> +> putLogLn (logFile p) (show $ dataSeeds p) >> +> putLogLn (logFile p) (show $ initDist p) >> +> putLogLn (logFile p) (show $ dataMode p) >> +> putLogLn (logFile p) (show $ maxLength p) >> +> putLogLn (logFile p) (show $ sampleSize p) >> +> putLogLn (logFile p) (show $ filterData p) >> +> putLogLn (logFile p) (show $ outNamePre p) >> +> putLogLn (logFile p) (show $ minProb p) >> +> putLogLn (logFile p) (show $ logFile p) + +> makeLogFN :: FilePath -> FilePath +> makeLogFN fp = reverse (drop 3 $ reverse fp) ++ "log" + +> readMode :: String -> [Mode] +> readMode "Major" = [Major] +> readMode "Minor" = [Minor] +> readMode "Both" = [Major, Minor] +> readMode x = error ("Badly formed mode: "++show x) + + +========================================== + +Grammar reading + +> testPCFG f = readFile f >>= (printPCFG . parsePCFG) + +> splitBy2 :: (Eq a) => [a] -> [a] -> [[a]] +> splitBy2 a [] = [] +> splitBy2 a str = +> let xs = takeWhile (not . (`elem` a)) str +> rest = splitBy2 a $ drop (length xs + 1) str +> in if null xs then rest else xs : rest + +> parsePCFG :: String -> (RTerm, [RRule RTerm]) +> parsePCFG gramstr = +> let gLines = filter (not.null) $ lines gramstr +> gLines' = map (splitBy2 "->") gLines +> sLines = filter ((==1).length) gLines' +> rLines = filter ((>=2).length) gLines' +> startSym = if null sLines then error "(parsePCFG) No start symbol!" +> else read $ head $ head sLines +> f rln = (read $ head rln, map read $ splitBy ',' $ rln !! 1) +> in (startSym, map f rLines) + +> showRule2 :: RRule RTerm -> String +> showRule2 (l,r) = show l ++ " -> " ++ showRohrStr r ++ "\n" + +> printPCFG (s, rs) = +> putStrLn ("Start Symbol: " ++ show s) >> +> putStrLn (concatMap showRule2 rs) + +> readPCFG :: FilePath -> IO (RTerm, [RRule RTerm]) +> readPCFG fp = readFile fp >>= (return . parsePCFG) + + + +========================================== + +Simple data file parsing + +> readData f = readFile f >>= (return . parseData) +> readData2 f = readFile f >>= (return . parseData2) + +Old definition of parseData: + +> parseData :: String -> [(Int, Mode, [CType])] +> parseData dstr = +> let dlines = filter (not.null) $ lines dstr +> rlines = map (splitBy '\t') $ tail dlines +> g = map read . splitBy ' ' +> f s = (read (s !! 0), readMode2 (s !! 1), g (s !! 2)) +> in map f rlines + +> parseData2 :: String -> [(Int, Mode, [RTerm])] +> parseData2 dstr = +> let dlines = filter (not.null) $ lines dstr +> ftype = head dlines +> rlines = map (splitBy '\t') $ tail dlines +> g = map (readR ftype) . splitBy ' ' +> f s = (read (s !! 0), readMode2 (s !! 1), g (s !! 2)) +> in map f rlines + +> readR :: String -> String -> RTerm +> readR "Numerals" = C . read +> readR "TSD" = read + +> readMode2 "Major" = Major +> readMode2 "Minor" = Minor +> readMode2 x = error ("(readMode2) Bad mode: "++show x) + + + + +========================================== + +STUFF THAT NEEDS TO BE MOVED TO OTHER FILES + + +> iotr = [(TR, [T]), +> (TR, [TR, TR]), +> (TR, [DR, T]), +> (TR, [TR, DR]), +> +> (DR, [DR, DR]), +> (DR, [D]), +> (DR, [SR, D]), +> +> (SR, [S]), +> (SR, [SR, SR]), +> +> (T, [C VI]), +> (T, [C III]), +> (T, [C I]), +> (T, [C I, C II, C VI]), +> (T, [T,P]), + +> (D, [C VII]), +> (D, [C V]), + +> (S, [C IV]), +> (S, [C II]), +> (S, [C IV, C III, C IV]), + +> (P, [C IV, C I]), +> (P, [C IV, P])] + + +bachChords = filter parseable $ map (map C) $ + let majExs = filter (\(a,b,c) -> b==mode) chordData + justCs = map (\(a,b,c) -> c) majExs + cs = take 10000 justCs + in if useDataFilter then dataFilter cs else cs + +> fst3 (a,b,c) = a +> snd3 (a,b,c) = b +> thd (a,b,c) = c + + bachChords' p rules ss = filter (parseable rules ss) $ map (map C) $ + let okLines = filter ((`elem` dataMode p).snd3) chordData + unfiltered = map thd okLines + filtered = filter ((<=maxLength p).length) unfiltered + in if (filterData p) then filtered else unfiltered + +> procChords :: [(Int, Mode, [CType])] -> Params -> [RRule RTerm] -> RTerm -> [[RTerm]] +> procChords chords p rules ss = filter (parseable rules ss) $ map (map C) $ +> let okLines = filter ((`elem` dataMode p).snd3) chords +> unfiltered = map thd okLines +> filtered = filter ((<=maxLength p).length) unfiltered +> in if (filterData p) then filtered else unfiltered + +> procChords2 :: [(Int, Mode, [RTerm])] -> Params -> [RRule RTerm] -> RTerm -> [[RTerm]] +> procChords2 chords p rules ss = filter (parseable rules ss) $ +> let okLines = filter ((`elem` dataMode p).snd3) chords +> unfiltered = map thd okLines +> filtered = filter ((<=maxLength p).length) unfiltered +> in if (filterData p) then filtered else unfiltered + +> parseable rules ss = (ss `elem`) . concat . last . allRowsMS 3 rules + +================================= + +Code to support InsideOutside implementation that will do learning for either datatype + +Default function for RHS side matching for simple CFGs (no parameters). + +> findByRHS1 :: (Eq a) => [RRule a] -> TStr a -> [TRuleInst a] +> findByRHS1 rs xs = +> let rsi = zip [0..length rs-1] rs +> rsi' = filter ((==xs).snd.snd) rsi +> in map (\(i, (l,r)) -> TRuleInst i l r) rsi' + +Default function for rule grouping with simple CFGs. + +> ruleGroups1 :: (Eq a) => [RRule a] -> [[RuleIndex]] +> ruleGroups1 rs = +> let rsi = zip [0..length rs-1] rs +> in map (map fst) $ groupBy (\a b -> fst (snd a) == fst (snd b)) rsi + +Default function for RHS matching for temporal CFGs + +> findByRHS2 :: (Eq a) => [RRule (a,Rational)] -> TStr (a,Rational) -> [TRuleInst (a,Rational)] +> findByRHS2 rs xs = +> let xsNorm = temporalNorm xs +> is = findIndices ((==xsNorm).snd) rs +> rs' = map (rs !!) is +> trs = map (makeInstance xs) $ zip is rs' +> in filter validInstance trs + +> temporalNorm :: TStr (a, Rational) -> TStr (a, Rational) +> temporalNorm xs = +> let tsum = sum $ map snd xs +> in map (\(a,b) -> (a,b/tsum)) xs + +> validInstance :: TRuleInst (a,Rational) -> Bool +> validInstance (TRuleInst id lhs rhs) = +> let test1 = sum (map snd rhs) == snd lhs -- total durations are preserved +> test2 = and $ map (\d -> elem d allDurs) $ snd lhs : map snd rhs -- no weird durs like 1/3 +> in test1 && test2 + +The following are all possible durations we can expect to encounter in the data. The +start symbol is assumed to be (I, 1.0) always, so durations must be <=1.0 and of the +form 1/(2^n) for n in [0,8]. + +> allDurs = [wn, hn, qn, en, sn, tn, 1/64, 1/128, 1/256] :: [Rational] + +> makeInstance :: TStr (a, Rational) -> (RuleIndex, RRule (a, Rational)) -> TRuleInst (a, Rational) +> makeInstance xs (id, ((l,d),r)) = TRuleInst id (l, sum $ map snd xs) xs + +Default function for rule grouping with PCFGs written as pairs. Since the Rational component +should always be 1.0 for the rules, the approach for simple CFGs will also work with PCFGs in +this form. + +> ruleGroups2 :: (Eq a) => [RRule a] -> [[RuleIndex]] +> ruleGroups2 = ruleGroups1 + +==================================== + +Reading Q-Files (for use in other modules) + +> readProbsFinal :: FilePath -> IO [[Double]] +> readProbsFinal fp = do +> str <- readFile fp +> let valsRaw = map (splitBy '\t') $ lines str +> dVals = map (map read) $ map (drop 1) $ tail valsRaw +> return dVals +
+ Kulitta/Learning/LearningMain.lhs view
@@ -0,0 +1,23 @@+Main module for Learning +Donya Quick + +Last modified: 22-Jan-2016 + +A GHC-compilable interface to Learning.lhs + +To compile, use: + +ghc -O2 LearningMain.lhs -o "Learning.exe" -rtsopts -threaded + +To run, use: + +Learning.exe configFile.txt +RTS -Nx + +where x is the number of cores you wish to use (e.g. use -N8 for 8 cores). + +See the sampleConfig folder for examples of configuration files. + +> module Main where +> import Learning + +> main = mainL
+ Kulitta/Learning/PCFGtoPTGG.lhs view
@@ -0,0 +1,67 @@+PCFG to PTGG Conversion +Donya Quick + +Last modified: 22-Jan-2016 + +Module for turning a PCFG into a PTGG for use with Kulitta's +generative algorithms. + +> module Kulitta.Learning.PCFGtoPTGG where +> import Kulitta.EuterpeaSpecial +> import Kulitta.Grammars.MusicGrammars +> import Kulitta.Learning.Parser +> import Kulitta.PTGG + +> toTerm :: MP -> Dur -> a -> Term a MP +> toTerm p d x = NT (x, p{dur=d}) + +> s' = S :: RTerm + +Make a PTGG using constant durations: + +> ptggRule1 :: Dur -> (Double, Kulitta.Learning.Parser.Rule a ) -> Kulitta.PTGG.Rule a MP +> ptggRule1 dConst (p, (lhs,rhs)) = +> (lhs,p) :-> \p -> map (toTerm p dConst) rhs where + +> toPTGG1 :: Dur -> [(Double, Kulitta.Learning.Parser.Rule a )] -> [Kulitta.PTGG.Rule a MP] +> toPTGG1 d = map (ptggRule1 d) + + +Make a PTGG using temporal divisions of 2 and 4 and a minimum duration: + +> ptggRule2 :: (Double, Kulitta.Learning.Parser.Rule a ) -> Kulitta.PTGG.Rule a MP +> ptggRule2 (a, (lhs, rhs)) = (lhs,a) :-> \par -> durPats par rhs where +> durPats p xs = case xs of +> [x] -> [NT (x, p)] +> [x1,x2] -> map NT $ zip [x1,x2] [h p, h p] +> [x1,x2,x3] -> map NT $ zip [x1,x2,x3] [q p, q p, h p] +> [x1,x2,x3,x4] -> map NT $ zip [x1,x2,x3, x4] [q p, q p, q p, q p] +> _ -> error ("(toPTGG2) Bad rule rank: "++show (length xs)) + +> toPTGG2 :: (Dur -> Bool) -> [(Double, Kulitta.Learning.Parser.Rule a )] -> [Kulitta.PTGG.Rule a MP] +> toPTGG2 fd = map (toRelDur fd . ptggRule2) + + +Make a PTGG Using only CTypes + +> ptggRule3 :: (Double, Kulitta.Learning.Parser.Rule RTerm ) -> Kulitta.PTGG.Rule CType MP +> ptggRule3 (d, (lhs, rhs)) = ptggRule2 (d, (forceCT lhs, map forceCT rhs)) + +> toPTGG3 :: (Dur -> Bool) -> [(Double, Kulitta.Learning.Parser.Rule RTerm )] -> [Kulitta.PTGG.Rule CType MP] +> toPTGG3 fd = normalize . map (toRelDur2 fd . ptggRule3) + + + + +Utility for forcing conversion of generated Terms. TR and T are forced to +I, DR and D are forced to V, and so on. P in this case is "plagal" (which +resolves to I), but this interpretation would also work for P as "phrase." + +> forceCT :: RTerm -> CType +> forceCT (C ct) = ct +> forceCT r = +> let rts = [Piece, TR, DR, SR, T, D, s', T, TP, TCP, SP, DP, P] :: [RTerm] +> cts = [I, I, V, IV, I, V, IV, I, I, I, IV, V, I] :: [CType] +> rcts = zip rts cts :: [(RTerm, CType)] +> in case lookup r rcts of Just y -> y +> Nothing -> error "(forceCT) Unhandled constructor"
+ Kulitta/Learning/Parser.lhs view
@@ -0,0 +1,150 @@+CYK Parsing Module+Donya Quick++Last modified: 22-Jan-2016++> module Kulitta.Learning.Parser where+> import Data.List++> type Rule a = (a, [a])+> type Partial a = [Rule a]+> type Parse a = [Partial a]++1. Given a list of symbols, need a way to find+all possible rule parses. ++The following function will find possible rules to apply+to the start of a string (list) of symbols.++> findMatches :: (Eq a) => [Rule a] -> [a] -> [(a, [a])]+> findMatches rules xs = +> let f (lhs, rhs) = take (length rhs) xs == rhs+> in filter f rules+++We try brute-force left to right parsing, given a rule list.++> recParse1 :: (Eq a) => [Rule a] -> [a] -> [Partial a] -- [[(a, [a])]]+> recParse1 rules [] = [[]]+> recParse1 rules xs = +> let mats = findMatches rules xs -- get all possible next steps+> f (lhs, rhs) = drop (length rhs) xs +> xs' = map f mats -- cut xs based on mats+> finals = map (recParse1 rules) xs'+> finals' = zipWith (\h ts -> map (h:) ts) mats finals+> in filter (okParse xs) $ concat finals'++if null mats then [] else undefined -- filter (okParse xs) finalStrs++> okParse :: (Eq a) => [a] -> [(a, [a])] -> Bool+> okParse xs parse = length xs == length (concatMap snd parse)+++> nextLevel :: (Eq a) => [Rule a] -> Partial a -> [Partial a]+> nextLevel rules = recParse1 rules . map fst +++We need to do the following:+1. First form an initial parse list. Must go from [a] to [Partial a].+2. For each Partial, x, create a new [Partial a], xs. + - for each y in xs, append x to it. Make it a Parse a.+ + +> iterParseStep :: (Eq a) => [a] -> [Rule a] -> Parse a -> [Parse a]+> iterParseStep dset rules [] = map (\x -> [x]) $ recParse1 rules dset+> iterParseStep dset rules parse = +> let theStr = head parse+> nextLevels = nextLevel rules theStr+> in map (\x -> x:parse) nextLevels++> isStart :: (Eq a) => a -> [Rule a] -> Bool+> isStart ssym [(a,bs)] = ssym==a+> isStart ssym _ = False++> type StopFun a = Parse a -> Bool++> noReps :: (Eq a) => [a] -> Bool+> noReps [] = True+> noReps (x:xs) = not (elem x xs) && noReps xs++> isNew :: (Eq a) => [[a]] -> [a] -> Bool+> isNew allPs newP = +> let x = head newP+> f p = elem x p+> in not $ or $ map f allPs++> filterUniques :: (Eq a) => [[a]] -> [[a]]+> filterUniques [] = []+> filterUniques (x:xs) = +> if isNew xs x then x:filterUniques xs else filterUniques xs++> removeRedundants :: (Eq a) => [[a]] -> [[a]]+> removeRedundants xs = +> let f a bs = elem (head a) $ tail bs+> g x = not $ or $ map (f x) xs+> in filter g xs++> iterParse :: (Eq a) => StopFun a -> [a] -> [Rule a] -> [Parse a] -> Int -> Int -> [Parse a]+> iterParse stopFun dset rules parses count lim = +> let iStops = findIndices stopFun parses -- find any finished parses+> parses' = concatMap (iterParseStep dset rules) parses+> fullParse = iterParse stopFun dset rules (iterParseStep dset rules []) (count+1) lim+> recParse = filter (noReps) $ nub $ iterParse stopFun dset rules parses' (count+1) lim+> recParse' = filterUniques recParse+> in if count >= lim then parses else -- stop because of iterations limit+> if null parses then fullParse else -- start from beginning+> if null iStops then recParse' else map (parses !!) iStops++> parse :: (Eq a) => StopFun a -> [Rule a] -> [a] -> Int -> [Parse a]+> parse stopFun rules dset maxIters = iterParse stopFun dset rules [] 0 maxIters+++> iterParse2 :: (Eq a) => StopFun a -> [a] -> [Rule a] -> [Parse a] -> Int -> Int -> [Parse a]+> iterParse2 stopFun dset rules parses count lim = +> let iStops = findIndices stopFun parses -- find any finished parses+> fParses = map (parses!!) iStops+> uParses = map (parses!!) [x | x<-[0..length parses-1], not $ elem x iStops]+> parses' = concatMap (iterParseStep dset rules) uParses+> fullParse = iterParse2 stopFun dset rules (iterParseStep dset rules []) (count+1) lim+> recParse = nub $ iterParse2 stopFun dset rules parses' (count+1) lim+> in if null parses then fullParse else +> if count >= lim then fParses else (fParses ++ recParse)++> parseAll :: (Eq a) => StopFun a -> [Rule a] -> [a] -> Int -> [Parse a]+> parseAll stopFun rules dset maxIters = iterParse2 stopFun dset rules [] 0 maxIters++======= DISPLAY =======++> showRHS :: (Show a) => Partial a -> String+> showRHS = show . concatMap snd++> showParse :: (Show a) => Parse a -> String+> showParse [] = []+> showParse [x] = showLevel x ++ "\n" ++ showRHS x ++ "\n\n"+> showParse (h:t) = showLevel h ++ "\n" ++ showParse t++> showLevel :: (Show a) => Partial a -> String+> showLevel [] = []+> showLevel (h:t) = show h ++ " " ++ showLevel t+++> printParse p = putStr $ showParse p++======= TESTING =======++> testStr = [1,1,1]+> testRules = [(1, [1,1]),+> (1, [1,2]),+> (2, [2,2]),+> (1, [1])]++> testStop :: StopFun Int+> testStop ([(1,_)]:_) = True+> testStop _ = False++> testP = parse testStop testRules testStr 100+> testP' = parseAll testStop testRules testStr 100++> testStr2 = [1,1,1,2]+> testP2 = parse testStop testRules testStr2 100+> testP2' = parseAll testStop testRules testStr2 100
+ Kulitta/Learning/TemporalGen.lhs view
@@ -0,0 +1,97 @@+PTGG Generation module for creating training data sets +Donya Quick +Last modified: 22-Jan-2016 + +> module Kulitta.Learning.TemporalGen where +> import Kulitta.PTGG +> import Kulitta.Grammars.MusicGrammars +> import Data.List +> import System.Random +> import Kulitta.Learning.InsideOutside + + +> type TSym a = (a, Rational) +> type RHS a = [TSym a] +> type TRule a = (a, RHS a) + + +> tSeed = [i (defMP{dur=maxDur})] :: Sentence CType MP +> maxDur = 1.0 +> minDur = sn +> dataPoints = 1000 +> rSeed = 0 +> iters = 4 +> useLets = False + +> infInts g = +> let (g1, g2) = split g +> (i, g') = next g +> in i : infInts g2 + +Generating a data set from the + +gen (rRules1 minDur useLets) iters i Major tSeed + +> genData = +> let f i = snd (gen (rRules1 minDur useLets) (mkStdGen i, tSeed) !! iters) +> theData = map f $ take dataPoints $ infInts (mkStdGen rSeed) +> in map toPairs theData + +> writeData = writeFile "tdata.txt" $ concat $ intersperse "\n" $ map show genData + + +====================== + +> convRule :: (Prob, TRule a) -> Rule a MP +> convRule (p, (lhs, rhs)) = (lhs, p) :-> toRuleFun rhs + +> toRuleFun :: [(a, Dur)] -> RuleFun a MP +> toRuleFun rhs p = map (\(c,d) -> (NT (c, dFac d p))) rhs + +> readTemporalRules :: FilePath -> IO ((CType, Dur), [(Prob, TRule CType)]) +> readTemporalRules fp = do +> str <- readFile fp +> let theLines = lines str +> startSym = read (head theLines) :: (CType, Dur) +> theRules = map (read) $ tail $ theLines +> return (startSym, theRules) + +> readTemporalRules2 :: FilePath -> IO ((CType, Dur), [Rule CType MP]) +> readTemporalRules2 fp = do +> (startSym, theRules) <- readTemporalRules fp +> return (startSym, map convRule theRules) + +> readPTGG = readTemporalRules2 + + +> readTemporalData :: FilePath -> IO [[(CType, Dur)]] +> readTemporalData fp = do +> str <- readFile fp +> return $ map (read) $ lines str + +> showTemporal :: ((CType, Dur), [TRule CType]) -> String +> showTemporal (startSym, rules) = +> show startSym ++ "\n\n" ++ +> concat(intersperse "\n" $ map showTRule rules) + +> showTRule (lhs, rhs) = show lhs ++ " -> "++ +> concat (intersperse " " $ map show rhs) + +> printTemporal = putStrLn . showTemporal + +gen (map (toRelDur2 minD) rs) numIters i Major tSeed + +> genFromFile fpIn fpOut minD dataAmt seed numIters = do +> (startSym, rs) <- readTemporalRules2 fpIn +> let f i = snd (gen (map (toRelDur2 (<minD)) rs) (mkStdGen i, tSeed) !! numIters) +> theData = map f $ take dataPoints $ infInts (mkStdGen seed) +> theData' = map toPairs theData +> writeFile fpOut $ concat $ intersperse "\n" $ map show theData' + +> genDataTest = genFromFile "trules.txt" "tdata.txt" 0.01 1000 0 3 + +> genDataTest2 = genFromFile "trules2.txt" "tdata2.txt" 0.01 1000 0 3 + +> trules2 = genFromFile "trules2.txt" "tdata2.txt" minDur dataPoints 4 iters + +> trules3 = genFromFile "learning\\trules3.txt" "learning\\tdata3.txt" minDur dataPoints 4 iters
+ Kulitta/Learning/sampleConfig/BachChordsTSD.txt view
@@ -0,0 +1,4100 @@+TSD + 5 Major T D T T T S S S S T + 5 Major T S D D T S D D T T S D + 5 Major T T S S T S D T T D D D T + 5 Major T D T T T S S S S T + 5 Major T S D D T S D D T T S D + 5 Major T T S S T S D T T D D D T + 5 Major D T T D T D T + 5 Major T T T T D D D D T T T T D + 5 Major T T S T T S D T T T + 5 Major T T S S T T S D T T S D D D T + 7 Minor T + 10 Major D T D T T + 10 Major S D T T S S D + 10 Major T T T + 10 Major D D S S T + 7 Minor T D D + 7 Minor T T D + 10 Major T T T T S D T T + 10 Major S S D D T + 10 Major T T + 5 Major S T T T T D + 5 Major T S D T S + 0 Minor D S T + 0 Minor D D T D T T T T + 0 Minor T D T D + 2 Minor T D T S T S D T + 2 Minor T T T D + 5 Major D T T S S + 2 Minor D + 2 Minor T D S S T S D T S D T + 2 Minor S + 9 Minor T T S T T D T + 0 Major S D D T + 0 Major D T D T S S T + 5 Major T + 5 Major T S S T T S + 2 Minor S S T T T + 0 Minor T D T S S T S T D D T + 0 Minor T T + 3 Major T D D D T D S S S + 0 Minor S D + 0 Minor T T D S S T S D T S D T + 0 Minor S + 7 Minor T S T S D T S D D T + 7 Minor D + 3 Major S D S D D T T S D D T + 3 Major T S T + 2 Major S T S T T T S T + 11 Minor T D T + 11 Minor T D D T T S S T S D T T D T + 11 Minor T T T + 2 Major S T T T S T + 11 Minor T D T + 11 Minor T D D T T S S T S D T T D T + 9 Major S T D S D T D T S T T D D T D T + 9 Major S T S S S + 11 Minor D T T S S T S S D + 2 Major T S T S S T T T T T S T D T + 2 Major T S D T S T S D D T S T S T + 9 Major T T T T S D T S D T T D T + 9 Major T T T T S T S T D D T S T D S T + 9 Major T T T T S D T S D T T D T + 9 Major T T T T S T S T D D T S T D S T + 9 Major T D T T D D T T S D T T T S + 9 Major D T T S D S S T S D D T + 9 Major T T S S T S T D T S D T + 11 Minor T S S S S T T S S D D T T D + 11 Minor T S T T D D T D T T T S T T D + 11 Minor T + 9 Major T S T D S D D T D T T T S T S S + 9 Major D D T S T S + 11 Minor T D D T S T T T S + 11 Minor T T D T D T T D D T S T T S S + 11 Minor T T D D D T D T T S T S T D S + 11 Minor T S S S D + 2 Major T D D + 2 Major S D T T S D T T T T D D S + 2 Major D D T T S S D D D D T + 2 Major T T T T D D T T T S T T T T D D + 2 Major S D T T S D T T T T D D S + 2 Major D D T T S S D D D D T + 2 Major D S D D T T S D S S S + 4 Minor T S S D T + 4 Minor D D T D D D D D D T + 11 Minor S + 11 Minor S T S T S T S T D T D + 2 Major T S T T S T D T D D T T D D D + 2 Major T S S S T S D T S D D D T T + 11 Minor T T T D D T T T T D D T + 11 Minor T T D T D D T T T T T T + 11 Minor D D T T T T S S T T D D T + 11 Minor T S S T T D T + 9 Major S D S D T + 9 Major T T S S S S D D T D T + 11 Major T D S D + 11 Major S S D D D T + 0 Major T T S S T T T T T D D T + 0 Major T D S + 9 Minor T S D T T D D T T T D D + 9 Minor D T D T + 0 Major T T S S T T + 0 Major T T T D D T T D S + 9 Minor T S D + 9 Minor T T D D T T T D D D T D T + 9 Minor T + 7 Major S D D D D T T T D T T T T S S + 7 Major D T S S D S T T S S + 7 Major T + 9 Minor D T + 0 Major T S S S T T T S S T T + 0 Major T T T D D T T D S + 9 Minor T S D + 9 Minor T T D D T T T D D D T D T + 7 Major T D T T S D S D T T D D T + 7 Major T T T D T S T D D T T T S D D T + 7 Major T D T T S D S D T T D D T + 7 Major T T T D T S T D D T T T S D D T + 7 Major T D T S T + 9 Minor T T S T T + 9 Minor S T D T D T + 4 Minor S T T S S S D + 4 Minor T T T T D T S T T T S T T T S + 7 Major D T + 11 Minor T T S S D D T S S T D D T + 11 Minor T T D D D S T T T S T T T T D + 11 Minor T T S S D D T S S T D D T + 11 Minor T T D D D S T T T S T T T T D + 11 Minor T T D D T T D T S S T T D D T + 11 Minor T T D D T T D T D T D T T S D + 11 Minor D T T D S T T D T T S S D D + 11 Minor D + 10 Major T T T S T T T T S D + 7 Minor D S T + 7 Minor T D S T S T T S T S D D T + 7 Minor T T + 10 Major T S T T T T S D + 7 Minor D S T + 7 Minor T D S T S T T S T S D D T + 10 Major D T T T T D T D D S S D T + 5 Major S T + 5 Major S S D T D T S D T T D S D D T + 5 Major S S T S D T S S D S T T T + 7 Major T T S S D T T T T T S D T + 7 Major S S D D T D T T S S D D T + 7 Major T T S S D T T T T T S D T + 7 Major S S D D T D T T S S D D T + 7 Major D T D D T T D S + 2 Major S D + 2 Major T D T T T D T T S S D + 7 Major D + 7 Major S S D D T T T T S D S D D T + 9 Major T D S S S D T T T S S D T + 9 Major D T S S T S D T + 9 Major T D S S S D T T T S S D T + 9 Major D T S S T S D T + 9 Major S D T D + 6 Minor D T D S S T T T D + 6 Minor D + 9 Major T D D T T D D S S T S D + 9 Major D D T + 7 Major D D T D D T T S T S S S T T S + 7 Major D T + 2 Major T S T S S D D T + 7 Major D T S D + 7 Major D D T D D T T S T S S S T T S + 7 Major D T S T D T + 2 Major S D D T T T D T + 2 Major S T S S T S D D T T S T D D T + 7 Major T T T T T T S S T S D T S S S T + 7 Major T D D S S T T S S S D T + 7 Major T S D D T T + 7 Major D D S S D T + 7 Major T D D + 9 Minor S S D + 9 Minor T S T + 4 Major T + 0 Major T T T + 0 Major S T D D S S T + 0 Major S S T T S + 7 Major T T + 7 Major T T S S D + 7 Major D T T S + 0 Major T T + 0 Major T T T D S T S T D D D T + 10 Major T T D T S S T D D T + 10 Major S S D S S T S S D D T + 10 Major T T D T S S T D D T + 10 Major S S D S S T S S D D T + 10 Major T S S S S D D T T T T S + 10 Major T T S T T D D T + 5 Major S D D D + 10 Major T S S T S D D T T D D T + 4 Major D T S S S S + 2 Major T S T + 2 Major T S T T S S T T T T D T + 2 Major S D D T D T T S D + 2 Major D T T T T S S S S T T S T + 2 Major T D S D T T D T S S D D T + 2 Major D T T T T S S S S T S T + 2 Major S S D T D S S D D T + 2 Major D T T T T S D S S T T D D T + 2 Major T T D T D S D D T + 2 Major D T D T T D D T T + 2 Major T D T D S D D T D + 2 Major T D T T D D T T T + 2 Major D T D S D D T D T + 2 Major D T T D D T T T D + 2 Major T D S D D T D T D + 2 Major T T D D T T T T T T S + 2 Major T T S D S T T D T + 2 Major D D S S D D T D + 2 Major T T T D D T + 4 Minor T T T T T S D T D T S + 4 Minor T D + 2 Major T S D T T T S + 2 Major D T S S T T S T S S T + 2 Major T D T D T T T T T T S S T S D + 2 Major S D T T T T T S D + 4 Minor D + 4 Minor T D T + 7 Major T T S T S T D T T T S D T + 7 Major D + 11 Minor S T S S D T D T D T T T T + 11 Minor T D T T T T T T T T T D T D + 7 Minor T T T T T T D D T T T S + 7 Minor T D + 2 Minor S T T S S T + 2 Minor T S T T D D + 7 Minor D + 7 Minor T + 10 Major S T T S S T S T + 10 Major D T T S D T + 7 Minor D D T S T D + 6 Minor S S S S T D + 6 Minor D T + 2 Major T S D D + 2 Major T D D D D T + 2 Major T D T S S + 2 Major S S + 11 Minor T T T S S + 11 Minor S S D + 11 Minor T + 6 Minor S S S T D + 6 Minor D T + 2 Major T S D D + 2 Major T D D D D T + 2 Major T D T S S + 2 Major S S + 11 Minor T T T S S + 11 Minor S S D + 11 Minor T + 2 Major T S D + 2 Major T + 11 Minor T S + 11 Minor T D D + 11 Minor T S S D + 11 Minor D D T S S D + 11 Minor D T + 4 Major T T T T S S S S S S D D D T D T + 11 Major T T D T D D T S D D T T S S D D + 11 Major T S + 4 Major T T T S T S S D T S D + 4 Major T T D T T S D T T D D T T + 4 Major S S D D D T T T T T S T S T + 4 Major D D T T T T T T S D T T + 4 Major S S D T T + 11 Minor S T S T T S T S S T D D T + 11 Minor T D T D T S T T D T + 11 Minor D T + 4 Minor T S S D T T S S T S + 4 Minor D D T T D D T D T + 7 Major T + 7 Major T S D T T T D T S D T + 7 Major D S T T S S T D T D S T + 4 Minor D T + 9 Minor T S T S S D D T S T D D T + 9 Minor T D D D + 0 Major D T + 9 Minor T T T S S S D + 9 Minor D T T S S D D T D S T T D T + 9 Minor T S T T T D S S T S T T S T S T + 9 Minor D T T S S T S T T D T T D T + 9 Minor T T + 0 Major T T S D T D T T S S S + 0 Major D T S T S D D + 0 Major D T T T T T T T S T + 0 Major S + 9 Minor T D T T T + 0 Major S T T T T + 0 Major T T S T T T T S T T D D D D T + 0 Major T T T T T T S S S + 9 Minor T S D D T + 9 Minor T + 2 Minor S T T D T T D T + 2 Minor S D T T T T T D D S + 0 Major D D T S T S + 5 Major T T T T T D D T D S T D T + 5 Major T T D T S S D T S D T + 0 Major S T D T + 0 Major S T T S T T S S D T T D T + 0 Major S S T T S D T S D S D + 5 Major D T + 5 Major T S D T T S S T T S D T T D + 5 Major D + 0 Major S S D T D D T T D T + 7 Major S D D D T D T D T D D T + 7 Major T S S D T D D D T + 7 Major D T + 2 Major D T S S S T T D T T + 2 Major T T S S S + 7 Major D T T T T S + 2 Major S S D D D D D S D D D T + 2 Major S S S D + 4 Minor S D + 7 Major T + 7 Major D T D S T S S S D D T + 10 Major T S S D T T D S D T + 10 Major T S T T T S D T T S D + 10 Major T T D D T T T T D + 10 Major T T + 10 Major S S T + 10 Major T T D T D T D D T T T S D + 10 Major D T S D T T D D T T D D T + 0 Major T T T T T D D T T T S T T + 0 Major T D T T T T T T T T + 0 Major D D D D T T S T D T D + 0 Major T S D D D D T T D D D D S S + 0 Major D D D T D T T T D T T + 0 Major S T D T S S T D D D D T + 2 Major T D T S T D T D T T + 2 Major T S D + 11 Minor T T T S T D D T + 11 Minor T S T + 2 Major S T D T D T T + 2 Major T S D + 11 Minor T T T + 9 Major D S T T S + 9 Major D D T T S T S S D T T + 9 Major T D D T S S D D T + 9 Major T S + 2 Major S S D D D D T + 2 Major T S T S D T D + 9 Minor T T T S D D T S D T S S S S D + 9 Minor D T T T T S S D D T + 9 Minor T T T S D D T S D T S S S S D + 9 Minor D T T T T S S D D T + 0 Major T T D S T T S T D T T D T + 0 Major T S S T + 2 Minor S D D T T D + 7 Major S S T T T T S D T S T S S D T + 7 Major T T S + 9 Minor T T S T D T T T T D + 11 Minor T S D T T S S D + 11 Minor T T S T S D + 11 Minor D T + 2 Major D T T T T D D D D T T + 2 Major T T T S D D T T T T S S D D T + 2 Major T D T T T T T T S + 9 Major S D D T + 9 Major D T + 0 Major T T D T D S D D T + 0 Major D T D T T D D T T + 0 Major T D T D S D D T D + 0 Major T D T T D D T T T T + 0 Major T + 2 Minor D T D D T T T D + 0 Major T D T D D S S D D + 0 Major T D T T T D D T + 4 Major T T T S D T T D T S D + 4 Major D + 11 Major D T T S S T S D D + 4 Major S D + 4 Major T T T S D T T D T S D + 4 Major D + 11 Major D T T S S T S D D D T + 11 Major S T S S + 4 Major T S D T S D T S D + 4 Major T T S S T S T S T T D D T + 0 Minor D T D D D D T T T D T T D + 10 Major T S + 10 Major S D T T S S T S T S D T S D D T + 10 Major S D T + 0 Minor S D D T T T D T T D + 10 Major T S + 10 Major S D T T S S T S T S D T S D D T + 10 Major D D T T D S D D T T D S T T T + 7 Minor T T S S T D S S T S T D T T D + 7 Minor T T T D S T D T T T T T T D + 7 Major T T T D T S S T T D D T + 7 Major S S D S S T D S T S D D T + 7 Major T T T D T S S T T D D T + 7 Major S S D S S T D S T S D D T + 7 Major T S + 2 Major S D T T T T T T S + 2 Major S S D D T D T + 7 Major D T D T S S D + 7 Major T T S S T S D D T T D D T D D T + 2 Major T T S T T T S T T D T + 2 Major T D S S S + 11 Minor S T T D D T T T T + 11 Minor D D T T + 2 Major T S T T + 2 Major T S T T D T T D S S S + 11 Minor S + 11 Minor T T D D T T T T D D T + 11 Minor T D S D T T S S D + 9 Major D T D T T S S + 9 Major D T T D T S T S + 6 Major T + 6 Minor S S T T T T + 9 Major D D T + 9 Major S S D T S D D T D D T S + 9 Major T S T + 11 Minor D S T T T T T D D T S + 2 Major T T T S S D T T T T T S D + 2 Major S S T D D T T S S T S T D D T + 2 Major T T T S S D T T T T T S D + 2 Major S S T D D T T S S T S T D D T + 11 Minor T T S S D T T S T T D D T + 11 Minor S T D + 2 Major D T S D D T + 11 Major D T D T S D T S S S + 11 Major D T D T S D + 6 Minor T + 6 Minor T T T D T D + 4 Major T S + 4 Major T T S D D T S S S + 4 Major D D T T S + 9 Major S D T T + 9 Major T T T S T T D T D + 9 Major T D + 5 Major T S T T T T S D T T D D + 5 Major T S S D D T S S S D D T + 5 Major T S T T T T S D T T D D + 5 Major T S S D D T S S S D D T + 5 Major D T T S S S + 7 Minor T S S D T T + 10 Major T D S T T T T S S S D D T + 10 Major D D S + 5 Major S T T T T S D T T D D + 5 Major T T S S T D T S T D D T + 6 Minor T T T S S T T S S D + 6 Minor T T T T D S T T S S D + 9 Major T T S D D T T T T S D T + 9 Major T S T S D T T S S T D T T + 9 Major T D T T T T T T S T D S D + 4 Major T T T D T T S S D S T + 0 Major T T D T S S T D T T S T S + 4 Minor S T + 4 Minor S T T S T S T T S S S S T T + 4 Minor T T S D T + 0 Major T T S T T S S D D T + 0 Major T T D T S S T D T T S T S + 4 Minor S T + 4 Minor S T T S T S T T S S S S T T + 4 Minor T T S D T T S + 0 Major S T T S S D D T + 0 Major T S S S D T D T T S T S D + 0 Major D D T T T D T T S D T T S S D + 0 Major T T S T D D T + 7 Major S D D T S + 7 Major T T D T S S D T T T S D T + 7 Major S S T + 0 Major D T S T T T S S D D T S + 0 Major T T T T D T T S T T S S S D + 0 Major T T S T S D D T + 7 Major T D D D D T T T S S D D T + 7 Major D T S D T + 2 Major S D T + 7 Major D D T D T T S T S S D + 7 Major T S D T T D D D T T T S T + 7 Major T S S T S T D D T + 9 Minor D T S T D T D S T T D + 9 Minor S T T D D T T S S S T T T D T + 9 Minor D T S T D T D S T T D + 9 Minor S T T D D T T S S S T T T D T + 9 Minor S D + 4 Minor S T D D T S T T S S D + 9 Minor D D T S T T D T S T T D T + 9 Minor T D T T S S D D S T T D + 2 Minor T D S T S T T T S S D + 2 Minor S D + 9 Minor T T D D T + 9 Minor D T D S + 2 Minor S T T T S S D + 2 Minor S D D + 9 Minor T D D T + 0 Major T S D D T D T T S T + 0 Major T S + 2 Minor S S D T D + 2 Major D + 7 Major T T T S D T S D T + 7 Major S S D S D T S T S + 9 Minor D + 0 Major T T T S D T S + 7 Major D + 7 Major T D D T S T + 7 Major S T D D D T + 9 Minor T D + 0 Major T T S T S T + 0 Major T D T D T S + 0 Major D T S D D T + 9 Major T S T T T S D T T D D + 9 Major T T S D T T D D D D T + 9 Major T S T T T S D T T D D + 9 Major T T S D T T D D D D T + 9 Major D T T S S S + 11 Minor T T T D D T T + 11 Minor T D + 2 Major D T T T D D D + 9 Major T S S + 9 Major T D S D D T S S T D + 9 Major T T S S T D T D D D D T + 2 Major T T T T S T S D D T D T + 2 Major D D D + 9 Major T T T D S T T D T T S S D + 2 Major D T T T T S T S S D T S D + 2 Major T T D T T S S S D D T T S T S + 2 Major D D D D T T T T T T T D D + 2 Major T + 9 Major S D + 2 Major D T T T T S D T T + 2 Major S D S D D T + 5 Major T T S D D T T D D S S T T S + 5 Major D D T D T T T T S S D D T D S S D + 5 Major T T T S D D T T D D S S T T S + 5 Major D D T D T T T + 0 Major T D D T T S D D D T + 0 Major S T S S T T D S T + 5 Major D T T S S D + 5 Major T T T T T D S T T S D T S D T + 5 Major T T D T S S T S D D S S D D T + 0 Major T D T S D D D T S D T + 0 Major D T D D T T D S D T S + 0 Major D D T T D T S D D + 0 Major D T S D T D T D D T T + 0 Major D S D T S D D T + 0 Major T D D S T + 7 Major T S S D D T T D + 7 Major T T T T D T + 9 Minor T S + 0 Major S D T + 0 Major D T T S T S S T S D D T T D + 0 Major D D T + 2 Major T D T T S T S T D S T D T + 9 Major T T T T D T S D T D T S S D D + 9 Major T + 2 Major T T T T S S S T D T D D + 2 Major T T D T T S S D D T D T T + 2 Major S D D T T T T + 6 Minor S T D T T + 6 Minor S S S T T T T T T + 2 Major T S S T T + 2 Major S S D D T + 11 Minor S S D D T S T D T D D T + 11 Minor T + 4 Minor T D T T T T S + 11 Minor T T S + 11 Minor S S D D T S T D T D D T + 4 Minor D T D T T T T S D D T + 4 Minor T T T T S S S S T + 7 Major D T + 7 Major T T D + 11 Minor S T + 7 Major T T D D T + 7 Major T T D T T T D T T D D D D + 7 Major S + 3 Major T D D T T D D T T S S T + 3 Major S S D T S S T S D D D T + 3 Major T T D D S S T T S + 0 Minor D T T D + 0 Minor T T D + 3 Major D T T T T S D S D D T + 3 Major T S S T T S + 5 Minor T S D T T D + 5 Minor T T T + 10 Major T S S T S T T D T + 3 Major D D T T T T T T S D T S D + 3 Major T S T D S S T S D D D D D T + 7 Major T T S D + 9 Minor D D T S + 9 Minor D T T T T S D D T + 9 Minor T T T S S T S D D T S + 9 Minor D T T T T S D D T + 9 Minor T T S T T S S T T D + 7 Major T S T T S S S T D D D D T + 7 Major T T S + 9 Minor S S T T T D S S T T D + 9 Minor D T T T T S D + 9 Minor S S T T S S S S D + 9 Minor D T T T T S S D S T S S T + 9 Minor D D T + 0 Major S D S D T + 9 Minor D S S S S D D + 9 Minor D T T T T S S D S T S S T + 9 Minor T + 0 Major T D S S T T S S D T T S T + 0 Major T + 9 Minor T T T T S S T + 9 Minor T D S T T D D T S S D + 9 Minor T + 2 Minor D T T D D T T S + 11 Minor T D T D D T T S S S T D + 11 Minor T D D T T S T T S S D + 11 Minor T D T D D T T S S S T D + 11 Minor T D D T T S T T S S D + 9 Major T S S D D T T S T S S D D D T + 9 Major T D T T S S S + 6 Minor D S T T D D T + 6 Minor T S + 2 Major T D D T T D D D T T + 2 Major T D T T S S S S T + 10 Major S T T S + 10 Major T S D D T T D D T + 10 Major T S D T D D T S T T S + 10 Major T S D D T T D D T + 10 Major T T T T T T S T S S D T T D + 10 Major D T T T T D D T + 7 Minor T S S D T + 7 Minor T S T D D T T D + 10 Major D T + 7 Major T T T T T S T T S T T D D T + 7 Major T T T T S T D S T + 4 Minor D T T T T D + 4 Minor D T T T T S S T T T + 7 Major S D + 7 Major T T S S T S D D T T D D D D D T + 7 Minor T T D T D T S D + 7 Minor D D T S T T S T + 7 Minor D T T T D T + 7 Minor D T S D D D T + 7 Minor S T T S T D T + 7 Minor D T D + 10 Major T T S D T + 10 Major T D T S + 11 Minor T S T S T T S S T T D D T + 11 Minor S D D S T D D D T T T T D + 11 Minor T S T S T T S S T T D D T + 11 Minor S D D S T D D D T T T T D + 11 Minor T S S T T D D S D T T T D T + 11 Minor T + 9 Major D T T S D T D T T S T D T + 9 Major T T S + 11 Minor T D S T T T D T T S T S + 11 Minor D + 9 Major T D T D D T D T T S T S S + 9 Major T D T T T T S S D D + 9 Major D D T S T D S S D T + 6 Minor T T + 6 Minor D T T S S T T T T T T T S T + 6 Minor S + 9 Major T T T T S D T S D T T + 9 Major T T S S D S T D T T S S S S D D + 9 Major T S D S D D T S T S + 9 Major D D T + 9 Major T T S S D T + 9 Major S D T T T T T T + 9 Major T T D T S D T + 9 Major T T T S S D T + 9 Major S D T T T T T T + 9 Major T T D T S D T + 9 Major T S D T D + 6 Minor T D T + 6 Minor S D T T + 4 Major T S T + 4 Major S S D D T + 9 Major T T T + 9 Major S D S D + 2 Major D D D T + 2 Major D T T T S T D D S + 11 Minor S T D + 11 Minor T + 9 Major D T + 2 Major D T T T + 2 Major S S D D T + 4 Major S D + 4 Major D T S D D T T + 4 Major S D T D D T D S S + 4 Major S T + 9 Major T S D T D D + 9 Major T T S S T D D T + 5 Major T D D T D T S T S S T S S T + 5 Major D T + 0 Major T S D T T S + 5 Major S S D + 5 Major T S S D S D T T D D T + 5 Major T D D T D T S T S S T S S T + 5 Major D T + 0 Major T S D T T S + 5 Major S S D + 5 Major T S S D S D T T D D T + 5 Major D T D T + 5 Major T T T T D D D D T T T T D D + 5 Major D D T T T T S S D D T T T + 5 Major D D S S D S S T T S S S D T + 2 Major T T D T S T D D T T T T S S T + 2 Major T S T T S S T + 6 Minor T S T S + 2 Major D T + 2 Major T D S S T D T S T S D T D T + 2 Major T T D T S T D D T T T T S S T + 2 Major T S T T S S T + 6 Minor T S T S + 2 Major D T + 2 Major T D S S T D T S T S D T D T + 2 Major T D T S D D T T S T S T S S D + 2 Major D D T T T D T S D T T T T T + 11 Minor T S T D S D S T D T D + 9 Major T S S T T D T T S + 11 Minor S D + 11 Minor T T S T D D D T T S D T D + 11 Minor T T T + 2 Major T T T T T T S T S D + 2 Major T D D D T + 7 Major T S S D D T S T T D T + 7 Major S D T S T T D T + 7 Major S D D T T D D T T D D + 7 Major S S T S T D T T D D T S S D D D + 2 Major D T T S + 7 Major D T S + 7 Major T T T T S T T S + 4 Minor D + 4 Minor T + 2 Major S T S D S T T T T S + 7 Major D S D + 7 Major T S T T D T S S T T + 7 Major D T T D T D D T S + 7 Major T S D T D S T D D D T + 2 Major D D T + 7 Major T T T T D D T S T D T + 7 Major S D T T S S S D T + 7 Major D T S T D S S T S S T + 7 Major D T D T T D D T + 0 Minor D S S T T S T D T T D T T + 0 Minor D + 5 Minor D S S T T S S T T T D T + 5 Minor T D T T S T D D + 0 Minor T D + 5 Minor D D + 5 Minor S D D T S T T S S T T D T T + 5 Minor T D S T D S D + 0 Minor T T T T T D T + 0 Minor T T T D T D T T S S D D D T + 0 Minor D T + 5 Minor D T S T T S S D D T D + 5 Minor T D T T S T T T T S S D D D T + 5 Minor T S T S S D D T + 7 Minor D T T S T S T D T D T T T S S S S D + 7 Minor T T D D T + 10 Major T S + 7 Minor T S D S S S S T + 7 Minor D T T S T S T D T D T T T S S S S D + 7 Minor T T D D T + 10 Major T S T D T S S S D T + 10 Major T T T S S T D T T T S T S D D T + 10 Major T + 7 Minor T D D T D S S T S T T D T T + 5 Major D T T S S S D D T T T S S + 5 Major S S D + 7 Minor S S D T S S T D S D T D + 7 Minor T S T D + 0 Major T T D S D T D T S D + 9 Minor T + 9 Minor T D D T S T S S T D D T + 9 Minor T T + 0 Major D S D T D T S D + 9 Minor T + 9 Minor T D D T S T S S T D D T + 9 Minor D T T D T D D S T T T D + 9 Minor T T S T S S T T D + 7 Major T S S D T + 7 Major S S T S D T S S D S T S + 9 Major S T T T S S D D + 9 Major D T D T T T S D T S T S S + 9 Major D T T T T S S S D D D T T + 9 Minor T S T T T S S D D D T D T T T + 9 Major S D T S T S S D T + 0 Major T T T S D D D T T T T S S S D D T + 0 Major T S D S T S T T S S S S S + 9 Minor D D T + 2 Minor D T T T T D T T T D T + 2 Minor T T D D T T T T T T D D T T D + 2 Minor D T T T T D T T T D T + 2 Minor T + 9 Minor S T D S T S S S S T T T + 5 Major S T + 5 Major T D T D S T D T S T T D + 2 Minor S T + 2 Minor T T D D T T S T S S T D D T + 2 Minor D T T S S T D S + 0 Major D T D T S D + 0 Major D T T S + 9 Minor T S S T T D D T T S + 9 Minor D + 0 Minor D T T T T D T T T D T + 0 Minor T T D D T T T T T T D D T T D + 0 Minor D T T T T D T T T D T + 0 Minor T + 7 Minor S T D S T S S S S T T T + 3 Major S T + 3 Major T D T D S T D T S T T D + 0 Minor S T + 0 Minor T T D D T T S T S S T D D T + 0 Minor D T T S S T D S + 10 Major D T D T S D + 10 Major D T T S + 7 Minor T S S T T D D T T S + 7 Minor D + 5 Major T D D T D T T T T T T D + 5 Major T D T S S T D S S T T + 5 Major D D T D T T D D T D + 5 Major T T T T T T D T D T + 5 Major S S T D S S T T D D T D T + 5 Major T S D S D T T T S T D T S S + 5 Major D T S + 0 Major T S D S S T D T S + 0 Major D D T D T T T + 5 Major T D S S D + 5 Major T T S S D D D T T S D T D + 5 Major S S T T D D T D T + 9 Minor T S T S T S T T S S D T T D T S S + 9 Minor D D T T T S T S D T T + 9 Minor T S T S T S T T S S D T T D T S S + 9 Minor D D T T T S T S D T T + 9 Minor T T S S T S T D T S D + 9 Minor D T T D D T D T D S + 9 Minor D T T D D S T S T D + 9 Minor T T S T S S T T D + 2 Major T T T T S D T D T + 2 Major D D T T T S S T S D T S S T S D D + 2 Major D T T T T T S + 2 Major D T D T D D T T T S S T S + 2 Major D T S S T S D D D T + 2 Major T D T S T S S T + 9 Major S + 9 Major S T D D D D T T S T S D D T + 9 Major T S D T + 2 Major D S T D T D T + 2 Major D D T T T S S T S D T S S T S D D + 2 Major D T + 7 Minor D D T D T S T S T D S T S D + 7 Minor T T D S T T T T S D S S S S S T + 7 Minor D D T D T S T S T D S T S D + 7 Minor T T D S T + 10 Major S S T S D S D D T + 10 Major T D S D D T S T S T T T D T + 10 Major T D T T S T D T + 5 Major T S D D + 5 Major T T D D D D T T T S S S S D + 5 Major T + 10 Major D T S T S T D T + 7 Minor T T T D T S D D T S S T T + 7 Minor T T T D D T T T D T S S + 7 Minor S S D T S D T + 7 Minor D + 5 Major T T T S T T T D T S + 5 Major D T T S D S + 5 Major S + 2 Minor T D D T S D T + 10 Major T T T T T D T D T D T T + 7 Minor T D T D T S + 7 Minor T S T S T D + 7 Minor D T T T T T S S S S D T S + 7 Minor D + 9 Minor T T D T T S D + 9 Minor T T T T S S T T S S D + 0 Major T T D T T T T S D T + 0 Major T S S S T T S S S T T D T T + 0 Major T D T + 7 Major S T T S T D D S D T D T + 7 Major T T S T T S S D D S + 7 Major T S S D S D + 7 Major T S D T S + 7 Major T + 0 Major T T S T S D + 0 Major T T + 7 Major T S S + 7 Major D S D T S D T + 7 Major S T + 0 Major T T S + 0 Major T S D T T + 5 Major T D + 0 Major S T S D T + 0 Major T T T T T S S T + 0 Major S S T T D T + 0 Major T S T S D D T + 0 Major T + 5 Major T + 0 Major T T + 0 Major T D T S D T D D D T + 0 Major D T + 7 Major D D D T D T S + 7 Major S S T + 9 Major D T S + 9 Major T D T D T T D D S + 2 Major T + 2 Major T D T T D D D D D T + 7 Major D D D T D T S + 7 Major S S T + 9 Major D T S + 9 Major T D T D T T D D S + 2 Major T + 2 Major T D T T D D D D D T + 2 Major D D D T D D T T + 2 Major D D D T D D T T + 2 Major T T T S + 7 Major D + 4 Minor T T D + 4 Minor D T S D D T + 4 Minor D D + 7 Major D T D + 4 Minor T T D + 4 Minor D T S D D T + 4 Minor D D D T S + 2 Major S S D + 2 Major S D T S D T + 10 Major T T T T S D T S + 10 Major D D T T T + 5 Major D + 5 Major T D T S D S D T + 5 Major T S + 7 Minor T S + 5 Major S D + 5 Major T D D T T + 7 Minor D T + 10 Major D T + 10 Major S T D T S T T S D T T + 5 Major T S S D D S S T + 10 Major T T D S D + 10 Major T D D T T T D T T D D T + 10 Major T + 5 Major T S S D D S S T + 10 Major T T D S D + 10 Major T D D T T T D T T D D T + 10 Major T T S D T S D T T D T + 10 Major T T T T S S D D S S T D + 10 Major T T T T S S T T S S S S T + 7 Minor D T D + 7 Minor T + 10 Major T T T T S S T T D D T T + 10 Major D D D D T + 11 Minor T T T D T D D T T S S D + 11 Minor D D T S T T T T S S + 11 Minor T T T T T D T + 11 Minor D D T T S S D D D T + 11 Minor S T T T T S S T T + 11 Minor D T D D T + 2 Major T T S D T T + 2 Major T T D T + 11 Minor S D T S T T D + 9 Major T D T D D T T D S D T S D T T + 9 Major S D T T T D T S T D T + 9 Major D S T T T T S S D T T T + 9 Major T T T T D S T T T + 2 Major D T T T S D + 2 Major T S T D D D D T + 4 Major D T S T S T + 4 Major S T D D T D T T T T D T T D D T + 9 Major S S D D T T T S D D D D T + 2 Major S D D D D T D D D T D D T + 2 Major T S S S S D T D D T + 2 Major D T T S + 9 Major D T S S S T T D D T + 9 Major T S T S + 7 Major T D T D T T + 9 Major S S D S D T D T D T T + 9 Major S S S S + 11 Minor T T T T + 2 Major T T + 2 Major T D S T S T D D D T + 7 Minor D T S T T T D D T D + 7 Minor S T D D T D T D D D T + 7 Minor D T S T T T D D T D + 7 Minor S T D D T D + 2 Minor S T T T S + 2 Minor S D T D D T T T T S D + 2 Minor T + 7 Minor D T S T T D S T T T S D T + 7 Minor T D T T S S T T S T T D + 7 Minor D D D + 5 Major T T T D T T T S S D T + 5 Major T D T S S T T T S D T T D + 5 Major T T T T T S D T T S D D T + 5 Major T T T D T T T S S D T + 5 Major T D T S S T T T S D T T D + 5 Major T T T T T S D T T S D D T + 5 Major T D T S D + 7 Minor T + 5 Major S T S + 5 Major T S S D D T D T T D D D D T + 10 Major T S S D D T S T S D T T + 10 Major S D T S S D T D T + 10 Major S D T T D D T T D D S S T S + 10 Major D T D T D S T + 5 Major S D D T + 10 Major D D T S D D T S T D T T S S T + 7 Minor D + 7 Minor S D + 5 Major S D T S D D T S + 5 Major T T S T D + 10 Major D T T S S T T D T + 10 Major S S T S D D T S S S S S D T S + 10 Major T T T S D D T T D S D + 10 Major T T T S D D T T T D D T T S S T T + 10 Major S T S S D T D T T T S S + 10 Major S S T D D D T D T T S S D D D T + 4 Minor T D S S T T S D D T + 4 Minor T D S T D T D T T T T D + 4 Minor T S T T T D D T + 4 Minor T D S S T T S D D T + 4 Minor T D S T D T D T T T T D + 4 Minor T S T T T D D T + 7 Major T T T D T S D D T + 7 Major T S S D T D T T + 4 Minor D T D D + 4 Minor D T D D S S T T S D + 7 Minor T S D D T T T S S D T S + 7 Minor T S D D T T S T T D + 10 Major T T D D T S D D T T + 10 Major T T + 5 Major T D S T S T D S D T T + 5 Major S S T D T + 2 Minor T S T S S + 2 Minor D D T T T S D D + 7 Major D D + 0 Minor S S S D S D T T T S T S T + 0 Minor S T D D T T T T T T + 7 Minor S D + 7 Minor T T T T S S S S S S S S T D T D + 7 Minor T T T T S D S D S T T D D T S T T + 7 Minor D + 8 Major T S S D T S T D S D T + 8 Major T S T D T S D S T T T S D + 8 Major D S T S D T T T T D + 8 Major T T S D D T T T S T S + 5 Minor S T + 5 Minor T T D D T T T S T D T T T T D + 5 Minor D T T D S T + 8 Major T S T S D D D T + 4 Major T S T S D T T S D T + 4 Major D T T T + 1 Minor T T T D D T + 4 Major T S T S D T T S D T + 4 Major D T T T + 1 Minor T T T D D T + 4 Major T T D S T T S T D D S T S T + 4 Major T S T + 6 Minor D D D T T D + 6 Major D + 11 Major T T T T S S T T S S D T + 11 Major S S S + 4 Major S T S D D T + 3 Major T S T S D T T S D T + 3 Major D T T T + 0 Minor T T T D D T + 3 Major T S T S D T T S D T + 3 Major D T T T + 0 Minor T T T D D T + 3 Major T T D S T T S T D D S T S T + 3 Major T S T + 5 Minor D D D T T D + 5 Major D + 10 Major T T T T S S T T S S D T + 10 Major S S S + 3 Major S T S D D T + 2 Major S T S T T T S T T D T + 2 Major S S D T S T S S T T S T T T + 2 Major T S T S T T T S T T D T + 2 Major S S D T S T S S T T S + 11 Minor D D T + 11 Minor T D S + 9 Major S D D T T T T S T D T + 9 Major S S D T S S + 11 Minor T S S T T T T D + 11 Minor T T D T + 6 Minor S T S T S T + 9 Major T S + 9 Major S S T S D D D D S S D + 4 Major T T T D S T S T D D T D + 11 Major T + 11 Major T T T T S S D D T T S S S D D D D + 11 Major T S T S + 6 Minor D T D T T T D T + 4 Major S + 4 Major T T D T D S D S D T T S T S + 4 Major D S D D T T T T T S S S T + 4 Major D D T + 1 Minor D T T S T T T T D T + 4 Major T + 4 Major S S S D D T + 11 Minor T S S T S D T D D T D T T + 11 Minor T D T D + 2 Major T T D T D + 2 Major S T S D T D T T S D D T + 2 Major T T D D S S D D T T T T T T S S + 2 Major T T S + 11 Minor S S S S D T S S T T T + 11 Minor D + 10 Major T T T S T T D S T S T S T + 10 Major D D T S D T S T S S T D + 10 Major T S D + 10 Major T S T T D T D T T + 10 Major S S D T T S S T S T T S S + 10 Major T S T D D T S D D D D D + 10 Major S T S D D T + 5 Major T S D D T T T D S D T + 5 Major T T T T T D D D T T T T S D + 5 Major D T D T T T S S D + 5 Major T T D T T T S S D D T + 5 Major T S T T T S D D T D T T S S D + 5 Major D T T S D T T S T S T T D D T + 9 Major T T S S D T T D S S T S D D + 9 Major T T S S T T T T S S D T T + 9 Major T T S S D T T D S S T S D D + 9 Major T T S S T T T T S S D T T + 9 Major D T T S + 11 Minor T S S S D D T + 11 Minor T S + 2 Major D T T S S S T T D T T + 9 Major T D S D T T S D T S D D D + 9 Major T T S S T D T S T D T T T + 11 Minor T S T D D S D T T + 11 Minor T S T D D T D T + 2 Major D + 2 Major S T S T S S T D T S D D D T + 2 Major T D D S D D T T T T T T S S + 2 Major T T S + 5 Major T T S S T S D T S D T + 5 Major T T + 2 Minor T T T T T D D T + 5 Major T T S S T S D T S D T + 5 Major T T + 2 Minor T T T T T D D T + 5 Major T T D S T T S T D D S T S T + 5 Major T + 7 Minor S T T D T T T D + 7 Minor D + 0 Major T T T T S T S D T + 0 Major S + 5 Major T S D T T D D T D D T + 0 Major T T S S T S D T S D T + 0 Major T + 9 Minor T S S S T D T T + 0 Major T T S S T S D T S D T + 0 Major T + 9 Minor T S S S T D T T + 9 Minor T T D T D + 5 Major T S D D T T D + 5 Major D D T T D S T + 2 Minor D T T D D + 2 Major D + 7 Major T T T T T S S T T S D T + 7 Major S + 9 Major D D T T T T S S S T + 9 Major T T D T T D T T T S T + 9 Major D T S D T S T D T D + 9 Major T T D T T T S D T + 9 Major T S T D T T S T T T T S D + 9 Major T T T S D T T T S T D T + 9 Major D T D T S T + 9 Major S T S D T S D D D T + 9 Major T D S S T D T + 6 Minor D + 6 Minor T D T T T T T S T S S D + 9 Major T D T S T T S S T D T + 9 Major S D T + 4 Major D T T S D D T + 4 Major T S S D + 11 Minor S S T D + 9 Major D S + 9 Major T T T S T D T D D D D D D T + 9 Minor D D T D D S S T S D + 9 Minor T T D D T T S T D + 9 Minor T D T T T S T D S + 2 Minor D + 2 Minor T D T T + 9 Minor D D S T + 9 Minor S + 7 Major T T S T T S T T D + 7 Major S T S D + 2 Minor D D T D D T D + 9 Minor S T T T T T T T S T T + 9 Minor D + 9 Minor T S T T T T D D D D T S S S T T + 9 Minor T T S S T S T D D T T S D D T T + 9 Minor T T S S S S T + 4 Minor S T T T + 4 Minor S D T S S T T T T T T T T S S + 4 Minor T T S + 2 Minor T T T D D D T T D + 4 Major T T T S T + 11 Major S S D T S S T + 11 Major T D T T S D T S S S D T + 11 Major S + 4 Major T T S T + 11 Major S S D T S S T + 11 Major T D T T S D T S S S D T + 11 Major S + 4 Major T T T T T S D T S D T D D + 4 Major T D S T S T D T T T D D T + 0 Minor T T T D T T + 3 Major T S S T D T + 3 Major T T T S + 0 Minor D T T + 3 Major T S S T D T + 10 Major S T S S S S D D T D T T + 10 Major T S T S D D T + 10 Major T + 8 Major D T D T T D D T T + 8 Major D T D + 3 Major S D D T + 4 Major T S T S S D + 9 Major D + 9 Major S D D T D S D D T + 9 Major T D S T S S S T + 9 Major T D T D D D S D T + 9 Major T S T S T T D T + 9 Major D D D T + 4 Major D T S D T + 9 Major T T S S T T S D T D D + 9 Major T D S T T S D D T + 7 Minor T S T S S D D T T S T + 7 Minor T S T D D T S T S + 7 Minor T + 10 Major T S S S S T T S S D D D T + 10 Major T T D D S T T D T T T T S S + 10 Major D T S S S D T T D T T S + 10 Major T + 10 Minor D D T D D S S T S D + 10 Minor T S D T S T D + 10 Minor T D T T T S T T S + 3 Minor D + 3 Minor T S D + 10 Minor T D D S T + 10 Minor T S T S T T T T T + 10 Minor T D T T T T S S T S D + 10 Minor T D T D T S T T S + 3 Minor D + 10 Minor S T T T T T T T S T T + 10 Minor D + 3 Major T D T T D T S S S S T + 3 Major T T T T S S T D S T S S S S T + 3 Major T S S T D T D T S S T + 3 Major D T T D T T + 3 Major D T S S S S T T T T T S S T D + 3 Major S T S S S S T T S S T D T D + 3 Major T S S T D T + 3 Major T S S S T + 3 Major D D T D D D T T S D T T S D + 3 Major T T T T T S D S S T D T + 3 Major D T S D T T T T T T + 0 Minor D + 0 Minor T T D D S T T D T S T S S D + 0 Minor T T T D T T + 3 Major S T S D + 3 Major T S D D T + 2 Minor T D D T T S S S T T T T T D T + 2 Minor T D S D D T S T T S S D + 5 Major T D T T S + 9 Minor D S S D D S D T S + 9 Minor D D T T S S T S D T S D T + 9 Minor D D T T T S S T + 5 Major D T T S D D T + 5 Major T S + 2 Minor S D S T T S S T T + 2 Major S S S T T S D T T D T D + 7 Major D + 7 Major T T S S T S D D T T D D D T + 7 Major T T T S D D T S D D D + 2 Major T D + 7 Major D + 7 Major T T S S T S D D T T D D D T + 7 Major D T D S T T S + 9 Minor T T T T D + 4 Minor T S + 4 Minor T D T T T T S S T T T T T T + 4 Minor D + 7 Major D T D T T S D T T S T S S D + 7 Major T T S S D T S D T T S S S D D T + 0 Major T D D S T D D T D S T D T + 0 Major T T T + 5 Major D D D S T D T D T T D + 5 Major T D T D T T S T S S T T T + 0 Major S T + 0 Major T T T T S S D T T D S S T D D T + 7 Major T D T S D D T T S + 7 Major S T D T + 7 Major T T T + 7 Major T T D D T S D T S S D + 4 Minor T + 0 Major T T T + 2 Major S S D S D + 2 Major T T S T S D T + 4 Minor T + 4 Minor T S D T S + 2 Major D D T T T D S S D D D T S T T D T + 2 Major T D D D T T + 9 Major D D T T S D D T + 9 Major S T S D T T D T T D S T T D + 4 Major D T + 4 Major S D T T T D T T S S S T D T S + 2 Major S + 2 Major D D T T S S D D T T D + 0 Major D T S D T T S S T D + 0 Major T D S T + 7 Major S T S T T + 7 Major D D T T S T D S D D + 7 Major T S + 0 Major T T T S S D T D T S + 0 Major T + 9 Minor D T S S D + 7 Major S + 7 Major T S T T D T T T T S D T S + 7 Major D T T T D T + 6 Minor T T T T T T D D T S S T T D D T + 6 Minor T S S T T D D T T T T S D T + 6 Minor D D T T D T S D T T S S D D T + 6 Minor T T S T T T D T T S T T T D + 6 Minor D D T T T T S S D D T T T T S T + 6 Minor T T T D D D D T + 5 Major T T T T D + 5 Major D D T S S D T + 10 Major T D T T T T T + 5 Major T + 5 Major T S S D D + 5 Major T T T T S D T T + 0 Major T + 5 Major T T T T D + 5 Major D D T S S D T + 10 Major T D T T T T T + 5 Major T + 5 Major T S S D D + 5 Major T T T T S D T T + 0 Major T + 5 Major D T D D T D + 5 Major T S D T S T T S + 2 Minor T D S D D + 2 Minor T + 5 Major S S D D T D T + 5 Major D D T S S D S D D D + 5 Major T + 9 Major T S T T D T D T T S S T T S T + 9 Major D D T S S T T T D S + 9 Major D S D T D T S D T T T S S T S S + 9 Major T S T S D T S D T T S T S T T S + 9 Major T T S S T S T T D D T S D T + 9 Major D D T T S T S S D D T + 9 Minor T T T S D D T S T T S S S S D + 9 Minor D T D T T S T S D D T + 9 Minor T T T S D D T S T T S S S S D + 9 Minor D T D T T S T S D D T + 0 Major T T D S T T S T D D S S T S T + 0 Major T S S T T S T S + 2 Minor T D + 2 Minor D + 7 Major T T T T S D T T S S D T + 7 Major S + 9 Minor D T S T T S S D S D T D + 4 Major T S D S T S D T T D + 9 Major S S D + 9 Major S S D D D T D D D T S D D T + 9 Major T D T S T D T S D D D S S D + 9 Major S S D D D T D D D T S D D T + 9 Major T T T S D S T T S S T S D T D + 9 Major T S D D T S T T S T D D D T D T + 7 Major T T T D T T S D T T S S D D T + 7 Major S S T T S S S T D T T D D D D T + 7 Major T T T D T T S D T T S S D D T + 7 Major S S T T S S S T D T T D D D D T + 7 Major T T T T D D T S T T T D T T D + 7 Major D D T T T D T S T T T T S S T + 7 Major T D T T S S T S D T T D D D D T + 2 Major T S S T S S T S S D D T + 11 Minor D T T T T S S S S D D T + 2 Major T S S T S S T S S D D T + 11 Minor D T T T T S S S S D D T + 2 Major T S D D T T T S S D D T T T S T + 2 Major T T S + 6 Major S S S S T T + 9 Major D D T T D S T T S S D T + 9 Major T + 2 Major S D S T T D D S + 2 Major D D T + 2 Major T D D T S D D T D S T D T + 2 Major T T T T + 2 Major T T D T S T D D D T + 9 Major S S S D D T D + 9 Major T T S T S D T + 2 Major T S D T T S D T S T S T + 2 Major D D T + 0 Major D S D + 0 Major T S D T T D D D T T D D T T + 0 Major T D T D T S D D S D + 0 Major T S D T T D D D T T D D T T + 0 Major T S S S T S + 0 Major D D T + 0 Major T T T S S D S S T T D + 0 Major T T T T S D T T S S S S T T + 9 Minor T + 0 Major T T T S D T S D D T T + 0 Major D D T + 7 Major T T T D T T S T S T T D D T + 7 Major S S D S S T T S S S T D T T + 7 Major T T T D T T S T S T T D D T + 7 Major S S D S S T T S S S T D T T + 7 Major T S S S S D D D T D T T S + 7 Major T D D T S D D T + 2 Major T S S D + 7 Major S D + 7 Major T T S S T S D D T S S S D T + 7 Major T D T D T T S T S S T T T S + 7 Major D D T + 2 Major T S T S S D D T T S D T + 2 Major S T S T T + 7 Major T S T S S T T T S + 7 Major D D T + 2 Major T S T S S D D T T S D T + 2 Major S T S D T T D + 7 Major S D T T S D + 7 Major T D T S T D S T T S D T S D T + 7 Major T T D T S D T T S D S S T S D T + 7 Major T D D T S S S S T + 7 Major T T D T T D D T S S S T S D D T + 7 Major T D D T S S S S T + 7 Major T T D T T D D T S S S T S D D T + 7 Major D S D T D D T T T + 2 Major S T + 2 Major T T S + 7 Major S D T T T S D S D + 7 Major T S S T T T S S T T S + 7 Major T T D D T S D T D D T + 5 Major T T T S D S T D T S D + 5 Major T T S D S D D T T D T T S S S T + 5 Major D T T T T D D D T T S T + 2 Minor D T + 2 Minor D T T S S D D T T S + 5 Major D + 5 Major D D T T T T S S D D D T T T T T S + 2 Minor S + 2 Minor T T S D + 7 Major S T S + 7 Major T S D T T D T T S D D T + 7 Major S T S T T S S D D T + 7 Major S D T S S + 0 Major T S D D D T + 0 Major S T S S T D T S S S D D T + 0 Major S D S D T T S + 9 Minor T S D D T + 9 Minor T + 0 Major S T S S T D T S S S D D T + 0 Major S D S D T T S + 9 Minor T S D D T + 9 Minor T D T D D S S T T T + 7 Major S T + 7 Major S S D T D T S S T T S S S D D T + 7 Major S S T S D T S S D S T T T + 0 Major T D S T T D T T S S D T + 0 Major S D + 9 Minor S S T T S T S D D T + 9 Minor T + 0 Major T D S T T D T T S S D T + 0 Major S D + 7 Major D T S S D T T T T S + 7 Major T S + 9 Minor S T T D + 9 Minor T + 7 Major S D T D T S S T T S T S T S + 7 Major D T + 0 Major S S T T S + 2 Major S T S S T D T S D D T + 2 Major S D + 11 Minor S S T D S T S D D T + 11 Minor T + 2 Major S T S S T D T S D D T + 2 Major S D + 2 Major T S T D T + 2 Major D T + 11 Minor D D T D D S T T T D + 11 Minor T T S + 9 Major T D T S S T S D D T + 9 Major D T T D T S S D + 11 Minor T S D D T + 7 Major T T T T T T T S S D D T T + 7 Major T T T T S D T T S S D D D T + 7 Major D D D S T + 4 Minor D D T T T S S D D D T + 4 Minor T T T T D D D + 11 Minor T S S T + 7 Major D T T + 7 Major T D T T S D T T S S D D D T + 7 Major S D S T T S S + 0 Major T T T D T + 9 Minor T + 9 Minor T D T D T S T T S D T T + 2 Minor D T D D T T T T S S D D S T T + 0 Major D T D D T T T T S S D + 9 Minor S T T T + 9 Minor T S S D D T T T D D S + 7 Major T T T T S S D T S D T T S T + 7 Major T D T S D T S T S D D T S S D T + 7 Major T T T T S S D T S D T T S T + 7 Major T D T S D T S T S D D T S S D T + 7 Major T T D D T T S S T T S D S S T T T S + 7 Major D T T S S T T S + 4 Minor S T D S + 7 Major T + 7 Major T S D D T T S T S D D T S S D T + 2 Major T T T S S T T T S D T T S + 2 Major D T T D D T D S + 2 Major T S D S D + 11 Minor S D S D T T S + 11 Minor D D T T + 2 Major T T S S T T + 2 Major T S D T T S D T + 2 Major T D D T D S T S D S D + 11 Minor S + 11 Minor D S D T T S D D T + 11 Minor T S S D T T T T S D T + 11 Minor T T + 4 Minor S D T D T T T D + 4 Minor T D T S D T S + 4 Minor D T S T T D + 2 Major S S S D + 2 Major T T T D T T S + 11 Minor S T T T D T T S S D T T S + 11 Minor D + 2 Major T T S T S S D D D D T T + 2 Major T T T S D T S T D T T T + 2 Major T T S T S S D D D D T T + 2 Major T T T S D T S T D T T T + 2 Major D D T T T D T D + 11 Minor T D D + 11 Minor S S S S T T T T T D D T T + 2 Major T T S S D T T S S D + 2 Major S T T S D T S S D T T T + 7 Major T T D D T T S D D T T + 7 Major T T T T D D D D T + 2 Major S S D D T T + 2 Major T T T T S T T T D D D T T T + 2 Major T + 7 Major D D D T D T T S S S D D T T + 2 Major S S S S D D T T S S S D D T T + 2 Major S S T T S + 7 Major D T S T D T T T + 7 Major T T T D D T T T D D T + 7 Major D T S S T T D D D T + 7 Major T T T S D T T D D + 7 Major T T T S D T T D D D T S T S S D + 7 Major D T S S T D D D T + 5 Major T D T T S D T S D D D T + 5 Major T T S S T S + 9 Minor S T S D + 2 Minor T D + 2 Minor D T T T T S S S S D T D D T + 2 Minor T T D D T T S S T T T T D + 4 Minor T T T D D T T D + 4 Minor T T D S T S S D + 7 Major T S D D + 7 Major T S D T D D T T S T S S D + 7 Major T D T + 4 Minor D T T S S T + 4 Minor T T T T T T D T + 4 Minor S D T T T D D S S + 4 Minor T T T T D T T T T T T D + 4 Minor T T T T D D T D T T S S D + 7 Major T S S D D T S D T S T T D T + 7 Major D T T S S T T S S D T D T + 7 Major T S S D D T S D T S T T D T + 7 Major D D T T S S T T S S D T D T + 7 Major T D D T T S T D D T T T D T + 7 Major S S T T S S T T S T T D D S S D + 7 Major T T T T S + 9 Minor D S T D T T T D + 9 Minor D D T T T T S T S S T T T D T + 9 Minor T T D D S S D D T + 7 Major S D D T S T + 7 Major T T T S D D T T T S T D T T S T + 7 Major S S D S D D T + 7 Major T T T T T T T S S D S D T S T + 7 Major S D T T D S D S T D S S D D + 7 Major T T S + 2 Major T D T T T S D T D T D T + 2 Major T T S S S + 4 Minor T S S T T S S D D D + 4 Minor D D T D T + 7 Major T S S S D D D T T T S D S D D + 7 Major T T S S D D D T + 7 Major T T S T D T T D T S T + 7 Major S D T D T D T D + 7 Major T S D D T T T S T + 7 Major D T T D T S T S D T D + 7 Major T D T D T S D D + 7 Major T T T T S D T T T T T D + 7 Major T D T T T T S T + 7 Major T T T D T T T T S T + 7 Major D D T T D T T D D T T S D + 7 Major T T D T D D S S T T + 7 Major S D D T + 11 Minor T T T S T S S T T S S S S D + 11 Minor D T T T T T T D D T + 11 Minor T T T S T S S T T S S S S D + 11 Minor D T T T T T T D D T + 11 Minor T T S S D T S S S + 2 Major D T T S T + 2 Major T + 4 Minor S T T S D T T T T D + 4 Minor D + 9 Major T T T T S D T T S S D T + 9 Major S S S + 2 Major T S T S D T S D T + 2 Major T T T T + 11 Minor T T T D D T + 2 Major T S T S D T S D T + 2 Major T T + 11 Minor T T T T T D D T + 2 Major T T D S T D S T D D S T S T + 2 Major T S + 4 Minor D S S D D T T D + 4 Major D + 9 Major T T T T S D T S D T + 9 Major S S D T S + 11 Minor T D S D S T T T T D + 5 Major T D T S D T T S D T T + 5 Major D S T + 9 Minor T T T T + 5 Major T D T S D T T S D T T + 5 Major D + 9 Minor S T T T T T + 9 Minor T T S T T S S D + 5 Major S D D T D T + 5 Major T T S S D D T D T + 5 Major T T T + 2 Minor T S D T T T S T T T T D + 2 Minor T S S T T T D D T + 10 Major T T S T S D D T T S S T S D T + 10 Major T T T D T S D D T T S S S D D T + 10 Major T T S T T T D D D D D T T D D T + 10 Major T T T T T D D D D D T T S + 7 Minor D T D + 7 Minor T D T S T D T D T S T D T + 2 Minor T T S S S D T D T D T S S T T T T D + 2 Minor T T T T T T S T T D D T + 2 Minor T S D S D + 5 Major D D D S T + 2 Minor T D T T S S T + 2 Minor D D T T S S T T T T T S T D T T T D + 2 Minor T S T T S + 7 Minor D T T T D T D + 5 Major T T T S D D T D T + 2 Minor T T T T + 2 Minor T T D D D T S T S T T T T D + 5 Major D S + 5 Major T D S D D D S S T T T T T D D T + 5 Major T D T D T T D T + 2 Major T S T T S S T S S T T D T + 2 Major D + 5 Major T S T D T + 5 Major T S T T D D T T T T T D T D S + 5 Major T T S S S D D T S T T T T T S D T + 5 Major T D S S S S + 2 Minor S S T T D T T T T D T T D + 2 Minor T T T T S + 9 Minor S S S D T S T T S D T T S D D T + 2 Minor D T T S S D D T T D T T D T + 2 Minor T T T T D + 9 Minor S T T S D T T S + 2 Minor D D D + 2 Minor D T T S S D D T T D T T D T + 2 Minor T T T T S D S S T + 5 Major T S D T + 5 Major T D T S D + 9 Minor T S S D D T T S D T + 9 Minor S T T T + 5 Major T T S D + 2 Minor S T T S T T T + 2 Minor T T S S T T T D T T + 11 Minor S S D T S T T T S D T T S + 4 Minor T T T D + 4 Minor D D T T S D S T D T T T T T D D T + 4 Minor T + 11 Minor S D T S T T T S D T T S + 4 Minor T T T D + 4 Minor D D T T S D S T D T T T T T D D T + 4 Minor T T T T S T S D T S T S D + 4 Minor D D T T T D + 11 Minor T S S D + 7 Major S S T T S + 2 Major T T + 2 Major D T T S T S S T T S S T T D + 2 Major T S D T S S T + 7 Major S D + 9 Minor D D D T D + 9 Minor D T D T T S D D T + 9 Minor T T D T S D D D T D + 9 Minor D T D T T S D D T + 9 Minor T S S T S D T S D + 9 Minor D T D T D T T S + 9 Minor S S T T T T S D S T D + 9 Minor D T D T T S D + 9 Minor T S S T T T T T T D T T + 9 Minor D + 2 Minor D S S T T S S T T T D T + 2 Minor T T T T D T D + 9 Minor D T T D T T + 9 Minor D + 2 Minor D S S T T S S T T T D T + 2 Minor T D S T D + 9 Minor D T T T T T T D T + 9 Minor T T T D T D T T S S D D D T + 9 Minor D T + 2 Minor D T S T T S S D D T D + 2 Minor T D T T S T T T T S S D D D T + 2 Minor T S T S S D D T + 5 Major T T D T S D T D D T + 5 Major S T S D T T D D T + 5 Major T S S D D D T T T T T T S D + 5 Major T S D T S D D T + 7 Major T T D T T S T T + 7 Major T D T D T S + 0 Major T + 5 Minor T + 9 Minor S + 9 Minor T T T + 7 Major S D D D + 4 Minor T D + 4 Minor T S T S S D + 7 Major T S D + 7 Major T + 2 Major S T S T S D S D D D T + 2 Major S S D T S S S T + 7 Major T D T + 9 Minor D T D T T T T T T D T T T D + 9 Minor T S D D T T S T S D T T T D + 9 Minor T T S T + 2 Minor D T T D D T T D + 2 Minor T S D D T T S T S D T T D + 2 Minor T D T T T D T D S T + 0 Major S S T T S + 0 Major T T S S S D D T T S D T T S D T T + 0 Major D T S D D T T S + 2 Minor D T S T T + 2 Minor T D T T S S T T D T D D T + 0 Major T D T S D D T T S S T + 7 Minor S S T + 7 Minor S S T S D D T T T S D + 7 Minor T T S S T T T D D T S T S + 0 Major T + 0 Major T D D D D T T D T S + 5 Major T T D S D T D + 5 Major T T S D T D D T T S S T T T + 5 Major S + 10 Major T T D D T T S T S S D D + 10 Major T T D D T T S D T T S S + 10 Major D + 0 Minor T T D D T T D T T T T S T + 0 Minor D T T T T T T D D T T T S D + 0 Minor D D T T T S D T S D D T T T + 0 Minor T T T T S S S D T S S S D + 3 Major S D D D T + 3 Major T S T D T T S T D T T D + 0 Minor T + 0 Minor T T S D T T S S T S T T T D T T + 9 Minor T T D T T S D T T D T T D D + 9 Minor T T T D D D D D T T S + 9 Minor T T T D T T S S T S T + 5 Major D T T T T S S D T S S D T + 5 Major T D D T T D D T D T + 5 Major D T T T T S S D T S S D T + 5 Major T D D T T D D T D T + 5 Major D S D D T T S S D D T T T S D + 5 Major D T S D + 0 Major T S S D T D T + 0 Major T S S S + 5 Major S T T S T S D T + 5 Major T T D D T T D D T D T + 2 Minor D D T T S T D D T T S S T D T + 2 Minor T T T T S S D D T T D S S S D T + 2 Minor T T T D T T T T T D + 9 Minor T D D T + 9 Minor S T T S D T S T D + 2 Minor T S D T + 2 Minor S S T D D T D D S T D T T T T D + 9 Minor T T T D S S T T T D T + 4 Minor D D T T S S D T T D D S D T + 4 Minor T T T S S D D D S S S D T + 4 Minor T T D + 11 Minor S S S T T D D T + 11 Minor D T T T D T T S T D S T T S + 4 Minor T + 11 Minor T T T D D T S S S S T T + 11 Minor D T S T T T D T T + 2 Major T T T T T T S T S S T T T T + 2 Major S D T T T D T T T T + 2 Major T T T T D D T T S D D T + 2 Major T T T T T T S T S S T T T T + 2 Major S D T T T D T T T T + 2 Major T T T T D D T T S D D T + 2 Major T S S D D T T D D D D T T T S + 2 Major S + 9 Major T T T S T T D D S D T D + 9 Major S T S D D T T T S S S + 2 Major T + 2 Major S T S S D S D D T T D D T T S + 2 Major S S T S T + 4 Minor T S T S T S D D + 4 Minor T + 2 Major D T T T T T T S S D S + 2 Major D S T D T + 7 Major T D S T + 9 Major S S S D D + 9 Major S D T T S T S D D T T T + 9 Major S T S D T S T D + 2 Major S T D D D T + 2 Major T D T T S S T T D D T T + 2 Major S S D T + 5 Major T T T T D T T T D T + 5 Major T T D D T S T D T T D S S D + 5 Major D T T T T T S S T T S D T T T D D + 5 Major D T T T S T D T T S S D D D T + 5 Major T T T D T D T T D D S D + 5 Major T T D D S S D D T S D T S D T + 5 Major D T T T T D D T T + 5 Major S T D T T D S + 0 Major D T T D D T + 2 Minor D + 2 Minor D D D T D T T T T S S T T S S + 2 Minor D + 0 Major T D D T S D D T T S T T + 0 Major T T S D S T S D + 7 Major T T S S D D D T + 7 Major T + 0 Major T T T T S D T S D T D T + 0 Major S S D T D S D T T T S S D D D T + 0 Major T D D T S D D D T T S S S D + 0 Major T T T S T T D T T D D D T + 0 Major S S T T T S S T T S D S D D D T + 7 Major D D T + 7 Major D T S T T T D + 0 Major S T D T S S D + 0 Major S S D T T S S S D D T T S + 7 Major D S + 7 Major D D T S T T T D D T T S D D T + 7 Major T T T S S S D T T S S D D D T + 7 Major D S T S S D T D T T D D T + 7 Major T T T T S S S D T T S S D D D T + 7 Major D S T S S D T D T T D D T + 7 Major T D D T D T S T D T T S D + 7 Major D D T T T T S S D D T T D D D T + 7 Major S S D T T S S S D T S D S D + 7 Major T T S S S D T T S S D D D T + 2 Major T T T T D D T S T D D D T + 2 Major S S S + 7 Major S S D D T T D D T + 2 Minor T T T T T T D D T T T T T S S + 2 Minor S T T + 5 Major T T D D T T S S + 5 Major D S D T T S D T T T D + 5 Major T T T T D S D S D + 2 Minor S D T T T T + 2 Minor T T D T T T D T S + 2 Minor D T D D T T S D + 7 Major T D T S D T S + 7 Major D S T + 9 Minor T T S D D T + 9 Minor T T + 0 Major T T T S S T S T S + 7 Major T T S D T T D D T + 7 Major T D D T T S T S + 7 Major S D T T S T S D + 7 Major T S S T S D D D D T + 2 Minor T T + 9 Minor D D S S T T D D T S + 9 Minor T S T D D D D T S S + 2 Minor S T T D + 2 Minor D D T T T S S T D S S S D + 5 Major D D T + 5 Major S S T T T T T D T T D T + 5 Major S D T T T S S T D T T T + 5 Major S S D D T + 0 Major D D T T T D T T T T D D D T D T + 0 Major S T S T S D S S T T D S T D T + 0 Major S S S S S D T T T T T + 7 Major D D S D T + 7 Major D S T T S S T T D T + 10 Major S D S S T T + 10 Major T T S D D D T D T D D T T + 10 Major D T D T T D S T S T S D + 10 Major T T T D T T S S D S S T T + 10 Major T T S D D D T D T D D T T + 10 Major D T D T T D S T S T S D + 10 Major D D T D D T T S S S S T S + 0 Minor T + 0 Minor S D T T + 10 Major S D T D S D + 10 Major T T T S S S T T T D T T + 4 Major T S S T S S D D T T D + 4 Major D D T T D D T D T S T D D D T + 4 Major T S S S T S + 9 Major D T T S D T S D + 9 Major T D D T S D D T T S S D T + 4 Major S T S S D T S D T T S D D + 4 Major T S T T S S T + 9 Major D T T D D + 9 Major T + 4 Major S T S S D T + 4 Major S D T T S D D T S T T + 4 Major S S T + 9 Major D T T D D T + 9 Major T S + 11 Minor T S S T T D D T S D + 9 Major T D T T S S D T S D T S D + 9 Major T T D + 6 Minor D T T D D T T S S T T T D + 6 Minor T T S D + 9 Major T S D T T D D T T T + 9 Major D D D D D T + 7 Major T T T S S T S D T + 7 Major T T T T T S D T T D D D D T + 7 Major T D D T T T S + 4 Minor S D + 4 Minor T T T T T T S + 11 Minor D S T T T T S + 11 Minor T T T D T T S + 7 Major S D + 7 Major D D D T S D T + 7 Major T T T T T T S D T D + 7 Major D D T + 4 Minor T D D T T T D D T + 2 Minor D T D D + 2 Minor D T T T T S D T T S D T T + 2 Minor T T T D T + 9 Minor T S S + 9 Minor D D T + 2 Minor D T D D D T T T T + 2 Minor S D T T S D T T T + 5 Major T D D T T T T S D T T S S D D D + 5 Major T T D D T T T T S S T T + 5 Major S S S D D T T T S D D T + 2 Minor T + 2 Minor T T T T D T D T T S S T T + 2 Minor S S D + 2 Major T T T T D T + 9 Major S T S S D D D T + 9 Major S D T S + 2 Major S T T S T D T D D T + 2 Major T T T T D T T D T + 9 Major S D D D T + 9 Major S + 2 Major S D S S T T S T D T D D T + 2 Major T S T S T D T S D T T + 2 Major T T S S D T T T S D T S D + 2 Major S S S + 4 Minor T S S D D T D + 2 Major T T T + 2 Major S S T D S T D D T T T S D D T + 2 Major T D T S T S T T D D T D T S D + 2 Major T T D T S S T T S T S T D D T + 2 Major T D T S T S T T D D T D T S D + 2 Major T T D T S S T T S T S T D D T + 2 Major T S T T S S D T S S D T S T + 2 Major S D T T T S D T S D S S S S + 2 Major T T T + 4 Minor D T + 2 Major T T S D D S S D D + 2 Major T D S S D D T + 2 Major T T T S T S T D S T D T T + 2 Major S T S T S S D T T D T T + 2 Major D T T T T S S D D T T T + 2 Major S S D D S S D D T T D T T + 2 Major T T T T T T T S D T D D + 2 Major D D S S S S S S + 4 Minor D + 2 Major D T S T T S T + 2 Major S T S S D T D D T T S T S D + 2 Major T T T D T T T T T S D S + 2 Major D T D S S S D T T T S S + 2 Major S T S S D T T D T T S T T D D + 2 Major T + 9 Minor D D D D D T T S D T + 0 Major T S T T T + 0 Major T D T T S T D T T S S T T T S D S T + 0 Major T T + 9 Minor D D D T T S D T + 0 Major T S T T T + 0 Major T D T T S T D T T S S T T T S D S T + 0 Major T T S S S S D T D T S D D D T S S D + 0 Major T T T T T T S + 9 Minor D T T T T S S T + 0 Major T + 0 Major T T S S S S S D D T T S S D D D T + 0 Major T D T D T S D D T T T T S S + 0 Major T T T S D S D + 5 Major T T T T D T S D D T D D T T + 5 Major T T S + 2 Minor T T T T T + 2 Minor D T D D S S T T T T T S S S D + 2 Minor T D + 5 Major T T D D D T T T T S D S S + 5 Major S S D D T T T S S D T S D + 5 Major T T T T D D T T S S D D T + 10 Major T S T T T T D D T T S S D D T + 10 Major T T T S S D D T S D D T + 10 Major T S T T T T D D T T S S D D T + 10 Major T T T S S D D T S D D T + 10 Major T T T T D D T T D D T S T T D + 10 Major D + 7 Minor T T T D T T T D T D S D + 7 Minor T T T T + 10 Major S T T T S D D T + 10 Major T T D S T T T T D T T S + 10 Major D T D T T S D T T D T + 10 Major T T D S T T T T D T T S + 10 Major D T D T T S D T T D T + 5 Major S D T S T D S S T T T D T D T + 5 Major T T S + 10 Major S D D T T S D T T D D T + 10 Major D D T D S D D T T D T T D T + 7 Minor T T T T T D D T T S T D T + 7 Minor T T D T T S S D D T T T D + 7 Minor T S S T T T T D T + 7 Minor T T T T T D D T T S T D T + 7 Minor T T D T T S S D D T T T D + 7 Minor T S S T T T T D T + 7 Minor T T T T T T D T T S T S S D + 7 Minor T T T T T T D S T T T T T S S D + 0 Minor T S S T + 7 Major S T T T S S D T + 7 Major D D T S D D T + 0 Major T T T S D D T T D T S + 0 Major T T T T T D T S T S S D T + 0 Major T T T S D D T T D T S + 0 Major T T T T T D T S T S S D T + 0 Major T S D S T T T T D T D T T T D T + 7 Major S + 7 Major T S S S S S D T T T D T T D D T + 7 Major T T S S T T S + 0 Major T D T S S T T T S S + 0 Major T T D T + 7 Major T D T T T S D D T T S S D T + 7 Major S D S D T S D D D T T D D + 7 Major T + 2 Major S T T S D T T S D S D D D T + 2 Major S S + 4 Minor D T T T S S D D D T + 4 Minor D D T S T T D D T + 11 Minor D T D D S D T S S T T S + 11 Minor T D + 2 Major D T T D T + 2 Major S S D T S T S + 11 Minor S D + 11 Minor D T D D S D T S S T T S + 11 Minor T D + 2 Major D T T D D T + 2 Major S S D T S T S + 11 Minor S D + 11 Minor D T T T D D D T T S D + 11 Minor D T T S T S T S S T D + 11 Minor T + 9 Major D D T S D T D D T S T T S + 9 Major T T T S D D T S T T S D T T D + 9 Major S + 2 Major S D T S S T S T T D S D + 2 Major T T + 11 Minor D T D + 9 Minor T S D T S D T S S D T S S + 9 Minor T T T D S S T T D D T D + 9 Minor T T D T S S S D D T T S D T S + 9 Minor D T S S D T S S T T T D + 9 Minor S S T T D D T D T + 0 Major S T T S D D T + 0 Major T + 9 Minor D T S T T S S T D T T S S T D + 9 Minor D T T T T S T T T S T T S S T D + 9 Minor T + 7 Major S T S T T T T D + 9 Minor S D T S S T T + 9 Minor S S T T T T D T S D T T S D T + 0 Major T S D D T S T D T S D + 9 Minor T S S T D D + 9 Minor T T T D D D + 7 Minor T D T T T D T D T S T T + 10 Major T T T T + 10 Major T D T T T T S D S T T S S D T + 10 Major T + 7 Minor D T T T D T D T S T T + 10 Major T T T T + 10 Major T D T T T T S D S T T S S D T + 10 Major T T S S S + 7 Minor T T D D T S T D D S T T T D + 7 Minor D T D T T S S D T S S T T S S + 7 Minor D S T + 2 Major T T D T S S D D D T D T D D T + 2 Major D T S T + 9 Major S D D T T D D T + 9 Major S S S D T + 4 Major S S S T T D T D D T + 4 Major S S D T D T T S T + 9 Major T S T S S + 9 Major T S D T S T T S T T S T + 4 Minor T T T S T S T D T S T T T T T T T + 4 Minor T S T + 7 Major S S T T S S D T D D + 7 Major T D S D D T T + 4 Minor T T S T S T D + 4 Minor T S T T T T T T T T S T + 7 Major S S + 7 Major T T S S D T D D T D S D D T + 7 Major T D D T S D D T S T + 9 Minor S T D T S + 9 Minor T T D D D + 4 Minor S T D T D S T + 4 Minor S S S D T D T S S S S S S + 4 Minor T S T T D T T + 7 Minor T T T S T S D T T S S S D D D T + 7 Minor S S D + 5 Major D T T S S T + 7 Minor D T D T T D + 7 Minor T S S T T D D T T S S D D D T + 7 Minor T T T S T S D T T S S S D D D T + 7 Minor S S D + 5 Major D T T S S T + 7 Minor D T D T T D + 7 Minor T S S T T D D T T S S D + 10 Major T T T + 10 Major D D T T S D T T T D T T S D D T + 10 Major T D T S D T S D T T T + 7 Minor D D T + 2 Major T T S S D T D T S D S + 2 Major T D D T T S D T T D D D T + 2 Major T T S S D T D T S D S + 2 Major T D D T T S D T T D D D T + 2 Major T D D T T T D T T S T + 9 Major D D + 9 Major S T S S T T T T S T D D T T T + 9 Major S + 2 Major T T D D T T T T S S S T D D + 2 Major T T S D T T S S T T D D T + 2 Major T D D T T T D T T S T + 9 Major D D + 9 Major S T S S T T T T S T D D T T T + 9 Major S + 2 Major T T D D T T T T S S S T D D + 2 Major T T S D T T S S T T D D T + 2 Major T D D T T T D T T S D T T T + 2 Major T S T D T T S S T T D D T + 7 Major T S D T T D S T T D T S D + 7 Major S + 2 Major D T T S T S S D + 7 Major D + 7 Major S D T T S T T D D + 2 Major T + 2 Major T D S T T S D D D T T T D + 2 Major T S + 0 Major T S D T + 0 Major S + 7 Major T S S T T T D D T T S S + 7 Major T T D D T + 7 Major T T T S D D T T S S S T D T + 7 Major T T D T S T + 4 Minor D T T T D T + 4 Minor T T S T T T D T T T T T D D T + 4 Minor D S S T T D D T T T T D D T + 4 Minor T D T S S T T T T T T T T S T + 4 Minor S S D + 2 Major T S T T S D T T D D T + 2 Major S T S S D + 7 Major D T T D D T + 7 Major T + 2 Major T S T T S D T T D D T + 2 Major S + 7 Major D T T S D T T D D T + 7 Major T T S D S S T D D T + 7 Major T T T T S S D D S S T S D + 7 Major T T T T S D T D S T D T T T T + 7 Major S T T D S D T S D T T + 7 Major D D D T + 5 Major T T S D D D T S + 5 Major T S T S D D S D T + 5 Major T T T S T T D T + 5 Major D D T S T D T T S S + 5 Major D T T D T T S D + 5 Major D D T S S S + 2 Minor T T + 2 Minor S S S D D D T T S + 2 Minor T D S T D S S T T D T T + 2 Minor D + 7 Minor D D T S T + 7 Minor D T T T D T T + 0 Major T T + 0 Major S T D T S T + 5 Major D S D + 5 Major D T T T S S T + 5 Major S D T D D D T T + 5 Major T S D T T T S T D T T + 10 Major T T T S D T + 5 Major D T + 5 Major S D T T S S T S S D + 5 Major D T S D S D T + 5 Major S + 10 Major T T S D T + 5 Major D T + 5 Major S D T T S S T S S D + 5 Major D T S D S D T + 5 Major T D D + 10 Major D D T S D S + 10 Major D T T T D T S + 10 Major D D T T D D D T + 0 Major D T D D T D T S S T T T + 0 Major T + 7 Major T S S T D D D D D T D + 0 Major D + 0 Major S T D D T T S S T S S S D D T + 0 Major D T D D T D T S S T T T + 0 Major T + 7 Major T S S T D D D D D T D + 0 Major D + 0 Major S T D D T T S S T S S S D D T + 0 Major T D T D D T S S T + 7 Major S T T D D D T + 7 Major T T T S D D T S D T T S D S + 7 Major D D D T T T S T T T T T D S + 7 Major D D S + 7 Major S D T T + 7 Major S S D D T + 0 Major S D D T S S T T + 0 Major D D T T D D D T D D T + 0 Major D T S S T T S + 7 Major D D D T + 6 Minor T + 9 Major D T D T T + 9 Major S D T T S S D + 9 Major T T T + 4 Major S S + 4 Major T T D D T D D + 4 Major S + 11 Minor T T D D T T + 11 Minor T + 4 Minor T + 7 Major D T D T T + 7 Major S D T T S S D + 7 Major T T T + 7 Major D D D D + 2 Major T T + 4 Minor D D + 4 Minor S T T D D T + 0 Major T T D D + 0 Major T S S D D T T T T T T S D D D T T + 0 Major T S S + 5 Major S D S D T + 5 Major D D T T T D T D T S D S D + 5 Major T T T T S S S D D T T T S S T T T D D + 5 Major T T D D D T D + 0 Major S D D T S D T T S S S D D + 0 Major T + 5 Major T T T T S S D D T T T S T + 5 Major S D S D D D T + 10 Major T T T T T S S S S T T T T + 10 Major S T D D T T T T T T T T + 10 Major S S D D T T T D T T T T D + 10 Major T D D D D T T S + 7 Minor T S S T T T T + 7 Minor S S D + 10 Major T T D T T T T T T + 10 Major D D D D T D T T S S D D T + 2 Major T S S T T + 2 Major S D T T T T + 2 Major S D T D T T D + 2 Major T D T S D D T S + 2 Major S + 11 Minor D + 2 Major T D T T T + 2 Major D D D T S D T + 3 Major T T T T T T T S T D T + 3 Major D D T T D D T T T S D + 10 Major T S S D + 3 Major S + 3 Major D T T T S D D D T S S D T D + 3 Major T D S T D D D T T S S D D + 3 Major T D D D D T S D T D + 10 Major T D + 10 Major T D + 3 Major S D T T D D T T + 3 Major S D S T T S S S D D T + 0 Major T T T D S S T D T T D D D T S T + 0 Major D T T + 9 Minor D D T T D T + 9 Minor D D T T S T S D T T T T D D D T + 9 Minor T T T D T S T + 0 Major D T T D D T S T + 0 Major D T T + 9 Minor D D T T D T + 9 Minor D D T T S T S D T T T T D D D T + 9 Minor T S T S S D D T D S T T T S + 9 Minor D T T S D T D T T D T + 0 Major T + 2 Minor D S S D D S S T + 0 Major T S S S S T + 0 Major S D S T T T T D T T S S + 0 Major D D T D T + 9 Minor D S S T T T S D + 9 Minor T S T T D D S T D T T T S T D T + 9 Minor T T S D T T S D T T S S S D + 9 Minor T S T T D D S T D T T T S T D T + 9 Minor T T S D T T S D T T S S S D + 9 Minor T + 0 Major T S S T T S T S D T T D D D T + 0 Major D S D D T T T D S D T + 9 Minor S T D + 9 Minor T T T T T S S S T S S T D D + 9 Minor T T S T D D T D S + 9 Minor D T T T T T S S S + 9 Minor T S S T D D T T S + 9 Minor T D D T D S D + 0 Major T S S T T S T S D T T D D D + 0 Major T D D D D T T S + 9 Major T S D T + 9 Major D D D T + 7 Major T T D T T D D T T S D + 7 Major S + 7 Major D T T S D T D T T D D T + 7 Major D T T T T D D D T T + 7 Major S D + 7 Major T T S S T T S D T T T T D T + 10 Major T T S D T S D T D D T T D T D T T + 10 Major T S + 7 Minor D D T T S S T T S S S D D D T + 7 Minor T + 10 Major T S D T S D T D D T T D T D T + 7 Minor T + 7 Minor T S D D T T S S T T S S S D D D T + 7 Minor D T T S D T T D D D T T S T T D + 7 Minor T T T D S T T S D T T T S D + 7 Minor T T T D D T D S S T T S S S D + 7 Minor T S D D T S S T T T D T + 7 Minor T S D D S S T T T D + 7 Minor T S D D T S S T T T D T + 7 Minor T S D D S S T T T D + 7 Minor T S D T T S T S S T S T D T + 7 Minor T T T D T T D + 2 Minor T T S T T S D T + 2 Minor T + 10 Major D T S D D T D T D T T S T S + 4 Minor D T S S D T S S S D D T + 4 Minor T T T D T D + 6 Minor T S T S T T T T T + 6 Minor T S T T T D D S + 11 Major T S D S D D T + 9 Major T T T T T D S S S D T + 4 Major S S D T + 4 Major S S S S S D T T T T D D T T + 4 Major T T S S S S D T + 9 Major T S D T T D S + 9 Major T T T T T S D T T T S D T D T + 9 Minor D D T T S S S S T T S S D + 9 Minor D D D D T T S S T T T T T D + 9 Minor T T T T D D S S T T T + 0 Major S T + 0 Major S T S S D T D T S S D D T + 0 Major T T T T D D D D T T T T T + 9 Minor D + 9 Minor T T T T T T T T S T S S D + 9 Minor T T T D D T T S S S T S S T + 9 Minor T S S T S T D T S S T T S S D D D T + 9 Minor T T T D D T T S S S T S S T + 9 Minor T S S T S T D T S S T T S S D D D T + 9 Minor D + 4 Minor D D T T T D T T S D D D D T S + 4 Minor T D + 9 Minor D T T D T T T D D T T T S S D + 9 Minor D D T T T D T T T S S T D D D + 6 Minor T S T T D T T S S + 6 Minor D + 9 Major S S T T S D T T D T + 9 Major S S D D T T D T + 9 Major S + 6 Minor D T T S S D + 9 Major S S + 9 Major T T S D T T D T S S D D T + 9 Major T S T D + 6 Minor T D S T D S T T D + 6 Minor T D D + 2 Major S D D T S D D + 2 Major T T S S T + 9 Major S D T T T T T T + 9 Major S D S T T D D T T D D D T + 0 Major T D D S T T D T T S T S S T + 0 Major T S T T S S D D T D T D T S T T + 0 Major T T S S D D T D T T S T D D T + 0 Major T D D S T T D T T S T S S T + 0 Major T S T T S S D D T D T D T S T T + 0 Major T T S S D D T D T T S T D D T + 0 Major T T T + 0 Major D T T S S D + 0 Major D D T T T D T T S D T T T S T + 0 Major T T S T D D T D T T S S T D T + 0 Major D T + 7 Major D T T S T T S S S D T D T + 9 Minor T T D D T T D T T T T S S D S + 9 Minor T D T S D D T T T T T T T S + 0 Major D + 0 Major T T D D D D T + 7 Minor D D T S D T T D D D S T T S D + 7 Minor T T D + 10 Major T D D D T T T T T + 10 Major S S T T S T D T D D T + 10 Major D D T T S D T T T S T S S T T + 10 Major T + 0 Major T S T D T T S T S + 0 Major D T S + 9 Minor T T S + 9 Minor T S T S D T D + 9 Minor T T T D + 0 Major T T D S T + 0 Major S + 9 Minor D T T T T T D D + 9 Minor D D S D D T D + 9 Minor D T D D T S T S T S + 9 Minor D T D T T D T + 9 Minor T + 4 Minor S T T T + 7 Minor D S S S T T T T T T + 7 Minor S S S S T S T T D D T + 7 Minor T T D S + 7 Minor D S S S T T T T T T + 7 Minor S S S S T S T T D D T + 5 Major D D T T T D T S D S S T D S S + 5 Major S D D T + 10 Major T D T T S D + 7 Minor D + 7 Minor T T T T S S T T T T S S T T T D + 7 Minor T S D D T T T T T T T T + 7 Minor S S T T S S S T D + 7 Minor T T T T D D T T T S D + 7 Minor T T T D + 10 Major D T T T D S + 10 Major D T T S D D D T + 10 Major T + 7 Minor D T S S S S D T T T + 7 Minor S T D D D D T D D T S + 7 Minor T T S S S S D D T + 7 Minor T T T + 10 Major S S T S D + 10 Major T D D D D D D + 7 Minor D T + 7 Major T S T S S S T D D T T + 7 Minor T S T D D D T T T D T T T S T D + 7 Minor D T D D S T + 10 Major T T D T + 2 Minor T T D D T + 2 Minor T S T D D D T T T T T D T + 2 Minor S S + 7 Minor T D D D T T T D T T T S T D + 7 Minor D T D D S T + 10 Major T T D T + 2 Minor T T D D T + 2 Minor T S T D D D T T T T T D T + 2 Minor T + 0 Minor D D D D T T T T S + 7 Minor D S T S + 7 Minor D T D S S S T T D D T T D T T + 0 Major T T T S D D T T D D D T + 0 Major T + 7 Major T S S S D T S S T S + 7 Major D D D T + 0 Major T S S D T T + 0 Major T S + 2 Minor T D S T T T T T D + 0 Major T S T T D T S S T T S + 7 Major D D S + 7 Major T S S D T T T S D T + 0 Major D D S S D + 0 Major D T T T T S S S T T T S D T T S D S + 0 Major D D T + 4 Major S S S S S S S D T D D T + 4 Major T S T D S T S T D D T + 4 Major S S S S S S S D T D D T + 4 Major T S T D S T S T D D T + 9 Major T T S D T T D T T S D T T D + 9 Major T S + 11 Minor T S S T S D T + 11 Minor S + 9 Major T T D S T T S D T T T S D + 9 Major S T T S T D D T S T D T S T S + 9 Major D D D T + 5 Major S S S S D T T T D T + 5 Major T S S D S T D T T T D T + 5 Major S S S S S S D T T T D T + 5 Major T S S D S T D T T T + 10 Major S D + 10 Major T D S S T S D T T S S T D + 10 Major T + 0 Minor T S D T S D T + 0 Minor T D T + 10 Major D T T D S T T S S D + 10 Major S T S S D T S T T D D T + 5 Major T T T T S S D S D T T + 5 Major S D + 10 Major D D T S D T + 10 Major T T S S S T D D T T D T + 10 Major S D + 5 Major T T T T S S T D D D D + 5 Major T D D T D D T T S + 5 Major T D T T S D D T + 7 Minor T D S T T T T T T S S + 7 Minor T T S D T T T T T T D D T T D D + 7 Minor T T T T D T T S D T T T T T D T T T + 7 Minor T T T T T T T T T T D T T T D + 7 Minor T T D T D T T T T S S D D T S + 7 Minor D D T T S S T T T D T T T T D + 7 Minor T + 10 Major T T T S S D D T T T T D T T T S S + 10 Major T T T S + 7 Minor S T S S T T S S T T T D D + 7 Minor D D T T S T S D T T S S S D + 7 Minor T T D T S D D T T S D T T D + 7 Minor D D S + 5 Major T D S D D T T T S T S + 5 Major T T T D + 7 Minor S D D T T T T D S T + 7 Minor T T D T S D D S T S D T T + 7 Minor S + 9 Minor T T T D T T S S T S T D T + 9 Minor T D T T S D T S S T S T T T D + 9 Minor T T T D T T S S T S T D T + 9 Minor T D T T S D T S S T S T T T D + 7 Major T S S D D T T S D T S D + 0 Major S D + 0 Major T D D T D S T S D T T D D T + 0 Major D S T D D T T S + 9 Minor S T D + 9 Minor T D S D T S T S T T D + 7 Minor T D T T D T T S S T T S D D + 7 Minor T T T T T S D T S S S T T + 7 Minor D T D T T D T T + 7 Minor S S T T S D D T T T T T + 7 Minor S D T S S S T T D + 5 Major T S S D T T S S T S D D D + 5 Major T S + 10 Major D T T T T S S T T + 10 Major S S D D T D + 7 Minor T T D S T T + 7 Minor T D T D T T T D T T S T + 7 Minor S S D + 10 Minor T T T T D D T D S S T S D D T + 10 Minor T T T T S D T S S S T T D + 10 Minor T T T T D D T D S S T S D D T + 10 Minor T T T T S D T S S S T T D + 8 Major T S S D D T T S D S S D D T + 8 Major S + 1 Major S D D T D S T S D T S D D T + 1 Major D D T T D D T T D + 10 Minor D T T D + 10 Minor T T T D T T S T S D + 9 Major T T S D + 9 Major D D T S D T S S D D D T + 9 Major D D D T T T S S S + 4 Major T D S + 4 Major D S T T S D T S D D T + 4 Major S + 9 Major D T D S D S D T T D T T D D + 9 Major T S T T T T S T S D T S S D + 9 Major T T S D T S D D D T T T T T S + 9 Major S D T T S D T T S S D D D T + 7 Minor T T D T T D S T T S + 7 Minor T T S S D D T T S S D T + 7 Minor D + 10 Major D T S D S D + 7 Minor S T + 7 Minor T T D T T D S T T S + 7 Minor T T S S D D T T S S D T + 7 Minor D + 10 Major D T S + 5 Major T D T T S + 5 Major T T D T T D S T S D + 5 Major T T S S D D T S D T S S + 5 Major T + 7 Minor S T T D T T S S D + 7 Minor D D D D T D T T T D T S S + 7 Minor D + 0 Minor T T T S T D T T T D + 0 Minor T T D S S T T S S D D T T T + 3 Major T S T S S T D D D T D D + 3 Major D D T T S D T S T T D T T T T + 3 Major T T T S D D + 0 Minor D D T T S S D D D D + 0 Minor T T T D T T T D S T T T D + 0 Minor T T S S T T T D T S D + 0 Minor T S T T S T S S S T D + 2 Minor T T T S D T S D D T + 2 Minor T T T D T D T T T D + 2 Minor S S T S T T D D T + 2 Minor T T T S D T S D D T + 2 Minor T T T D T D T T T D + 2 Minor S S T S T T D D T + 2 Minor T + 5 Major T T T S D T T S S D D T + 5 Major T D S D S T S S T + 9 Minor S T D D + 9 Minor T S + 9 Major T S T T T S D T T D D + 9 Major T T S D D T T T S D D T + 9 Major T S T T T S D T T D D + 9 Major T T S D D T T T S D D T + 9 Major D T + 11 Minor S T T T T T T D D T + 2 Major T D D T T T T T S D D T + 2 Major D D T S S D + 9 Major S D T S D D + 9 Major T T S S D D T T S S D D T + 2 Major T S D D T S D D T T D S D + 2 Major T S T S D T D D D T + 2 Major T D T D T S T D T + 2 Major T S D D T S D D T T D S D + 2 Major T S T S D T D D D T + 2 Major D T D T + 2 Major T T T T D D D D T T T T D D + 2 Major T T S D T T S S S D D T T T + 2 Major T T S S T S D T T S S S D D T + 11 Minor T T S S D D T T T S T S D T + 11 Minor T T T + 2 Major S D D T T D T T T S + 2 Major T D D D T + 11 Minor S T T S S D D T + 11 Minor T T T T D D T T D T T + 10 Major T S S T T T S D T D D + 10 Major T D S T T T T S D D T + 10 Major T S S T T T S D T D D + 10 Major T D S T T T T S D D T + 10 Major D T + 0 Minor T T T T T D D T T + 0 Minor T D + 3 Major D T T T D D D D T T + 10 Major T S S T T S D T D D + 10 Major T S S D D T S D T T + 10 Major T S T D S D + 10 Major T T S T S D D T T T D S D T + 10 Major D + 5 Major T T T D D D S D T T S T + 5 Major S D T T T S S T + 10 Major T T + 10 Major S D S S D T D S T S D T + 10 Major T S T D D T D T T S D T + 10 Major T + 10 Major T T T D T T S D T T S D T T D + 10 Major S T T T T S S D T + 10 Major D S D T D S T T T T T T + 10 Major T S + 10 Major S D D T S T S D D T + 10 Major T T T D T T S D T T S D T T D + 10 Major S T T T T S S D T + 10 Major D S D T D S T T T T T T + 10 Major T S + 10 Major S D D T S T S D D T + 10 Major D D D D D D T S T T S T T T S + 10 Major S D D D D D D D T T S T + 10 Major T T T D T T S D T T S S D D T + 10 Major T D D S + 0 Minor S T S D D T S + 0 Minor T T S S S D + 7 Minor D T T S S S S + 7 Minor S S D T T + 0 Minor T S T T S T + 0 Minor S S T D T D T S S + 0 Minor D D S D D T T + 10 Major D T T T T + 10 Major T T S S T S S S T S S D D T + 4 Minor T T D T T S S D D T S T T T T + 4 Minor T T D D T T + 0 Major D T D + 4 Minor T + 4 Minor T T T S S T T T S T S T T T D D T + 4 Minor T + 7 Major S T T S S S S S T S D T D D D + 7 Major T T T S S D D T S T D + 7 Major T T S D T + 2 Minor S S T T T T S D T T S S T T D D + 2 Minor T + 7 Minor D D T T S D T T D + 7 Minor T S D S S T T T D T S + 7 Minor D + 2 Minor S S T T D D T T S S + 2 Minor T T T D D T T T S S D D S S T + 7 Major D + 7 Major T + 9 Minor T T D T D T T T + 0 Major T T T + 0 Major S S T T D D T T S D T T S D D + 0 Major T T + 9 Minor T D T D + 9 Minor T T T + 0 Major T T T S S T T D D T T + 0 Major S D T T S D D T + 0 Major T T S D D T S D D T T T S + 0 Major D D T T D D T T S S D T T T + 2 Minor T T T T S S T T T S S T T T D + 2 Minor T D D T T T T T D T T + 2 Minor T T T T T T S + 5 Major D D D T + 2 Minor T T T T S S T T T S S T T T D + 2 Minor T D D T T T T T D T + 5 Major T + 5 Major T D S T S T S D D D T + 5 Major D T D T T T D T S S S + 5 Major D T T T T T T T S S + 5 Major S S T D D S S T + 2 Minor T T + 0 Major T T S T S D T T T T D + 0 Major D T + 7 Major D T S D T T + 7 Major T T S S S T S S S + 9 Minor T D + 0 Major T T T T T T S T S S S T S + 7 Major D T + 7 Major T S S S S D D D D T S T + 0 Major D T + 0 Major D D T T D D T T D D T + 5 Major T T T S T T T D D T T + 5 Major T T S S T T T S + 5 Major T D S D D S D + 5 Major T S D T D T + 5 Major S + 2 Minor T D + 5 Major D T T S D S D + 5 Major T T T T D D T T T D D T + 5 Major T T S D T D D D + 5 Major T T T T T T S D S D + 5 Major T T T T D D T T + 2 Minor S D + 2 Minor T T T T S T D D + 5 Major S T D T T + 5 Major T D T S D T T D T + 5 Major S S D T T S T S S T + 7 Major T T T S T T T S S D D D D T + 7 Major T T D D D D T T S + 4 Minor D + 4 Minor T + 7 Major T T S T T T S S D D D D T + 7 Major T T D D D D T T S T + 2 Major D T D T D T T T S S S S T + 2 Major T S S T T T D D T + 2 Major T S + 7 Major T T T S + 4 Minor T D D T T S S T + 4 Minor T S T S T T D + 4 Major S S S S D T D D D T + 4 Major T S T T S D D T S T D D D T + 4 Major T S S S S D S D T T T D D T + 4 Major T S T S S T + 9 Major S T S D + 9 Major T S S T S D D T T S D T T D + 9 Major T + 11 Minor T S T T T D T + 11 Minor S + 9 Major T D T S S T S S D + 9 Major S S T T D D D D T S T D T T T T + 9 Major D D T + 0 Major D T S T T S S S T T T T S D D T + 0 Major S S T T D T D D T T T T S D + 0 Major D T D T S S T T D D T S + 0 Major T T D T S S S S D T T D + 7 Major T T T T S D S D T D S T + 7 Major S S T T S D S D D D T + 2 Minor T D D T T + 2 Minor S S T T S S S D D D T T T D + 2 Minor T T T T T D S T T T D D D + 0 Major S + 0 Major D T S T S S T T T T S S + 0 Major T + 9 Minor D T D D D T + 0 Major T S D T + 0 Major D D T D T S S S D D T T T T S S T T D T + 0 Major T S T T S D T D T T S S D T T S S S D D D D T D D + 0 Major T T T D D T T T T T D T T S S + 0 Major S T S T T D D T + 2 Minor D D S D T T S T T + 2 Minor T T T T D T T S D D T T T T + 7 Major S D + 7 Major D T S S S S D S S T T T D S D T T S D S D D D + 7 Major T S S S + 0 Major T S S S D T D T T S D S + 0 Major D + 9 Minor T D T T T D D + 0 Major T T + 7 Major S S + 7 Major T T T T S D T T S D D + 7 Major T T T S S T T T T S T T S S + 7 Major S S T S D D T D T D D T + 2 Major D S S D D D + 2 Major T S S D + 7 Major S S D D T S T S D D T T T + 7 Major S D T T S T D S D D D T T S D T + 7 Major D S T S T S + 2 Minor T T T T D D D D D D + 7 Minor T T T T D D T T S D T T S D D + 7 Minor T T T T T D D T T + 7 Minor S D T T S D D T T T D D + 7 Minor T S T T S D T T D D D D S + 7 Minor T D T T S S D T T T + 10 Major T D D + 10 Major T T T T S D T T S D D D D T + 10 Major T D D T T T T D D T T S D D + 10 Major T T T + 7 Minor D T T T D D T T + 7 Minor D T S S S D D D T T S S D + 7 Major D D D T T T T D + 7 Major T T T T S S T T S D T T S S D D D + 7 Major T T T T T D D D D + 7 Major T T T T D T T T T S S T T + 7 Major S D T T S S D D D T + 2 Major S S T T S D T S D + 7 Major D T D + 7 Major T T S T S T S T T S D T D D D + 7 Major T + 7 Minor T S T D T T S T S S D + 7 Minor D T S D + 2 Major T D T D T D T S T + 2 Minor T T S + 10 Major S D D T T T T S + 5 Major S T D T D T D T + 7 Minor S D T T S T T T + 7 Minor T D D T T T T S D T T D S T S S + 7 Minor D D T T T T T D D T D + 7 Minor T T T S T T T T S T T T S D D T T T S S + 7 Minor D D T T T T D T D T S T + 7 Minor S S D D T T D + 2 Major S D T + 2 Major D T + 7 Major T D D D T D T D T T S S D D T + 7 Major D T S T D T T S S D + 7 Major D D T T T D T S T D T T S S S D + 7 Major T T S S T T S S D D T T D D T + 7 Major T S D T T S S D D D T + 9 Major T D D D D T T T T S S D D T + 9 Major D T S D D D D + 4 Major T D T + 9 Major D D T T D T D D T S T T S S D + 9 Major T T S D T T S S S T T D T S T + 9 Major T S D T T S S D D T + 2 Major T T T T S S D T T S D T + 9 Major S T + 9 Major T S D T D T S D D T + 9 Major S + 2 Major T T T S S D T T S D T + 9 Major S T + 9 Major T S D T D T S D D T + 9 Major T T S S T T S + 2 Major S S T S D T S D + 2 Major T T S D T T D T S T T D D T + 7 Major T D T T D D T S D T + 7 Major T S S T T S D S D D T + 7 Major T S D T T D D T S D + 7 Major T T T T S D T T D D D T + 7 Major T T T T T T S D T T D D + 7 Major T T T T T S S S T S + 9 Minor T T T + 7 Major S S T + 7 Major T T S S D D T T S T + 7 Major T T S D T T T S D T T S S S D D T + 7 Major T T T D T T T T S D S D D T + 7 Major T T T T D D T S D T T S D S D D + 7 Major T T T T D T T T T + 7 Major S D S D D T T T T T D D T + 7 Major S D T T S D S D D T + 7 Major T T T T D D D D T T T T T + 7 Major S S T T S D T T S D S D D T + 9 Minor D T S T D S T D T + 9 Minor D D T S S T T T + 9 Minor T T S S D D T S + 9 Minor T D S T D T D D + 9 Minor T S S T T T T T S S D + 9 Minor T D T T D S T S S D + 9 Minor T T D T + 0 Major T D D T + 0 Major D D T S D T T + 9 Minor D D + 9 Minor T T D S D T D + 3 Major T T T T S T S S D T D T D T + 3 Major D T D D T T T T + 10 Major D T T S S S D D D D + 10 Major T S T S + 3 Major T S T S S D T S T + 3 Major T T D T T S S D D T T S S S + 3 Major D D D T T T T T S S S T + 3 Major D D T + 0 Minor T T T T T T T T T D T + 4 Minor T T S S T T T T S S D + 4 Minor T + 7 Major T T D T T S S D T D D T T + 4 Minor T T T S D T T S D T T T + 4 Minor T T T + 7 Major T D D T T S D S S D D D T + 7 Major T D T T S S S S D D D D T S S + 7 Major D T D D S D T T D D D D T T T S + 7 Major T T T T S + 4 Minor S T T D D D D T T S T + 4 Minor S D + 9 Minor S T S T S S D D T S T T T S D T + 9 Minor T S D D T S T S S S D D T + 0 Major D D T T D D T T S S T D T + 2 Minor D T + 2 Minor D T D T S S T D T T T D + 2 Minor T D D T T S T S S D D T D + 2 Minor T D D T T D T T T S T + 9 Minor D D D T T T D T T T T T S S D D D + 9 Minor T D D T S D S S T T S S S + 9 Minor D D D D T T T D + 9 Minor T T T T T S S D D D T D D T + 9 Minor S D S S T T S S S D + 0 Major D D T T S S D T T D T T D D D + 0 Major T T + 9 Minor T T D T T T S S D + 9 Minor T T S T T T D D D D T D T T + 9 Minor S D S S D D S + 2 Minor T D T T + 2 Minor S S T D T T S + 9 Minor D D T + 0 Major T + 0 Major D T T T S S D D T T T T T + 0 Major T + 9 Minor T T D T T D + 0 Major S T T T S D S T D + 0 Major S T S S D T S D T T T T T + 0 Major S T D T T D S S T T T D + 2 Minor S + 2 Minor T S T D T S T T D T S + 2 Minor T T T T D D T + 0 Minor T S S T T T T S T S D + 0 Minor T T T S S T + 3 Major T D D + 0 Minor T + 0 Minor T S S T T T T S T S D + 0 Minor T T T S S T T D + 3 Major D T + 10 Major S S D D T S T D T + 10 Major T D D T + 0 Minor D T T T T D T T + 9 Major T D T D D T S S D T D T T + 9 Major D D T T T D T S T D + 9 Major T T T S T T T S D T + 6 Minor T T + 6 Minor T D T D S S T D T + 6 Minor T + 9 Major D D D D T T T S S S + 9 Major D T T S + 9 Major D T + 9 Major S S D S D D T T D D T + 9 Major T T T T S S S S T + 9 Major T D T D D T T T D S T D T + 9 Major T T T T T S S S S T + 9 Major T D T D D T T T D S T D T + 9 Major D T D T D D T T D T + 4 Major S T + 4 Major T S T T T S S D D T + 11 Minor D T T S S T T S + 9 Major T S + 9 Major T T D T T S S S D D T T + 0 Major S S D T T S S T T T T T T T T + 0 Major D D T T D D T T S S T D S T T S + 0 Major D D T T S + 2 Minor T T T T T S D T T D + 2 Minor D S S D D T T T T S S T + 7 Major T D T T D D T S D T T D D D T + 7 Major T S D T S D T S D D D S S D T + 7 Major T D T T D D T S D T T D D D T + 7 Major T S D T S D T S D D D S S D T + 7 Major T T S D T T T S S S D T T T S D S D + 7 Major T S S T S S D D T D T T T D D T + 7 Major T D D D T D T T S D T T D D D T + 0 Major T T T T T S S T T T S D T + 0 Major T T T S T T T T S D T S D D T + 0 Major T T T T T S S T T T S D T + 0 Major T T T S T T T T S D T S D D T + 0 Major T S S T S D D T T + 9 Minor T T + 7 Major T S + 7 Major S T D D T T S S D + 0 Major S D D S T T + 0 Major T T S S D T S T T T S T + 2 Minor T T + 2 Minor T S S D T S + 5 Major D D T T T T + 5 Major S D S D T + 7 Major S S S S D D T S S + 7 Major D D T T S D T S D T S D T + 7 Major S + 0 Major T T D T T S S T S D D T S T T + 0 Major D D T + 5 Major T S T S D T + 10 Major D S S D + 10 Major T D T T S T T D D T + 10 Major T + 5 Major T S T S D T + 10 Major D S S D + 10 Major T D T T S T T D D T + 10 Major T D S T T T S S T T S T + 10 Major T T T S S D S S T S D + 10 Major T S T S D T D S T D T T T + 7 Minor T + 10 Major T S T S D S D S T T + 10 Major D D D T + 0 Major S T S S T T T + 0 Major S D T T T S T + 0 Major T T T D T T S D T T + 0 Major T T S T S S T T T + 0 Major S D T T T S T + 0 Major T T T D T T S D T T + 0 Major T S D + 9 Minor T S S S D T + 9 Minor T T D T T + 7 Major S D D T + 7 Major S D D T T D T + 7 Major S T T + 0 Major D T S T T + 2 Minor T T T T S T D + 2 Minor T S + 0 Major T T T S S + 0 Major S T D D T D S + 7 Major S S D + 7 Major D T S S D D T T + 0 Major D + 0 Major T S T S S T D T T + 0 Major T S D T S T D T T + 0 Major S D T T + 0 Major D D T S D D T S S S + 0 Major D T T D D T D + 0 Major D + 7 Major T S D D D + 2 Major S D T S + 2 Major T T S S D D T T T + 9 Minor S T S S T D T S T T S + 9 Minor D D T + 7 Major S S S T S S D T D D T T + 7 Major S D T S D D T S S S T + 7 Major S S D T D D T T S D T S + 7 Major D D T + 10 Major T S D D T T T S D T + 10 Major T T T T T T D D T D T T S S D + 10 Major D D T T S D T T T T T D + 10 Major T T S S D T + 7 Minor T D T S S T + 7 Minor T + 10 Major S D D T S D T T T S D + 10 Major D D T S D T S S S T D D T + 9 Major T T D T T T S D T + 9 Major T T T T T T D D T T T T S D + 9 Major D D T + 11 Minor S D T D T + 4 Major D S + 4 Major S S T T T T D D T S D T + 4 Major T T S T + 9 Major D T T S S T S D D D T + 9 Major T D S T S D T T T T S D T + 9 Major T T T T T D D S T D T S D + 9 Major D D T S D D T D T + 9 Major T T T S D D T S T T S S S S D T + 9 Major T S D T D T D S T S T T T S S D + 9 Major T T T S D S T T T S T S D D T + 9 Major D D T S T T S D S T + 9 Major T S T D T T D D T T T T D S D + 9 Major D T S D T T T S S D + 9 Major T T + 6 Minor S D T S T S S T + 6 Minor T + 9 Major S T D T T S T T T T S D + 9 Major D T S D T T T S T D T + 0 Major T T S T T S S S D T + 0 Major T + 9 Minor T D T T T T T D + 9 Minor D T T D D T T S S S D T T D + 9 Minor T S S T S S D + 2 Minor T D T T S S D + 2 Minor T + 7 Minor D T T D T + 5 Major S T D T T + 5 Major S S T S D T T S T S T + 5 Major S D T T S D D T + 5 Major T S D T S T T T S S D + 2 Minor D + 2 Minor T + 7 Minor D T T D T + 5 Major S T D T T + 5 Major S S T S D T T S T S T + 5 Major S D T T S D D T + 5 Major T + 7 Minor D D D S S S D T T T T S D T T + 7 Minor T D D D + 5 Major T S S D D T D T T + 5 Major S S D D T + 7 Major T T T T T S T S D T D T + 7 Major T S T D S S S D D T T D D D D T + 7 Major T T T T T S T S D T D T + 7 Major T S T D S S S D D T T D D D D T + 7 Major S D D T T S T D D T + 7 Major T T S D D T D D T T D S D + 0 Major S S D D D D T T T D T + 0 Major S D D D D T D D + 7 Major T T + 11 Minor S S D D T D T D T D D T + 4 Minor D T T D D T D T T S + 11 Minor S S T T S + 11 Minor S S D D T D T D T D D T + 4 Minor D T T D D T D T T S T T D D T + 4 Minor T T T T S T S S T D + 11 Minor T + 11 Minor T T S D S S D D T D D T + 11 Minor S + 7 Major D T T T T D D T T D D S + 7 Major T + 4 Minor T S S T T T S D D T + 7 Minor T S T D D T S T D T + 7 Minor T T D D T T D D T T T T S T + 7 Minor D S T T T T S S T S D D T + 7 Minor T D T D + 5 Major S D D T D T + 5 Major T + 7 Minor T T T T S S S S D D T D S D + 7 Major T T S D D T + 5 Major D + 5 Major T + 2 Minor D T D T T T D S S S S D + 2 Minor T T D S S D T T T T + 9 Minor D + 9 Minor T T T T D + 7 Minor D T T S S D + 7 Minor D D T T S S S S D D D T + 2 Minor D + 2 Minor D T S T T D D T + 2 Minor T T D D D T S D + 2 Minor T T T S T S T T T D + 5 Minor T T S S T S S D T T T + 5 Minor T + 8 Major T D T T T S S D T T + 8 Major S + 5 Minor S S D T T S D T T + 5 Minor T T T T S S S S D T D + 10 Minor D + 10 Minor T T T T T T T T S S D + 5 Minor T S + 5 Minor D T S S T S D D T + 5 Minor T T T T D D D D D + 0 Minor T D D T + 8 Major T + 8 Major T T T T S D T T D D D T T T + 8 Major S S S S S S S S D D D D T T T + 5 Minor D + 5 Minor T T T T T T T T D D T + 3 Major T T S S D T D S D + 3 Major T S D S D T T D + 3 Major T T S + 10 Major T T D T S + 10 Major T S D D T + 0 Minor D D D D + 0 Minor T D T D T T T S T + 0 Minor S D D T + 3 Major T S S S S T T + 3 Major T D D D D T + 5 Major T T T T T T S S D D T D T S S D + 5 Major T T T D D T T T S S T T T D T T T + 5 Major T T T T T T S S D D T D T S S D + 5 Major T T T D D T T T S S T T T D T T T + 5 Major T T T T T S T T D T S S D + 5 Major T S S T T T D D T S T T S S S T + 5 Major S S D D T T D D T T T T T T T T S + 5 Major D D T + 0 Minor T T S S S D D T T T T T T D D + 0 Minor D T + 3 Major D T T S D + 3 Major S S D T S S D T T T S T S D S D D T + 3 Major T S S S S S T T T + 0 Minor T T T T T D D + 0 Minor D T + 3 Major D T T S D + 3 Major S S D T S S D T T T S T S D S D D T + 3 Major T S T S D D S T S + 10 Major T S S + 10 Major S S D S D T D T S D D D D T + 10 Major S T S S S + 8 Major T D D D T T T T S S T + 8 Major S + 3 Major T S D D T T S D T T D D + 3 Major D S + 10 Major T S S T + 3 Major D T S T + 3 Major S D D T T D D T T S D S D D D T + 7 Minor T S T T T S T S S S T D T + 7 Minor T D T T D D D + 7 Minor D + 7 Minor T D T D D D D T T T T T T + 7 Minor D T S S D D T S T S S D + 7 Minor D D D D D D D T T T T T T T + 7 Minor D D D D T D D D D T T T T T D + 7 Minor T T D D D D S D T T T T + 7 Minor S S S T S S D + 9 Minor D T T T T D D T S S D + 9 Minor D T D T S T D T D D T + 0 Major D + 9 Minor T T D D T T S S T D + 9 Minor T T D T T D S T S D D T + 5 Major T D S D S T S D T T D D T T + 5 Major S S D D T T S D T S S D + 9 Minor D + 9 Minor S S T T T S S D D D D T + 2 Minor D S D T T D + 2 Minor T D T T D D T T S T S T S + 2 Minor T T T D + 5 Major S T D T D T T T T S S T T + 5 Major S S T D T T T S S D D T T + 5 Major T T D D T T S S D D D D D T T + 5 Major D D D T T S D D T T S + 2 Minor T T D + 2 Minor T T T T D + 5 Major D T T S + 2 Major T S S S S T T + 2 Major S D S T T S S S D D T + 2 Major T D T D D T D T S S + 4 Minor D T + 4 Minor T T T T S S D + 9 Major D T + 2 Major T T T D T D T D T T S S T T T + 2 Major S + 4 Minor D T T S S S D S T + 2 Major D D T D T T T T D D T D S T T T + 2 Major S S S T S D S D T T + 2 Major T T S + 9 Minor D D T T T T T T + 9 Major S S D D D T + 9 Major S D S S T + 6 Minor D T T T T S T + 6 Minor D + 9 Major D T T T T T S T S D D + 9 Major T T + 2 Major D D T T D D T T T S S T + 2 Major S D S D D D T + 7 Minor T T D T T T S S T T + 7 Minor T D T S D T T D + 10 Major D T T + 10 Major T T S S T S D D T + 10 Major T T D + 5 Major T S S D D T T T S S + 5 Major T T D D T S T T S + 10 Major T S + 10 Major T S + 3 Major T T S T + 7 Minor T D T T T T T S S T T T D + 7 Minor T + 10 Major D T T T T T S S S S D D + 10 Major T T D T D T T S D T T + 10 Major D D + 0 Minor S D T T T T D D T T + 0 Minor S D D T T T D + 10 Major S T + 10 Major S D T T T + 7 Minor T T T S S S D D + 7 Minor S S T S T D + 7 Major T S T S T T T D T T T S D T + 2 Major S T S D T T T T T S D S D D D T + 2 Major S T S + 7 Major S T T T D T T T S D T + 2 Major S T S D T T T T T S D S D D D T + 2 Major S + 9 Minor T T S T T T D S S T T T S S S D D D + 9 Minor T T T D D T T T D T T T T T + 9 Minor T + 0 Major T T T T S S S D T T T T T S S D D + 0 Major T + 7 Major T T D D T T D D T D T T + 7 Major S D S D D D T + 7 Minor T D T D D T T + 10 Major T S T S T + 10 Major D D T T D T D D T + 10 Major T T T T S T S D D + 7 Minor S D D + 5 Major T D T D D T T S S D T T D + 5 Major D D T T T S + 2 Minor T T T T + 2 Minor T T T S T D D D T T T T D T + 7 Minor D D T T T D T T T T S T D D D D + 7 Minor T T T T T + 2 Minor T T S T T T D T T T T T S + 2 Minor D T T T T T T T T T D D T + 5 Major T + 5 Major S S T T S T S S T D T + 2 Minor T T S T T T D T T T T T S + 2 Minor D T T T T T T T T T D D T + 5 Major T + 5 Major S S T T S T S S T D T + 5 Major T S T T T D T T S S T T + 5 Major T T D D D D D S + 7 Minor T T D T D + 7 Minor T T S T S T S S T T T + 7 Minor D + 5 Major T T D T S D D T D T D S S T T + 5 Major T T D D T T T T T D T T + 5 Major T T S T S S T S D D T T + 5 Major T T T + 0 Major S T T T T S S T T S S D D + 0 Major D D T D D S S S + 2 Minor D T T + 2 Minor T D T T T T S S D T T + 7 Major T T D T T S S S T S + 7 Major T D D T T S S S S T T T T D D + 7 Major D D T T T T D T + 7 Major T S S S T S T D D T T S S + 7 Major S S T T T T D D D D T + 7 Major T D D T T T S S D T S D + 7 Major T T T S S T T T D T T T D D + 7 Major D D T + 2 Major T D T T T T S S D D S S T S T + 2 Major T T D T T S D T + 2 Major T D T T T T S S D D S S T S T + 2 Major T T D T T S D T + 2 Major T T T T T T + 9 Major D D T D T D T T T + 9 Major T T S D T T D S D D T + 9 Major T S + 2 Major T T T S S T T T S S T + 7 Major T T T T + 2 Minor T D T S T T T D T + 2 Minor T D S D + 5 Major D T S S S S T + 5 Major T D T T S D T T D D + 9 Minor D T S + 9 Minor S T T S S T D D T S D T + 9 Minor D D T + 5 Major S D T T S T D T + 5 Major T S S T D T + 2 Minor T S T T D + 11 Minor S D D D D T D + 11 Minor D D T T S T S S D D D T + 11 Minor D D T S S T T S S D D D D T D + 11 Minor D D T T S T S S D D D T + 11 Minor T + 2 Major T S S S S T D D D T D T + 2 Major D D T T D D T T T T S D + 4 Minor T S S D T + 9 Minor D D D D + 9 Minor T T T S D D D S T + 9 Minor D D T S S T T S T S D S S D + 9 Minor D T T T T S D T D + 0 Major T T S S D T D D T + 0 Major D D T + 7 Major T S S S T D T D D T + 7 Major T + 0 Major D T T T T S T S T D T S S T + 0 Major D D T T S S T + 9 Major S D D T + 9 Minor D D T D + 9 Minor D D T S T S D D T T T T + 9 Minor T T T S S T S D D D T D + 9 Minor D D T S T S D D T T T T + 9 Minor T T S S T T S S T T D + 9 Minor D T S S T T T D S S T T D + 9 Minor S T T T D T S T S T D T D T D + 9 Minor S T T S T T D D T + 6 Minor T T T T S D T T D T T T D T + 6 Minor T D + 9 Major D D D T D T T T S D S D T + 9 Major T T T S D S T T T T S + 6 Minor S + 6 Minor S S T T T + 9 Major S D S T D S S S S T + 9 Major D T + 6 Minor D T S S T T T T D D T + 6 Minor T T T T D T T S S T + 9 Major D T T S S + 9 Major D T D T S S S D D + 9 Major D T T + 6 Minor D T S T + 9 Major T S T + 9 Major S D T D D T T T D T D T T + 9 Major T T T D T S D D T S D D T + 9 Major T T T T S T S S T D D D + 9 Major S T S D T S + 2 Major T T + 6 Minor T T T T T D T S D T T S T S S + 6 Minor T + 9 Minor T T D T D D T T S T T D + 9 Minor T S T T T T S T D T S S T S + 9 Minor T D D T D T S T T D + 9 Minor T T T T T T S S S D + 0 Major D T T T D S + 0 Major T T S D T T D D S + 9 Minor S T T D D T + 9 Minor T T T T T T T D D S T D + 9 Minor T T S T D D S D D S S T S + 9 Minor T D T T S T T D + 5 Major T S T T T T S T S D T D T + 5 Major D S + 9 Minor S T T S D T S T T D D T + 0 Major T T T T S S D T S D T T D T D D D + 0 Major T D D T T + 7 Major T S T T + 7 Major D T T S D T T S S D D D T + 7 Major T S T S S T + 0 Major D T T S T S S + 0 Major T T T + 7 Major S D T S S S S + 7 Major T S T S D T T T T S D T D + 7 Major D D D D T T + 7 Minor T T T S D T T T D D T T T S S D D + 7 Minor T T T T S S S S S D D T T D + 7 Minor D S D T T T D T T D + 10 Major S T T + 10 Major T T T D S D D T T D D D T + 10 Major T D S T T T T S D T T T D D + 10 Major D D T S D T T S S S + 7 Minor T D D + 7 Minor D T D D T T T D T T S D + 7 Minor T T S T T T D D D T T T + 9 Minor T T T T D D T T S D D + 9 Minor T T S S D D T T T T D D + 9 Minor T T S D D T T S S D D + 0 Major T D D D T T D + 0 Major T T T S + 5 Major D + 9 Minor S S T T + 9 Minor S S T T S S T T S D T T T D + 0 Major T S D D T S + 9 Minor S T T T S T T D S + 9 Minor T T S S D + 5 Major D T T T S D S D T D D + 5 Major T T S T D T S D S D T T T + 2 Minor T T T T S D T T S S T S S D T T T T T + 2 Minor S + 2 Minor T S S D T D D + 2 Minor T T S T S T S S S D T T T + 2 Minor T T S D T S S S S S D T T T + 9 Minor T T T T T S D D T T D T T S S S D + 5 Major D D T + 5 Major T T S D S D D S T D T T T S D T T D D T S S D S + 5 Major D T T T T S D + 2 Minor T S T T + 2 Minor T T T D T T D D T T + 2 Minor S D D T T D T S S D + 0 Major D D S T S T S S D T + 0 Major T + 0 Major T T T S S T S S S S T D T T S S + 0 Major T T D T T D D T T S S + 0 Major D D T T T T T + 9 Minor T D + 4 Minor T + 4 Minor D D T T S D T T S + 7 Major T T T S S + 7 Major S D T D S S D D T T S D + 7 Major T T T S S D D T D S T D + 7 Major T T T T S + 0 Major T S S T + 7 Major T T S S + 7 Major S D T T D D T T D D D T + 0 Major T D T + 3 Major T T T T T S T D T + 10 Major T S D T T S D D T + 3 Major T S S D T S D T T D + 3 Major T T T D D T T T S S S D T + 3 Major D T S D T + 10 Major D D T + 10 Major S S T S + 3 Major S T T T D T S S S S + 3 Major T S S T T S D D T + 7 Major T D T S D T D T S + 7 Major T T D D D T S T S D T + 7 Major T D T T D + 4 Minor T D T T T T T + 4 Minor T + 7 Major S D T D D T T T S D T + 7 Major T T S T D S T D T T T S + 7 Major S D T T T T T S + 2 Major D T + 7 Major T D T D T S D + 7 Major D D T T D D T T S T D D T T S S + 7 Major D D T + 9 Major T D T S D D T T D S T T T + 9 Major T S D T D S T T T S D T + 9 Major T S D T T D D T D T T T T T S + 9 Major T T T T D T S T T S + 6 Minor S S S S T + 6 Minor D D T S T T S S T T T D D D D T + 4 Major T S S S S D D T T S S S D D D T + 4 Major T S S T T T S + 9 Major T T D T S S T S D D T + 9 Major D D T + 7 Major T T D T S T T D + 7 Major S D T S T D + 7 Major T D T + 7 Major T T D T S T T D + 7 Major S D T S T D + 7 Major T D T + 7 Major D + 9 Minor S S T T D T + 9 Minor D T D D D T + 9 Minor S T T + 4 Minor D D T + 7 Major D + 7 Major T T S T D D + 7 Major T S D S T D D T + 9 Major T T T S S D T D T T S + 9 Major T T T D D D T T T S S S D T + 9 Major T S D T + 6 Minor T S D T S T + 9 Major T T T T + 9 Major T S D T D D T T T T S D S D D T + 9 Major T S D T T D D T S D T T T T T S + 4 Major T S T S S D D T T + 9 Major D D T S D + 9 Major D D D T D D D T T T S S S S D D T T T S D S + 9 Major D D T + 5 Major T D T S D D T S D T S D T T S D S + 5 Major D D D T T T S D T T S D + 5 Major T S D D T + 0 Major S T T S D T S T D D + 0 Major T + 5 Major D T T T S S D T T S D T T D D D + 5 Major T S S T T D D D T + 7 Major T T T T S D T T D D S T T S D D T + 7 Major T T S S S T S S S T T D T T T T T D + 7 Major T T S S T T T S + 2 Major T T S T S S S S D T + 7 Major T S S T S D T S S T T D D D T + 7 Major T T T T D D T T + 7 Major S D T T D D D D T T D + 7 Major S D D D T S D D + 7 Major T T T S D T D T + 7 Major T T T T D D T T + 7 Major S D T T D D D D T T D + 7 Major S D D D T S D D + 7 Major T T T S D T D T + 7 Major T T S D T T D + 4 Minor D S D D D + 4 Minor T T T T T D D S T T D D + 4 Minor T S T S D T T T T + 7 Major S + 7 Major T S D T D T T T T S D T T + 7 Major D D D T D D T S D S + 7 Major T S T S T D D T T D D T T T S + 7 Major D T D T + 9 Minor T T T T T D T T S T T S S D + 9 Minor T D D T S S D T S S T D + 9 Minor D T T T T T T T T D T T + 9 Minor S T T S S D T D D T + 9 Minor S S D T S S T D D T T T + 9 Minor D T D + 0 Major T T T T S T S D D T + 0 Major T S T S + 9 Minor T D S T T T T D D T + 4 Minor T D T T T S T T T T T D T S D S + 4 Minor T T T T D D T D + 7 Major T S D D T T + 7 Major T T D S S D D T T S S D D T + 7 Major D T D S D S D D D D T S D D T T + 7 Major T T D D T D T T D D T T T T S S + 7 Major S + 4 Minor T T D + 4 Major T T T S T T S D + 4 Major T S D D T T D D D S S D + 4 Major T S S D S S T T D D D T + 4 Major T D T T T S T T S D + 4 Major T S D D T T D D D S S D + 4 Major T S S D S S T T D D D T + 4 Major D T D T + 4 Major S T D D T T D T D D + 4 Major T T S D T T S S S D D T T T + 4 Major D T T T T S S T S D D T + 5 Major D + 5 Major D T T D T S S S D D T T D D T + 5 Major T S S S D T T T T S S S S S S T + 5 Major T T T S S T D T T S S T D D T + 10 Major T S S D T S T T S D T + 10 Major T S T T T S D T T S D + 10 Major D T S D T T T T D + 10 Major T T + 7 Minor D T S T + 10 Major S S D T + 10 Major T T T D T D T D T S D + 10 Major T T D T T S S T S D D T + 4 Major T T T S + 4 Major S S D D D T D T D D T + 4 Major T S S S S D T T D T + 4 Major D T + 11 Major D T T S T D T T + 11 Major T T S + 4 Major D T T T T T T S + 9 Major T T T + 11 Major D T + 4 Major T S D + 4 Major T S T S S T D T + 4 Major D D D T T S T S D D T + 7 Minor T S S T T D T T D T D + 7 Minor T S T S T T D D S D T T S + 7 Minor T D D T S T D + 7 Minor T T T T T T S S D + 3 Major S D D D T + 3 Major D T S T D + 7 Minor T S S T T D + 5 Major T D D T T S T S + 5 Major T S T T D D T T D D D D T + 5 Major S T S T T S + 10 Major S S S + 10 Major D T S T T T T D T T S + 10 Major D D T T T S + 7 Minor T S D T D T T D D T + 7 Minor T T D D D S T T T D T T T T T D + 7 Minor T S D T D T T D D T + 7 Minor T T D D D S T + 10 Major T S D S S T T + 7 Minor T D + 7 Minor T + 5 Major S T S D T D S S T T S + 5 Major D T D S T D S T S D D T + 5 Major D D S + 7 Minor S S T T T S T D S T S + 7 Minor D + 7 Minor T S S S S T T S D + 7 Minor D T S S T S D + 10 Major T T D D T T T S D S T + 10 Major T T D D T D T T S D D T + 10 Major T D T T T T T T S + 5 Major T D D T + 5 Major T T S T T S S D D S + 5 Major T T T S D D T T S S D T S S + 5 Major D T T D + 0 Major S S S + 0 Major T D T S D T D T S T S S + 0 Major S + 5 Major T S T T S D D T S D + 5 Major T D S S + 7 Minor S T + 10 Major T T S + 10 Major D D T D S T + 5 Major T T D + 5 Major T T D T T D D + 10 Major T T S S T T T S D T T D D + 10 Major T D S T T S T S D T T + 10 Major T T S S T T T S D T T D D + 10 Major T D S T T S T S D T T + 10 Major D D T S T S + 0 Minor T S D D T + 3 Major T D D T T T T S D D T + 3 Major T + 10 Major S S T T T S D T S D D + 10 Major T D S T T S T S D T T T + 7 Minor S T S S S D T T S S + 7 Minor T D + 0 Minor T D T T + 0 Minor S S T T T D D T + 7 Minor S T S S S D T T S S + 7 Minor T D + 0 Minor T D T T + 0 Minor S S T T T D D T + 3 Major T T D T S D T T T + 3 Major S D D T T T D T + 3 Major S D T T T S D D T + 3 Major T S D T S + 0 Minor T T T D + 0 Minor T T T S D T S T D + 10 Major T T D T D T S D D D + 10 Major S D T S D T T D D T T + 10 Major T D T D T S D D D S D + 10 Major T S D T T D D T T D D + 10 Major T T S T S S D S T + 10 Major T T S S D T S S D + 10 Major T D T T D D D T + 7 Minor T T T T S S D D T S T S D D T + 7 Minor T D S D T T T + 10 Major T S T D S S T + 10 Major T S D T T D D T D T T D T + 10 Major T T T D + 7 Minor S T T D D T T D + 1 Minor T T S S D D + 1 Minor T + 9 Major D T D T D S T D T D + 9 Major T S T + 4 Major D D T D T S + 4 Major T S D D T D T D T T + 4 Major T + 9 Major D D T + 4 Major D S D T + 4 Major D D T D D T + 9 Major D T D T D D + 9 Major T T D D S S T T T T T D + 9 Major D + 4 Major T T S T T S + 4 Major S S D T T S S D + 9 Major D + 9 Major T D T D D D T + 7 Major T S + 7 Major T T S S D T T D T + 7 Major T S D T T T D D T T S S D + 7 Major D + 2 Major S T S D D T S + 0 Major T S S T S + 0 Major D D D D S S T D T T T D + 2 Major S D S D S D D D D T T + 2 Major T S S S T T T D T + 2 Major D + 9 Major S S D D T D T S D D T + 9 Major T S T S T S T S + 7 Major D T + 9 Major S S D S D T D T D D T + 9 Major S S S S + 2 Major T S S S D T + 2 Major D D T T T T D D D D T + 4 Minor T T T T S S T S D D T + 4 Minor T T T S T S T T D + 4 Minor T T T T D T T + 4 Minor T T T T S S T S D D T + 4 Minor T T T S T S T T D + 4 Minor T T T T D T T + 4 Minor T T T T S S T T D + 11 Minor T T + 11 Minor T T S T T T S T T T D D + 11 Minor T T S S S T S S D T + 4 Major D + 4 Major T + 0 Major T T S D D D T + 0 Major T S T T T D + 0 Major T S D T + 7 Major S S D + 7 Major D T T S D T T S + 7 Major D T S D T T T + 7 Major S T T S D + 0 Major T T T S S T T T T T D D D T + 0 Major T D S T S + 9 Minor S T T D D T T T + 9 Minor D D T + 0 Major T T T S S T T + 0 Major T T T D D D T T D S T S + 9 Minor S + 9 Minor T T D D T T T D D T + 9 Minor T D S + 7 Major D D D T T T D T T T T S S + 7 Major D T + 9 Minor T T T S S T T D D T S + 9 Minor T T D D + 4 Minor T T S + 0 Major T T T S + 0 Major D T + 9 Minor T S D T S S S S T D D + 9 Minor T T T T D + 9 Major T D T D T D T + 6 Minor T D D T + 6 Minor D T S D D T T S + 9 Major S D D S S + 9 Major T T S D D T + 6 Minor T T S D + 6 Minor T S D T S D T T T T + 6 Major T T S S S D T + 11 Major D T T T D S T S + 11 Major T D T D T T S + 11 Major D + 6 Minor T + 1 Minor S T T S D T + 4 Major S T T S D D T S + 4 Major S D T T S + 9 Major T D + 9 Major T S D T D D T + 9 Major S + 9 Major T S S D T D S D T + 9 Major T S S T S D T + 9 Major T S S D T D S D T + 9 Major T S S T S D T + 9 Major D D D D T D D T D T + 9 Major T T D T D T S T S + 9 Major D D T + 7 Major T T D T S S T D D T + 7 Major S S D S S T T S D D T + 7 Major T T D T S S T D D T + 7 Major S S D S S T T S D D T + 7 Major T S S S S D D T T T T S + 7 Major T T S T T D D T + 2 Major S D D T + 2 Major S S + 7 Major S T S D D T T D D T + 11 Minor D T D D T D T S T T D D + 11 Minor T + 9 Major T + 2 Major D T T D T + 2 Major S S T T T T D T + 11 Minor S T D D T D T S T T D D + 11 Minor T + 9 Major T + 2 Major D T T D T + 2 Major S S T T T T D T + 2 Major T T D T D D T T T S D T + 2 Major D T D S T T T T T T S + 2 Major T S T D T D D T + 2 Major D + 11 Minor D D D S T S T S T + 2 Major S T D T + 2 Major S D D T S D T D T T T T T T + 2 Major D T + 4 Minor D D + 4 Minor S D T T S T T S S T D D T + 4 Minor T T T D T D S D + 4 Minor D D + 4 Minor S D T T S T T S S T D D T + 4 Minor T T S D S T D + 11 Minor T T S D T + 11 Minor S T S S S T T T T S T T D T + 11 Minor D T T S D T + 4 Minor T D S D D T D + 4 Minor T D T T S S T S T S T D T + 4 Minor T S S S S D + 0 Major T T T T S S S D D D T + 0 Major D D D D T + 7 Major T D D T T S T S D T T + 0 Major D T D T T S S S S D T S D + 0 Major T T D T T S S D D T T S S S + 0 Major D T T T T D T S D D D + 7 Major T + 7 Major D D D D S D T + 0 Major T T T T S T T + 0 Major S S D D T + 2 Major S T S T D T + 2 Major D T S T S + 7 Major T S T S D T + 7 Major T + 2 Major S T S T D T + 2 Major D T S T S + 7 Major T S T S D T + 7 Major T T S D T D T S + 7 Major D T T T T S + 7 Major S D S S T T D + 7 Major T T D S S + 4 Minor D T T + 4 Minor S T D D T T + 7 Major T + 7 Major S T S D T D T S + 7 Major D D T D T + 0 Major T S T S T T T S T D T + 0 Major T D S + 9 Minor T S S T T D D T T T T + 9 Minor D D T T + 0 Major S T S T T + 0 Major T S T D T T D S + 9 Minor T S S + 9 Minor T T D D T T T T D D T + 9 Minor T D S + 7 Major S D D T D T T S D T + 7 Major S S D T + 9 Minor T T D T S T T D + 9 Minor T + 0 Major S T S S T T T T S + 9 Minor T D D T + 9 Minor T S D T S S S D T D T T T + 9 Minor D + 0 Minor D D D D + 0 Minor T T S D D D D T + 0 Minor T T D T S D D D D + 0 Minor T T S D D D D T + 3 Major T S S T D T + 3 Major D T S D T T T T S T D S D + 3 Major D T T S S S D D S T + 3 Major D T S S T + 9 Minor T S T T T S T T S S D T D + 9 Minor T T T D T T T T D T + 7 Major T + 7 Major S T D S D D T T T S D D T D T + 7 Major S T S S T + 0 Major S T T T T D T T + 0 Major T + 9 Minor D T T D S T S T T S D T T D + 9 Minor D T T D D S T S T S S T S D S + 9 Minor T + 7 Minor T T T D T T T T D D T T D + 7 Minor D T T D D T T T S S T + 7 Minor D D T D T D D T T + 7 Minor T T D D T T D D T T + 7 Minor D D T T T S S T D D T + 2 Minor S D T D D T S T S + 5 Major D T + 5 Major T D D S + 7 Minor T T T D T T T S S + 7 Minor D T T D T D + 7 Minor T T S T D + 7 Minor T T T D T S S S S D D T + 7 Minor T T T T S D T S S T D + 7 Minor T D T T D T S S S S D D T + 7 Minor T T T T S D T S S T D + 7 Minor D + 5 Major S S D + 10 Major D T T T T S S D + 10 Major T S D T T T S S S S D D T + 10 Major T T T T D D T + 7 Minor T T S S D + 7 Minor T T T S T S D + 0 Major D D D + 0 Major T T + 7 Major T + 7 Major T D T + 7 Major D D T T D D D + 7 Major T + 7 Major T + 0 Major D D D + 0 Major T T + 7 Major T + 7 Major T D T + 7 Major D D T T D D D + 7 Major T + 2 Major T + 7 Major D D T T T + 2 Major T + 2 Major T S D T T + 2 Major D D T + 0 Major D T D + 0 Major T T D T + 7 Major T + 7 Major D T D D + 7 Major T + 7 Major T T S T S D D D + 7 Major D D D T T T T + 2 Major D + 2 Major T T T S S S T + 7 Major T T T S D D T D + 7 Major T D T S D T + 7 Major D D T T T D T + 2 Major T D T S T S T S D D T T D S D + 2 Major T S D T S S T T S D S S D D T + 2 Major T D T S T S T S D D T T D S D + 2 Major T S D T S S T T S D S S D D T + 2 Major T S T T S + 9 Major D T S D + 2 Major D T S + 2 Major T T S S D T T T S D D T + 2 Major S + 4 Minor T S T T T T D D D D T + 2 Major S T + 2 Major T T D D S S D T D T T S S D D T + 4 Minor T D S S S T S D D T + 4 Minor T D S T D T D T T S D + 4 Minor T T T S D D T + 4 Minor T D S S S T S D D T + 4 Minor T D S T D T D T T S D + 4 Minor T T T S D D T + 4 Minor T D D T S T T T D + 7 Major D T + 11 Minor T T S T T T S T T T D D + 11 Minor T + 9 Minor S T S D S D T T D D T + 9 Minor T T S T S D T T D T + 0 Major D T D T S T S S D + 0 Major T D T T + 2 Minor T T D T T T + 2 Minor D T D T S T S S D + 2 Minor T T T S S D T T T D T D + 11 Minor T T T D T D D T S S D + 11 Minor D + 2 Major T + 11 Minor T S T + 11 Minor T T S D T T T T D T + 11 Minor D D T S S D D + 2 Major T + 11 Minor T S T T T S D T + 11 Minor D T D T T T T S + 2 Major D T T + 2 Major T D T S + 3 Major T T D T D D D T + 3 Major T S T D D T T S S D T T S S T + 3 Major T T D S D D T T S T S D D T + 3 Major T D D S D T S S D T D T T + 3 Major D D T + 0 Minor S S D T T S S T T T D + 0 Minor T T S T S S S T S T D D T T + 0 Minor T T S S S D T D T S D T T D T T + 4 Major T D D T D T S T S S S T T S + 4 Major D T T T D T S S D T D T S D + 4 Major T D D T D T S T S S S T T S + 4 Major D T T T + 11 Major T S D D T S T T D T + 11 Major S S S D T T D T S T D T + 11 Major S S + 4 Major T T S S T S T S T + 4 Major T D S S T D D S D T + 2 Minor T T T T S S T T T T D D T + 2 Minor T T T T S S S S T T T S S D + 2 Minor T D T T S S D D T + 2 Minor T T T T S S T T T T D D T + 2 Minor T T T T S S S S T T T S S D + 2 Minor T D T T S S D D T + 2 Minor T T T + 5 Major T S S T T D T T D D T + 5 Major T T S S D D T T T + 9 Minor D T T + 2 Minor D D D D + 2 Minor T T T T T S S T S T D D D + 11 Minor T T T D T T D D S S S S D + 11 Minor D D T D D S S T T T T S S + 11 Minor T T T T T D T T + 11 Minor D D S S S S D D D T D D + 11 Minor S S T T T T S S T T + 11 Minor D T T D S T + 2 Major T T S S S D D T + 2 Major T T D T S D T S S T S T + 7 Minor T T D T T S D + 7 Minor D T S S T S D + 7 Minor D T + 10 Major D T T T T S D T + 10 Major T T D S T T T T S S D T + 10 Major T D T T T + 5 Major T S D T D T + 5 Major D T + 7 Minor D T D T T S T S D + 4 Major D T D T S T S S T + 11 Major S T + 11 Major T T S T S T S S D + 4 Major S D D S S D + 4 Major T D T D T S T S S T + 11 Major S T + 11 Major T T S T S T S S D D T T D D T + 11 Major S T S D T T D D T T S S D D T + 4 Major T + 6 Minor T D T S S T T D T D D T T T D + 6 Minor D D T D T T D + 4 Major S D D T S D D T + 2 Minor T D T S S T T T T D D T + 2 Minor D T T S S T T D D T T S D + 2 Minor D S T T T D T D S T D T + 2 Minor S + 9 Minor T T S S T T S D T T S D T + 9 Minor D T + 5 Major T S S D D T T T T S D T + 5 Major T S + 2 Minor S T D T T S S T T S + 0 Major D T T D T S S T T T T D D T + 7 Major T S T S S D D T T D D T + 7 Major T T D T S T T D S T T S S D + 7 Major D + 2 Major T T S D + 7 Major S D D T S T S D T D + 7 Major T S D T T T S S T + 11 Minor T + 11 Minor T T D D T D S S S T T D D T T S + 11 Minor D D T T S D T D + 11 Minor T + 9 Major D T + 11 Minor T T T D D T D S S S + 11 Minor T T D D T T S D D T + 4 Major D T + 9 Major T D D T D T T S S D T + 9 Major S D T D D S T + 11 Minor D S T T T S S S S D + 11 Minor T S D T D T T + 11 Minor T + 11 Minor T T D D T D S S S T T D D T T S + 11 Minor D + 0 Minor T T D T D D T S D + 0 Minor D D T S S T T T T T + 0 Minor D T T T D T + 0 Minor D D T S D D D T + 0 Minor S S T T T T T D T + 3 Major T T D D T T T S D D T + 3 Major T S D S S T T D S T S + 0 Minor T T + 0 Minor D + 2 Major S D T D D T D D D T T D D T + 2 Major T S S D T T D T + 2 Major D T S + 9 Major D T T + 2 Major T T D S D D + 2 Major D T D T T T T S + 9 Major S D D D D D S S D T + 9 Major S S + 2 Major T S T D T + 2 Major D T D S T S S S D D T + 7 Major T T T S S T S D S T S + 7 Major T T D D D T S T S D T + 7 Major T D T T D + 4 Minor T D T T T T T + 4 Minor T + 7 Major D T D D T T S D T + 7 Major T T S T D S T D T T T S + 7 Major S T T T T S S D D T T S S D + 7 Major D S T S T D T T S T D D T T D T T + 7 Major D T D T + 2 Minor T S T D D T + 5 Major S T T T + 5 Major T S S D T T D D T + 5 Major T S D T D D T S T T T + 5 Major T S S D T T D D T + 5 Major T D T T S S S T T T D + 5 Major D T T S S T T D S + 5 Major T S S D T T D D T + 10 Major T T D T S T T S D T + 10 Major T T T T T T D T D T S D + 10 Major D D T T S S T T T S S D + 10 Major T T D T S T T S S S S S T + 10 Major T S D D T D D D T T T T S D + 10 Major T T S D D T T S D T S D D T + 7 Major T T T D T S S T T T D D T + 7 Major S S D S S T T T T D D T D D T + 7 Major T T T D T S S T T T D D T + 7 Major S S D S S T T T T D D T D D T + 7 Major T S S S S D D + 2 Major T T T T S + 2 Major S S D D S D T + 7 Major S T T T S S D + 7 Major T S D T S D D T T D D T D T + + +
+ Kulitta/Learning/sampleConfig/Learning.exe view
file too large to diff
+ Kulitta/Learning/sampleConfig/configTSDx3.txt view
@@ -0,0 +1,17 @@+dataFile= BachChordsTSD.txt :: String Input file for chord sequences +gramrFile= TSDx2.txt :: String Input file for grammar definition +gramMode= PCFG :: GramMode Type of grammar: PCFG or Temporal +learnIters= 50 :: Int Number of InOut iterations +convThresh= 0.06 :: Double Convergence threshold to use +dataSeeds= [0,1,2] :: [Int] Random seeds for data selection +initDist= Uniform :: DistMode Mode for creating initial distributions +dataMode= Major :: Mode Modality of data to use (Major, Minor, or Both) +maxLength= 6 :: Int Maximum length of a sample +minLength= 2 :: Int Minimum length of a sample +sampleSize= 20 :: Int Sample size to take from data +filterData= True :: Bool If true, then restricts sample length +outNamePre= _ :: String Name of output file prefix. +minProb= 0.001 :: Double Minimum probability to allow for a rule. +# +# Comment line +#
+ Kulitta/Learning/sampleConfig/configTSDx5.txt view
@@ -0,0 +1,17 @@+dataFile= BachChordsTSD.txt :: String Input file for chord sequences +gramrFile= TSDx3.txt :: String Input file for grammar definition +gramMode= PCFG :: GramMode Type of grammar: PCFG or Temporal +learnIters= 50 :: Int Number of InOut iterations +convThresh= 0.06 :: Double Convergence threshold to use +dataSeeds= [0,1,2] :: [Int] Random seeds for data selection +initDist= Uniform :: DistMode Mode for creating initial distributions +dataMode= Major :: Mode Modality of data to use (Major, Minor, or Both) +maxLength= 6 :: Int Maximum length of a sample +minLength= 2 :: Int Minimum length of a sample +sampleSize= 20 :: Int Sample size to take from data +filterData= True :: Bool If true, then restricts sample length +outNamePre= _ :: String Name of output file prefix. +minProb= 0.001 :: Double Minimum probability to allow for a rule. +# +# Comment line +#
+ Kulitta/PTGG.lhs view
@@ -0,0 +1,133 @@+Probabilistic Temporal Graph Grammar Implementation +Donya Quick +Last modified: 20-Dec-2014 + +Based on the original monadic implementation by Donya Quick and Paul Hudak +(see ICMC 2013 and FARM 2013 papers). + +Major changes: +- Removal of the S constructor for sentences. +- Removal of Mod constructor. Modulation information will be stored as a parameter. +- Chord constructor renamed to MSym to allow for PTGGs over other features. + +> module Kulitta.PTGG where +> import Data.List +> import System.Random + +The Term data structure has three constructors: + 1. NT - a nonterminal that has a symbol and a parameter. + 2. Let - a means of capturing variable instantiation in a Term. + 3. Var - a variable + +> data Term a b = NT (a,b) | Let String (Sentence a b) (Sentence a b) | Var String +> deriving (Eq, Show) + +A Sentence is a list of Terms. + +> type Sentence a b = [Term a b] + +A rule has a left and righthand side. The lefthand side has +an un-parameterized symbol and a probability for application of +the rule. The righthand side is a function from a parameter to +a Sentence. + +> type Prob = Double +> data Rule a b = (a, Prob) :-> RuleFun a b +> type RuleFun a b = b -> Sentence a b + + +A function to rewrite one Sentence to another using an +L-System-like approach to generation where all symbols are +updated from left to right. + +> update :: (Eq a, Eq b) => [Rule a b] -> (StdGen, Sentence a b) -> (StdGen, Sentence a b) +> update rules (g, []) = (g,[]) +> update rules (g,(t:ts)) = case t of +> NT (c,d) -> let (g1, t') = applyRule rules g (c,d) +> (g2, ts') = update rules (g1, ts) +> in (g2, t'++ts') +> Let x a e -> let (g1,a') = update rules (g, a) +> (g2,e') = update rules (g1, e) +> (g3,ts') = update rules (g2, ts) +> in (g3, Let x a' e' : ts') +> x -> let (g1, ts') = update rules (g, ts) +> in (g1, x : ts') + +Function to update a single symbol: + +> applyRule :: (Eq a) => [Rule a b] -> StdGen -> (a,b) -> (StdGen, Sentence a b) +> applyRule rules g (c,d) = +> let rs = filter (\((c',p) :-> rf) -> c'==c) rules +> (p,g') = randomR (0.0::Double, 1.0) g +> in if null rs then (g, [NT (c,d)]) else (g', choose rs p $ d) where -- See note below +> choose :: [Rule a b] -> Prob -> (RuleFun a b) +> choose [] p = error "Nothing to choose from!" +> choose (((c,p') :-> rf):rs) p = +> if p<=p' || null rs then rf else choose rs (p-p') + +Note: we assume the value is a NT (nonterminal) because applyRule can only +be called from NT in update. We want to leave these as NTs rather than forcing +them to terminals in case the user wishes to apply different rule sets later. + +User-level generation: + +> gen :: (Eq a, Eq b) => [Rule a b] -> (StdGen, Sentence a b) -> [(StdGen, Sentence a b)] +> gen rules (g,t) = iterate (update rules) (g,t) + +The expand function eliminates Lets and Vars from a generated Term a. +It allows for nested Let expressions for variables with the same name +with lexical scoping. For example: + +expand [] [Let "x" t1 [Let "x" t2 (Var "x")]] ==> t2 + +> expand :: [(String, Sentence a b)] -> Sentence a b -> Sentence a b +> expand e [] = [] +> expand e (t:ts) = case t of +> Let x a exp -> expand ((x, expand e a) : e) exp ++ expand e ts +> Var x -> (maybe (error (x ++ " is undefined")) id $ lookup x e) ++ expand e ts +> x -> x : expand e ts + +------------------------------------------------------------------------ + +Additional manipulations + +Map defined over Term to convert pairs of one type to pairs of another. + +> tMap :: ((a,b) -> (c,d)) -> Sentence a b -> Sentence c d +> tMap f [] = [] +> tMap f (t:ts) = +> let t' = case t of +> Let x a exp -> Let x (tMap f a) (tMap f exp) +> Var x -> Var x +> NT x -> NT $ f x +> in t' : tMap f ts + +Flattening completely to a list + +> toPairs :: Sentence a b -> [(a, b)] +> toPairs = map f . expand [] where +> f (NT (ct, d)) = (ct,d) +> f _ = error "(toPairs) Variable or Let expression encountered" + +Reassigning probabilities + +> updateProbs :: [Rule a b] -> [Prob] -> [Rule a b] +> updateProbs rs ps = +> if length rs /= length ps then error "(updateProbs) Probability/rule count mismatch." +> else zipWith (\((l,_):->rhs) p -> (l,p):->rhs) rs ps + +Accessing the various portions of a rule without pattern matching + +> lhs ((c,p) :-> rf) = c +> prob ((c,p) :-> rf) = p +> rfun ((c,p) :-> rf) = rf + +Normalize the probabilities for a rule set + +> normalize :: (Eq a) => [Rule a b] -> [Rule a b] +> normalize [] = [] +> normalize (r@((l,p) :-> rf):rs) = +> let rset = r : filter ((l==).lhs) rs +> rset' = filter ((l/=).lhs) rs +> psum = sum $ map prob rset +> in map (\((l',p') :-> c') -> ((l',p'/psum) :-> c')) rset ++ normalize rset'
+ Kulitta/PostProc.lhs view
@@ -0,0 +1,151 @@+Post Processing Module to Link Grammar with OPTIC Functions +Donya Quick and Paul Hudak +Last modified: 19-Dec-2014 +For paper: Grammar-Based Automated Music Composition in Haskell + +Post processing module to turn Terms into music using Euterpea. + +> module Kulitta.PostProc where +> import Kulitta.EuterpeaSpecial +> import Kulitta.PTGG +> import Kulitta.Grammars.MusicGrammars +> import Kulitta.ChordSpaces +> import Data.List +> import System.Random + +Intermediate types: +(NOTE: AbsPitch = PitchNum) + +> type Key = (AbsPitch, Mode) +> type RChord = (Key, Dur, CType) +> type TChord = (Key, Dur, AbsChord) +> type TNote = (Key, Dur, AbsPitch) +> type Voice = [TNote] + +Accessing the members of a TNote: + +> tnK (k,d,p) = k +> tnD (k,d,p) = d +> tnP (k,d,p) = p +> newP (k,d,p) p' = (k,d,p') + + +The goal using these intermediate types is the following: + +INPUT STEP OUTPUT FUNCTION +Seeds -----(grammar)-------> Sentence gen +Sentence --(mode info)-----> [TChord] toAbsChords +[TChord] ------------------> [Voice] toVoices +[Voice] -------------------> Music Pitch vsToMusic or vsToMusicI + + +> unTerm :: [Term a MP] -> [(Key, Dur, a)] +> unTerm = map (\(a,mp) -> ((key mp, mode mp), dur mp, a)) . toPairs . expand [] + +> toChords :: [Term CType MP] -> [RChord] +> toChords = unTerm + +> toAbsChords :: [Term CType MP] -> [TChord] +> toAbsChords ts = map toAbsChord $ toChords ts + +> toAbsChord :: RChord -> TChord +> toAbsChord ((k,m),d,c) = ((k,m), d, t k $ toAs c m) + +We also provide an alternate version that doesn't use diminished chords. + +> toAbsChordNoDim :: RChord -> TChord +> toAbsChordNoDim ((k,m),d,c) = ((k,m), d, t k $ toAsNoDim c m) + +> toAbsChordsNoDim :: [Term CType MP] -> [TChord] +> toAbsChordsNoDim ts = map toAbsChordNoDim $ toChords ts + +Conversion of a single chord to a mode rooted at zero: + +> toAs :: CType -> Mode -> [AbsPitch] +> toAs ct m = +> let s = getScale m ++ map (+12) s -- fininite scale +> i = head $ findIndices (==ct) [I, II, III, IV, V, VI, VII] -- can be updated w/enum +> in map (s !!) $ map (+i) [0,2,4] + +> toAsNoDim :: CType -> Mode -> [AbsPitch] +> toAsNoDim ct m = +> let s = getScale m ++ map (+12) s -- fininite scale +> i = head $ findIndices (==ct) [I, II, III, IV, V, VI, VII] -- can be updated w/enum +> in map (s !!) $ fixDim $ map (+i) [0,2,4] where +> fixDim x = if optEq x [0,3,6] then t (head x) [0,3,7] else x + + + +Transposition using a key (to avoid C-major assignment only): + +> atTrans :: AbsPitch -> [(Key, Dur, AbsChord)] -> [(Key, Dur, AbsChord)] +> atTrans a = map (\((k,m),d,c) -> (((k+a) `mod` 12,m), d, t a c)) + +map (\((k,m),d,c) -> ((fixK k a m,m),d, t (a `mod` 12) c)) + +The toCords functon does a similar thing, but returns a CType and +its key/mode context without performing the conversion to AbsChord. + +> ctTrans :: AbsPitch -> [(Key, Dur, CType)] -> [(Key, Dur, CType)] +> ctTrans a = map (\((k,m),d,c) -> (((k+a) `mod` 12,m),d,c)) + +map (\((k,m),d,c) -> ((fixK k a m,m),d,c)) + +> fixK k a Major = (k + a) `mod` 12 +> fixK k a Minor = ((k + a) `mod` 12) + 12 + + +Conversion of intermediate type to Music Pitch: + +> tChordsToMusic :: [TChord] -> Music Pitch +> tChordsToMusic = line . map f where +> f ((k,m),d, as) = chord $ map (\a -> note d (pitch a)) as + + +============ SPLITTING VOICES APART =========== + +The code here places TChords into a form more suitable +for additional musical processing. A Voice is a list of +pitches with duration and key/mode context. + +> toVoices :: [TChord] -> [Voice] +> toVoices ts = +> let (ks,ds,ps) = unzip3 ts +> in if checkMatrix ps then map (\v -> zip3 ks ds v) $ Data.List.transpose $ ps +> else error "(toVoices) chords must all have the same number of voices!" where +> checkMatrix [] = True +> checkMatrix (x:xs) = and $ map (==length x) $ map length xs + +This alternative version of the function turns the list of chords into a matrix +by filling in holes with pitch number -1 (which will be interpreted as a rest). +Chords are padded on the right. So, the progression [[0,4], [0,4,7]] would become +[[0,4,-1], [0,4,7]]. + +> toVoices' :: [TChord] -> [Voice] +> toVoices' ts = +> let (ks,ds,ps) = unzip3 ts +> in map (\v -> zip3 ks ds v) $ Data.List.transpose $ fillGaps ps where +> fillGaps [] = [] +> fillGaps cs = +> let maxLen = maximum $ map length cs +> f x = x ++ take (maxLen - length x) (repeat (-1)) +> in map f cs + +> toNotes :: Voice -> Music Pitch +> toNotes = line . map (\(k,d,p) -> note' d p) where +> note' d p = if p<0 then rest d else note d (pitch p) + +> vsToMusic :: [Voice] -> Music Pitch +> vsToMusic = +> chord . map toNotes + +> vsToMusicI :: [InstrumentName] -> [Voice] -> Music Pitch +> vsToMusicI is = +> chord . zipWith (\i m -> instrument i m) is . map toNotes + + + + + + +
+ Kulitta/QuotientSpaces.lhs view
@@ -0,0 +1,42 @@+> module Kulitta.QuotientSpaces where +> import Data.List +> import System.Random +> import Control.DeepSeq +> import Data.Maybe + + +> type EqClass a = [a] -- equivalence class +> type QSpace a = [EqClass a] -- quotient space +> type Predicate a = a -> Bool +> type Norm a = a -> a -- normalizations +> type EqRel a = a -> a -> Bool -- equivalence relations + +========= QUOTIENT SPACE IMPLEMENTATION ========= + +First we define the "slash" operator for S/R. + +> (//) :: (Eq a) => [a] -> EqRel a -> QSpace a +> [] // r = [] +> xs // r = +> let sx = [y | y <- xs, r y (head xs)] +> in sx : [z | z <- xs, not (elem z sx)] // r + +The eqClass function is used to find the equivalence class of an +element, x, given a quotient space and the relation used to form it. +We need to know the relation used, because we do not require that +x is in the quotient space, qs. + +> eqClass :: (Eq a, Show a) => QSpace a -> EqRel a -> a -> EqClass a +> eqClass qs r x = +> let ind = findIndex (\e -> r x (head e)) qs +> in maybe (error ("(eqClass) No class for "++show x)) (qs !!) ind + +============================= + +Code for randomizing a list. + +> randomize :: StdGen -> [a] -> [a] +> randomize sg rs = +> let n = length rs +> plist = take n (nub (randomRs (0,n-1) sg)) +> in map (rs!!) plist
+ Kulitta/Search.lhs view
@@ -0,0 +1,398 @@+Search algoritm for use with chord spaces +Donya Quick and Paul Hudak +Last modified: 13-Jan-2016 + +Implementation of a search algorithm for traversing chord spaces using +let-in constraints as well as progression level predicates. + + +> module Kulitta.Search where +> import Data.List +> import Kulitta.ChordSpaces +> import Control.DeepSeq +> import Control.Parallel.Strategies +> import System.Random +> import Kulitta.PTGG hiding (choose) +> import Kulitta.Grammars.MusicGrammars +> import Kulitta.PostProc +> import Kulitta.Constraints + +> type Constraints = [[(Int, Int)]] +> type Index = Int +> type Bound = Int + +> printIt = True -- flag for whether to show evidence of search progress +> printIter = 5000 -- number of solutions to check before reporting back + +========= OBTAINING SOLUTIONS ========= + +The allSolns function finds all R-equivalent sequences given a quotient +space, qs, and a relation, r. + +This is the obvious, but slightly less efficient way to obtain solutions. +The lazy evaluation in Haskell allows it to do aggressive pruning similarly +to how pairProg handles it. + +> allSolns :: (Eq a, Show a) => QSpace a -> EqRel a -> [a] -> [[a]] +> allSolns qs r [] = [[]] +> allSolns qs r (x:xs) = +> [(y:ys) | y <- eqClass qs r x, ys <- allSolns qs r xs] + +Unfortunately, allSolns won't work with really big problems. Large chord +spaces and long progressions (even with small chord spaces) cause an +exponential blowup in the search space. Two alternative options below +prune the solution space more aggressively. + +The pairProg function applies a predicate as it generates the +solutions. + +> pairProg :: (Eq a, Show a) => QSpace a -> EqRel a -> Predicate (a,a) -> [a] -> [[a]] +> pairProg qs r c [] = [] +> pairProg qs r c [x] = map (\a -> [a]) $ eqClass qs r x +> pairProg qs r c (x:xs) = +> let endSolns = pairProg qs r c xs -- map xs to a new progression +> f y soln = c (y, head soln) -- filter using the classifier +> newSolns = [(y:ys) | y<-eqClass qs r x, ys<-endSolns, f y ys] +> in if null newSolns then error "No solutions that satisfy the consraints!" +> else newSolns + +Now we define the greedy algorithm, greedyProg. + +We define choose, a function to stochastically select an element +from a list. + +> choose :: StdGen -> [a] -> (StdGen, a) +> choose g xs = +> let (r, g') = next g +> in (g', xs !! (r `mod` length xs)) + +And finally the recursive, greedy function, greedyProg, and its +"helper," greedyChord. + + +> type Fallback a = EqClass a -> StdGen -> a -> (StdGen, a) + +> greedyProg :: (Eq a, Show a) => QSpace a -> EqRel a -> +> Predicate (a,a) -> Fallback a -> StdGen -> [a] -> [a] +> greedyProg qs r c f g [] = [] +> greedyProg qs r c f g (x:xs) = +> let e = eqClass qs r x +> (g', y0) = choose g e -- randomly choose the first AbsChord +> in greedyRec qs r c f g y0 xs where +> greedyRec qs r c f g y pts = +> let (g', yi) = greedyChord (eqClass qs r (head pts)) y c f g +> in if null pts then [y] +> else y : greedyRec qs r c f g' yi (tail pts) + +> greedyChord :: (Eq a, Show a) => EqClass a -> a -> Predicate (a,a) -> +> Fallback a -> StdGen -> (StdGen, a) +> greedyChord e yprev hpair f g = +> let (rand, g') = next g +> yxs = zip (repeat yprev) e +> ys = map snd $ filter hpair yxs +> in if null ys then f e g' yprev -- fallback case +> else (g', ys !! (rand `mod` length ys)) -- ok case + + +Now we need some fall-back functions. We can construct them from +predicates. + +> fallFun :: (Show a) => Predicate (a,a) -> EqClass a -> StdGen -> a -> (StdGen, a) +> fallFun c e g x = +> let ys = map snd $ filter c $ zip (repeat x) e +> (i, g') = next g +> in if null ys then error ("Stuck at symbol "++show x++". No viable options left!") +> else (g', ys !! (i `mod` length ys)) + +This is the default fallback function we used in our experiments: + +> defFall = fallFun (maxClass 7) + + +And also a nearest neighbor fallback function that would always +succeed if the equivalence class has at least one element (which +should always be the case). + +> nearFall :: EqClass AbsChord -> StdGen -> AbsChord -> (StdGen, AbsChord) +> nearFall e g x = +> let ds = map (simpleDist x) e :: [Double] +> y = e !! (head $ findIndices (==minimum ds) ds) +> in (g, y) + + +This version of greedyProg operates over a list of equivalence classes. + +> greedyProg' :: (Eq a, Show a) => +> Predicate (a,a) -> Fallback a -> StdGen -> [EqClass a] -> [a] +> greedyProg' c f g [] = [] +> greedyProg' c f g (e:es) = +> let (g', y0) = choose g e -- randomly choose the first AbsChord +> in greedyRec' c f g y0 es where +> greedyRec' c f g y pts = +> let (g', yi) = greedyChord (head pts) y c f g +> in if null pts then [y] +> else y : greedyRec' c f g' yi (tail pts) + +> pairProg' :: (Eq a, Show a) => Predicate (a,a) -> [EqClass a] -> [[a]] +> pairProg' c [] = [[]] +> pairProg' c (e:es) = +> let newSolns = [(y:ys) | y<-e, ys<-pairProg' c es, +> if null ys then True else c (y, head ys)] +> in if not $ null newSolns then newSolns +> else error "No solutions that satisfy the consraints!" + + +====================== + +LET CONSTRAINTS + +Let-in expressions impose constraints on the interpretation of +the results as music. These can be viewed as progression-level +constraints, or predicates. + +mkCons fundtion looks through the let-in structure of a Term +and produces a progression-level predicate for use with the +ChordSpaces module. + +> mkCons :: (Eq a) => [Term b c] -> Predicate [a] +> mkCons t xs = toCons (findInds [] t) xs where +> toCons :: (Eq a) => [[(Int, Int)]] -> [a] -> Bool +> toCons [] xs = True +> toCons (c:cs) xs = +> let f (i,j) = take (j+1-i) $ drop i xs +> in (and $ map (f (head c) == ) $ +> map f $ tail c) && toCons cs xs + + +The findInds function looks through a Term for let-in expressions. +When it finds Let x a exp, it calls findIndsSub on x and exp to +determine which indices in the sequence are occupied by instances +of x. + +> findInds :: [(String, [Term a b])] -> [Term a b] -> [[(Int, Int)]] +> findInds e [] = [] +> findInds e (t:ts) = let rest = findInds e ts in case t of +> Var x -> undefined +> NT x -> map (map (pAdd 1)) $ findInds e ts +> Let x a exp -> +> let a' = expand e a +> exp' = expand ((x,a'):e) exp +> in findInds e a ++ findIndsSub x (length a') (expand' e exp) : +> map (map (pAdd $ length exp')) rest + +> expand' :: [(String, Sentence a b)] -> Sentence a b -> Sentence a b +> expand' e [] = [] +> expand' e (t:ts) = case t of +> Let x a exp -> expand' ((x, expand' e a) : e) exp ++ expand' e ts +> Var x -> case lookup x e of +> Nothing -> Var x : expand' e ts +> Just a -> a ++ expand' e ts +> x -> x : expand' e ts + + +The findIndsSub function looks for instances of a variable and +determines what indices they occupy. + +> findIndsSub :: String -> Int -> [Term a b] -> [(Int, Int)] +> findIndsSub x xLen [] = [] +> findIndsSub x xLen (t:ts) = let rest = findIndsSub x xLen ts in case t of +> Var y -> if x==y then (0, xLen-1) : map (pAdd xLen) rest else rest +> NT y -> map (pAdd 1) $ findIndsSub x xLen ts +> Let y a e -> error "(find Instances) This point should be unreachable." + +> pAdd amt (a,b) = (a+amt, b+amt) + +======================== + +SEARCH IMPLEMENTATION + + +All of these functions assume that constraints are SORTED. This is used to +"jump ahead" to the next solution that would meet constraints early-on in the +depth-first traversal. We give preference to changing indices further right +in the sequence. It is assumed that the constraints are fully sorted (inner +and outer) by doing the following for k :: Constraints: + + sort (map sort k) + +If this is not done, then the constraints cannot be guaranteed to be satisfied. +The findSoln function looks for the first solution satisfying two types of +constraints: those from let-in statements and more generic, progression-level +constraints supplied as a Predicate function. + +> findSoln :: (Eq a, Show a) => +> Constraints -> Predicate [a] -> [[a]] -> (Int, [a]) +> findSoln k f ecs = +> let n = length ecs +> bs = map (`elem` freeInds n k) [0..length ecs-1] +> lens = map length ecs +> g i = zip3 bs i lens +> frec j iCurr = +> let iNext = findNext2 k $ g iCurr +> soln = zipWith (!!) ecs iCurr +> in if last iCurr < 0 then error "No more solutions." else +> if f soln then (j, soln) else frec (j+1) iNext +> in frec 0 $ take (length ecs) $ repeat 0 + +> findSoln2 :: (NFData a, Eq a, Show a) => +> Constraints -> Predicate [a] -> [[a]] -> IO (Int, [a]) +> findSoln2 k f ecs = +> let initVal = take (length ecs) $ repeat 0 +> bs = map (`elem` freeInds (length ecs) k) [0..length ecs-1] +> lens = map length ecs +> g i = zip3 bs i lens +> frec j iCurr = do +> let iNext = findNext2 k (g iCurr) +> soln = makeSoln 0 ecs iCurr +> jNext = j+1 +> if last iCurr < 0 then error "No more solutions." else +> if f (force soln) then return (j, soln) else -- SEE NOTE BELOW +> if j `mod` printIter == 0 && printIt then +> putStrLn ("Solutions examined: "++show j) >> +> frec jNext iNext +> else frec jNext iNext +> in frec 0 initVal + +Note on use of force in findSoln2: if force is not used and used exactly where +it has been placed above, the function experiences a thunk leak. Printing iCurr, +iNext, or soln can help to knock back memory usage, but it still leaks until +printed unless force is used. Using seq can slow the leak to a trickle, but it +still occurs and will cause long searches to crash. Using force appears to be +the best solution for this leak. + + +> findSolnPar :: (NFData a, Eq a, Show a) => +> Constraints -> Predicate [a] -> [[a]] -> Int -> IO (Int, [a]) +> findSolnPar k f ecs parSize = +> let initVal = take (length ecs) $ repeat 0 +> bs = map (`elem` freeInds (length ecs) k) [0..length ecs-1] +> lens = map length ecs +> g i = zip3 bs i lens +> frec j iCurr = do +> let iCurrs = filter ((>=0).last) (iCurr : findNextI k (g iCurr) (parSize - 1)) +> iNext = findNext2 k $ g $ last iCurrs -- for next iteration +> solns = filter f $ seq (force iCurrs) +> (map (makeSoln 0 ecs) iCurrs `using` parList rdeepseq) +> jNext = j+length iCurrs +> if last iCurr < 0 then error "No more solutions." else +> if not $ null solns then return (j, head solns) else +> if printIt then +> putStrLn ("Solutions examined: "++show j) >> frec jNext iNext +> else frec jNext iNext +> in frec 0 initVal + + +> makeSoln :: Int -> [[a]] -> [Int] -> [a] +> makeSoln j [] [] = [] +> makeSoln j [] is = error "(makeSoln) Not enough equivalence relations!" +> makeSoln j ecs [] = error "(makeSoln) Not enough indices!" +> makeSoln j (e:ecs) (i:is) = +> if i < length e then (e !! i) : makeSoln (j+1) ecs is +> else error ("Bad index at position "++show j++": "++show i++", classes="++show (length e)) + +> fetch xs i = if i >= length xs then error "(fetch) Index is too large!" else xs !! i + + +The findNext function performs the actual traversal of the space. It bypasses +a lot of irrelevant points by only looking at points that at least satisfy +the let-in constraints. Those points may or may not satisfy the Predicate, f, +and so the function may have to explore many solutions. + + +> findNext :: Constraints -> [Index] -> [Bound] -> [Index] +> findNext k is lens = +> let bs = map (`elem` freeInds (length is) k) [0..length is-1] +> xs = zip3 bs (is) (lens) +> in foldl applyCons (incr xs) k + + +This version is used for one of the recursive implementations. + +> findNext2 :: Constraints -> [(Bool, Index, Bound)] -> [Int] +> findNext2 k xs = foldl' applyCons (incr2 xs) k + +> findNextI :: Constraints -> [(Bool, Index, Bound)] -> Int -> [[Index]] +> findNextI k xs i = +> let xs' = findNext2 k xs +> fixWith = zipWith (\(a,b,c) d -> (a,d,c)) +> in xs' : take (i-1) (iterate (findNext2 k . fixWith xs) xs') where + +The applyCons function applys let-in constraints to an index list. Indices +on the left are given preference when satisfying constraints. + +> applyCons :: [Int] -> [(Int, Int)] -> [Int] +> applyCons inds [] = inds +> applyCons inds ((i,j):ijs) = +> foldl (f val) inds (map fst ijs) where -- might need seq here +> val = (take (j-i+1) $ drop i inds) +> f val src i = take i src ++ val ++ +> drop (i + length val) src + +Solutions are explored by keeping track of a list of indices into equivalence +classes. This list is incremented by considering which indices can actually +be changed (those unconstrained by let-in expressions). If the end of the +search space is reached, an error is thrown since there is no solution. + + + +The following modification avoids a memory error if used for traversal +with something like iterate. It returns a "flag" at the end (-1) if +no solutions exist. This must be picked up by the calling functions for +termination to occur. + +> incr :: [(Bool, Int, Int)] -> [Int] +> incr ((b,i,l):xs) = let is = map (\(x,y,z) -> y) xs in +> if b then if i >= l-1 then 0 : incr xs else (i+1) : is +> else i : incr xs +> incr [] = error "No more solutions!" + + +The following version uses a flag instead of an error message: + +> incr2 :: [(Bool, Int, Int)] -> [Int] +> incr2 ((b,i,l):xs) = let is = map (\(x,y,z) -> y) xs in +> if b then if i >= l-1 then 0 : incr2 xs else (i+1) : is +> else i : incr2 xs +> incr2 [] = [-1] -- no more solutions exist + + +The freeInds function turns let-in constraints into a list of indices that +can be updated or incremented. + +> freeInds :: Int -> Constraints -> [Int] +> freeInds n k = +> let k' = map (map (\(i,j) -> [i..j])) k +> t = nub $ concat $ concatMap tail k' +> in filter (not . (`elem` t)) [0..n-1] + + +================================== + +THIS VERSION OF GREEDY PROG DOES NOT WORK - LETS ARE NOT DONE RIGHT + +A version of greedyProg to support Let statements. Constraints are satisfied from +left to right. Breaks are likely to occurr with repeats. For example, with the +progression + + let x = ... in x x + +a break in voice-leading behavior is likely to occur between the last chord of the +first instance of x and the first chord of the second instance of x. There is +currently no way around this using the greedy approach. The more exact searches +further up in this file are alternatives in such cases. + +> greedyLet :: (Eq a, Show a) => Predicate (a,a) -> Fallback a -> Constraints -> +> [EqClass a] -> StdGen -> [a] +> greedyLet p f k es g = +> let n = length es +> cs = greedyProg' p f g es +> consPat = foldl applyCons [0..n-1] (sort k) +> in map (cs !!) consPat + +> greedyLetT :: QSpace AbsChord -> EqRel AbsChord -> Predicate (AbsChord,AbsChord) -> +> Fallback AbsChord -> Constraints -> [TChord] -> StdGen -> [TChord] +> greedyLetT q r p f k cs g = +> let justCs = map tnP cs +> es = map (eqClass q r) justCs +> justCs' = greedyLet p f k es g +> in zipWith newP cs justCs'
+ LICENSE view
@@ -0,0 +1,2 @@+(c) Donya Quick 2018 +This software is not intended for commercial use.
+ README.txt view
@@ -0,0 +1,58 @@+Kulitta: a Library for Automated Music Composition +(c) Donya Quick 2014-2017 +Version: 2.2.1 + +Kulitta is a framework for automated composition that +can also be configured to run as a standalone AI for +generating music in a particular style. + +This library is not intended for commercial use. + +For more information on Kulitta, go to: +http://www.donyaquick.com/kulitta + +Note: Kulitta's graphical interface is now provided +as an example use of the larger Kulitta library. It +is located in the Examples\GUI folder in GUI.lhs. + + +====================== + +INSTALLATION INSTRUCTIONS + +To use Kulitta, you will need Haskell Platform. +Please use Haskell Platform 2014 or 7.10.13. Note +that Kulitta's GUI may not work on Macs running +7.10.3 but should work with Haskell Platform 2014. + +This version of the code uses Euterpea 2.0 from +GitHub. If you want to use Kulitta's GUI, you will +also need the HSoM library. See euterpea.com for +information on installing these libraries. + +Once you have installed these, run "cabal install" +from within the library folder (where kulitta.cabal +is located). You can then use Kulitta by importing +the following: + +Kulitta + Contains the PTGG, ChordSpaces, PostProcessing, + Search, and Constraints modules. These can also + be imported individually if desired. + +Kulitta.Grammars.MusicGrammars + Some musical grammars derived from music theory + and recent publications on the topic. + +Kulitta.Foregrounds + All of Kulitta's foreground modules. This includes + ClassicalFG, JazzFG, and SimplePianoFG. These can + also be imported individually if desired. + +Kulitta.Learning.Learning + Kulitta's learning module, intended to be compiled + and run separately as in LearningMain.lhs. + +Please consult individual lhs files within the library +for documentation on the functions within. +
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple +main = defaultMain +