feat: reduce the size of the search space by acknowledging that there are <=10 distinct feedbacks vs 1330 targets

This commit is contained in:
wi11-holdsworth 2025-10-07 13:37:27 +11:00
parent 91a65cdb60
commit 8f07d1a83c

View file

@ -36,7 +36,13 @@
-- As the performer, we must guess the target in as few steps as possible given
-- the feedback from the composer at each turn.
--
-- TODO: finish explanation of initialGuess and nextGuess
-- TODO: finish explanation of 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 maximum 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,
@ -49,10 +55,9 @@ module Proj2
where
import Data.List
import Data.Map qualified as M
import Data.Ord (comparing)
import Data.Set qualified as S
import Debug.Trace
import Text.XHtml (target)
-- ==== DATA STRUCTURES =======================================================
@ -163,8 +168,8 @@ initialGuess = (bestFirstGuess, allChords)
-- TODO: is this really the best first guess?
bestFirstGuess =
[ Pitch A One,
Pitch B Two,
Pitch C Three
Pitch D Two,
Pitch G Three
]
-- takes in the previous guess, the game state, and the feedback for the
@ -173,25 +178,25 @@ initialGuess = (bestFirstGuess, allChords)
-- strategy:
-- 1. reduce the size of the search space by removing all guesses inconsistent
-- with the answer received for the previous guess.
-- 2. TODO: mini-max?
-- 2. for each candidate, calculate the worst case number of remaining target
-- 3. choose the candidate with the smallest of this number
--
nextGuess :: ([Pitch], GameState) -> (Int, Int, Int) -> ([Pitch], GameState)
-- nextGuess (prevGuess, chords) answer | trace ("calling nextGuess with: " ++ show prevGuess ++ show chords ++ show answer) False = undefined
nextGuess (prevGuess, chords) answer = (guess, consistentChords)
nextGuess (prevGuess, state) prevFeedback = (chosen, newState)
where
consistentChords = filter (consistentWith answer) chords
scoredGuesses = map (\x -> (x, averageNumTargets x)) consistentChords
guess = fst $ minimumBy (comparing snd) scoredGuesses
chosen = fst $ minimumBy (comparing snd) scored
newState = filter (/= chosen) candidates
-- helper functions
consistentWith answer chord = answer == feedback prevGuess chord
averageNumTargets answer = map (`squaredFreqs` consistentChords) consistentChords
squaredFreqs answer = map ((^ 2) . length) . group . sort . map (feedback answer)
averageFreqs answer chords = sum freqs `div` length freqs
where
freqs = squaredFreqs answer chords
scored = map (\x -> (x, score x candidates)) candidates
candidates = filter (\x -> prevFeedback == feedback prevGuess x) state
-- TODO: implement me
-- maximum number of possible targets per candidate
score candidate candidates =
maximum $
M.elems $
M.fromListWith
(+)
[(feedback candidate target, 1) | target <- candidates]
-- ==== HELPER FUNCTIONS ======================================================