使用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,Fas Int 5,Andas +,Oras *和Notnegate.

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为每个函数提供折叠所有子树的结果.当你folde打开时And l r,它首先折叠两个子树,然后将这些结果传递给参数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.