comp30002-project-2/Proj2.hs

-- 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.
--
-- TODO: finish explanation of initialGuess and nextGuess

module Proj2
  ( Pitch,
    toPitch,
    feedback,
    GameState,
    initialGuess,
    nextGuess,
  )
where

import Data.List
import Data.Set qualified as S
import Debug.Trace

-- ==== DATA STRUCTURES =======================================================

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