Support generating chords for a particular key

Generate chords for a given key.

I believe my Theory.allChords function is taking a long time to generate all of
the chord possibilities. I would like to profile this to verify this
assumption. I think I can create a "staging area" for changes and only
regenerate chords when "committing" the options from the "staging area". This
should stress the application less.

TODO: Profile application to find bottleneck.

website/sandbox/chord-drill-sergeant/src/ChordInspector.elm

@@ -1,6 +1,7 @@
 module ChordInspector exposing (render)
 
 import Html exposing (..)
+import NoteInspector
 import Theory
 
 
@@ -11,15 +12,4 @@ render chord =
             p [] [ text "Cannot retrieve the notes for the chord." ]
 
         Just notes ->
-            ul []
+            NoteInspector.render notes
-                (notes
-                    |> List.map
-                        (\note ->
-                            li []
-                                [ text
-                                    (Theory.viewNote
-                                        note
-                                    )
-                                ]
-                        )
-                )

website/sandbox/chord-drill-sergeant/src/Main.elm

@@ -5,6 +5,7 @@ import ChordInspector
 import Html exposing (..)
 import Html.Attributes exposing (..)
 import Html.Events exposing (..)
+import NoteInspector
 import Piano
 import Random
 import Random.List
@@ -18,11 +19,13 @@ type alias Model =
     , whitelistedChordTypes : List Theory.ChordType
     , whitelistedInversions : List Theory.ChordInversion
     , whitelistedPitchClasses : List Theory.PitchClass
+    , whitelistedKeys : List Theory.Key
     , selectedChord : Maybe Theory.Chord
     , isPaused : Bool
     , tempo : Int
     , firstNote : Theory.Note
     , lastNote : Theory.Note
+    , practiceMode : PracticeMode
     , debug :
         { enable : Bool
         , inspectChord : Bool
@@ -30,6 +33,13 @@ type alias Model =
     }
 
 
+{-| Control the type of practice you'd like.
+-}
+type PracticeMode
+    = KeyMode
+    | FineTuneMode
+
+
 type Msg
     = NextChord
     | NewChord Theory.Chord
@@ -42,7 +52,11 @@ type Msg
     | ToggleInversion Theory.ChordInversion
     | ToggleChordType Theory.ChordType
     | TogglePitchClass Theory.PitchClass
+    | ToggleKey Theory.Key
     | DoNothing
+    | SetPracticeMode PracticeMode
+    | SelectAllKeys
+    | DeselectAllKeys
 
 
 {-| The amount by which we increase or decrease tempo.
@@ -80,18 +94,31 @@ init =
 
         pitchClasses =
             Theory.allPitchClasses
+
+        keys =
+            Theory.allKeys
+
+        practiceMode =
+            KeyMode
     in
-    { whitelistedChords =
+    { practiceMode = practiceMode
-        Theory.allChords
+    , whitelistedChords =
-            { start = firstNote
+        case practiceMode of
-            , end = lastNote
+            KeyMode ->
-            , inversions = inversions
+                keys |> List.concatMap Theory.chordsForKey
-            , chordTypes = chordTypes
+
-            , pitchClasses = pitchClasses
+            FineTuneMode ->
-            }
+                Theory.allChords
+                    { start = firstNote
+                    , end = lastNote
+                    , inversions = inversions
+                    , chordTypes = chordTypes
+                    , pitchClasses = pitchClasses
+                    }
     , whitelistedChordTypes = chordTypes
     , whitelistedInversions = inversions
     , whitelistedPitchClasses = pitchClasses
+    , whitelistedKeys = keys
     , selectedChord = Nothing
     , isPaused = True
     , tempo = 60
@@ -121,6 +148,31 @@ update msg model =
         DoNothing ->
             ( model, Cmd.none )
 
+        SetPracticeMode practiceMode ->
+            ( { model
+                | practiceMode = practiceMode
+                , isPaused = True
+              }
+            , Cmd.none
+            )
+
+        SelectAllKeys ->
+            ( { model
+                | whitelistedKeys = Theory.allKeys
+                , whitelistedChords =
+                    Theory.allKeys |> List.concatMap Theory.chordsForKey
+              }
+            , Cmd.none
+            )
+
+        DeselectAllKeys ->
+            ( { model
+                | whitelistedKeys = []
+                , whitelistedChords = []
+              }
+            , Cmd.none
+            )
+
         NewChord chord ->
             ( { model | selectedChord = Just chord }
             , Cmd.none
@@ -239,6 +291,23 @@ update msg model =
             , Cmd.none
             )
 
+        ToggleKey key ->
+            let
+                keys =
+                    if List.member key model.whitelistedKeys then
+                        List.filter ((/=) key) model.whitelistedKeys
+
+                    else
+                        key :: model.whitelistedKeys
+            in
+            ( { model
+                | whitelistedKeys = keys
+                , whitelistedChords =
+                    keys |> List.concatMap Theory.chordsForKey
+              }
+            , Cmd.none
+            )
+
         SetTempo tempo ->
             ( { model
                 | tempo =
@@ -327,6 +396,30 @@ inversionCheckboxes inversions =
         )
 
 
+keyCheckboxes : List Theory.Key -> Html Msg
+keyCheckboxes keys =
+    div []
+        [ h2 [] [ text "Choose Key" ]
+        , button [ onClick SelectAllKeys ] [ text "Select all" ]
+        , button [ onClick DeselectAllKeys ] [ text "Deselect all" ]
+        , ul []
+            (Theory.allKeys
+                |> List.map
+                    (\key ->
+                        li []
+                            [ label [] [ text (Theory.viewKey key) ]
+                            , input
+                                [ type_ "checkbox"
+                                , onClick (ToggleKey key)
+                                , checked (List.member key keys)
+                                ]
+                                []
+                            ]
+                    )
+            )
+        ]
+
+
 displayChord :
     { debug : Bool
     , chord : Theory.Chord
@@ -364,9 +457,37 @@ view model =
             , handleDecrease = DecreaseTempo
             , handleInput = SetTempo
             }
-        , pitchClassCheckboxes model.whitelistedPitchClasses
+        , div []
-        , inversionCheckboxes model.whitelistedInversions
+            [ h2 [] [ text "Practice Mode" ]
-        , chordTypeCheckboxes model.whitelistedChordTypes
+            , input
+                [ type_ "radio"
+                , id "key-mode"
+                , name "key-mode"
+                , checked (model.practiceMode == KeyMode)
+                , onClick (SetPracticeMode KeyMode)
+                ]
+                []
+            , label [ for "key-mode" ] [ text "Key Mode" ]
+            , input
+                [ type_ "radio"
+                , id "fine-tune-mode"
+                , name "fine-tune-mode"
+                , checked (model.practiceMode == FineTuneMode)
+                , onClick (SetPracticeMode FineTuneMode)
+                ]
+                []
+            , label [ for "fine-tune-mode" ] [ text "Fine-tuning Mode" ]
+            ]
+        , case model.practiceMode of
+            KeyMode ->
+                keyCheckboxes model.whitelistedKeys
+
+            FineTuneMode ->
+                div []
+                    [ pitchClassCheckboxes model.whitelistedPitchClasses
+                    , inversionCheckboxes model.whitelistedInversions
+                    , chordTypeCheckboxes model.whitelistedChordTypes
+                    ]
         , playPause model
         , if model.debug.enable then
             debugger

website/sandbox/chord-drill-sergeant/src/Misc.elm

@@ -1,5 +1,7 @@
 module Misc exposing (..)
 
+import Array exposing (Array)
+
 
 comesAfter : a -> List a -> Maybe a
 comesAfter x xs =
@@ -33,3 +35,13 @@ comesBefore x xs =
 
             else
                 comesBefore x (z :: rest)
+
+
+find : (a -> Bool) -> List a -> Maybe a
+find pred xs =
+    case xs |> List.filter pred of
+        [] ->
+            Nothing
+
+        x :: _ ->
+            Just x

website/sandbox/chord-drill-sergeant/src/Theory.elm

@@ -1,6 +1,7 @@
 module Theory exposing (..)
 
 import Array exposing (Array)
+import Dict exposing (Dict)
 import List.Extra
 import Maybe.Extra
 import Misc
@@ -230,11 +231,10 @@ type alias NoteMetadata =
     }
 
 
-scaleDegree : Int -> Key -> PitchClass
+{-| An integer representing which note in a given scale to play.
-scaleDegree which { pitchClass } =
+-}
-    case pitchClass of
+type alias ScaleDegree =
-        _ ->
+    Int
-            C
 
 
 {-| Returns the Note in the cental octave of the piano for a given
@@ -373,16 +373,16 @@ intervalsForMode mode =
     in
     case mode of
         MajorMode ->
-            List.map up [ Whole, Whole, Half, Whole, Whole, Whole, Half ]
+            List.map up [ Whole, Whole, Half, Whole, Whole, Whole ]
 
         MinorMode ->
-            List.map up [ Whole, Half, Whole, Whole, Half, Whole, Whole ]
+            List.map up [ Whole, Half, Whole, Whole, Half, Whole ]
 
         BluesMode ->
             List.map up [ MinorThird, Whole, Half, Half, MinorThird ]
 
 
-{-| Return a list of the intervals the comprise a chord. Each interval measures
+{-| Return a list of the intervals that a chord. Each interval measures
 the distance away from the root-note of the chord.
 -}
 intervalsForChordType : ChordType -> ChordInversion -> List IntervalVector
@@ -648,7 +648,7 @@ notesForChord { note, chordType, chordInversion } =
         |> Maybe.map (\notes -> note :: notes)
 
 
-{-| Return the scale for a given `key`
+{-| Return the scale for a given `key`.
 -}
 notesForKey : Key -> List Note
 notesForKey { pitchClass, mode } =
@@ -718,6 +718,31 @@ allChordTypes =
     ]
 
 
+{-| Return a list of all of the key modes about which we know.
+-}
+allModes : List Mode
+allModes =
+    [ MajorMode, MinorMode, BluesMode ]
+
+
+{-| Return a list of all of the keys about which we know.
+-}
+allKeys : List Key
+allKeys =
+    allPitchClasses
+        |> List.Extra.andThen
+            (\pitchClass ->
+                allModes
+                    |> List.Extra.andThen
+                        (\mode ->
+                            [ { pitchClass = pitchClass
+                              , mode = mode
+                              }
+                            ]
+                        )
+            )
+
+
 {-| Return an array of every note on a piano.
 Note: Currently this piano has 85 keys, but modern pianos have 88 keys. I would
 prefer to have 88 keys, but it's not urgent.
@@ -832,261 +857,19 @@ notes.
 -}
 noteAsNumber : Note -> Int
 noteAsNumber note =
-    case note of
+    let
-        C1 ->
+        result =
+            noteMetadata
+                |> Array.toList
+                |> List.indexedMap Tuple.pair
+                |> Misc.find (\( _, x ) -> x.note == note)
+    in
+    case result of
+        Nothing ->
             0
 
-        C_sharp1 ->
+        Just ( i, _ ) ->
-            1
+            i
-
-        D1 ->
-            2
-
-        D_sharp1 ->
-            3
-
-        E1 ->
-            4
-
-        F1 ->
-            5
-
-        F_sharp1 ->
-            6
-
-        G1 ->
-            7
-
-        G_sharp1 ->
-            8
-
-        A1 ->
-            9
-
-        A_sharp1 ->
-            10
-
-        B1 ->
-            11
-
-        C2 ->
-            12
-
-        C_sharp2 ->
-            13
-
-        D2 ->
-            14
-
-        D_sharp2 ->
-            15
-
-        E2 ->
-            16
-
-        F2 ->
-            17
-
-        F_sharp2 ->
-            18
-
-        G2 ->
-            19
-
-        G_sharp2 ->
-            20
-
-        A2 ->
-            21
-
-        A_sharp2 ->
-            22
-
-        B2 ->
-            23
-
-        C3 ->
-            24
-
-        C_sharp3 ->
-            25
-
-        D3 ->
-            26
-
-        D_sharp3 ->
-            27
-
-        E3 ->
-            28
-
-        F3 ->
-            29
-
-        F_sharp3 ->
-            30
-
-        G3 ->
-            31
-
-        G_sharp3 ->
-            32
-
-        A3 ->
-            33
-
-        A_sharp3 ->
-            34
-
-        B3 ->
-            35
-
-        C4 ->
-            36
-
-        C_sharp4 ->
-            37
-
-        D4 ->
-            38
-
-        D_sharp4 ->
-            39
-
-        E4 ->
-            40
-
-        F4 ->
-            41
-
-        F_sharp4 ->
-            42
-
-        G4 ->
-            43
-
-        G_sharp4 ->
-            44
-
-        A4 ->
-            45
-
-        A_sharp4 ->
-            46
-
-        B4 ->
-            47
-
-        C5 ->
-            48
-
-        C_sharp5 ->
-            49
-
-        D5 ->
-            50
-
-        D_sharp5 ->
-            51
-
-        E5 ->
-            52
-
-        F5 ->
-            53
-
-        F_sharp5 ->
-            54
-
-        G5 ->
-            55
-
-        G_sharp5 ->
-            56
-
-        A5 ->
-            57
-
-        A_sharp5 ->
-            58
-
-        B5 ->
-            59
-
-        C6 ->
-            60
-
-        C_sharp6 ->
-            61
-
-        D6 ->
-            62
-
-        D_sharp6 ->
-            63
-
-        E6 ->
-            64
-
-        F6 ->
-            65
-
-        F_sharp6 ->
-            66
-
-        G6 ->
-            67
-
-        G_sharp6 ->
-            68
-
-        A6 ->
-            69
-
-        A_sharp6 ->
-            70
-
-        B6 ->
-            71
-
-        C7 ->
-            72
-
-        C_sharp7 ->
-            73
-
-        D7 ->
-            74
-
-        D_sharp7 ->
-            75
-
-        E7 ->
-            76
-
-        F7 ->
-            77
-
-        F_sharp7 ->
-            78
-
-        G7 ->
-            79
-
-        G_sharp7 ->
-            80
-
-        A7 ->
-            81
-
-        A_sharp7 ->
-            82
-
-        B7 ->
-            83
-
-        C8 ->
-            84
 
 
 {-| Return true if all of the notes that comprise `chord` can be played on a
@@ -1223,3 +1006,95 @@ viewPitchClass pitchClass =
 
         B ->
             "B"
+
+
+viewMode : Mode -> String
+viewMode mode =
+    case mode of
+        MajorMode ->
+            "major"
+
+        MinorMode ->
+            "minor"
+
+        BluesMode ->
+            "blues"
+
+
+{-| Return the human-readable format of `key`.
+-}
+viewKey : Key -> String
+viewKey { pitchClass, mode } =
+    viewPitchClass pitchClass ++ " " ++ viewMode mode
+
+
+{-| Returns a pairing of a scale-degree to the type of chord at that scale
+degree.
+-}
+practiceChordsForMode : Mode -> Dict ScaleDegree ChordType
+practiceChordsForMode mode =
+    case mode of
+        MajorMode ->
+            Dict.fromList
+                [ ( 1, Major )
+                , ( 2, Minor )
+                , ( 3, Minor )
+                , ( 4, Major )
+                , ( 5, Major )
+                , ( 6, Minor )
+                , ( 7, Diminished )
+                ]
+
+        MinorMode ->
+            Dict.fromList
+                [ ( 1, Minor )
+                , ( 2, Diminished )
+                , ( 3, Major )
+                , ( 4, Minor )
+                , ( 5, Minor )
+                , ( 6, Major )
+                , ( 7, Major )
+                ]
+
+        BluesMode ->
+            Dict.fromList
+                [ ( 1, MajorDominant7 )
+
+                -- While many refer to the blues progression as a I-IV-V, the IV
+                -- chord is really a MajorDominant7 made from the third scale
+                -- degree.
+                , ( 3, MajorDominant7 )
+                , ( 5, MajorDominant7 )
+                ]
+
+
+{-| Returns a list of chords for a particular `key`.
+-}
+chordsForKey : Key -> List Chord
+chordsForKey key =
+    let
+        chords =
+            practiceChordsForMode key.mode
+    in
+    notesForKey key
+        |> List.indexedMap
+            (\i note ->
+                case Dict.get (i + 1) chords of
+                    Nothing ->
+                        Nothing
+
+                    Just chordType ->
+                        Just
+                            (allInversions
+                                |> List.Extra.andThen
+                                    (\inversion ->
+                                        [ { note = note
+                                          , chordType = chordType
+                                          , chordInversion = inversion
+                                          }
+                                        ]
+                                    )
+                            )
+            )
+        |> Maybe.Extra.values
+        |> List.concat