uke chords generated

LICENSE

@@ -0,0 +1 @@
+BSD3

README

@@ -0,0 +1,106 @@
+I took 16 chord types and found all ways to make them with at least 1
+open string and within the first 3 frets.  These are the chords which
+will generally form barre chords the best.  E.g. since C7 is 0001, you
+can form D7 by adding 2 to everything to get 2223.  This means you
+play fret 2 on the G-string, 2 on the C-string, 2 on the E-string, and
+3 on the A-string.  Use your index finger to cover all the 2s then use
+your middle finger to add the 3 on the A-string.
+
+Chord inversions are ignored in this list.  I.e. in the 0100 voicing
+of A7 the lowest-pitch note is C# not A so this might more properly be
+called A7-first-inversion (or A7/C#).  --Dan
+
+major
+0003: CM
+2220: DM
+0331: EbM
+2010: FM
+2013: FM
+0232: GM
+2100: AM
+
+minor
+0333: Cm
+2210: Dm
+1013: Fm
+2120: F#m
+0231: Gm
+2000: Am
+2003: Am
+
+diminished
+2320: Ebdim
+2020: F#dim
+2023: F#dim
+0131: Gdim
+3101: A#dim
+
+augmented
+1003: Caug
+2110: C#aug
+0332: Ebaug
+
+dominant seventh
+0001: C7
+1202: E7
+0212: G7
+0100: A7
+
+major seventh
+0002: CM7
+1302: EM7
+0222: GM7
+1100: AM7
+3210: BbM7
+
+minor seventh
+1102: C#m7
+0202: Em7
+0211: Gm7
+0000: Am7
+
+diminished seventh
+0101: C#dim7
+
+half-diminished seventh
+0102: C#m7b5
+0201: Em7b5
+0111: Gm7b5
+1101: Am7b5
+
+minor major seventh
+1103: C#mM7
+0302: EmM7
+0221: GmM7
+1000: AmM7
+3110: BbmM7
+
+augmented major seventh
+1002: CaugM7
+1303: EaugM7
+0322: GaugM7
+1110: AaugM7
+3220: BbaugM7
+
+augmented seventh
+1001: Caug7
+1203: Eaug7
+0312: Gaug7
+0110: Aaug7
+
+ninth
+3203: C9
+0310: F9
+1021: Ab9
+
+major ninth
+1031: AbM9
+
+minor ninth
+2032: Am9
+
+dominant seventh sharp ninth (hendrix chord)
+3303: C7#9
+1310: F7#9
+1022: Ab7#9
+

src/Main.hs

@@ -0,0 +1,149 @@
+-- We want to find all chords of common types that use an open string
+-- and don't go too high on the fretboard.
+
+-- Music terms:
+-- - note
+-- - pitch
+-- - pitch class
+-- - timbre
+-- - tonality
+-- - key: we decide that key is always major key..
+-- - scale: ..and scale can be major or minor or other
+-- - scale degree
+-- - triad: three-note chord of two thirds
+-- - tone: note or pitch or timbre or tonality
+-- - root: reference note of a chord
+-- - tonic: first scale degree
+--   tonic
+--   supertonic
+--   mediant
+--   subdominant
+--   dominant
+--   submediant
+--   leading tone
+-- Our nonce terms:
+-- - A "chord sig" is the pairwise half-step-distances formed by pitch classes,
+--   in the inversion of the chord that maximizes the first distance (then the
+--   second on a tie, and so on).
+
+import Control.Arrow
+import Control.Monad
+import Data.Function
+import Data.List
+import Data.Maybe
+import Data.Monoid
+import Data.Ord
+import qualified Data.Map as Map
+
+data PitchClass = C | Cs | D | Ds | E | F | Fs | G | Gs | A | As | B
+  deriving (Show, Eq, Ord, Read, Enum, Bounded)
+
+aFlat = Gs
+bFlat = As
+dFlat = Cs
+eFlat = Ds
+gFlat = Fs
+
+type Pitch = (PitchClass, Int)
+
+octaveInt :: Int
+octaveInt = 1 + fromEnum (maxBound :: PitchClass)
+
+pitchToInt :: Pitch -> Int
+pitchToInt = uncurry (+) . second (octaveInt *) . first fromEnum
+
+swap :: (a, b) -> (b, a)
+swap (a, b) = (b, a)
+
+intToPitch :: Int -> Pitch
+intToPitch = first toEnum . swap . (`divMod` octaveInt)
+
+pitchDiff :: Pitch -> Pitch -> Int
+pitchDiff = (-) `on` pitchToInt
+
+pitchPlus :: Pitch -> Int -> Pitch
+pitchPlus n = intToPitch . (pitchToInt n +)
+
+adjPairs :: [a] -> [(a, a)]
+adjPairs = ap zip tail
+
+onAdjPairs :: (b -> b -> c) -> [b] -> [c]
+onAdjPairs f = map (uncurry f) . adjPairs 
+
+allCyclesForever :: [t] -> [[t]]
+allCyclesForever l = l : allCyclesForever (rest ++ [l0]) where (l0:rest) = l
+
+pitchClassesToChordSig :: [PitchClass] -> [Int]
+pitchClassesToChordSig = bestSig . 
+  onAdjPairs (flip (-)) . octowrap . map fromEnum . map head . group . sort
+  where
+  octowrap :: [Int] -> [Int]
+  octowrap l = l ++ [head l + octaveInt]
+  bestSig :: [Int] -> [Int]
+  bestSig l = maximum . take n $ allCyclesForever l where n = length l
+
+majChord = [C, E, G]
+minChord = [C, eFlat, G]
+dimChord = [C, eFlat, gFlat]
+augChord = [C, E, Gs]
+
+domSevChord = [C, E, G, bFlat]
+majSevChord = [C, E, G, B]
+minSevChord = [C, eFlat, G, bFlat]
+dimSevChord = [C, eFlat, gFlat, A]
+
+halfDimSevChord = [C, eFlat, gFlat, bFlat]
+minMajSevChord = [C, eFlat, G, B]
+augMajSevChord = [C, E, Gs, B]
+augDomSevChord = [C, E, Gs, bFlat]
+
+domNinChord = [C, E, bFlat, D]
+majNinChord = [C, E, B, D]
+minNinChord = [C, eFlat, bFlat, D]
+domSevAugNinChord = [C, E, bFlat, Ds]  -- hendrix
+
+chordSigs :: [([Int], String)]
+chordSigs = map (first pitchClassesToChordSig) [
+  (majChord, "M"),
+  (minChord, "m"),
+  (dimChord, "dim"),
+  (augChord, "aug"),
+  (domSevChord, "7"),
+  (majSevChord, "M7"),
+  (minSevChord, "m7"),
+  (dimSevChord, "dim7"),
+  (halfDimSevChord, "m7b5"),
+  (minMajSevChord, "mM7"),
+  (augMajSevChord, "augM7"),
+  (augDomSevChord, "aug7"),
+  (domNinChord, "9"),
+  (majNinChord, "M9"),
+  (minNinChord, "m9"),
+  (domSevAugNinChord, "7#9")
+  ]
+
+maxFret :: Int
+maxFret = 3
+
+geetStrs :: [Pitch]
+geetStrs = [(G, 3), (C, 3), (E, 3), (A, 3)]
+
+functorRunSnd :: (Functor f) => (a, f b) -> f (a, b)
+functorRunSnd = uncurry (fmap . (,))
+
+chordGetName :: [PitchClass] -> Maybe String
+chordGetName = flip Map.lookup (Map.fromList chordSigs) . 
+  pitchClassesToChordSig
+
+main :: IO ()
+main = do
+  let
+    frets = 
+      filter (any (== 0)) . sequence $ replicate (length geetStrs) [0..maxFret]
+    fretsToName = catMaybes . map functorRunSnd .  zip frets $ 
+      map (chordGetName . map fst . zipWith pitchPlus geetStrs) frets
+    nameToFrets = Map.fromListWith (++) $ map (swap . first (:[])) fretsToName
+    myShow (name, fretss) = map ((++ name) . (++ ": ") . showFrets) fretss
+    showFrets l = concatMap show l
+  putStr . unlines . concat . map (myShow . second sort) . catMaybes $ 
+    map ((\ k -> functorRunSnd (k, Map.lookup k nameToFrets)) . snd) chordSigs

uke-chords.cabal

@@ -0,0 +1,13 @@
+name:           uke-chords
+version:        0.1
+license:        BSD3
+license-file:   LICENSE
+author:         [email protected]
+synopsis:       see source
+build-type:     Simple
+cabal-version:  >= 1.6
+
+executable uke-chords
+  hs-source-dirs: src
+  main-is:        Main.hs
+  build-depends:  base >= 4, containers