diff --git a/Main.hs b/Main.hs index 711ac3f..bbd5eec 100644 --- a/Main.hs +++ b/Main.hs @@ -39,4 +39,7 @@ toChord = fromJust . mapM toPitch . words -- | Prompt for a target and use guessTest to try to guess it. main :: IO () main = do - putStr $ show avgGuesses + putStr "Target chord (3 pitches separated by spaces): " + hFlush stdout + text <- getLine + guessTest $ toChord text diff --git a/Proj2.hs b/Proj2.hs index 496aba1..757234d 100644 --- a/Proj2.hs +++ b/Proj2.hs @@ -54,14 +54,13 @@ module Proj2 GameState, initialGuess, nextGuess, - avgGuesses, ) where -import Data.Function (on) +import Data.Function import Data.List import Data.Map qualified as Map -import Data.Ord (comparing) +import Data.Ord import Data.Set qualified as Set -- ==== DATA STRUCTURES ======================================================= @@ -108,10 +107,9 @@ instance Show Octave where toPitch :: String -> Maybe Pitch toPitch [note, octave] = Pitch <$> charToNote note <*> charToOctave octave where - charToNote :: Char -> Maybe Note - charToNote c = - lookup - c + charToNote = + flip + lookup [ ('A', A), ('B', B), ('C', C), @@ -120,10 +118,9 @@ toPitch [note, octave] = Pitch <$> charToNote note <*> charToOctave octave ('F', F), ('G', G) ] - charToOctave :: Char -> Maybe Octave - charToOctave c = - lookup - c + charToOctave = + flip + lookup [ ('1', One), ('2', Two), ('3', Three) @@ -202,8 +199,8 @@ nextGuess (prevGuess, state) prevFeedback = (chosen, newState) chosen = fst $ minimumBy (comparing snd) scored newState = filter (/= chosen) candidates - scored = map (\x -> (x, score x candidates)) candidates - candidates = filter (\x -> prevFeedback == feedback prevGuess x) state + scored = map ((,) <*> (`score` candidates)) candidates + candidates = filter ((== prevFeedback) . feedback prevGuess) state -- average number of possible targets per candidate score candidate candidates = ((/) `on` fromIntegral) (sum l) (length l) @@ -226,7 +223,7 @@ matches :: (Eq a, Show a) => [a] -> [a] -> Int matches xs ys = maximum permutationMatches where permutationMatches = map (pairwiseMatches xs) (permutations ys) - pairwiseMatches xs = length . filter (uncurry (==)) . zip xs + pairwiseMatches xs ys = length $ filter (uncurry (==)) $ zip xs ys -- 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 @@ -237,12 +234,11 @@ matches xs ys = maximum permutationMatches -- allChords :: [[Pitch]] allChords = - [ chord + [ [p1, p2, p3] | p1 <- allPitches, p2 <- allPitches, - p3 <- allPitches, - let chord = [p1, p2, p3], p1 < p2, + p3 <- allPitches, p2 < p3 ] where @@ -251,22 +247,3 @@ 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 d84db88..1490f0c 100644 --- a/README.md +++ b/README.md @@ -1,12 +1,4 @@ # 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 de6de60..d0b0bdf 100644 --- a/justfile +++ b/justfile @@ -12,4 +12,4 @@ build: # run musician run: - time ./target/{{exec}} + ./target/{{exec}}