Как уменьшить дублирование кода при работе с рекурсивными типами сумм

Question

В настоящее время я работаю над простым интерпретатором языка программирования, и у меня есть такой тип данных:

data Expr
  = Variable String
  | Number Int
  | Add [Expr]
  | Sub Expr Expr

И у меня есть много функций, которые выполняют простые вещи, такие как:

-- Substitute a value for a variable
substituteName :: String -> Int -> Expr -> Expr
substituteName name newValue = go
  where
    go (Variable x)
      | x == name = Number newValue
    go (Add xs) =
      Add $ map go xs
    go (Sub x y) =
      Sub (go x) (go y)
    go other = other

-- Replace subtraction with a constant with addition by a negative number
replaceSubWithAdd :: Expr -> Expr
replaceSubWithAdd = go
  where
    go (Sub x (Number y)) =
      Add [go x, Number (-y)]
    go (Add xs) =
      Add $ map go xs
    go (Sub x y) =
      Sub (go x) (go y)
    go other = other

Но в каждой из этих функций я должен повторить часть, которая вызывает код рекурсивно, с небольшим изменением одной части функции. Есть ли какой-нибудь способ сделать это более обобщенно? Я бы предпочел не копировать и вставлять эту часть:

    go (Add xs) =
      Add $ map go xs
    go (Sub x y) =
      Sub (go x) (go y)
    go other = other

И просто каждый раз менять один случай, потому что кажется неэффективным дублировать подобный код.

Единственное решение, которое я могнужно иметь функцию, которая вызывает функцию сначала для всей структуры данных, а затем рекурсивно для результата, подобного следующему:

recurseAfter :: (Expr -> Expr) -> Expr -> Expr
recurseAfter f x =
  case f x of
    Add xs ->
      Add $ map (recurseAfter f) xs
    Sub x y ->
      Sub (recurseAfter f x) (recurseAfter f y)
    other -> other

substituteName :: String -> Int -> Expr -> Expr
substituteName name newValue =
  recurseAfter $ \case
    Variable x
      | x == name -> Number newValue
    other -> other

replaceSubWithAdd :: Expr -> Expr
replaceSubWithAdd =
  recurseAfter $ \case
    Sub x (Number y) ->
      Add [x, Number (-y)]
    other -> other

Но я чувствую, что, вероятно, должен быть более простой способ сделать этоуже. Я что-то упустил?

Answer 1

Поздравляем, вы только что заново открыли анаморфизмы!

Вот ваш код, перефразированный так, чтобы он работал с пакетом recursion-schemes. Увы, он не короче, потому что нам нужен шаблон для работы оборудования. (Там может быть какой-то автоматический способ избежать шаблон, например, с помощью дженериков. Я просто не знаю.)

Ниже ваш recurseAfter заменен стандартным ana.

Сначала мы определяем ваш рекурсивный тип, а также функтор, для которого он является фиксированной точкой.

{-# LANGUAGE DeriveFunctor, TypeFamilies, LambdaCase #-}
{-# OPTIONS -Wall #-}
module AnaExpr where

import Data.Functor.Foldable

data Expr
  = Variable String
  | Number Int
  | Add [Expr]
  | Sub Expr Expr
  deriving (Show)

data ExprF a
  = VariableF String
  | NumberF Int
  | AddF [a]
  | SubF a a
  deriving (Functor)

Затем мы соединяем два с несколькими экземплярами, чтобы мы могли развернуть Expr в изоморфный ExprF Expr и сложите его обратно.

type instance Base Expr = ExprF
instance Recursive Expr where
   project (Variable s) = VariableF s
   project (Number i) = NumberF i
   project (Add es) = AddF es
   project (Sub e1 e2) = SubF e1 e2
instance Corecursive Expr where
   embed (VariableF s) = Variable s
   embed (NumberF i) = Number i
   embed (AddF es) = Add es
   embed (SubF e1 e2) = Sub e1 e2

Наконец, мы адаптируем ваш исходный код и добавим пару тестов.

substituteName :: String -> Int -> Expr -> Expr
substituteName name newValue = ana $ \case
    Variable x | x == name -> NumberF newValue
    other                  -> project other

testSub :: Expr
testSub = substituteName "x" 42 (Add [Add [Variable "x"], Number 0])

replaceSubWithAdd :: Expr -> Expr
replaceSubWithAdd = ana $ \case
    Sub x (Number y) -> AddF [x, Number (-y)]
    other            -> project other

testReplace :: Expr
testReplace = replaceSubWithAdd 
   (Add [Sub (Add [Variable "x", Sub (Variable "y") (Number 34)]) (Number 10), Number 4])

Альтернативой может быть определение только ExprF a, а затем получить type Expr = Fix ExprF. Это экономит некоторые из вышеприведенных шаблонов (например, два экземпляра) за счет необходимости использовать Fix (VariableF ...) вместо Variable ..., а также аналогично другим конструкторам.

Можно было бы еще больше облегчитьчто с использованием шаблонных синонимов (хотя и ценой чуть большего количества шаблонов).

---

Обновление: я наконец-то нашел автоматизированный инструмент, использующий шаблон Haskell. Это делает весь код достаточно коротким. Обратите внимание, что функтор ExprF и два вышеупомянутых экземпляра все еще существуют под капотом, и мы все еще должны их использовать. Мы избавляем вас от необходимости определять их вручную, но это экономит много усилий.

{-# LANGUAGE DeriveFunctor, DeriveTraversable, TypeFamilies, LambdaCase, TemplateHaskell #-}
{-# OPTIONS -Wall #-}
module AnaExpr where

import Data.Functor.Foldable
import Data.Functor.Foldable.TH

data Expr
  = Variable String
  | Number Int
  | Add [Expr]
  | Sub Expr Expr
  deriving (Show)

makeBaseFunctor ''Expr

substituteName :: String -> Int -> Expr -> Expr
substituteName name newValue = ana $ \case
    Variable x | x == name -> NumberF newValue
    other                  -> project other

testSub :: Expr
testSub = substituteName "x" 42 (Add [Add [Variable "x"], Number 0])

replaceSubWithAdd :: Expr -> Expr
replaceSubWithAdd = ana $ \case
    Sub x (Number y) -> AddF [x, Number (-y)]
    other            -> project other

testReplace :: Expr
testReplace = replaceSubWithAdd 
   (Add [Sub (Add [Variable "x", Sub (Variable "y") (Number 34)]) (Number 10), Number 4])

Answer 2

В качестве альтернативного подхода это также типичный вариант использования пакета uniplate. Он может использовать Data.Data генерики вместо Template Haskell для генерации шаблона, так что если вы получаете Data экземпляров для вашего Expr:

import Data.Data

data Expr
  = Variable String
  | Number Int
  | Add [Expr]
  | Sub Expr Expr
  deriving (Show, Data)

, то применяется transform функция из Data.Generics.Uniplate.Dataфункция рекурсивно для каждого вложенного Expr:

import Data.Generics.Uniplate.Data

substituteName :: String -> Int -> Expr -> Expr
substituteName name newValue = transform f
  where f (Variable x) | x == name = Number newValue
        f other = other

replaceSubWithAdd :: Expr -> Expr
replaceSubWithAdd = transform f
  where f (Sub x (Number y)) = Add [x, Number (-y)]
        f other = other

Обратите внимание, что, в частности, replaceSubWithAdd функция f записана для выполнения нерекурсивного замещения;transform делает его рекурсивным в x :: Expr, поэтому он выполняет ту же магию с вспомогательной функцией, что и ana в ответе @ chi:

> substituteName "x" 42 (Add [Add [Variable "x"], Number 0])
Add [Add [Number 42],Number 0]
> replaceSubWithAdd (Add [Sub (Add [Variable "x", 
                     Sub (Variable "y") (Number 34)]) (Number 10), Number 4])
Add [Add [Add [Variable "x",Add [Variable "y",Number (-34)]],Number (-10)],Number 4]
> 

Это не меньше, чем решение @ chi Template Haskell,Одним из потенциальных преимуществ является то, что uniplate предоставляет некоторые дополнительные функции, которые могут быть полезны. Например, если вы используете descend вместо transform, он преобразует только немедленных потомков, которые могут дать вам контроль над тем, где происходит рекурсия, или вы можете использовать rewrite для повторного преобразованиярезультат преобразований, пока вы не достигнете фиксированной точки. Одним потенциальным недостатком является то, что «анаморфизм» звучит намного круче, чем «uniplate».

Полная программа:

{-# LANGUAGE DeriveDataTypeable #-}

import Data.Data                     -- in base
import Data.Generics.Uniplate.Data   -- package uniplate

data Expr
  = Variable String
  | Number Int
  | Add [Expr]
  | Sub Expr Expr
  deriving (Show, Data)

substituteName :: String -> Int -> Expr -> Expr
substituteName name newValue = transform f
  where f (Variable x) | x == name = Number newValue
        f other = other

replaceSubWithAdd :: Expr -> Expr
replaceSubWithAdd = transform f
  where f (Sub x (Number y)) = Add [x, Number (-y)]
        f other = other

replaceSubWithAdd1 :: Expr -> Expr
replaceSubWithAdd1 = descend f
  where f (Sub x (Number y)) = Add [x, Number (-y)]
        f other = other

main = do
  print $ substituteName "x" 42 (Add [Add [Variable "x"], Number 0])
  print $ replaceSubWithAdd e
  print $ replaceSubWithAdd1 e
  where e = Add [Sub (Add [Variable "x", Sub (Variable "y") (Number 34)])
                     (Number 10), Number 4]