fork download
  1. import Data.Array.IO
  2. import Data.Char
  3. import System.IO
  4. import Control.Monad
  5. import Control.Applicative
  6.  
  7. one :: [a] -> [(a, [a])]
  8. one xs = sub xs []
  9. where
  10. sub [] _ = []
  11. sub (x:xs) ac = (x, xs++ac) : (sub xs (x:ac))
  12.  
  13. two :: [a] -> [(a, a, [a])]
  14. two [] = []
  15. two [a] = []
  16. two xs = do
  17. (x, rest) <- one xs
  18. do
  19. (y, rest) <- one rest
  20. return (x, y, rest)
  21.  
  22. data Expr = Val Int | Add Expr Expr | Sub Expr Expr | Mul Expr Expr
  23. type Number = (Expr, Int)
  24.  
  25. eval :: Number -> Int
  26. eval = snd
  27.  
  28. apply :: [Number] -> [[Number]]
  29. apply xs = concat $ do
  30. ((e, x), (f, y), rest) <- two xs
  31. (Add e f, x + y) : rest,
  32. (Sub e f, x - y) : rest,
  33. (Mul e f, x * y) : rest
  34. ]
  35.  
  36. bfs :: Int -> [[Number]] -> [Number]
  37. bfs n [] = []
  38. bfs n ([x] : rest) =
  39. (if (eval x) == n then [x] else []) ++ (bfs n rest)
  40. bfs n (xs : rest) = bfs n (rest ++ (apply xs))
  41.  
  42. instance Show Expr where
  43. show (Val n) = show n
  44. show (Add e f) = "(" ++ show e ++ " + " ++ show f ++ ")"
  45. show (Sub e f) = "(" ++ show e ++ " - " ++ show f ++ ")"
  46. show (Mul e f) = "(" ++ show e ++ " * " ++ show f ++ ")"
  47.  
  48. toVal :: Int -> Number
  49. toVal n = (Val n, n)
  50.  
  51. solve a b c d = do
  52. let anss = bfs 10 [[toVal a, toVal b, toVal c, toVal d]]
  53. if null anss
  54. then print 0
  55. else print $ fst $ head $ anss
  56.  
  57. main = do
  58. [a,b,c,d] <- (map read . words)<$>getLine :: IO [Int]
  59. if (minimum [a,b,c,d]) == 0
  60. then return ()
  61. else solve a b c d >> main
  62.  
  63.  
Success #stdin #stdout 0.06s 4780KB
stdin
1 1 1 1
9 9 9 9
1 2 3 4
2 3 4 5
0 0 0 0
stdout
0
0
(((1 + 2) + 3) + 4)
(5 - ((2 - 3) - 4))