138 lines
3 KiB
Haskell
138 lines
3 KiB
Haskell
-- Will Holdsworth 1353032
|
|
--
|
|
--
|
|
|
|
module Proj2
|
|
( Pitch,
|
|
toPitch,
|
|
feedback,
|
|
GameState,
|
|
initialGuess,
|
|
nextGuess,
|
|
)
|
|
where
|
|
|
|
import Data.List
|
|
import Data.Set qualified as S
|
|
import Debug.Trace
|
|
|
|
-- datatypes --
|
|
|
|
type GameState = [[Pitch]]
|
|
|
|
data Note = A | B | C | D | E | F | G
|
|
deriving (Eq, Show, Ord, Enum, Bounded)
|
|
|
|
data Octave = One | Two | Three
|
|
deriving (Eq, Ord, Enum, Bounded)
|
|
|
|
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
|
|
|
|
--
|
|
|
|
-- required functions --
|
|
|
|
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
|
|
-- since pitches are unique in a guess,
|
|
-- we can use set math to count how many are correct
|
|
targetSet = S.fromList target
|
|
guessSet = S.fromList guess
|
|
|
|
correctPitches = S.intersection targetSet guessSet
|
|
|
|
newTarget = S.toList $ S.difference targetSet correctPitches
|
|
newGuess = S.toList $ S.difference guessSet correctPitches
|
|
|
|
(targetNotes, guessNotes) = (map note newTarget, map note newGuess)
|
|
(targetOctaves, guessOctaves) = (map octave newTarget, map octave newGuess)
|
|
|
|
-- since notes and octaves are not unique in a guess,
|
|
-- we can compare the guess to all possible permutations of the target
|
|
-- and count the pairwise note/octave matches
|
|
correctNotes = matches targetNotes guessNotes
|
|
correctOctaves = matches targetOctaves guessOctaves
|
|
|
|
initialGuess :: ([Pitch], GameState)
|
|
initialGuess = (chord, chords)
|
|
where
|
|
chord : chords = allChords
|
|
|
|
-- implement me
|
|
nextGuess :: ([Pitch], GameState) -> (Int, Int, Int) -> ([Pitch], GameState)
|
|
nextGuess (prevGuess, chord : chords) _ = (chord, chords)
|
|
|
|
--
|
|
|
|
-- helper functions --
|
|
|
|
allChords :: [[Pitch]]
|
|
allChords =
|
|
[ chord
|
|
| p1 <- allPitches,
|
|
p2 <- allPitches,
|
|
p3 <- allPitches,
|
|
let chord = [p1, p2, p3],
|
|
length (nub chord) == 3,
|
|
p1 < p2,
|
|
p2 < p3
|
|
]
|
|
|
|
allPitches :: [Pitch]
|
|
allPitches =
|
|
[ Pitch note octave
|
|
| note <- allNotes,
|
|
octave <- allOctaves
|
|
]
|
|
|
|
allOctaves :: [Octave]
|
|
allOctaves = [minBound .. maxBound]
|
|
|
|
allNotes :: [Note]
|
|
allNotes = [minBound .. maxBound]
|
|
|
|
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
|
|
|
|
--
|