haskell - Cómo reducir la duplicación de código cuando se trata con tipos de suma recursiva

functional-programming

Question

Actualmente estoy trabajando en un intérprete simple para un lenguaje de programación y tengo un tipo de datos como este:

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

Y tengo muchas funciones que hacen cosas simples como:

-- 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

Pero en cada una de estas funciones, tengo que repetir la parte que llama al código de forma recursiva con solo un pequeño cambio en una parte de la función. ¿Existe alguna forma de hacer esto de manera más genérica? Preferiría no tener que copiar y pegar esta parte:

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

Y solo cambie un caso cada vez porque parece ineficiente duplicar código como este.

La única solución que se me ocurre es tener una función que llame primero a una función en toda la estructura de datos y luego recursivamente en el resultado de esta manera:

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

Pero siento que probablemente ya debería haber una forma más simple de hacer esto. ¿Me estoy perdiendo de algo?

Answer 1

¡Felicitaciones, acabas de redescubrir anamorfismos!

Aquí está su código, reformulado para que funcione con el paquete de recursion-schemes . Por desgracia, no es más corto, ya que necesitamos un poco de repetitivo para que la maquinaria funcione. (Puede haber alguna forma automática de evitar el repetitivo, por ejemplo, usando genéricos. Simplemente no lo sé).

A continuación, su recurseAfter se reemplaza con el estándar ana .

Primero definimos su tipo recursivo, así como el functor del que es el punto fijo.

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

Luego conectamos los dos con algunas instancias para que podamos desplegar Expr en el ExprF Expr isomórfico y plegarlo de nuevo.

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

Finalmente, adaptamos su código original y agregamos un par de pruebas.

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])

Una alternativa podría ser definir ExprF a solo, y luego derivar el type Expr = Fix ExprF . Esto ahorra algo de la placa anterior (por ejemplo, las dos instancias), a costa de tener que usar Fix (VariableF ...) lugar de Variable ... , así como lo análogo para los otros constructores.

Uno podría aliviar aún más el uso de sinónimos de patrones (a costa de un poco más repetitivo, sin embargo).

Actualización: Finalmente encontré la herramienta automágica, usando la plantilla Haskell. Esto hace que todo el código sea razonablemente corto. Tenga en cuenta que el functor ExprF y las dos instancias anteriores todavía existen debajo del capó, y todavía tenemos que usarlos. Solo ahorramos la molestia de tener que definirlos manualmente, pero eso solo ahorra mucho esfuerzo.

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

Como un enfoque alternativo, este también es un caso de uso típico para el paquete uniplate . Puede usar Data.Data generics en lugar de Template Haskell para generar el repetitivo, por lo que si deriva instancias de Data para su Expr :

import Data.Data

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

entonces la función de transform de Data.Generics.Uniplate.Data aplica una función recursivamente a cada Expr anidado:

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

Tenga en cuenta que, en replaceSubWithAdd en particular, la función f se escribe para realizar una sustitución no recursiva; transform hace recursivo en x :: Expr , por lo que está haciendo la misma magia a la función auxiliar que ana hace en la respuesta de @ 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]
> 

Esto no es más corto que la solución Template Haskell de @ chi. Una ventaja potencial es que uniplate proporciona algunas funciones adicionales que pueden ser útiles. Por ejemplo, si usa descend en lugar de transform , transforma solo los elementos secundarios inmediatos que pueden darle control sobre dónde ocurre la recursión, o puede usar rewrite para volver a transformar el resultado de las transformaciones hasta llegar a un punto fijo. Una desventaja potencial es que el "anamorfismo" suena mucho mejor que "uniplate".

Programa completo:

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