MastermindSolver

module Main where
import Data.Char
import qualified Data.Set as S
import qualified Data.List as L

type Quad  = (Int, Int, Int, Int)
type Distance = (Int, Int)
type Move = (Quad, Distance, Int)

main :: IO ()
main = do
    code <- getLine
    putStrLn (solve code)

when :: (a -> Bool) -> a -> (a -> a) -> a -> a
when c r f s
    | c s       = f s
    | otherwise = r

solve :: String -> String
solve = when l l' $ when d d' run
    where l  = (==) 4 . length
          l' = "Enter exactly 4 digits"
          d  = and . map ((`elem` [1..6]) . digitToInt)
          d' = "Only use digits 1-6"

run :: String -> String
run = unlines . map moveToString . knuth . quad . map digitToInt

quad :: [Int] -> Quad
quad [a, b, c, d] = (a, b, c, d)

unquad :: Quad -> [Int]
unquad (a, b, c, d) = [a, b, c, d]

allQuads :: S.Set Quad
allQuads = S.fromList [(x, y, z, w) | x <- [1..6], y <- [1..6], z <- [1..6], w <- [1..6]]

knuth :: Quad -> [Move]
knuth = guess (1, 1, 2, 2) allQuads allQuads

-- Having leftover guesses l and possible answers s
-- Test guess g and determine:
--   l' (l without g)
--   s' (possibilities after answer to g)
--   g' the next guess based on l' and s'
guess :: Quad -> S.Set Quad -> S.Set Quad -> Quad -> [Move]
guess g l s q
    | d == (4,0) = m:[]
    | otherwise  = m:m'
    where g' = S.findMin s' -- TODO: Optimize using the real algo
          l' = S.delete g l
          s' = S.filter (equidistant g d) s
          d  = distance g q
          m  = (g, d, S.size s')
          m' = guess g' l' s' q

equidistant :: Quad -> Distance -> Quad -> Bool
equidistant g d q = distance q g == d

split :: [Int] -> [Int] -> ([(Int, Int)], [(Int, Int)])
split [] [] = ([],[])
split (x:xs) (y:ys)
    | x == y    = ((x,y):z, z')
    | otherwise = (z, (x,y):z')
    where (z, z') = split xs ys

distance :: Quad -> Quad -> Distance
distance g q = (a, b)
    where (x, y)   = split (unquad g) (unquad q)
          a        = length x
          (x', y') = unzip y
          b        = weakDistance x' y'

weakDistance :: [Int] -> [Int] -> Int
weakDistance [] _ = 0
weakDistance (g:gs) q
    | g `elem` q = n+1
    | otherwise  = n
    where n  = weakDistance gs q'
          q' = L.delete g q

moveToString :: Move -> String
moveToString (g, d, s) = "Guessed " ++ g' ++ " result " ++ d' ++ " left " ++ s' ++ " combinations"
    where g' = (map intToDigit . unquad) g
        d' = show d
        s' = show s