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.
main :: IO ()
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,
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 =
charToNote =
flip
lookup
c
[ ('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 =
charToOctave =
flip
lookup
c
[ ('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

View file

@ -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

View file

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