--scalegen.hs
--Generate every possible western scale (where ascension and descension are the same)
--scales are subsets of the set [1,2,3,4,5,6,7,8,9,10,11,12] with a specific set of rules
-- 1. Must include the root (1)
-- 2. Must have atleast 5 notes.
-- 3. Must go in ascending order.
--
-- So basically, the lazy way is to generate the powerset (all the subsets of [1..12] and
-- filter the output based on the rules of what usually constitutes a scale.
import List
powerset :: [a] -> [[a]]
powerset [] = [[]]
powerset (x:xs) = powerset xs ++ map (x:) (powerset xs)
--We're going to use flats for the accidentals since the parallel minor to C is Eb in order
--to avoid as many conflicts with enharmonic spelling as possible.
numToNoteLilypond num | num >= 1 && num <= 12 = let chrom = ["c4","des","d","ees","e","f","ges","g","aes","a","bes","b"]
in
chrom!!(num-1)
--Quick and easy way to turn the numbers to notes.
numToNote num | num >= 1 && num <= 12 = let chrom = ["C","C#/Db","D","D#/Eb","E","F","F#/Gb","G","G#/Ab","A","A#/Bb","B"]
in
chrom!!(num-1)
--Rules
--Does the scale include the root?
includesRoot :: [Int] -> Bool
includesRoot [] = False
includesRoot set = if set!!0 == 1 then
True
else
False
--Does the scale include atleast 5 notes?
atleastFiveNotes :: [Int] -> Bool
atleastFiveNotes set = if (length set) >= 5 then
True
else
False
--Is the scale in ascending order?
isAscending :: [Int] -> Bool
--Normally, we would say that an empty list is sorted, but we don't want an empty list
--so we say that an empty list is not ascending.
isAscending [] = False
isAscending set | (length set) == 2 = True
isAscending (set:sets) = let a = sets!!0
b = sets!!1
in
if set <= a && a <= b then
isAscending sets
else
False
--Chain all of these rules together...Make sure all three criteria are met.
fitsCriteria :: [Int] -> Bool
fitsCriteria x = (includesRoot x) && (atleastFiveNotes x) && (isAscending x)
--Generate the scales.
genscales :: [Int] -> [[Int]]
genscales set = filter (\x -> fitsCriteria x ) (powerset set)
genscalesnums :: [[Int]]
genscalesnums = sort (genscales [1..12])
{-
--The old way
genscalesnotes :: [[String]]
genscalesnotes = genscalesnoteshelper (sort (genscales [1..12]))
genscalesnoteshelper [] = []
genscalesnoteshelper (x:xs)= [(map numToNote x)] ++ (genscalesnoteshelper xs)
-}
genscalesnotes :: [[String]]
genscalesnotes = foldl1 (++) (map (\x -> [map numToNote x]) (sort (genscales [1..12])))
genscaleslilypond :: [[String]]
genscaleslilypond = foldl1 (++) (map (\x -> [map numToNoteLilypond x]) (sort (genscales [1..12])))
--Format the scaleline in lilypond with formatting.
genscaleslilypondformat = map (\z -> "{ " ++ (foldl1 (++) z) ++ "}") (map (\x -> map (\y -> y ++ " ") x) (map (\x -> x ++ (tail (reverse x))) genscaleslilypond))
writefile :: (Show t) => [t] -> FilePath -> IO ()
writefile (x:xs) filename = do writeFile filename (show x)
mapM_ (\y -> appendFile filename ((show y) ++ "\n")) xs
writelilypond :: FilePath -> IO ()
writelilypond filename = do writeFile filename "\\relative c'' { << \n"
mapM_ (\y -> appendFile filename (y ++ "\n")) genscaleslilypondformat
appendFile filename ">> }"