Compare commits

..

1 commit

Author SHA1 Message Date
wi11-holdsworth
17587190a5 refactor: idiomatic best-practices 2025-10-08 15:54:14 +11:00
4 changed files with 18 additions and 46 deletions

View file

@ -39,4 +39,7 @@ 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 $ show avgGuesses putStr "Target chord (3 pitches separated by spaces): "
hFlush stdout
text <- getLine
guessTest $ toChord text

View file

@ -54,14 +54,13 @@ module Proj2
GameState, GameState,
initialGuess, initialGuess,
nextGuess, nextGuess,
avgGuesses,
) )
where where
import Data.Function (on) import Data.Function
import Data.List import Data.List
import Data.Map qualified as Map import Data.Map qualified as Map
import Data.Ord (comparing) import Data.Ord
import Data.Set qualified as Set import Data.Set qualified as Set
-- ==== DATA STRUCTURES ======================================================= -- ==== DATA STRUCTURES =======================================================
@ -108,10 +107,9 @@ 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 :: Char -> Maybe Note charToNote =
charToNote c = flip
lookup lookup
c
[ ('A', A), [ ('A', A),
('B', B), ('B', B),
('C', C), ('C', C),
@ -120,10 +118,9 @@ toPitch [note, octave] = Pitch <$> charToNote note <*> charToOctave octave
('F', F), ('F', F),
('G', G) ('G', G)
] ]
charToOctave :: Char -> Maybe Octave charToOctave =
charToOctave c = flip
lookup lookup
c
[ ('1', One), [ ('1', One),
('2', Two), ('2', Two),
('3', Three) ('3', Three)
@ -202,8 +199,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 (\x -> (x, score x candidates)) candidates scored = map ((,) <*> (`score` candidates)) candidates
candidates = filter (\x -> prevFeedback == feedback prevGuess x) state candidates = filter ((== prevFeedback) . feedback prevGuess) 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)
@ -226,7 +223,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 = 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 -- 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
@ -237,12 +234,11 @@ matches xs ys = maximum permutationMatches
-- --
allChords :: [[Pitch]] allChords :: [[Pitch]]
allChords = allChords =
[ chord [ [p1, p2, p3]
| p1 <- allPitches, | p1 <- allPitches,
p2 <- allPitches, p2 <- allPitches,
p3 <- allPitches,
let chord = [p1, p2, p3],
p1 < p2, p1 < p2,
p3 <- allPitches,
p2 < p3 p2 < p3
] ]
where where
@ -251,22 +247,3 @@ 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,12 +1,4 @@
# 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:
time ./target/{{exec}} ./target/{{exec}}