diff --git a/Main.hs b/Main.hs index bbd5eec..711ac3f 100644 --- a/Main.hs +++ b/Main.hs @@ -39,7 +39,4 @@ toChord = fromJust . mapM toPitch . words -- | Prompt for a target and use guessTest to try to guess it. main :: IO () main = do - putStr "Target chord (3 pitches separated by spaces): " - hFlush stdout - text <- getLine - guessTest $ toChord text + putStr $ show avgGuesses diff --git a/Proj2.hs b/Proj2.hs index 757234d..496aba1 100644 --- a/Proj2.hs +++ b/Proj2.hs @@ -54,13 +54,14 @@ module Proj2 GameState, initialGuess, nextGuess, + avgGuesses, ) where -import Data.Function +import Data.Function (on) import Data.List import Data.Map qualified as Map -import Data.Ord +import Data.Ord (comparing) import Data.Set qualified as Set -- ==== DATA STRUCTURES ======================================================= @@ -107,9 +108,10 @@ instance Show Octave where toPitch :: String -> Maybe Pitch toPitch [note, octave] = Pitch <$> charToNote note <*> charToOctave octave where - charToNote = - flip - lookup + charToNote :: Char -> Maybe Note + charToNote c = + lookup + c [ ('A', A), ('B', B), ('C', C), @@ -118,9 +120,10 @@ toPitch [note, octave] = Pitch <$> charToNote note <*> charToOctave octave ('F', F), ('G', G) ] - charToOctave = - flip - lookup + charToOctave :: Char -> Maybe Octave + charToOctave c = + lookup + c [ ('1', One), ('2', Two), ('3', Three) @@ -199,8 +202,8 @@ nextGuess (prevGuess, state) prevFeedback = (chosen, newState) chosen = fst $ minimumBy (comparing snd) scored newState = filter (/= chosen) candidates - scored = map ((,) <*> (`score` candidates)) candidates - candidates = filter ((== prevFeedback) . feedback prevGuess) state + scored = map (\x -> (x, score x candidates)) candidates + candidates = filter (\x -> prevFeedback == feedback prevGuess x) state -- average number of possible targets per candidate score candidate candidates = ((/) `on` fromIntegral) (sum l) (length l) @@ -223,7 +226,7 @@ matches :: (Eq a, Show a) => [a] -> [a] -> Int matches xs ys = maximum permutationMatches where permutationMatches = map (pairwiseMatches xs) (permutations ys) - pairwiseMatches xs ys = length $ filter (uncurry (==)) $ zip xs ys + pairwiseMatches xs = length . filter (uncurry (==)) . zip xs -- outputs a list of all possible chords, where a chord is a list of unique -- pitches. this function happens to generate chords such that the pitches are @@ -234,11 +237,12 @@ matches xs ys = maximum permutationMatches -- allChords :: [[Pitch]] allChords = - [ [p1, p2, p3] + [ chord | p1 <- allPitches, p2 <- allPitches, - p1 < p2, p3 <- allPitches, + let chord = [p1, p2, p3], + p1 < p2, p2 < p3 ] where @@ -247,3 +251,22 @@ allChords = | note <- [minBound .. maxBound], octave <- [minBound .. maxBound] ] + +-- ==== TESTING =============================================================== + +guessTest :: [Pitch] -> Int +guessTest target = loop target guess other 1 + where + (guess, other) = initialGuess + +loop :: [Pitch] -> [Pitch] -> GameState -> Int -> Int +loop target guess other guesses + | answer == (3, 0, 0) = guesses + | otherwise = loop target guess' other' (guesses + 1) + where + answer = feedback target guess + (guess', other') = nextGuess (guess, other) answer + +avgGuesses = fromIntegral (sum results) / fromIntegral (length results) + where + results = map guessTest allChords diff --git a/README.md b/README.md index 1490f0c..d84db88 100644 --- a/README.md +++ b/README.md @@ -1,4 +1,12 @@ # Spec +## Best first guess +### All different +[C1, D2, E3]: 4.27 +[A1, D2, G3]: 4.25 +### Same notes +[D1, D2, D3]: 4.80 +### Same octaves +[C2, D2, E2]: 4.34 ## Tips to improve `nextGuess` The best results can be had by carefully choosing each guess so that it is most likely to leave a small remaining list of possible targets. You can do this by diff --git a/justfile b/justfile index d0b0bdf..de6de60 100644 --- a/justfile +++ b/justfile @@ -12,4 +12,4 @@ build: # run musician run: - ./target/{{exec}} + time ./target/{{exec}}