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