90 lines
2 KiB
Haskell
90 lines
2 KiB
Haskell
--
|
|
|
|
module Proj2
|
|
( Pitch,
|
|
toPitch,
|
|
feedback,
|
|
GameState,
|
|
initialGuess,
|
|
nextGuess,
|
|
)
|
|
where
|
|
|
|
import Data.List
|
|
import Data.Set qualified as S
|
|
|
|
type GameState = [[Pitch]]
|
|
|
|
data Note = A | B | C | D | E | F | G
|
|
deriving (Eq, Show, Ord)
|
|
|
|
data Octave = One | Two | Three
|
|
deriving (Eq, Ord)
|
|
|
|
data Pitch = Pitch
|
|
{ note :: Note,
|
|
octave :: Octave
|
|
}
|
|
deriving (Eq, Ord)
|
|
|
|
instance Show Octave where
|
|
show One = "1"
|
|
show Two = "2"
|
|
show Three = "3"
|
|
|
|
instance Show Pitch where
|
|
show (Pitch note octave) = show note ++ show octave
|
|
|
|
toPitch :: String -> Maybe Pitch
|
|
toPitch [note, octave] = Pitch <$> charToNote note <*> charToOctave octave
|
|
where
|
|
charToNote :: Char -> Maybe Note
|
|
charToNote c =
|
|
lookup
|
|
c
|
|
[ ('A', A),
|
|
('B', B),
|
|
('C', C),
|
|
('D', D),
|
|
('E', E),
|
|
('F', F),
|
|
('G', G)
|
|
]
|
|
charToOctave :: Char -> Maybe Octave
|
|
charToOctave c =
|
|
lookup
|
|
c
|
|
[ ('1', One),
|
|
('2', Two),
|
|
('3', Three)
|
|
]
|
|
toPitch _ = Nothing
|
|
|
|
feedback :: [Pitch] -> [Pitch] -> (Int, Int, Int)
|
|
feedback target guess = (length correctPitches, correctNotes, correctOctaves)
|
|
where
|
|
targetSet = S.fromList target
|
|
guessSet = S.fromList guess
|
|
|
|
correctPitches = S.intersection targetSet guessSet
|
|
newTarget = S.difference targetSet correctPitches
|
|
newGuess = S.difference guessSet correctPitches
|
|
|
|
targetNoteSet = S.map note newTarget
|
|
guessNoteSet = S.map note newGuess
|
|
targetOctaveSet = S.map octave newTarget
|
|
guessOctaveSet = S.map octave newGuess
|
|
|
|
correctNotes = length $ S.intersection targetNoteSet guessNoteSet
|
|
correctOctaves = length $ S.intersection targetOctaveSet guessOctaveSet
|
|
|
|
initialGuess :: ([Pitch], GameState)
|
|
initialGuess = ([a1, a2, a3], [[]])
|
|
where
|
|
a1 = Pitch A One
|
|
a2 = Pitch A Two
|
|
a3 = Pitch A Three
|
|
|
|
-- implement me
|
|
nextGuess :: ([Pitch], GameState) -> (Int, Int, Int) -> ([Pitch], GameState)
|
|
nextGuess _ _ = ([], [[]])
|