puzzle http://www.guokr.com/post/67426/

puzzle.hs

import Data.List
import Data.Function
import Control.Monad

groupOn f = groupBy ((==) `on` f) . sortBy (compare `on` f)
uniq = map (!! 0) . groupOn id

-- 场景：假设a得到了数字x，b得到了数字y
-- 可看做二分图，其中possibleX，possibleY是顶点，possible是边，(aGuessY x)和(bGuessX y)分别表达x点和y点的邻接点集
possibleX = [4..198]
possibleY = [i * j | i <- [2 .. 99], j <- [2 .. 99], j >= i]

aGuess x = [(i, j) | i <- [2 .. x - 2], let j = x - i, j >= i]
bGuess x = [(i, j) | i <- [2 .. x `div` 2], let j = x `div` i, j >= i, j * i == x]

aGuessY x = map (\(i, j) -> i * j) $ aGuess x
bGuessX x = map (\(i, j) -> i + j) $ bGuess x

-- A说“我不知道，并且我确定你也不知道”
xs = [x | x <- possibleX, (length $ aGuessY x) > 1, (all ((>1) . length) [bGuessX y | y <- aGuessY x])]

-- B说“我现在知道了！”
ys = [y | y <- (uniq $ join $ map aGuessY $ xs), (length $ intersect (bGuessX y) xs) == 1]

-- A说“我现在也知道了！”
xs2 = [x | x <- intersect xs (uniq $ join $ map bGuessX $ ys), (length $ intersect (aGuessY x) ys) == 1]

-- 结论
rst' = [(x, y) | x <- xs2, y <- intersect (aGuessY x) ys]
rst = join [[(i, j) | i <- [2..99], j <- [i..99], i + j == x, i * j == y] | (x, y) <- rst']

-- rst' == [(17,52)]
-- rst == [(4,13)]