import Prelude hiding (length)
import Random
import Control.Monad
import Data.List (minimumBy)
import Debug.Trace

{-
 - A better-than-bruteforce approach to the NP-Complete
 - Carpenter's Ruler problem
 -}

problemSize = 1000
problemLen = 40


type Length = Integer

data Solution = Solution Length Length deriving Show

solution :: Length -> Length -> Solution
solution x y = Solution (min x y) (max x y)

length :: Solution -> Length
length (Solution small large) = small + large

instance Eq Solution where
    Solution s l == Solution s' l' =
        s == s' && l == l'

compareLengths :: Solution -> Solution -> Ordering
compareLengths (Solution s l) (Solution s' l') =
    compare (s + l) (s' + l')

type SolutionSet = [Solution]

better :: Solution -> Solution -> Bool
-- When is one solution _guarenteed_ to outperform another?
better (Solution small large) (Solution small' large') =
    (small < small' && large <= large')
    || (small <= small' && large < large')

insert :: Solution -> SolutionSet -> SolutionSet
insert solution [] = [solution]
insert solution (s : ss)
    | better solution s = insert solution ss
    | better s solution = s : ss
    | s == solution = s : ss
    | otherwise = s : insert solution ss

merge :: SolutionSet -> SolutionSet -> SolutionSet
merge [] set = set
merge (s : ss) set = merge ss (insert s set)

addJoint :: Length -> Solution -> SolutionSet
addJoint len (Solution small large)
    | len <= small = [solution (small - len) (large + len),
                      solution (small + len) (large - len)]
    | len >= large = [solution 0 (small + len)]
    | otherwise = [solution 0 (large + len),
                   solution (small + len) (large - len)]

iteration :: SolutionSet -> Length -> SolutionSet
iteration solutions len =
    trace (show solutions) $
    foldl1 merge $ map (addJoint len) solutions

bestSolution :: SolutionSet -> Length
bestSolution = length . minimumBy compareLengths

solve :: [Length] -> Length
solve (len : lens) = bestSolution $ foldl iteration [solution 0 len] lens

left :: Solution -> Length -> Solution
left (Solution small large) len
    | len <= small = solution (small - len) (large + len)
    | otherwise = solution 0 (large + len)

right :: Solution -> Length -> Solution
right (Solution small large) len
    | len <= large = solution (small + len) (large - len)
    | otherwise = solution 0 (small + len)

both :: Length -> Solution -> [Solution]
both len solution = [left solution len, right solution len]

allSolutions :: SolutionSet -> [Length] -> SolutionSet
allSolutions solutions [] = solutions
allSolutions solutions (len : lens) =
    allSolutions (concat $ map (both len) solutions) lens

bruteForce :: [Length] -> Length
bruteForce (len : lens) =
    bestSolution $ allSolutions [Solution 0 len] lens

generateLength :: IO Length
generateLength = do
  len <- randomIO
  return (mod len problemSize)

generateProblem :: IO [Length]
generateProblem = replicateM problemLen generateLength

main = do
  problem <- generateProblem
  putStrLn $ "Problem: " ++ show problem
  putStrLn $ "Quick Solution: " ++ show (solve problem)
  --putStrLn $ "Brute Solution: " ++ show (bruteForce problem)