Найти высоту дерева с помощью функции folde в Haskell

одно из заданий, над которым я работаю в преддверии экзаменов, заставило меня создать

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 as Int 1, F as Int 5, And as +, Or as * и Not как отменяет.

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

пока все хорошо, все работает. Я буду рад любой обратной связи по этому вопросу.

однако я не могу понять, как решить evh. evh предполагается рассчитать высоту дерева.

он должен быть!--19-->

в задании говорится, что он должен лечить T и F как высота 1. Это продолжается Not x следует оценить до height x + 1. And и Or имеет height of its tallest subtree + 1.

я, кажется, не могу понять, что я должен передать моему folde функции

6
haskell

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 on And l r, сначала он складывает оба поддерева, а затем передает эти результаты в аргумент folde. Итак, вместо того, чтобы вручную вызывать height x, folde собирается рассчитать это для вас и передать его в качестве аргумента, поэтому ваша собственная работа заканчивается чем-то вроде \x y -> max x y + 1. По сути, split 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

посмотреть рекурсия-схемы пакет изучать темные искусства. Это также делает эту работу для базовых типов, таких как [] с семейством типов и удаляет необходимость Fix все с обманом + какой-то че.

8