我如何使用递归方案而不是显式递归来遍历这种类型？

Question

考虑这段代码：

import Data.Maybe (fromMaybe)

data MyStructure = Foo Int | Bar String MyStructure | Baz MyStructure MyStructure | Qux Bool Bool MyStructure MyStructure deriving(Eq,Show)

makeReplacements :: [(MyStructure, MyStructure)] -> MyStructure -> MyStructure
makeReplacements replacements structure = fromMaybe (descend structure) (lookup structure replacements)
  where
    descend :: MyStructure -> MyStructure
    descend (Foo x) = Foo x
    descend (Bar x y) = Bar x (makeReplacements replacements y)
    descend (Baz x y) = Baz (makeReplacements replacements x) (makeReplacements replacements y)
    descend (Qux x y z w) = Qux x y (makeReplacements replacements z) (makeReplacements replacements w)

它定义了一个递归数据类型，以及一个通过遍历它来执行搜索和替换的函数。但是，我正在使用显式递归，并且想改用递归方案。

首先，我投入了makeBaseFunctor ''MyStructure。为了清楚起见，我在下面扩展了生成的模板 Haskell 和派生的 Functor 实例。然后我能够重写 descend:

{-# LANGUAGE DeriveTraversable, TypeFamilies #-}

import Data.Maybe (fromMaybe)
import Data.Functor.Foldable (Base, Recursive(..), Corecursive(..))

data MyStructure = Foo Int | Bar String MyStructure | Baz MyStructure MyStructure | Qux Bool Bool MyStructure MyStructure deriving(Eq,Show)

makeReplacements :: [(MyStructure, MyStructure)] -> MyStructure -> MyStructure
makeReplacements replacements structure = fromMaybe (descend structure) (lookup structure replacements)
  where
    descend :: MyStructure -> MyStructure
    descend = embed . fmap (makeReplacements replacements) . project

-- begin code that would normally be auto-generated
data MyStructureF r = FooF Int | BarF String r | BazF r r | QuxF Bool Bool r r deriving(Foldable,Traversable)

instance Functor MyStructureF where
  fmap _ (FooF x) = FooF x
  fmap f (BarF x y) = BarF x (f y)
  fmap f (BazF x y) = BazF (f x) (f y)
  fmap f (QuxF x y z w) = QuxF x y (f z) (f w)

type instance Base MyStructure = MyStructureF

instance Recursive MyStructure where
  project (Foo x) = FooF x
  project (Bar x y) = BarF x y
  project (Baz x y) = BazF x y
  project (Qux x y z w) = QuxF x y z w

instance Corecursive MyStructure where
  embed (FooF x) = Foo x
  embed (BarF x y) = Bar x y
  embed (BazF x y) = Baz x y
  embed (QuxF x y z w) = Qux x y z w
-- end code that would normally be auto-generated

如果我就此打住，我就已经赢了：我不再需要写出 descend 中的所有情况，而且我不会不小心犯下 descend (Baz x y) = Baz x (makeReplacements replacements y)（忘记替换里面的 x）。但是，这里仍然存在显式递归，因为我仍在其自己的定义中使用 makeReplacements 。我如何重写它以删除它，以便我在递归方案中执行所有递归？

Answer 1

跟进您问题下的讨论

para is (Base t (t, a) -> a) -> t -> a. To me, this looks close but not quite perfect. Wouldn't I actually want ((t, Base t a) -> a) -> t -> a or ((t, Base t (t, a)) -> a) -> t -> a so that I can look at the element I'm on?

这仍然是一个同构。 para 的类型看起来很奇怪，但它是更精确的类型。一对 (t, Base t a) 不编码两个组件总是将具有 "same" 构造函数的不变量。

您的提议似乎仍然是最自然的定义方式makeReplacements，只是递归方案库中没有定义。

para' :: Recursive t => (t -> Base t a -> a) -> t -> a
para' alg = go where
  go x = alg x (fmap go (project x))

Answer 2

我找到了一个我相当满意的解决方案：同构。

makeReplacements replacements = apo coalg
  where
    coalg :: MyStructure -> MyStructureF (Either MyStructure MyStructure)
    coalg structure = case lookup structure replacements of
      Just replacement -> Left <$> project replacement
      Nothing -> Right <$> project structure

再仔细考虑一下，我还看到了其中的对称性导致了等效的同构：

makeReplacements replacements = para alg
  where
    alg :: MyStructureF (MyStructure, MyStructure) -> MyStructure
    alg structure = case lookup (embed $ fst <$> structure) replacements of
      Just replacement -> replacement
      Nothing -> embed $ snd <$> structure

我如何使用递归方案而不是显式递归来遍历这种类型？

How can I walk this type with a recursion scheme instead of explicit recursion?

haskell

recursive-datastructures

recursion-schemes