24.hs

import Control.Monad
import Data.List
import Data.Ratio
import Test.Speculate.Utils

data Expr a = T Char (Expr a) (Expr a) | L a deriving Eq
instance Show (Expr Double) where
  show (L a) = show (truncate a)
  show (T op a b) = "(" ++ show a ++ [op] ++ show b ++ ")"
instance Show (Expr Integer) where
  show (L a) = show a
  show (T op a b) = "(" ++ show a ++ [op] ++ show b ++ ")"

puzzles = liftM4 (,,,) [1..13] [1..13] [1..13] [1..13]

ops = T <$> "+-*/"
t1 x y z a b c d = z a (y b (x c d))
t2 x y z a b c d = z a (y (x b c) d)
t3 x y z a b c d = z (y b (x c d)) a
t4 x y z a b c d = z (y (x b c) d) a
t5 x y z a b c d = z (y a b) (x c d)
configs = [uncurry4 $ f x y z | f <- [t1, t2, t3, t4 ,t5],
           x <- ops, y <- ops, z <- ops]
eval (L a) = fromIntegral a
eval (T '+' a b) = eval a + eval b
eval (T '-' a b) = eval a - eval b
eval (T '*' a b) = eval a * eval b
eval (T '/' a b) = eval a / eval b

exprs = ap configs $ map (\(a,b,c,d) -> (L a, L b, L c, L d)) puzzles

sols = filter ((< 1e-8) . abs . (24-) . eval) exprs

extract :: Expr Integer -> [Integer]
extract = sort . e where
  e (L a) = [a]
  e (T _ a b) = e a ++ e b

funny (L _) = False
funny e@(T '/' a b) = funny a || funny b ||
  (\v -> floor v /= ceiling v) (eval e)
funny (T _ a b) = funny a || funny b

solsF = filter (and . map funny)
  $ map (snd <$>)
  $ groupBy ((. fst) . (==) . fst)
  $ sortBy ((. fst) . compare . fst)
  $ zip (map extract sols) sols

main = do print solsF