Як зменшити дублювання коду при роботі з рекурсивними типами сум

Зараз я працюю над простим перекладачем мови програмування, і у мене є такий тип даних:

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

Але я відчуваю, що, мабуть, має бути простіший спосіб зробити це вже. Я щось пропускаю?

— Скотт
джерело

Складіть "підняту" версію коду. Де ви використовуєте параметри (функції), які вирішують, що робити. Тоді ви можете зробити конкретну функцію, передавши функції до знятої версії.

— Віллем Ван Онсем

Я думаю, ваша мова могла бути спрощена. Визначте Add :: Expr -> Expr -> Exprзамість цього Add :: [Expr] -> Exprі позбудьтесь Subвзагалі.

— чепнер

Я просто використовую це визначення як спрощену версію; хоча це буде спрацьовувати і в цьому випадку, я повинен мати можливість містити списки виразів і для інших частин мови

— Скотт,

Як от? Більшість, якщо не всі, ланцюгові оператори можуть бути зведені до вкладених бінарних операторів.

— чепнер

Я думаю , що ваш recurseAfterIS anaв маскуванні. Ви можете поглянути на анаморфізми та recursion-schemes. Зважаючи на це, я думаю, що ваше остаточне рішення є таким коротким, як воно може бути. Перехід на офіційні recursion-schemesанаморфізми не дуже заощадить.

— чі

Відповіді:

Вітаємо, ви просто перекрили анаморфізми!

Ось ваш код, перефразований так, щоб він працював з 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])

— чі
джерело

Вам справді потрібно Exprчітко визначитись , а не щось подібне type Expr = Fix ExprF?

— чепнер

@chepner Я коротко зазначив це як альтернативу. Трохи незручно використовувати подвійні конструктори для всього: Fix+ справжній конструктор. Використовувати останній підхід із автоматизацією TH - це приємніше, IMO.

— чі

Як альтернативний підхід, це також типовий випадок використання 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функція from 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]
>

Це не коротше рішення шаблону Haskell @ chi. Однією з потенційних переваг є uniplateнадання додаткових функцій, які можуть бути корисними. Наприклад, якщо ви використовуєте descendзамість цього transform, він перетворює лише безпосередніх дітей, які можуть надати вам контроль над тим, де відбувається рекурсія, або ви можете rewriteповторно перетворити результат перетворень, поки не досягнете фіксованої точки. Одним з потенційних недоліків є те, що "анаморфізм" звучить набагато крутіше, ніж "одноплановий".

Повна програма:

{-# 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]

— К. А. Бур
джерело