249 lines
8.6 KiB
Haskell
249 lines
8.6 KiB
Haskell
-- Will Holdsworth 1353032
|
|
--
|
|
--
|
|
-- Implements toPitch, feedback, initialGuess and nextGuess to efficiently
|
|
-- play the game of musician as both the composer and the performer.
|
|
--
|
|
--
|
|
-- The game of musician is two players, a composer and a performer. The
|
|
-- composer initially creates a three-pitch chord, where each pitch is a
|
|
-- usual musical note (A-G excluding flats and sharps) and an octave 1-3. The
|
|
-- performer must then guess the chord. At each turn, the performer they
|
|
-- provides a guess to the composer who returns with some feedback. The
|
|
-- feedback contains the number of correct pitches in the performer's guess, as
|
|
-- well as the number of correct notes and octaves in the composer's guess.
|
|
--
|
|
-- Note that notes and guesses are not double counted, e.g. if the performer
|
|
-- has been told pitch A1 in their guess is correct, they will not also be
|
|
-- told note A and octave 1 are correct (unless there are multiple instances of
|
|
-- A and/or 1).
|
|
--
|
|
-- As the composer, we must do the following:
|
|
-- 1. create a chord for the performer to guess
|
|
-- 2. provide feedback on the performer's guess
|
|
--
|
|
-- 1. is taken care of by the testing framework, so we only need to handle 2.
|
|
-- in this file. For pitches, find the intersection between the target and the
|
|
-- guess. This will give us the correct pitches (and the number of them). Then
|
|
-- we can remove the correct pitches from the target and the guess and split
|
|
-- up the target and guess into notes and octaves. We then permute the target
|
|
-- and match the guess with each permutation. To match means to count the
|
|
-- number of pairwise equivalences, e.g. if we match the guess [1,2,3] with a
|
|
-- permutation of the target [1,3,2], our "match value" is 2. This operation
|
|
-- can be performed on the notes lists and the octaves lists to get the number
|
|
-- of correct notes and octaves. This feedback is provided to the performer.
|
|
--
|
|
-- As the performer, we must guess the target in as few steps as possible given
|
|
-- the feedback from the composer at each turn.
|
|
--
|
|
-- To pick the best first guess, we play musician with a range of first-guess
|
|
-- candidates and calculate the average number of guesses needed over all
|
|
-- targets. The guess with the lowest average was [A1, D2, G3]. some
|
|
-- justifying metrics are provided in a comment above `initialGuess`.
|
|
--
|
|
-- To pick the best next guess, we filter the game state to contain only
|
|
-- targets that are consistent with the received feedback from the previous
|
|
-- guess. We then calculate, for each candidate, the average number of guesses
|
|
-- that would remain if we chose it as the next guess. We can then choose the
|
|
-- candidate that has the smallest of this number as the next guess.
|
|
|
|
module Proj2
|
|
( Pitch,
|
|
toPitch,
|
|
feedback,
|
|
GameState,
|
|
initialGuess,
|
|
nextGuess,
|
|
)
|
|
where
|
|
|
|
import Data.Function
|
|
import Data.List
|
|
import Data.Map qualified as Map
|
|
import Data.Ord
|
|
import Data.Set qualified as Set
|
|
|
|
-- ==== DATA STRUCTURES =======================================================
|
|
|
|
-- contains possible guesses. a possible guess is consistent with all current
|
|
-- and previous feedback given by the composer
|
|
--
|
|
type GameState = [[Pitch]]
|
|
|
|
-- represents a pitch, which is made of a note and a chord
|
|
--
|
|
data Pitch = Pitch
|
|
{ note :: Note,
|
|
octave :: Octave
|
|
}
|
|
deriving (Eq, Ord)
|
|
|
|
instance Show Pitch where
|
|
show (Pitch note octave) = show note ++ show octave
|
|
|
|
-- represents a standard musical note
|
|
--
|
|
data Note = A | B | C | D | E | F | G
|
|
deriving (Bounded, Enum, Eq, Ord, Show)
|
|
|
|
-- represents an octave of 1, 2 or 3
|
|
--
|
|
data Octave = One | Two | Three
|
|
deriving (Bounded, Enum, Eq, Ord)
|
|
|
|
instance Show Octave where
|
|
show One = "1"
|
|
show Two = "2"
|
|
show Three = "3"
|
|
|
|
-- ==== REQUIRED FUNCTIONS ====================================================
|
|
|
|
-- takes in a pitch-like string as input and outputs a pitch if conversion was
|
|
-- successful, or nothing if it failed. a "pitch-like" string can be something
|
|
-- like "A1" or "B2"
|
|
--
|
|
-- used in the testing framework as a utility function
|
|
--
|
|
toPitch :: String -> Maybe Pitch
|
|
toPitch [note, octave] = Pitch <$> charToNote note <*> charToOctave octave
|
|
where
|
|
charToNote =
|
|
flip
|
|
lookup
|
|
[ ('A', A),
|
|
('B', B),
|
|
('C', C),
|
|
('D', D),
|
|
('E', E),
|
|
('F', F),
|
|
('G', G)
|
|
]
|
|
charToOctave =
|
|
flip
|
|
lookup
|
|
[ ('1', One),
|
|
('2', Two),
|
|
('3', Three)
|
|
]
|
|
toPitch _ = Nothing
|
|
|
|
-- takes a target chord (usually created by the composer) and a guess chord,
|
|
-- and outputs an integer 3-tuple of feedback, where each element is the
|
|
-- number of correct items in the guess:
|
|
--
|
|
-- (pitches, notes, octaves)
|
|
--
|
|
-- as per the explanation at the top of this file, notes and octaves are not
|
|
-- double-counted
|
|
--
|
|
-- used in the testing framework as a utility function, and also by the
|
|
-- performer to decide on the best guess to make each turn
|
|
--
|
|
feedback :: [Pitch] -> [Pitch] -> (Int, Int, Int)
|
|
feedback target guess = (pitches, notes, octaves)
|
|
where
|
|
-- since pitches are unique in a guess,
|
|
-- we can use set math to count how many are correct
|
|
targetSet = Set.fromList target
|
|
guessSet = Set.fromList guess
|
|
|
|
pitchSet = Set.intersection targetSet guessSet
|
|
pitches = length pitchSet
|
|
|
|
-- 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
|
|
targetNoPitches = Set.toList $ Set.difference targetSet pitchSet
|
|
guessNoPitches = Set.toList $ Set.difference guessSet pitchSet
|
|
notes = matches (map note targetNoPitches) (map note guessNoPitches)
|
|
octaves = matches (map octave targetNoPitches) (map octave guessNoPitches)
|
|
|
|
-- outputs a 2-tuple of the "best first guess" and the initial game state,
|
|
-- which is all possible starting guesses. characteristics of these guesses
|
|
-- are described in the documentation for `allChords`
|
|
--
|
|
-- a pretty good first guess was found by playing musician over all possible
|
|
-- targets and calculating the average number of guesses (given a first guess)
|
|
--
|
|
-- here are some convincing metrics:
|
|
--
|
|
-- [A1, D2, G3]: 4.25
|
|
-- [C1, D2, E3]: 4.27
|
|
-- [A2, D2, G2]: 4.32
|
|
-- [C2, D2, E2]: 4.34
|
|
-- [D1, D2, D3]: 4.80
|
|
--
|
|
-- we choose [A1, D2, G3] as it has the lowest average number of guesses
|
|
--
|
|
initialGuess :: ([Pitch], GameState)
|
|
initialGuess = (bestFirstGuess, allChords)
|
|
where
|
|
bestFirstGuess =
|
|
[ Pitch A One,
|
|
Pitch D Two,
|
|
Pitch G Three
|
|
]
|
|
|
|
-- takes in the previous guess, the game state, and the feedback for the
|
|
-- previous guess and outputs the next guess and a (reduced in size) game state
|
|
--
|
|
-- strategy:
|
|
-- 1. reduce the size of the search space by removing all guesses inconsistent
|
|
-- with the answer received for the previous guess.
|
|
-- 2. for each candidate, calculate the average number of remaining targets
|
|
-- 3. choose the candidate with the smallest average
|
|
--
|
|
nextGuess :: ([Pitch], GameState) -> (Int, Int, Int) -> ([Pitch], GameState)
|
|
nextGuess (prevGuess, state) prevFeedback = (chosen, newState)
|
|
where
|
|
chosen = fst $ minimumBy (comparing snd) scored
|
|
newState = filter (/= chosen) candidates
|
|
|
|
scored = map ((,) <*> (`score` candidates)) candidates
|
|
candidates = filter ((== prevFeedback) . feedback prevGuess) state
|
|
|
|
-- average number of possible targets per candidate
|
|
score candidate candidates = ((/) `on` fromIntegral) (sum l) (length l)
|
|
where
|
|
l =
|
|
Map.elems $
|
|
Map.fromListWith
|
|
(+)
|
|
[(feedback candidate target, 1) | target <- candidates]
|
|
|
|
-- ==== HELPER FUNCTIONS ======================================================
|
|
|
|
-- given lists xs and ys, calculates the maximum number of pairwise matches
|
|
-- between xs and all permutations of ys
|
|
--
|
|
-- used in the feedback function to calculate the number of correct notes
|
|
-- and/or octaves
|
|
--
|
|
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
|
|
|
|
-- 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
|
|
-- in alphabetical order, but this is only to ensure that there are no
|
|
-- duplicate pitches
|
|
--
|
|
-- used in initialGuess as the game state (represents all possible targets)
|
|
--
|
|
allChords :: [[Pitch]]
|
|
allChords =
|
|
[ [p1, p2, p3]
|
|
| p1 <- allPitches,
|
|
p2 <- allPitches,
|
|
p1 < p2,
|
|
p3 <- allPitches,
|
|
p2 < p3
|
|
]
|
|
where
|
|
allPitches =
|
|
[ Pitch note octave
|
|
| note <- [minBound .. maxBound],
|
|
octave <- [minBound .. maxBound]
|
|
]
|