在 Haskell 中使用 folde 函数查找树高

Question

我正在为考试做的一项作业是我自己创建的

data Exp =  T | F | And Exp Exp | Or Exp Exp | Not Exp deriving (Eq, Show, Ord, Read)

然后它要求制作

folde :: a -> a -> (a -> a -> a) -> (a -> a -> a) -> (a -> a) -> Exp -> a

这是我想出来的

folde :: a -> a -> (a -> a -> a) -> (a -> a -> a) -> (a -> a) -> Exp -> a
folde t f a o n T = t
folde t f a o n F = f
folde t f a o n (And x y) = a (folde t f a o n x) (folde t f a o n y)
folde t f a o n (Or x y) = o (folde t f a o n x) (folde t f a o n y)
folde t f a o n (Not x) = n (folde t f a o n x)

作业要求evb、evi 和evh。

它们都应该使用正确的参数一次调用 folde 来工作。

Evb 计算布尔表达式。

evb :: Exp -> Bool
evb = folde True False (&&) (||) not

Evi 计算为整数，将T 视为Int 1，F 视为Int 5，And 视为+，Or 视为*，Not 视为否定。

evi :: Exp -> Int
evi = folde 1 5 (+) (*) negate 

到目前为止一切顺利，一切正常。我也很乐意为此提供任何反馈。

---

但是，我似乎无法理解如何解决evh。 evh 应该计算树的高度。

应该是evh :: Exp -> Int

作业说它应该将T 和F 视为高度1。 它继续Not x 应该评估为height x + 1。 And 和 Or 具有 height of its tallest subtree + 1。

我似乎不知道应该将什么传递给我的 folde 函数

Answer 1

作业说它应该将T 和F 视为高度1。它继续Not x 应该评估为height x + 1。 And 和 Or 的高度是其最高子树的高度 + 1。

你可以用显式递归直接写这个：

height T = 1
height F = 1
height (Not x) = height x + 1
height (And x y) = max (height x) (height y) + 1
height (Or  x y) = max (height x) (height y) + 1

现在，你如何用folde 写这个？递归折叠的关键在于folde 为您的每个函数提供了折叠所有子树的结果。当您在And l r 上folde 时，它首先折叠两个子树，然后将这些结果传递给folde 的参数。因此，不是您手动调用height x，而是folde 将为您计算并将其作为参数传递，因此您自己的工作最终会类似于\x y -> max x y + 1。本质上，将height 拆分为 5 个定义，每个构造函数一个，而不是解构和递归子树，而是将子树的高度作为参数：

heightT = 1 -- height T = 1
heightF = 1 -- height F = 1
heightN x = x + 1 -- height (Not x) = height x + 1
heightA l r = max l r + 1 -- height (And l r) = max (height l) (height r) + 1
heightO l r = max l r + 1 -- height (Or  l r) = max (height l) (height r) + 1

将它们提供给folde，然后简化

height = folde 1 1  -- T F
               ao   -- And
               ao   -- Or
               (+1) -- Not
         where ao x y = max x y + 1

---

现在有了新的东西！采用这个定义：

data ExpF a = T | F | Not a | And a a | Or a a
              deriving (Functor, Foldable, Traversable)

这看起来像你的Exp，除了它有一个类型参数和一堆用于该类型值的洞而不是递归。现在，看看ExpF下的表达式类型：

T :: forall a. ExpF a
Not F :: forall a. ExpF (ExpF a)
And F (Not T) :: forall a. ExpF (ExpF (ExpF a))

如果你在上面的每一个中设置a = ExpF (ExpF (ExpF (ExpF (ExpF ...))))（开到无穷大），你会发现它们都可以具有相同的类型：

T             :: ExpF (ExpF (ExpF ...))
Not F         :: ExpF (ExpF (ExpF ...))
And F (Not T) :: ExpF (ExpF (ExpF ...))

无限很有趣！我们可以使用Fix 对这种无限递归类型进行编码

newtype Fix f = Fix { unFix :: f (Fix f) }
-- Compare
-- Type  level: Fix f = f (Fix f)
-- Value level: fix f = f (fix f)
-- Fix ExpF = ExpF (ExpF (ExpF ...))
-- fix (1:) =    1:(   1:(  1: ...))
-- Recover original Exp
type Exp = Fix ExpF
-- Sprinkle Fix everywhere to make it work
Fix T :: Exp
Fix $ And (Fix T) (Fix $ Not $ Fix F) :: Exp
-- can also use pattern synonyms
pattern T' = Fix T
pattern F' = Fix F
pattern Not' t = Fix (Not t)
pattern And' l r = Fix (And l r)
pattern Or' l r = Fix (Or l r)
T' :: Exp
And' T' (Not' F') :: Exp

现在这是很好的部分：fold 的一个定义来统治它们：

fold :: Functor f => (f a -> a) -> Fix f -> a
fold alg (Fix ffix) = alg $ fold alg <$> ffix
-- ffix :: f (Fix f)
-- fold alg :: Fix f -> a
-- fold alg <$> ffix :: f a
-- ^ Hey, remember when I said folds fold the subtrees first?
-- Here you can see it very literally

这是一个单态height

height = fold $ \case -- LambdaCase extension: \case ... ~=> \fresh -> case fresh of ...
  T -> 1
  F -> 1
  Not x -> x + 1
  And x y -> max x y + 1
  Or  x y -> max x y + 1

现在是一个非常多态的height（在你的情况下它是一个；哦，好吧）。

height = fold $ option 0 (+1) . fmap getMax . foldMap (Option . Just . Max)
height $ Fix T -- 0
height $ Fix $ And (Fix T) (Fix $ Not $ Fix F) -- 2

查看recursion-schemes 包以了解这些黑暗艺术。它还使这项工作适用于具有类型族的[] 之类的基本类型，并消除了对Fix 的所有需要​​加上上述诡计+一些TH。