Come ridurre la duplicazione del codice quando si ha a che fare con tipi di somma ricorsivi

50

Attualmente sto lavorando a un semplice interprete per un linguaggio di programmazione e ho un tipo di dati come questo:

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

E ho molte funzioni che fanno cose semplici come:

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

Ma in ciascuna di queste funzioni, devo ripetere la parte che chiama il codice in modo ricorsivo con solo una piccola modifica a una parte della funzione. Esiste un modo esistente per farlo in modo più generico? Preferirei non dover copiare e incollare questa parte:

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

E basta cambiare un singolo caso ogni volta perché sembra inefficiente duplicare il codice in questo modo.

L'unica soluzione che ho potuto trovare è quella di avere una funzione che chiama prima una funzione sull'intera struttura dei dati e poi ricorsivamente sul risultato in questo modo:

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

Ma credo che probabilmente ci dovrebbe essere già un modo più semplice per farlo. Mi sto perdendo qualcosa?

haskell  functional-programming  dry  code-duplication  recursive-type 
— Scott
fonte
Crea una versione "rialzata" del codice. Dove si utilizzano i parametri (funzioni) che decidono cosa fare. Quindi è possibile effettuare una funzione specifica passando le funzioni alla versione sollevata.
— Willem Van Onsem,
Penso che la tua lingua potrebbe essere semplificata. Definisci Add :: Expr -> Expr -> Exprinvece di Add :: [Expr] -> Expre sbarazzati del Subtutto.
— Chepner,
Sto solo usando questa definizione come versione semplificata; mentre in questo caso funzionerebbe, devo essere in grado di contenere elenchi di espressioni anche per altre parti della lingua
— Scott
Ad esempio? La maggior parte, se non tutti, gli operatori concatenati possono essere ridotti a operatori binari nidificati.
— Chepner,
1
Penso che tu recurseAftersia anasotto mentite spoglie. Potresti voler guardare anamorfismi e recursion-schemes. Detto questo, penso che la tua soluzione finale sia la più breve possibile. Passare agli recursion-schemesanamorfismi ufficiali non farà risparmiare molto.
— Chi,

Risposte:

38

Complimenti, hai appena riscoperto gli anamorfismi!

Ecco il tuo codice, riformulato in modo che funzioni con il recursion-schemespacchetto. Purtroppo, non è più corto, dal momento che abbiamo bisogno di un piatto di caldaia per far funzionare le macchine. (Potrebbe esserci un modo automagico per evitare la piastra della caldaia, ad esempio l'uso di generici. Semplicemente non lo so.)

Di seguito, recurseAfterviene sostituito con lo standard ana.

Definiamo innanzitutto il tipo ricorsivo, nonché il funzione di cui è il punto fisso.

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

Quindi colleghiamo i due con alcuni casi in modo da poter dispiegarci Exprnell'isomorfo ExprF Expre ripiegarlo.

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

Infine, adattiamo il codice originale e aggiungiamo un paio di test.

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

Un'alternativa potrebbe essere quella di definire ExprF asolo e quindi derivare type Expr = Fix ExprF. Ciò consente di risparmiare parte della piastra di caldaia di cui sopra (ad esempio le due istanze), al costo di dover utilizzare al Fix (VariableF ...)posto di Variable ..., così come l'analogo per gli altri costruttori.

Si potrebbe alleviare ulteriormente l'uso di sinonimi di pattern (a costo di un po 'più di boilerplate).

Aggiornamento: ho finalmente trovato lo strumento automagic, usando il modello Haskell. Questo rende l'intero codice ragionevolmente breve. Si noti che il ExprFfunctor e le due istanze sopra esistono ancora sotto il cofano e dobbiamo ancora usarli. Evitiamo solo il fastidio di doverli definire manualmente, ma questo da solo fa risparmiare molto sforzo.

{-# 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
fonte
Devi davvero definire Expresplicitamente, piuttosto che qualcosa del genere type Expr = Fix ExprF?
— Chepner,
2
@chepner L'ho menzionato brevemente come alternativa. È un po 'scomodo dover usare doppi costruttori per tutto: Fix+ il vero costruttore. L'uso dell'ultimo approccio con l'automazione TH è più piacevole, IMO.
— Chi,
19

Come approccio alternativo, questo è anche un tipico caso d'uso per il uniplatepacchetto. Può utilizzare Data.Datagenerics piuttosto che Template Haskell per generare il boilerplate, quindi se derivate Dataistanze per il vostro Expr:

import Data.Data

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

quindi la transformfunzione da Data.Generics.Uniplate.Dataapplica una funzione ricorsivamente a ciascun nidificato 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

Si noti che, in replaceSubWithAddparticolare, la funzione fè scritta per eseguire una sostituzione non ricorsiva; transformlo rende ricorsivo x :: Expr, quindi sta facendo la stessa magia per la funzione helper anadella risposta di @ 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]
>

Questo non è più breve della soluzione Template Haskell di @ chi. Un potenziale vantaggio è che uniplatefornisce alcune funzioni aggiuntive che potrebbero essere utili. Ad esempio, se si utilizza descendal posto di transform, trasforma solo i figli immediati che possono darti il ​​controllo su dove si verifica la ricorsione, oppure puoi usare rewriteper ri-trasformare il risultato delle trasformazioni fino a raggiungere un punto fisso. Un potenziale svantaggio è che "l'anamorfismo" suona molto più fresco di "uniplate".

Programma 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
fonte
Utilizzando il nostro sito, riconosci di aver letto e compreso le nostre Informativa sui cookie e Informativa sulla privacy.
Licensed under cc by-sa 3.0 with attribution required.