如何在Haskell递归数据类型中实现分配律？

Question

我有一个任务是修正一个名为expand的函数。

infixl 6 :+:
infixl 7 :*:
data Expr = Val Int | Expr :+: Expr | Expr :*: Expr
    deriving (Show, Eq)

expand :: Expr -> Expr
expand ((e1 :+: e2) :*: e) = expand e1 :*: expand e :+: expand e2 :*: expand e
expand (e :*: (e1 :+: e2)) = expand e :*: expand e1 :+: expand e :*: expand e2
expand (e1 :+: e2) = expand e1 :+: expand e2
expand (e1 :*: e2) = expand e1 :*: expand e2
expand e = e

-- expression example: (Val 1 :+: Val 2 :+: Val 3) :*: (Val 4 :+: Val 5)
-- which is equivalent to (1 + 2 + 3) * (4 + 5)

-- expression, that given fucntion evaluates our example to: 
--(Val 1 :+: Val 2) :*: (Val 4 :+: Val 5) :+: Val 3 :*: (Val 4 :+: Val 5)

-- expression that corrected function must evaluate our example to:
-- Val 1 :*: Val 4 :+: (Val 1 :*: Val 5 :+: (Val 2 :*: Val 4 :+: (Val 2 :*: Val 5 :+: (Val 3 :*: Val 4 :+: Val 3 :*: Val 5))))

-- answers like (Val 1 :*: Val 2) :+: (Val 3 :*: Val 4) 
-- and          (Val 4 :*: Val 3) :+: (Val 1 :*: Val 2)
-- are considered to be equal

它不能正常工作，因为它只打开括号一次。所以，我将其修改为以下内容：

infixl 6 :+:
infixl 7 :*:
data Expr = Val Int | Expr :+: Expr | Expr :*: Expr
    deriving (Show, Eq)

expand :: Expr -> Expr
expand ((e1 :+: e2) :*: e) = (expand $ e :*: e1) :+: (expand $ e :*: e2)
expand (e :*: (e1 :+: e2)) = (expand $ e :*: e1) :+: (expand $ e :*: e2)
expand (e1 :+: e2) = expand e1 :+: expand e2
expand expr@(e1 :*: e2) = if isMul expr
                          then expr
                          else expand $ expand e1 :*: expand e2
expand e = e

isMul :: Expr -> Bool
isMul (Val a :*: expr) = isMul expr 
isMul (expr :*: Val a) = isMul expr
isMul (Val a) = True
isMul  _      = False

新增了函数 isMul，用于判断边界条件：如果表达式 (e1 :*: e2) 的形式为 Val 1 :*: Val 2 :*: Val 3 ...，则函数 expand 停止继续扩展并对表达式自身求值，否则递归继续进行。

在我的示例中它运行得还不错。

exp0 = (Val 1 :+: Val 2 :+: Val 3) :*: (Val 4 :+: Val 5)
exp1 = (Val 1) :*: ((Val 2) :+: (Val 3)) :*: (Val 4)
exp2 =  Val 1 :*: (Val 2 :*: (Val 3 :+: Val 4)) 
exp3 = ((Val 1) :+: (Val 2)) :*: ((Val 3) :+: (Val 4))
exp4 =  Val 2 :*: (Val 3 :+: Val 4)
exp5 = (Val 3 :+: Val 4) :*: Val 2
exp6 =  Val 3 :+: Val 4  :*: Val 2
exp7 =  Val 3 :*: (Val 4 :*: Val 2)
exp8 = (Val 3 :*: Val 4) :*: Val 2
exp9 =  (Val 1 :+: Val 2 :+: Val 3) :*: (Val 4 :+: Val 5) :*: (Val 6) :*: ((Val 7) :+: (Val 8)) :*: (Val 9)

尽管由于时间限制超过而未能通过某些测试。我猜测，递归没有在必须停止的地方停止，但我看不到在哪里。

- Mitrael Kankan

---

“无法通过测试”？那是一个QuickCheck，对吗？你能提取出无法完成的具体测试案例吗？ - undefined

我不知道那些测试是什么，也不知道如何提取它们。我只知道以下信息：

1. 时间限制：5秒，内存限制：256 MB
2. 通过标准输入和标准输出进行测试
3. 失败。超过了时间限制。

- undefined

Answer 1

错误出现在函数 isMul 中：表达式 isMul ((Val 3 :*: (Val 4 :*: Val 2)) :*: ((Val 3 :*: Val 4) :*: Val 2)) 的结果是 False。这是因为 data Expr 本质上是一棵树，所以表达式 Val 1 :*: (Val 2 :*: (Val 3 :*: Val 4)) 和 (Val 1 :*: Val 2) :*: (Val 3 :*: Val 4) 实际上是不同的。因此，我为 isMul 编写了一个更通用的实现：

isMul :: Expr -> Bool
isMul (e1 :*: e2) = isMul e1 && isMul e2
isMul (Val a) = True
isMul  _      = False

这使得程序按照预期工作。

- Mitrael Kankan