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 ======================================================

1
guesses.txt Normal file
View file

@ -0,0 +1 @@
[[""A1"","A3","B2"],["A1","B2","B3"],["A1","B2","D3"],["A1","B2","E3"],["A1","B2","F3"],["A1","B2","G3"],["A1","C2","C3"],["A1","C3","D2"],["A1","C3","E2"],["A1","C3","F2"],["A1","C3","G2"],["B1","B2","C3"],["B2","C1","C3"],["B2","C3","D1"],["B2","C3","E1"],["B2","C3","F1"],["B2","C3","G1"]]