Compare commits
6 commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
1a5e9a715f | ||
|
|
5103cb7f0e | ||
|
|
5bd5fb0a25 | ||
|
|
1f28cc7cda | ||
|
|
bfdcfde6c9 | ||
|
|
28532a3b3a |
4 changed files with 46 additions and 18 deletions
5
Main.hs
5
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
|
||||
|
|
|
|||
45
Proj2.hs
45
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
|
||||
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
|
||||
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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
2
justfile
2
justfile
|
|
@ -12,4 +12,4 @@ build:
|
|||
|
||||
# run musician
|
||||
run:
|
||||
./target/{{exec}}
|
||||
time ./target/{{exec}}
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue