fork download
  1. import Data.List
  2. import Data.Char
  3. import Control.Monad
  4.  
  5. data Expr = Number Int | Op Char
  6. instance Show Expr where
  7. show (Number x) = show x
  8. show (Op ch) = [ch]
  9.  
  10. type Ops a = [(a -> a -> [a], Char )]
  11.  
  12. solve :: (Num a,Eq a) => [Int] -> Int -> Ops a -> [[Expr]]
  13. solve xs ans ops = go [] xs
  14. where
  15. go [x] [] | x == fromIntegral ans = return []
  16. go (x1:x2:l) xs = shift (x1:x2:l) xs `mplus` reduce x1 x2 l xs
  17. go l xs = shift l xs
  18. shift l xs = do
  19. x <- xs
  20. r <- go (fromIntegral x:l) (delete x xs)
  21. return (Number x:r)
  22. reduce x1 x2 l xs = do
  23. (op,ch) <- ops
  24. x3 <- op x1 x2
  25. r <- go (x3:l) xs
  26. return (Op ch:r)
  27.  
  28. ops1 :: Ops Rational
  29. ops1 = [ (add,'+'),(sub,'-'),(mul,'*'),(divZero,'/') ]
  30. where
  31. add a b = return (a+b)
  32. sub a b = return (a-b)
  33. mul a b = return (a*b)
  34. divZero a b | b == 0 = [] | otherwise = return (a/b)
  35.  
  36. ops2 :: Ops Int
  37. ops2 = [ (add,'+'),(sub,'-'),(mul,'*'),(div','/') ]
  38. where
  39. add a b = return (a+b)
  40. sub a b | a < b = [] | otherwise = return (a-b)
  41. mul a b = return (a*b)
  42. div' a b | b == 0 || mod a b /= 0 = []
  43. | otherwise = return (div a b)
  44.  
  45. showExpr :: [Expr] -> String
  46. showExpr = go []
  47. where
  48. go [s] [] = s
  49. go (s1:s2:ss) (op:l) | isOp op = go ((unparen $ unwords [s1,show op,s2]):ss) l
  50. go ss (x:l) = go (show x:ss) l
  51. isOp (Op _) = True
  52. isOp _ = False
  53. unparen s = "(" ++ s ++ ")"
  54.  
  55. main :: IO ()
  56. main = do
  57. let l = do
  58. d1 <- [0..9]
  59. d2 <- [d1..9]
  60. d3 <- [d2..9]
  61. d4 <- [d3..9]
  62. return [d1,d2,d3,d4]
  63. forM_ l $ \xs -> do
  64. let s = map intToDigit xs
  65. let ans1 = solve xs 10 ops1
  66. let ans2 = solve xs 10 ops2
  67. when (null ans1) $ do
  68. putStrLn $ s ++ " no answer"
  69. when (null ans2 && not (null ans1)) $ do
  70. putStrLn $ s ++ " " ++ show (length ans1) ++ " " ++ showExpr (head ans1)
  71.  
Success #stdin #stdout 0.59s 6244KB
stdin
Standard input is empty
stdout
0000 no answer
0001 no answer
0002 no answer
0003 no answer
0004 no answer
0005 no answer
0006 no answer
0007 no answer
0008 no answer
0009 no answer
0011 no answer
0012 no answer
0013 no answer
0014 no answer
0015 no answer
0016 no answer
0017 no answer
0018 no answer
0022 no answer
0023 no answer
0024 no answer
0026 no answer
0027 no answer
0029 no answer
0033 no answer
0034 no answer
0035 no answer
0036 no answer
0038 no answer
0039 no answer
0044 no answer
0045 no answer
0047 no answer
0048 no answer
0049 no answer
0056 no answer
0057 no answer
0058 no answer
0059 no answer
0066 no answer
0067 no answer
0068 no answer
0069 no answer
0077 no answer
0078 no answer
0079 no answer
0088 no answer
0089 no answer
0099 no answer
0111 no answer
0112 no answer
0113 no answer
0114 no answer
0116 no answer
0117 no answer
0122 no answer
0123 no answer
0134 no answer
0144 no answer
0148 no answer
0157 no answer
0158 no answer
0166 no answer
0167 no answer
0168 no answer
0177 no answer
0178 no answer
0188 no answer
0222 no answer
0233 no answer
0236 no answer
0269 no answer
0277 no answer
0279 no answer
0299 no answer
0333 no answer
0335 no answer
0336 no answer
0338 no answer
0344 no answer
0345 no answer
0348 no answer
0359 no answer
0366 no answer
0369 no answer
0388 no answer
0389 no answer
0399 no answer
0444 no answer
0445 no answer
0447 no answer
0448 no answer
0457 no answer
0478 no answer
0479 no answer
0489 no answer
0499 no answer
0566 no answer
0567 no answer
0577 no answer
0588 no answer
0589 no answer
0599 no answer
0666 no answer
0667 no answer
0668 no answer
0677 no answer
0678 no answer
0689 no answer
0699 no answer
0777 no answer
0778 no answer
0788 no answer
0799 no answer
0888 no answer
1111 no answer
1112 no answer
1113 no answer
1122 no answer
1158 2 (8 / (1 - (1 / 5)))
1159 no answer
1169 no answer
1177 no answer
1178 no answer
1179 no answer
1188 no answer
1199 16 (9 * ((1 / 9) + 1))
1337 8 (3 * ((7 / 3) + 1))
1399 no answer
1444 no answer
1499 no answer
1666 no answer
1667 no answer
1677 no answer
1699 no answer
1777 no answer
2257 no answer
3444 no answer
3478 2 (8 * (3 - (7 / 4)))
3669 no answer
3779 no answer
3999 no answer
4444 no answer
4459 no answer
4477 no answer
4558 no answer
4899 no answer
4999 no answer
5668 no answer
5788 no answer
5799 no answer
5899 no answer
6666 no answer
6667 no answer
6677 no answer
6777 no answer
6778 no answer
6888 no answer
6899 no answer
6999 no answer
7777 no answer
7788 no answer
7789 no answer
7799 no answer
7888 no answer
7999 no answer
8899 no answer