{-
 -  Naam    : R.A.J. Wacanno
 -  UvAnetID: 11741163
 -  Studie  : BSc Informatica
 -
 -  MM.hs
 -  - Returns a sequence of guesses for the game Mastermind
 -    based on a given secret code/pattern
 -  - Generates this sequence either using a naive algorithm
 -    or Knuths algorithm.
 -}
module MM
where

import Data.List
import Data.Function (on)
import Control.Monad (replicateM)

data Color      = Red | Yellow | Blue | Green | Orange | Purple
                  deriving (Eq,Show,Bounded,Enum)

type Pattern    = [Color]


--                (# White, # Black)
type Feedback   = (Int, Int)

colors :: [Color]
colors = [minBound..maxBound]

-- A list with all possible patterns.
store = replicateM 4 colors

-- A list with all possible reactions.
reactions = [(wht, blk) | wht <- [0..4], blk <- [0..4],
                                         (wht + blk) <= 4,
                                         (wht, blk) /= (1, 3)]

-- Counts the number of colours which are present in both patterns
-- but not in the same position.
computeWhite :: Pattern -> Pattern -> Int
computeWhite pat1 pat2
    | null pat1 || null pat2 = 0
    | head pat1 `elem` pat2 =  1 + computeWhite (tail pat1)
                                   (delete (head pat1) pat2)
    | otherwise = computeWhite (tail pat1) pat2

-- Counts the number of colours which are present in both patterns
-- and are positioned equally.
computeBlack :: Pattern -> Pattern -> Int
computeBlack pat1 pat2
    | null pat1 || null pat2 = 0
    | head pat1 == head pat2 = 1 + computeBlack (tail pat1) (tail pat2)
    | otherwise = computeBlack (tail pat1) (tail pat2)

-- Returns feedback based on two patterns and the colours and
-- colour positions they share.
reaction :: Pattern -> Pattern -> Feedback
reaction pat1 pat2 = (computeWhite pat1 pat2 - computeBlack pat1 pat2,
                      computeBlack pat1 pat2)

-- Returns a subset of a given list containing those paterns which
-- generate the same reaction as the one given with the given pattern.
filtOnReac :: Feedback -> Pattern -> [Pattern] -> [Pattern]
filtOnReac reac pat pats
    | reac == (0,4) = []
    | otherwise = [x | x <- pats, reac == reaction x pat]

-- Recursive helperfunction which contatinates the first patern in the
-- given list to the recursive result.
naive_algorithm' :: Pattern -> [Pattern] -> [Pattern]
naive_algorithm' _ [] = []
naive_algorithm' secret pats = head pats : naive_algorithm' secret
                                                            (filtOnReac
                                                                (reaction
                                                                    (head pats)
                                                                    secret)
                                                                (head pats)
                                                                pats)

-- Returns a list of guesses with the first guess as the first element
-- and the derived secret as the last element.
naive_algorithm :: Pattern -> [Pattern]
naive_algorithm secret = naive_algorithm' secret store

-- Returns the difference in size between the given and the filtered list.
computeRemove :: Feedback -> Pattern -> [Pattern] -> Int
computeRemove reac pat pats = length pats - length (filtOnReac reac pat pats)

-- Returns the minimum amount of elements removed by filtration in a given list
-- using a given pattern.
minRemove :: Pattern -> [Pattern] -> Int
minRemove pat pats = minimum (foldl (\lastResult reac -> (computeRemove reac
                                                                        pat
                                                                        pats) :
                                                         lastResult)
                                    [] reactions)

-- Returns the pattern with the maximum amount of guaranteed (minimum)
-- removals from a given list. This pattern also originates from the given
-- list, which is not according to Knuths algoritm but does comply with the
-- example output.
maxMinRemove :: [Pattern] -> Pattern
maxMinRemove pats = fst (maximumBy (compare `on` snd)
                                   (foldl (\lastResult pat -> (pat,
                                                               (minRemove
                                                                    pat
                                                                    pats)) :
                                                              lastResult)
                                          [] pats))

-- Recursive helper function which concatinates the pattern with the
-- highest maxmin result to the recursive result. In case the pattern
-- [R,R,Y,Y] is given as the second argument this is set as the
-- maxmin pattern.
knuths_algorithm' :: Pattern -> Pattern -> [Pattern] -> [Pattern]
knuths_algorithm' _ _ [] = []
knuths_algorithm' secret [Red, Red, Yellow, Yellow] pats =
    let maxMinPat = [Red, Red, Yellow, Yellow]
    in maxMinPat : knuths_algorithm' secret [] (filtOnReac (reaction maxMinPat
                                                                     secret)
                                                           maxMinPat
                                                           pats)
knuths_algorithm' secret _ pats =
    let maxMinPat = maxMinRemove pats
    in maxMinPat : knuths_algorithm' secret [] (filtOnReac (reaction maxMinPat
                                                                     secret)
                                                           maxMinPat
                                                           pats)

-- Returns a list with generated guesses based on a given secret.
-- The first element is the hardcoded first guess and the last element
-- is the derived secret.
knuths_algorithm :: Pattern -> [Pattern]
knuths_algorithm secret =
    let fstPat = [Red, Red, Yellow, Yellow]
    in knuths_algorithm' secret fstPat store

-- Returns the average amount of guesses based on a given function.
tester :: (Pattern -> [Pattern]) -> Double
tester func = fromIntegral (foldl (\lastResult pat -> lastResult +
                                                      length
                                                          (func pat))
                                  0 store) / fromIntegral (length store)
