Declarative Project 1
===

###### tags: `declarative` `comp30020`

--  File     : Proj1.hs
--  Author   : Austen McClernon
--  Origin   : Thursday Sep 5 09:30:02 2019
--  Purpose  : Project 1 Submission, COMP30020, Declarative Programming.
--
-- This file implements functions that define an Agent that plays 'CardGuesser'
--
-- Card Guesser is a game where an 'answer' is selected. The 'answer' is a list 
-- of distinct western playing cards. The cards are taken from a deck of 52 
-- cards, where jokers are not included (e.g. '4C' four clubs,'TS' ten spades).
-- The 'guesser' then acts to correctly guess the answer via repeated guesses, 
-- informed by feedback in the form of a tuple. The 'feedback' function details
-- this.
--
-- This guess function solves this problem via generating every single possible
-- 'answer' for a given size & pruning this list via selecting guesses that 
-- would prune the GameState as much as possible. This is explained in the 
-- functions 'bestGuess' and 'guessScore'

module Proj1 (feedback, initialGuess, nextGuess, GameState) where

  import Data.List 
  import Data.Ord
  import Card
  
  
  -- | GameState represents a list of remaining possible answers
  --   Feedback represents the scoring format defined by the project
  --   specification. 
  newtype GameState = GameState [[Card]]
  type Feedback = (Int, Int, Int, Int, Int)
  
  
  -- | Takes a target & guess containing a list of cards of equal length, 
  --   returns tuple of five integers:
  --   1. size of intersection between target & guess
  --   2. number of cards with a rank strictly less than the lowest ranked card 
  --      in guess, from target
  --   3. size of intersection between target (rank only) & guess (rank only)
  --   4. number of cards with a rank strictly greater than the highest ranked 
  --      card in guess, from target
  --   5. size of intersection between target (suit only) & guess (suit only)
  feedback :: [Card] -> [Card] -> Feedback
  feedback target guess = (cardOverlap, cardsLesser, rankOverlap, 
                           cardsGreater, suitOverlap)
    where
      cardOverlap  = l (target `intersect` guess)
      cardsLesser  = l (filter (< minimum (map rank guess)) (map rank target))
      rankOverlap  = l (map rank target \\ (map rank target \\ map rank guess))
      cardsGreater = l (filter (> maximum (map rank guess)) (map rank target))
      suitOverlap  = l (map suit target \\ (map suit target \\ map suit guess))
      l            = length
  
  
  -- | Generates an initial guess, and a new game state enumerating every
  --   possible answer. The first guess is a logical spread of both Rank & Suit
  --   to eliminate the most possible answers (on average)
  initialGuess ::  Int -> ([Card],GameState)
  initialGuess  n = (cardSelection, makeGameState)
    where
      cardSelection = combineSelect n
      makeGameState = GameState (combsOfSizeK n cardSet)
  
  
  -- | Generates a list of cards, where rank is equally distant to both
  --   the first and last rank (2, Ace) & the other ranks selected. Suit,
  --   is then selected for minimal overlap. Refer to spec for +1 divison
  --   
  combineSelect :: Int -> [Card]
  combineSelect n = zipWith (\x y -> cardSet !! (x * numRanks + y)) 
                             selectSuits selectRank
    where
       selectRank   = [ x * (numRanks `div` (n + 1)) | x <- [1..n] ]
       selectSuits  = [ x `mod` numSuits | x <- [1..n]]
       numRanks     = length ([minBound..maxBound]::[Rank]) 
       numSuits     = length ([minBound..maxBound]::[Suit])
  
  
  -- | Prunes the game state such that only the guesses that would give the 
  --   same feedback, if we were to consider them the answer & using our
  --   previous guess. Based on this, the right guess is generated.
  nextGuess ::  ([Card],GameState)->Feedback->([Card],GameState)
  nextGuess (prevGuess, GameState possible) res = (reduction, state)
    where
      state        = reduce (prevGuess, GameState possible) res
      reduction = selectMethod state state
  
  
  -- | Filter's the candidate answers according to Knuth's Mastermind Algorithm.
  --   Where we reduce the pool of possible answers, by comparing the feedback
  --   received from the previous guess against using each of the candidate's 
  --   remaining as the target. Where any candidate that does not give the same
  --   feedback as that which we received in the previous guess, cannot be a 
  --   candidate answer. 
  --   https://bit.ly/2lUClFL for reference 
  reduce :: ([Card], GameState) -> (Int, Int, Int, Int, Int)-> GameState
  reduce (guess, GameState possible) res
   = GameState [ hand | hand <- possible, res == feedback hand guess]
  
  
  -- | Selects the guessing method to be used, if the number of candidate 
  --   answers is less than ~ 1400 then 'bestGuess' is possible - see function
  --   below for details. Otherwise, it is too computationally expensive and
  --   the first possibility is selected
  --   
  --   Further: 
  --   The figure 1400, was settled on via automated testing & timing on a
  --   single thread modern processor, in many cases didn't conclude reliably
  --   in under 10 seconds given the algorithm for finding the best guess is
  --   O(n^2(logn)).
  selectMethod :: GameState -> (GameState -> [Card])
  selectMethod (GameState gs)
                  | length gs < 1400   = bestGuess
                  | otherwise          = getHead
  
  
  -- | Generates the 'best' possible guess, given a game's state
  --   (candidate answers remaining) 'Best' is defined as the guess that when
  --   chosen will, on average result in the lowest number of remaining 
  --   candidates, if it's incorrect. To clarify, it reduces the number of
  --   candidate answers the most, therefore increasing the probability of the
  --   actual answer being selected in a future guess.
  bestGuess :: GameState -> [Card]
  bestGuess (GameState gs) = minimumBy(comparing $ guessScore $ GameState gs) gs
  
  
  -- | Calculates the average number of candidates that will remain, assuming 
  --   the guess is incorrect. Hence providing a 'score' of how effective is at
  --   reducing the size of the candidate pool.
  --
  --  Process:
  --  Given a possible guess, we compare that guess against every other 
  --  'candidate' within the game state we use the feedback function, where
  --  guess is compared to every other 'candidate' as the target. We then map
  --  the feedback of using this guess, over the candidates & group identical
  --  feedback's together. The guess is then scored according to: 
  --  sum (group_size^2) / sum (group_size), where a lower score corresponds to
  --  a higher reduction in candidates, on average if that guess were used.
  guessScore :: GameState -> [Card] -> Double
  guessScore (GameState gs) guess 
    = fromIntegral (sum $ map (^ 2) groupSizes) 
    where
      groupSizes = map length $ (group . sort) $ map (`feedback` guess) gs
  
  
  -- | Helper Function that returns the first group of cards
  --   in the game state of candidate answers
  getHead:: GameState -> [Card]
  getHead (GameState state) = head state
  
  
  -- | Helper function to returns the set of cards [2..A, C..D]
  cardSet :: [Card]
  cardSet = [minBound..maxBound] :: [Card]
  
  
  -- | Returns all combinations of a list, given a selection size using the 
  --   results from right twice, to increase performance above that of the 
  --   naive solution. solution is inspired by analysis of combinations
  --   see this link for further information -- https://bit.ly/2lTogbE
  combsOfSizeK :: Int -> [a] -> [[a]]
  combsOfSizeK k set = let len = length set
                       in if k>len then [] else combsOfSizeK set !! (len-k)
   where
     combsOfSizeK [] = [[[]]]
     combsOfSizeK (x:set) = let right = combsOfSizeK set
                       in zipWith (++) ([]:right) (map (map (x:)) right ++ [[]])