Haskell: 求解24点问题的多种变体

24点问题

给定一个长度为4的整数数组 cards ，代表你有 4 张卡片，每张卡片上都包含一个整数。您应该使用运算符 [’+’, ‘-’, ‘*’, ‘/’] 和括号 ‘(’ 和 ‘)’ 将这些卡片上的数字排列成数学表达式，以获得值 target。

你须遵守以下规则:

• 除法运算符 ‘/’ 表示有理数除法。例如， 4 /(1 - 2 / 3)= 4 /(1 / 3)= 12
• 每个运算都在两个数字之间。特别是，不能使用 “-” 作为一元运算符。例如，如果 cards =[1,1,1,1] ，则表达式 “-1 -1 -1 -1” 是 不允许 的。
• 你不能把数字串在一起。例如，如果 cards =[1,2,1,2] ，则表达式 “12 + 12” 无效。

如果可以得到这样的表达式，其计算结果为 target ，则以字符串形式返回所有结果为target的表达式，否则返回空列表。

第1种变体

不允许打乱cards数组的顺序，例如在target=24时，1 2 1 7的一个合理答案是(1+2)*(1+7)=24，但是1 1 2 7就不存在合理答案。

思路：分治法，自顶向下求解，当cards数组长度为n时，有n-1种办法把cards数组分成两部分，这两部分的树的全部可能，相互进行组合，会得到最终树的全部可能。记录所有求值等于target的树。

设计实现：

我们用树状结构来表示cards合并过程中的中间值，并利用语法制导实现树的求值、打印。

data Tree = Leaf Int | Add Tree Tree | Sub Tree Tree | Mul Tree Tree | Div Tree Tree deriving (Eq, Ord)

value :: Tree -> Maybe Rational
value (Leaf i) = Just (toRational i)
value (Add t1 t2) = liftA2 (+) (value t1) (value t2)
value (Sub t1 t2) = liftA2 (-) (value t1) (value t2)
value (Mul t1 t2) = liftA2 (*) (value t1) (value t2)
value (Div t1 t2) = value t2 >>= \v2 -> if v2 == 0 then Nothing else (/) <$> (value t1) <*> (pure v2)

priority :: Tree -> Int
priority (Leaf i) = 2
priority (Add t1 t2) = 0
priority (Sub t1 t2) = 0
priority (Mul t1 t2) = 1
priority (Div t1 t2) = 1

prettyPrint :: Tree -> String
prettyPrint (Leaf i) = show i
prettyPrint t@(Add t1 t2) = let
    l = if priority t1 > priority t then prettyPrint t1 else "(" ++ prettyPrint t1 ++ ")"
    r = if priority t2 > priority t then prettyPrint t2 else "(" ++ prettyPrint t2 ++ ")"
    in l ++ "+" ++ r
prettyPrint t@(Sub t1 t2) = let
    l = if priority t1 > priority t then prettyPrint t1 else "(" ++ prettyPrint t1 ++ ")"
    r = if priority t2 > priority t then prettyPrint t2 else "(" ++ prettyPrint t2 ++ ")"
    in l ++ "-" ++ r
prettyPrint t@(Mul t1 t2) = let
    l = if priority t1 > priority t then prettyPrint t1 else "(" ++ prettyPrint t1 ++ ")"
    r = if priority t2 > priority t then prettyPrint t2 else "(" ++ prettyPrint t2 ++ ")"
    in l ++ "*" ++ r
prettyPrint t@(Div t1 t2) = let
    l = if priority t1 > priority t then prettyPrint t1 else "(" ++ prettyPrint t1 ++ ")"
    r = if priority t2 > priority t then prettyPrint t2 else "(" ++ prettyPrint t2 ++ ")"
    in l ++ "/" ++ r

分治法过程

solve1 :: ([Int], Int) -> [String]
solve1 (cards, target) = [prettyPrint t | t <- trees cards, value t == Just (toRational target)] where
    trees [] = []
    trees [i] = [Leaf i]
    trees is = concatMap makeTree [splitAt i is | i <- [1..(length is - 1)]] where
        makeTree (is1, is2) = [n t1 t2 | t1 <- trees is1, t2 <- trees is2, n <- [Add, Sub, Mul, Div]] 

第2种变体

即正规的24点玩法。

思路：分治法，自顶向下求解，当cards数组长度为n时，有2^n 种办法把cards数组分成两部分，这两部分的树的全部可能，相互进行组合，会得到最终树的全部可能。记录所有求值等于target的树。注意组合的先后顺序是在2^n中体现的。

对于结果的去重，我们首先为树状结构定义一个排序。其次，我们排除以加法、乘法为根结点时，左侧大于右侧的树，因为这种树必然会在后续结果中再出现一次。最后，对于trees函数得到的全体树的列表，我们去除相等的树。

-- Tree should support Eq and Ord
data Tree = Leaf Int | Add Tree Tree | Sub Tree Tree | Mul Tree Tree | Div Tree Tree deriving (Eq, Ord)

solve2 :: ([Int], Int) -> [String]
solve2 (cards, target) = [prettyPrint t | t <- trees cards, value t == Just (toRational target)] where
    trees [] = []
    trees [i] = [Leaf i]
    trees is = ordNub $ concatMap makeTree [(is1, is2) | (is1, is2) <- split is, not (null is1), not (null is2)] where
        ordNub l = go Set.empty l where
            go _ [] = []
            go s (x:xs) = if x `Set.member` s then go s xs else x : go (Set.insert x s) xs
        split [] = []
        split [i] = [([i], []), ([], [i])]
        split (i:is) = concatMap (\(is1, is2) -> [(i:is1, is2), (is1, i:is2)]) (split is)
        makeTree (is1, is2) = [n t1 t2 | t1 <- trees is1, t2 <- trees is2, n <- [Sub, Div]] ++ [n t1 t2 | t1 <- trees is1, t2 <- trees is2, t1 <= t2, n <- [Add, Mul]]

第3种变体

只允许从左到右地计算结果，如8+4/2+18=24，从左向右算，无乘除优先级，无括号。(1+2)*(1+7)=24则不被认可，因为没有办法设计一个序列，从左到右计算24.

此时这个问题的搜索空间很明显是一棵固定的树，所以我们用DFS进行解决。这个过程不需要使用filter，在搜索到每个可能结果时就可以判定其是否满足target值的要求。

代码以后再补

原始代码

以上所述全部内容的原始代码，供参考

import Control.Applicative
import Data.Maybe
import Data.Ratio
import qualified Data.Set as Set

-- The tree definition

data Tree = Leaf Int | Add Tree Tree | Sub Tree Tree | Mul Tree Tree | Div Tree Tree deriving (Eq, Ord)

value :: Tree -> Maybe Rational
value (Leaf i) = Just (toRational i)
value (Add t1 t2) = liftA2 (+) (value t1) (value t2)
value (Sub t1 t2) = liftA2 (-) (value t1) (value t2)
value (Mul t1 t2) = liftA2 (*) (value t1) (value t2)
value (Div t1 t2) = value t2 >>= \v2 -> if v2 == 0 then Nothing else (/) <$> (value t1) <*> (pure v2)

priority :: Tree -> Int
priority (Leaf i) = 2
priority (Add t1 t2) = 0
priority (Sub t1 t2) = 0
priority (Mul t1 t2) = 1
priority (Div t1 t2) = 1

prettyPrint :: Tree -> String
prettyPrint (Leaf i) = show i
prettyPrint t@(Add t1 t2) = let
    l = if priority t1 > priority t then prettyPrint t1 else "(" ++ prettyPrint t1 ++ ")"
    r = if priority t2 > priority t then prettyPrint t2 else "(" ++ prettyPrint t2 ++ ")"
    in l ++ "+" ++ r
prettyPrint t@(Sub t1 t2) = let
    l = if priority t1 > priority t then prettyPrint t1 else "(" ++ prettyPrint t1 ++ ")"
    r = if priority t2 > priority t then prettyPrint t2 else "(" ++ prettyPrint t2 ++ ")"
    in l ++ "-" ++ r
prettyPrint t@(Mul t1 t2) = let
    l = if priority t1 > priority t then prettyPrint t1 else "(" ++ prettyPrint t1 ++ ")"
    r = if priority t2 > priority t then prettyPrint t2 else "(" ++ prettyPrint t2 ++ ")"
    in l ++ "*" ++ r
prettyPrint t@(Div t1 t2) = let
    l = if priority t1 > priority t then prettyPrint t1 else "(" ++ prettyPrint t1 ++ ")"
    r = if priority t2 > priority t then prettyPrint t2 else "(" ++ prettyPrint t2 ++ ")"
    in l ++ "/" ++ r

-- Solution for problem 1

solve1 :: ([Int], Int) -> [String]
solve1 (cards, target) = [prettyPrint t | t <- trees cards, value t == Just (toRational target)] where
    trees [] = []
    trees [i] = [Leaf i]
    trees is = concatMap makeTree [splitAt i is | i <- [1..(length is - 1)]] where
        makeTree (is1, is2) = [n t1 t2 | t1 <- trees is1, t2 <- trees is2, n <- [Add, Sub, Mul, Div]] 

-- Solution for problem 2

solve2 :: ([Int], Int) -> [String]
solve2 (cards, target) = [prettyPrint t | t <- trees cards, value t == Just (toRational target)] where
    trees [] = []
    trees [i] = [Leaf i]
    trees is = ordNub $ concatMap makeTree [(is1, is2) | (is1, is2) <- split is, not (null is1), not (null is2)] where
        ordNub l = go Set.empty l where
            go _ [] = []
            go s (x:xs) = if x `Set.member` s then go s xs else x : go (Set.insert x s) xs
        split [] = []
        split [i] = [([i], []), ([], [i])]
        split (i:is) = concatMap (\(is1, is2) -> [(i:is1, is2), (is1, i:is2)]) (split is)
        makeTree (is1, is2) = [n t1 t2 | t1 <- trees is1, t2 <- trees is2, n <- [Sub, Div]] ++ [n t1 t2 | t1 <- trees is1, t2 <- trees is2, t1 <= t2, n <- [Add, Mul]]

后记

这篇文章是对早年间 https://blog.csdn.net/WinterShiver/article/details/103206415 博客的改进。