{-
 -
 -}
module MM
where

import Data.List
import Data.Function (on)
import Control.Monad (replicateM)
-- Imported to allow the usage of parMap.
--import Control.Parallel.Strategies

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]

store = replicateM 4 colors

reactions = [(wht, blk) | wht <- [0..4], blk <- [0..4], (wht + blk) <= 4, (wht, blk) /= (1, 3)]


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

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)

reaction :: Pattern -> Pattern -> Feedback
reaction pat1 pat2 = (computeWhite pat1 pat2 - computeBlack pat1 pat2,
                      computeBlack pat1 pat2)

filtOnReac :: Feedback -> Pattern -> [Pattern] -> [Pattern]
filtOnReac reac pat pats
    | reac == (0,4) = []
    | otherwise = [x | x <- pats, reac == reaction x pat]

naive_algorithm' :: Pattern -> [Pattern] -> [Pattern]
naive_algorithm' _ [] = []
naive_algorithm' secret pats = head pats : naive_algorithm' secret (filtOnReac (reaction (head pats) secret) (head pats) pats)

naive_algorithm :: Pattern -> [Pattern]
naive_algorithm secret = naive_algorithm' secret store

computeRemove :: Feedback -> Pattern -> [Pattern] -> Int
computeRemove reac pat pats = length pats - length (filtOnReac reac pat pats)

minRemove :: Pattern -> [Pattern] -> Int
minRemove pat pats = minimum (foldl (\lastResult reac -> (computeRemove reac pat pats) : lastResult) [] reactions)
--minRemove pat pats = minimum (map (\reac -> (computeRemove reac pat pats)) reactions)

maxMinRemove :: [Pattern] -> Pattern
maxMinRemove pats = fst (maximumBy (compare `on` snd) (foldl (\lastResult pat -> (pat, (minRemove pat pats)) : lastResult) [] pats))
--maxMinRemove pats = fst (maximumBy (compare `on` snd) (map (\pat -> (pat, (minRemove pat pats))) store))

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)

knuths_algorithm :: Pattern -> [Pattern]
knuths_algorithm secret =
    let fstPat = [Red, Red, Yellow, Yellow]
    in knuths_algorithm' secret fstPat store

tester :: (Pattern -> [Pattern]) -> Double
tester func = (fromIntegral (foldl (\lastResult pat -> lastResult + length (func pat)) 0 store)) / (fromIntegral (length store))
