-- | Set class tables and database. module Music.Theory.Table where import Data.List import Data.Maybe import Music.Theory.Prime -- | Synonym for 'String'. type SC_Name = String -- | The set-class table (Forte prime forms). sc_table :: (Integral a) => [(SC_Name,[a])] sc_table = [("0-1",[]) ,("1-1",[0]) ,("2-1",[0,1]) ,("2-2",[0,2]) ,("2-3",[0,3]) ,("2-4",[0,4]) ,("2-5",[0,5]) ,("2-6",[0,6]) ,("3-1",[0,1,2]) ,("3-2",[0,1,3]) ,("3-3",[0,1,4]) ,("3-4",[0,1,5]) ,("3-5",[0,1,6]) ,("3-6",[0,2,4]) ,("3-7",[0,2,5]) ,("3-8",[0,2,6]) ,("3-9",[0,2,7]) ,("3-10",[0,3,6]) ,("3-11",[0,3,7]) ,("3-12",[0,4,8]) ,("4-1",[0,1,2,3]) ,("4-2",[0,1,2,4]) ,("4-3",[0,1,3,4]) ,("4-4",[0,1,2,5]) ,("4-5",[0,1,2,6]) ,("4-6",[0,1,2,7]) ,("4-7",[0,1,4,5]) ,("4-8",[0,1,5,6]) ,("4-9",[0,1,6,7]) ,("4-10",[0,2,3,5]) ,("4-11",[0,1,3,5]) ,("4-12",[0,2,3,6]) ,("4-13",[0,1,3,6]) ,("4-14",[0,2,3,7]) ,("4-Z15",[0,1,4,6]) ,("4-16",[0,1,5,7]) ,("4-17",[0,3,4,7]) ,("4-18",[0,1,4,7]) ,("4-19",[0,1,4,8]) ,("4-20",[0,1,5,8]) ,("4-21",[0,2,4,6]) ,("4-22",[0,2,4,7]) ,("4-23",[0,2,5,7]) ,("4-24",[0,2,4,8]) ,("4-25",[0,2,6,8]) ,("4-26",[0,3,5,8]) ,("4-27",[0,2,5,8]) ,("4-28",[0,3,6,9]) ,("4-Z29",[0,1,3,7]) ,("5-1",[0,1,2,3,4]) ,("5-2",[0,1,2,3,5]) ,("5-3",[0,1,2,4,5]) ,("5-4",[0,1,2,3,6]) ,("5-5",[0,1,2,3,7]) ,("5-6",[0,1,2,5,6]) ,("5-7",[0,1,2,6,7]) ,("5-8",[0,2,3,4,6]) ,("5-9",[0,1,2,4,6]) ,("5-10",[0,1,3,4,6]) ,("5-11",[0,2,3,4,7]) ,("5-Z12",[0,1,3,5,6]) ,("5-13",[0,1,2,4,8]) ,("5-14",[0,1,2,5,7]) ,("5-15",[0,1,2,6,8]) ,("5-16",[0,1,3,4,7]) ,("5-Z17",[0,1,3,4,8]) ,("5-Z18",[0,1,4,5,7]) ,("5-19",[0,1,3,6,7]) ,("5-20",[0,1,3,7,8]) ,("5-21",[0,1,4,5,8]) ,("5-22",[0,1,4,7,8]) ,("5-23",[0,2,3,5,7]) ,("5-24",[0,1,3,5,7]) ,("5-25",[0,2,3,5,8]) ,("5-26",[0,2,4,5,8]) ,("5-27",[0,1,3,5,8]) ,("5-28",[0,2,3,6,8]) ,("5-29",[0,1,3,6,8]) ,("5-30",[0,1,4,6,8]) ,("5-31",[0,1,3,6,9]) ,("5-32",[0,1,4,6,9]) ,("5-33",[0,2,4,6,8]) ,("5-34",[0,2,4,6,9]) ,("5-35",[0,2,4,7,9]) ,("5-Z36",[0,1,2,4,7]) ,("5-Z37",[0,3,4,5,8]) ,("5-Z38",[0,1,2,5,8]) ,("6-1",[0,1,2,3,4,5]) ,("6-2",[0,1,2,3,4,6]) ,("6-Z3",[0,1,2,3,5,6]) ,("6-Z4",[0,1,2,4,5,6]) ,("6-5",[0,1,2,3,6,7]) ,("6-Z6",[0,1,2,5,6,7]) ,("6-7",[0,1,2,6,7,8]) ,("6-8",[0,2,3,4,5,7]) ,("6-9",[0,1,2,3,5,7]) ,("6-Z10",[0,1,3,4,5,7]) ,("6-Z11",[0,1,2,4,5,7]) ,("6-Z12",[0,1,2,4,6,7]) ,("6-Z13",[0,1,3,4,6,7]) ,("6-14",[0,1,3,4,5,8]) ,("6-15",[0,1,2,4,5,8]) ,("6-16",[0,1,4,5,6,8]) ,("6-Z17",[0,1,2,4,7,8]) ,("6-18",[0,1,2,5,7,8]) ,("6-Z19",[0,1,3,4,7,8]) ,("6-20",[0,1,4,5,8,9]) ,("6-21",[0,2,3,4,6,8]) ,("6-22",[0,1,2,4,6,8]) ,("6-Z23",[0,2,3,5,6,8]) ,("6-Z24",[0,1,3,4,6,8]) ,("6-Z25",[0,1,3,5,6,8]) ,("6-Z26",[0,1,3,5,7,8]) ,("6-27",[0,1,3,4,6,9]) ,("6-Z28",[0,1,3,5,6,9]) ,("6-Z29",[0,1,3,6,8,9]) ,("6-30",[0,1,3,6,7,9]) ,("6-31",[0,1,3,5,8,9]) ,("6-32",[0,2,4,5,7,9]) ,("6-33",[0,2,3,5,7,9]) ,("6-34",[0,1,3,5,7,9]) ,("6-35",[0,2,4,6,8,10]) ,("6-Z36",[0,1,2,3,4,7]) ,("6-Z37",[0,1,2,3,4,8]) ,("6-Z38",[0,1,2,3,7,8]) ,("6-Z39",[0,2,3,4,5,8]) ,("6-Z40",[0,1,2,3,5,8]) ,("6-Z41",[0,1,2,3,6,8]) ,("6-Z42",[0,1,2,3,6,9]) ,("6-Z43",[0,1,2,5,6,8]) ,("6-Z44",[0,1,2,5,6,9]) ,("6-Z45",[0,2,3,4,6,9]) ,("6-Z46",[0,1,2,4,6,9]) ,("6-Z47",[0,1,2,4,7,9]) ,("6-Z48",[0,1,2,5,7,9]) ,("6-Z49",[0,1,3,4,7,9]) ,("6-Z50",[0,1,4,6,7,9]) ,("7-1",[0,1,2,3,4,5,6]) ,("7-2",[0,1,2,3,4,5,7]) ,("7-3",[0,1,2,3,4,5,8]) ,("7-4",[0,1,2,3,4,6,7]) ,("7-5",[0,1,2,3,5,6,7]) ,("7-6",[0,1,2,3,4,7,8]) ,("7-7",[0,1,2,3,6,7,8]) ,("7-8",[0,2,3,4,5,6,8]) ,("7-9",[0,1,2,3,4,6,8]) ,("7-10",[0,1,2,3,4,6,9]) ,("7-11",[0,1,3,4,5,6,8]) ,("7-Z12",[0,1,2,3,4,7,9]) ,("7-13",[0,1,2,4,5,6,8]) ,("7-14",[0,1,2,3,5,7,8]) ,("7-15",[0,1,2,4,6,7,8]) ,("7-16",[0,1,2,3,5,6,9]) ,("7-Z17",[0,1,2,4,5,6,9]) ,("7-Z18",[0,1,2,3,5,8,9]) ,("7-19",[0,1,2,3,6,7,9]) ,("7-20",[0,1,2,4,7,8,9]) ,("7-21",[0,1,2,4,5,8,9]) ,("7-22",[0,1,2,5,6,8,9]) ,("7-23",[0,2,3,4,5,7,9]) ,("7-24",[0,1,2,3,5,7,9]) ,("7-25",[0,2,3,4,6,7,9]) ,("7-26",[0,1,3,4,5,7,9]) ,("7-27",[0,1,2,4,5,7,9]) ,("7-28",[0,1,3,5,6,7,9]) ,("7-29",[0,1,2,4,6,7,9]) ,("7-30",[0,1,2,4,6,8,9]) ,("7-31",[0,1,3,4,6,7,9]) ,("7-32",[0,1,3,4,6,8,9]) ,("7-33",[0,1,2,4,6,8,10]) ,("7-34",[0,1,3,4,6,8,10]) ,("7-35",[0,1,3,5,6,8,10]) ,("7-Z36",[0,1,2,3,5,6,8]) ,("7-Z37",[0,1,3,4,5,7,8]) ,("7-Z38",[0,1,2,4,5,7,8]) ,("8-1",[0,1,2,3,4,5,6,7]) ,("8-2",[0,1,2,3,4,5,6,8]) ,("8-3",[0,1,2,3,4,5,6,9]) ,("8-4",[0,1,2,3,4,5,7,8]) ,("8-5",[0,1,2,3,4,6,7,8]) ,("8-6",[0,1,2,3,5,6,7,8]) ,("8-7",[0,1,2,3,4,5,8,9]) ,("8-8",[0,1,2,3,4,7,8,9]) ,("8-9",[0,1,2,3,6,7,8,9]) ,("8-10",[0,2,3,4,5,6,7,9]) ,("8-11",[0,1,2,3,4,5,7,9]) ,("8-12",[0,1,3,4,5,6,7,9]) ,("8-13",[0,1,2,3,4,6,7,9]) ,("8-14",[0,1,2,4,5,6,7,9]) ,("8-Z15",[0,1,2,3,4,6,8,9]) ,("8-16",[0,1,2,3,5,7,8,9]) ,("8-17",[0,1,3,4,5,6,8,9]) ,("8-18",[0,1,2,3,5,6,8,9]) ,("8-19",[0,1,2,4,5,6,8,9]) ,("8-20",[0,1,2,4,5,7,8,9]) ,("8-21",[0,1,2,3,4,6,8,10]) ,("8-22",[0,1,2,3,5,6,8,10]) ,("8-23",[0,1,2,3,5,7,8,10]) ,("8-24",[0,1,2,4,5,6,8,10]) ,("8-25",[0,1,2,4,6,7,8,10]) ,("8-26",[0,1,2,4,5,7,9,10]) ,("8-27",[0,1,2,4,5,7,8,10]) ,("8-28",[0,1,3,4,6,7,9,10]) ,("8-Z29",[0,1,2,3,5,6,7,9]) ,("9-1",[0,1,2,3,4,5,6,7,8]) ,("9-2",[0,1,2,3,4,5,6,7,9]) ,("9-3",[0,1,2,3,4,5,6,8,9]) ,("9-4",[0,1,2,3,4,5,7,8,9]) ,("9-5",[0,1,2,3,4,6,7,8,9]) ,("9-6",[0,1,2,3,4,5,6,8,10]) ,("9-7",[0,1,2,3,4,5,7,8,10]) ,("9-8",[0,1,2,3,4,6,7,8,10]) ,("9-9",[0,1,2,3,5,6,7,8,10]) ,("9-10",[0,1,2,3,4,6,7,9,10]) ,("9-11",[0,1,2,3,5,6,7,9,10]) ,("9-12",[0,1,2,4,5,6,8,9,10]) ,("10-1",[0,1,2,3,4,5,6,7,8,9]) ,("10-2",[0,1,2,3,4,5,6,7,8,10]) ,("10-3",[0,1,2,3,4,5,6,7,9,10]) ,("10-4",[0,1,2,3,4,5,6,8,9,10]) ,("10-5",[0,1,2,3,4,5,7,8,9,10]) ,("10-6",[0,1,2,3,4,6,7,8,9,10]) ,("11-1",[0,1,2,3,4,5,6,7,8,9,10]) ,("12-1",[0,1,2,3,4,5,6,7,8,9,10,11])] -- | Lookup a set-class name. The input set is subject to -- 'forte_prime' before lookup. -- -- > sc_name [0,1,4,6,7,8] == "6-Z17" sc_name :: (Integral a) => [a] -> SC_Name sc_name p = let n = find (\(_,q) -> forte_prime p == q) sc_table in fst (fromJust n) -- | Lookup a set-class given a set-class name. -- -- > sc "6-Z17" == [0,1,2,4,7,8] sc :: (Integral a) => SC_Name -> [a] sc n = snd (fromJust (find (\(m,_) -> n == m) sc_table)) -- | List of set classes. scs :: (Integral a) => [[a]] scs = map snd sc_table -- | Set class database with descriptors for historically and -- theoretically significant set classes. -- -- > lookup "6-Z17" sc_db == Just "All-Trichord Hexachord" -- > lookup "7-35" sc_db == Just "diatonic collection (d)" sc_db :: [(SC_Name,String)] sc_db = [ ("4-Z15","All-Interval Tetrachord (see also 4-Z29)") ,("4-Z29","All-Interval Tetrachord (see also 4-Z15)") ,("6-Z17","All-Trichord Hexachord") ,("8-Z15","All-Tetrachord Octochord (see also 8-Z29)") ,("8-Z29","All-Tetrachord Octochord (see also 8-Z15)") ,("6-1","A-Type All-Combinatorial Hexachord") ,("6-8","B-Type All-Combinatorial Hexachord") ,("6-32","C-Type All-Combinatorial Hexachord") ,("6-7","D-Type All-Combinatorial Hexachord") ,("6-20","E-Type All-Combinatorial Hexachord") ,("6-35","F-Type All-Combinatorial Hexachord") ,("7-35","diatonic collection (d)") ,("7-34","ascending melodic minor collection") ,("8-28","octotonic collection (Messiaen Mode II)") ,("6-35","wholetone collection") ,("3-10","diminished triad") ,("3-11","major/minor triad") ,("3-12","augmented triad") ,("4-19","minor major-seventh chord") ,("4-20","major-seventh chord") ,("4-25","french augmented sixth chord") ,("4-28","dimished-seventh chord") ,("4-26","minor-seventh chord") ,("4-27","half-dimished seventh(P)/dominant-seventh(I) chord") ,("6-30","Petrushka Chord {0476a1},3-11 at T6") ,("6-34","Mystic Chord {06a492}") ,("6-Z44","Schoenberg Signature Set,3-3 at T5 or T7") ,("6-Z19","complement of 6-Z44,3-11 at T1 or TB") ,("9-12","Messiaen Mode III (nontonic collection)") ,("8-9","Messian Mode IV") ,("7-31","The only seven-element subset of 8-28. ") ,("5-31","The only five-element superset of 4-28.") ,("5-33","The only five-element subset of 6-35.") ,("7-33","The only seven-element superset of 6-35.") ,("5-21","The only five-element subset of 6-20.") ,("7-21","The only seven-element superset of 6-20.") ,("5-25","The only five-element subset of both 7-35 and 8-28.") ,("6-14","Any non-intersecting union of 3-6 and 3-12.") ]