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.
|
-- | 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
|
|
||||||
|
|
|
||||||
49
Proj2.hs
49
Proj2.hs
|
|
@ -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
|
||||||
|
|
|
||||||
|
|
@ -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
|
||||||
|
|
|
||||||
2
justfile
2
justfile
|
|
@ -12,4 +12,4 @@ build:
|
||||||
|
|
||||||
# run musician
|
# run musician
|
||||||
run:
|
run:
|
||||||
./target/{{exec}}
|
time ./target/{{exec}}
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue