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

50

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?

haskell functional-programming dry code-duplication recursive-type Scott
fuente
Haga una versión "levantada" del código. Donde utiliza parámetros (funciones) que deciden qué hacer. Luego puede hacer una función específica pasando funciones a la versión elevada.
Willem Van Onsem
Creo que tu lenguaje podría simplificarse. Defina en Add :: Expr -> Expr -> Exprlugar de Add :: [Expr] -> Expry elimine por Subcompleto.
chepner
Solo estoy usando esta definición como una versión simplificada; si bien eso funcionaría en este caso, también necesito poder contener listas de expresiones para otras partes del lenguaje
Scott
¿Como? La mayoría, si no todos, los operadores encadenados se pueden reducir a operadores binarios anidados.
chepner
1
Creo que tu recurseAfterestá anadisfrazado. Es posible que desee mirar anamorfismos y recursion-schemes. Dicho esto, creo que su solución final es lo más breve posible. Cambiar a los recursion-schemesanamorfismos oficiales no ahorrará mucho.
chi

Respuestas:

38

¡Felicitaciones, acabas de redescubrir anamorfismos!

Aquí está su código, reformulado para que funcione con el recursion-schemespaquete. 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 recurseAfterse 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 desplegarnos Expren el isomorfo ExprF Expry plegarlo.

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 asolo y luego derivar type Expr = Fix ExprF. Esto ahorra algo de la placa anterior (por ejemplo, las dos instancias), a costa de tener que usarla en Fix (VariableF ...)lugar de Variable ..., así como lo análogo para los otros constructores.

Se 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 ExprFfunctor 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])
chi
fuente
¿Realmente tienes que definir Exprexplícitamente, en lugar de algo así type Expr = Fix ExprF?
chepner
2
@chepner Mencioné brevemente eso como una alternativa. Es un poco incómodo tener que usar constructores dobles para todo: Fix+ el constructor real. Usar el último enfoque con la automatización TH es mejor, en mi opinión.
chi
19

Como un enfoque alternativo, este también es un caso de uso típico para el uniplatepaquete. Puede usar Data.Datagenéricos en lugar de Template Haskell para generar el repetitivo, por lo que si obtiene Datainstancias para su Expr:

import Data.Data

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

entonces la transformfunción from Data.Generics.Uniplate.Dataaplica una función recursivamente a cada anidado 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

Tenga en cuenta que, en replaceSubWithAddparticular, la función fse escribe para realizar una sustitución no recursiva; transformlo hace recursivo x :: Expr, por lo que está haciendo la misma magia a la función auxiliar anaque 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 uniplateproporciona algunas funciones adicionales que pueden ser útiles. Por ejemplo, si usa descenden lugar de transform, transforma solo los elementos secundarios inmediatos que pueden darle control sobre dónde ocurre la recursión, o puede usar rewritepara 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]
KA Buhr
fuente