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

Question

我正在准备考试的作业之一让我创造了

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

然后它要求制作

折叠 ：： 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视为，将或视为*和Not视为否定。

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

到目前为止还不错，一切正常。我也很乐意收到有关此的任何反馈。

然而，我似乎不明白如何解决evhevh应该计算树的高度。

它应该是 evh ：： Exp -

赋值说它应该将T和F视为高度1。它继续说Not x应该评估为高度x 1。Andandandor具有其最高子树1的高度。

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




Answer 1

赋值说它应该将T和F视为高度1。它继续说Not x应该评估为高度x 1。Andandandor具有其最高子树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的参数。因此，您无需手动调用高度x，folde将为您计算并将其作为参数传递，因此您自己的工作最终会像\x y-

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

喂它们折叠，并简化

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)

这看起来像你的＜code＞Exp＜/code＞，除了它没有递归之外，它有一个类型参数和一堆用于该类型值的孔。现在，看看ExpF下的表达式类型：

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

如果设置< code > a = ExpF(ExpF(ExpF(ExpF(ExpF(ExpF...)))) (on to infinity)在上述每一种情况下，您会发现它们都可以具有相同的类型:

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

现在好的部分来了:用< code>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 = 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

现在是一个非常多态的＜code＞高度＜/code＞（在你的例子中，它是1；哦，好的）。

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

参见递归方案包来学习这些黑魔法。它还使这一点适用于具有类型家族的基本类型，如< code>[]，并消除了使用上述技巧< code >修复所有内容的需要。