初学 Haskell 练习：算24点

其中用到了 Monad 做不确定性计算。运行速度很快。

-- woodfox, Oct 10, 2014
import Control.Applicative
import Control.Monad
import Data.List

operators = [("+", (+)), ("-", (-)), ("*", (*)), ("/", (/))]

find_op :: String -> (Float -> Float -> Float)
find_op op_name = let (k, v):[] = filter (\(name, op) -> name == op_name) operators
                  in v

compose :: [Float] -> [String] -> [(Float, String)]
compose nums op_names = let a:b:c:d:[] = nums
                            f1name:f2name:f3name:[] = op_names
                            f1:f2:f3:[] = map find_op op_names

                            r1 = f3 (f1 a b) (f2 c d)
                            s1 = "(" ++ show a ++ f1name ++ show b ++ ")" ++ f3name ++ "(" ++ show c ++ f2name ++ show d ++ ")"
                            r2 = f3 (f2 (f1 a b) c) d
                            s2 = "((" ++ show a ++ f1name ++ show b ++ ")" ++ f2name ++ show c ++ ")" ++ f3name ++ show d
                            r3 = f3 (f2 a (f1 b c)) d
                            s3 = "(" ++ show a ++ f2name ++ "(" ++ show b ++ f1name ++ show c ++ "))" ++ f3name ++ show d
                            r4 = f3 a (f2 (f1 b c) d)
                            s4 = show a ++ f3name ++ "((" ++ show b ++ f1name ++ show c ++ ")" ++ f2name ++ show d ++ ")"
                            r5 = f3 a (f2 b (f1 c d))
                            s5 = show a ++ f3name ++ "(" ++ show b ++ f2name ++ "(" ++ show c ++ f1name ++ show d ++ "))"
                        in [(r1,s1), (r2,s2), (r3,s3), (r4,s4), (r5,s5)]

-- http://stackoverflow.com/questions/11358979/list-permutations-in-haskell
permute :: Eq a => [a] -> [[a]]
permute [] = [[]]
permute xs = concatMap (\x -> map (x:) $ permute $ delete x xs) xs

calc24 :: [Float] -> [String]
calc24 nums = do
	-- i <- nums
	-- j <- nums
	-- m <- nums
	-- n <- nums
	-- guard (i /= j && i /= m && i /= n && j /= m && j /= n && m /= n)

	i:j:m:n:[] <- (permute nums)

	(f1name, _) <- operators
	(f2name, _) <- operators
	(f3name, _) <- operators

	(result, str) <- (compose [i,j,m,n] [f1name, f2name, f3name])
	-- guard (result == 24)
	guard (abs (result - 24) < 0.00001)
	return str

测试：

*Main> calc24 [5,6,7,8]
["(5.0+7.0)*(8.0-6.0)","((5.0+7.0)-8.0)*6.0","(5.0+(7.0-8.0))*6.0","((5.0-8.0)+7.0)*6.0","(5.0-(8.0-7.0))*6.0","6.0*((5.0+7.0)-8.0)","6.0*(5.0+(7.0-8.0))","6.0*((5.0-8.0)+7.0)","6.0*(5.0-(8.0-7.0))","6.0*((7.0+5.0)-8.0)","6.0*(7.0+(5.0-8.0))","(6.0/(7.0-5.0))*8.0","6.0/((7.0-5.0)/8.0)","6.0*((7.0-8.0)+5.0)","6.0*(7.0-(8.0-5.0))","6.0*(8.0/(7.0-5.0))","(6.0*8.0)/(7.0-5.0)","(7.0+5.0)*(8.0-6.0)","((7.0+5.0)-8.0)*6.0","(7.0+(5.0-8.0))*6.0","((7.0-8.0)+5.0)*6.0","(7.0-(8.0-5.0))*6.0","(8.0-6.0)*(5.0+7.0)","(8.0-6.0)*(7.0+5.0)","8.0*(6.0/(7.0-5.0))","(8.0*6.0)/(7.0-5.0)","(8.0/(7.0-5.0))*6.0","8.0/((7.0-5.0)/6.0)"]

*Main> calc24 [8,10,3,2]
["(8.0+10.0)+(3.0*2.0)","8.0+(10.0+(3.0*2.0))","(8.0+10.0)+(2.0*3.0)","8.0+(10.0+(2.0*3.0))","(8.0+(3.0*2.0))+10.0","8.0+((3.0*2.0)+10.0)","(8.0+(2.0*3.0))+10.0","8.0+((2.0*3.0)+10.0)","(10.0+8.0)+(3.0*2.0)","10.0+(8.0+(3.0*2.0))","(10.0+8.0)+(2.0*3.0)","10.0+(8.0+(2.0*3.0))","((10.0*3.0)-8.0)+2.0","(10.0*3.0)-(8.0-2.0)","(10.0+(3.0*2.0))+8.0","10.0+((3.0*2.0)+8.0)","((10.0*3.0)+2.0)-8.0","(10.0*3.0)+(2.0-8.0)","(10.0+(2.0*3.0))+8.0","10.0+((2.0*3.0)+8.0)","((3.0*10.0)-8.0)+2.0","(3.0*10.0)-(8.0-2.0)","((3.0*10.0)+2.0)-8.0","(3.0*10.0)+(2.0-8.0)","(3.0*2.0)+(8.0+10.0)","((3.0*2.0)+8.0)+10.0","(3.0*2.0)+(10.0+8.0)","((3.0*2.0)+10.0)+8.0","(2.0-8.0)+(10.0*3.0)","2.0-(8.0-(10.0*3.0))","(2.0-8.0)+(3.0*10.0)","2.0-(8.0-(3.0*10.0))","(2.0+(10.0*3.0))-8.0","2.0+((10.0*3.0)-8.0)","(2.0*3.0)+(8.0+10.0)","((2.0*3.0)+8.0)+10.0","(2.0*3.0)+(10.0+8.0)","((2.0*3.0)+10.0)+8.0","(2.0+(3.0*10.0))-8.0","2.0+((3.0*10.0)-8.0)"]

补充一个测试，3，3，8，8 算 24点可以得到正确答案（已修正）：

*Main> calc24 [3,3,8,8]
["8.0/(3.0-(8.0/3.0))","8.0/(3.0-(8.0/3.0))","8.0/(3.0-(8.0/3.0))","8.0/(3.0-(8.0/3.0))"]