Compare commits

..

6 commits

4 changed files with 46 additions and 18 deletions

View file

@ -39,7 +39,4 @@ toChord = fromJust . mapM toPitch . words
-- | Prompt for a target and use guessTest to try to guess it. -- | Prompt for a target and use guessTest to try to guess it.
main :: IO () main :: IO ()
main = do main = do
putStr "Target chord (3 pitches separated by spaces): " putStr $ show avgGuesses
hFlush stdout
text <- getLine
guessTest $ toChord text

View file

@ -54,13 +54,14 @@ module Proj2
GameState, GameState,
initialGuess, initialGuess,
nextGuess, nextGuess,
avgGuesses,
) )
where where
import Data.Function import Data.Function (on)
import Data.List import Data.List
import Data.Map qualified as Map import Data.Map qualified as Map
import Data.Ord import Data.Ord (comparing)
import Data.Set qualified as Set import Data.Set qualified as Set
-- ==== DATA STRUCTURES ======================================================= -- ==== DATA STRUCTURES =======================================================
@ -107,9 +108,10 @@ instance Show Octave where
toPitch :: String -> Maybe Pitch toPitch :: String -> Maybe Pitch
toPitch [note, octave] = Pitch <$> charToNote note <*> charToOctave octave toPitch [note, octave] = Pitch <$> charToNote note <*> charToOctave octave
where where
charToNote = charToNote :: Char -> Maybe Note
flip charToNote c =
lookup lookup
c
[ ('A', A), [ ('A', A),
('B', B), ('B', B),
('C', C), ('C', C),
@ -118,9 +120,10 @@ toPitch [note, octave] = Pitch <$> charToNote note <*> charToOctave octave
('F', F), ('F', F),
('G', G) ('G', G)
] ]
charToOctave = charToOctave :: Char -> Maybe Octave
flip charToOctave c =
lookup lookup
c
[ ('1', One), [ ('1', One),
('2', Two), ('2', Two),
('3', Three) ('3', Three)
@ -199,8 +202,8 @@ nextGuess (prevGuess, state) prevFeedback = (chosen, newState)
chosen = fst $ minimumBy (comparing snd) scored chosen = fst $ minimumBy (comparing snd) scored
newState = filter (/= chosen) candidates newState = filter (/= chosen) candidates
scored = map ((,) <*> (`score` candidates)) candidates scored = map (\x -> (x, score x candidates)) candidates
candidates = filter ((== prevFeedback) . feedback prevGuess) state candidates = filter (\x -> prevFeedback == feedback prevGuess x) state
-- average number of possible targets per candidate -- average number of possible targets per candidate
score candidate candidates = ((/) `on` fromIntegral) (sum l) (length l) 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 matches xs ys = maximum permutationMatches
where where
permutationMatches = map (pairwiseMatches xs) (permutations ys) 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 -- 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 -- pitches. this function happens to generate chords such that the pitches are
@ -234,11 +237,12 @@ matches xs ys = maximum permutationMatches
-- --
allChords :: [[Pitch]] allChords :: [[Pitch]]
allChords = allChords =
[ [p1, p2, p3] [ chord
| p1 <- allPitches, | p1 <- allPitches,
p2 <- allPitches, p2 <- allPitches,
p1 < p2,
p3 <- allPitches, p3 <- allPitches,
let chord = [p1, p2, p3],
p1 < p2,
p2 < p3 p2 < p3
] ]
where where
@ -247,3 +251,22 @@ allChords =
| note <- [minBound .. maxBound], | note <- [minBound .. maxBound],
octave <- [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

View file

@ -1,4 +1,12 @@
# Spec # 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` ## Tips to improve `nextGuess`
The best results can be had by carefully choosing each guess so that it is most 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 likely to leave a small remaining list of possible targets. You can do this by

View file

@ -12,4 +12,4 @@ build:
# run musician # run musician
run: run:
./target/{{exec}} time ./target/{{exec}}