feat: initial minimax implementation (quite slow!)

This commit is contained in:
wi11-holdsworth 2025-10-03 12:58:05 +10:00
parent ede394ac39
commit 91a65cdb60
2 changed files with 17 additions and 2 deletions

View file

@ -49,8 +49,10 @@ module Proj2
where
import Data.List
import Data.Ord (comparing)
import Data.Set qualified as S
import Debug.Trace
import Text.XHtml (target)
-- ==== DATA STRUCTURES =======================================================
@ -174,10 +176,22 @@ initialGuess = (bestFirstGuess, allChords)
-- 2. TODO: mini-max?
--
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)
where
guess : consistentChords = filter consistentWithAnswer chords
consistentWithAnswer chord = answer == feedback prevGuess chord
consistentChords = filter (consistentWith answer) chords
scoredGuesses = map (\x -> (x, averageNumTargets x)) consistentChords
guess = fst $ minimumBy (comparing snd) scoredGuesses
-- 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
-- TODO: implement me
-- ==== HELPER FUNCTIONS ======================================================