Как я могу пройти этот тип с рекурсивной схемой вместо явной рекурсии? - PullRequest
Новая
       64

Как я могу пройти этот тип с рекурсивной схемой вместо явной рекурсии?

6 голосов
/ 01 октября 2019

Рассмотрим этот код: 

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. Для ясности я расширил результирующий Template 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 из своего собственного определения. Как я могу переписать это, чтобы удалить это, так что я делаю всю свою рекурсию внутри схем рекурсии?

Ответы [ 2 ]

6 голосов
/ 01 октября 2019

Я нашел решение, которым я вполне доволен: апоморфизм. 

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
3 голосов
/ 01 октября 2019

В продолжение обсуждения по вашему вопросу

para - это (Base t (t, a) -> a) -> t -> a. Для меня это выглядит близко, но не совсем идеально. Разве я не хочу на самом деле ((t, Base t a) -> a) -> t -> a или ((t, Base t (t, a)) -> a) -> t -> a, чтобы я мог посмотреть на элемент, на котором я нахожусь?

Это все еще параморфизм. Тип para выглядит странно, но он более точный. Пара (t, Base t a) не кодирует инвариант, что оба компонента всегда будут иметь «один и тот же» конструктор.

То, что вы предлагаете, все еще кажется наиболее естественным способом определения makeReplacements, оно просто не определенов библиотеке рекурсивных схем. 

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