Cara mengurangi duplikasi kode ketika berhadapan dengan tipe jumlah rekursif

Saat ini saya sedang mengerjakan penerjemah sederhana untuk bahasa pemrograman dan saya memiliki tipe data seperti ini:

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

Dan saya memiliki banyak fungsi yang melakukan hal-hal sederhana seperti:

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

Tetapi di masing-masing fungsi ini, saya harus mengulangi bagian yang memanggil kode secara rekursif hanya dengan perubahan kecil ke satu bagian dari fungsi. Apakah ada cara yang ada untuk melakukan ini secara lebih umum? Saya lebih suka tidak perlu menyalin dan menempel bagian ini:

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

Dan hanya mengubah satu kasus setiap kali karena tampaknya tidak efisien untuk menduplikasi kode seperti ini.

Satu-satunya solusi yang saya bisa buat adalah memiliki fungsi yang memanggil fungsi pertama pada seluruh struktur data dan kemudian secara rekursif pada hasil seperti ini:

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

Tapi saya merasa mungkin harus ada cara yang lebih sederhana untuk melakukan ini. Apakah saya melewatkan sesuatu?

— Scott
sumber

Buat versi kode "terangkat". Di mana Anda menggunakan parameter (fungsi) yang memutuskan apa yang harus dilakukan. Kemudian Anda dapat membuat fungsi tertentu dengan meneruskan fungsi ke versi yang diangkat.

— Willem Van Onsem

Saya pikir bahasa Anda bisa disederhanakan. Tetapkan Add :: Expr -> Expr -> Expralih-alih Add :: [Expr] -> Expr, dan singkirkan Subsama sekali.

— chepner

Saya hanya menggunakan definisi ini sebagai versi yang disederhanakan; sementara itu akan berhasil dalam kasus ini, saya harus dapat memuat daftar ekspresi untuk bagian lain dari bahasa juga

— Scott

Seperti? Sebagian besar, jika tidak semua, operator rantai dapat direduksi menjadi operator biner bersarang.

— chepner

Saya pikir Anda recurseAftersedang anamenyamar. Anda mungkin ingin melihat anamorphisms dan recursion-schemes. Yang sedang berkata, saya pikir solusi akhir Anda sesingkat mungkin. Beralih ke recursion-schemesanamorfisme resmi tidak akan banyak menghemat.

— chi

Jawaban:

Selamat, Anda baru saja menemukan kembali anamorfisme!

Ini kode Anda, diulang sehingga berfungsi dengan recursion-schemespaket. Sayangnya, ini tidak lebih pendek, karena kita membutuhkan pelat untuk membuat mesin bekerja. (Mungkin ada beberapa cara otomatis untuk menghindari boilerplate, misalnya menggunakan obat generik. Saya benar-benar tidak tahu.)

Di bawah, Anda recurseAfterdiganti dengan standar ana.

Kami pertama-tama menentukan jenis rekursif Anda, serta fungsi yang merupakan titik tetapnya.

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

Kemudian kita menghubungkan keduanya dengan beberapa contoh sehingga kita bisa membuka Exprke isomorfik ExprF Expr, dan melipatnya kembali.

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

Terakhir, kami mengadaptasi kode asli Anda, dan menambahkan beberapa tes.

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

Alternatif bisa dengan ExprF ahanya mendefinisikan , dan kemudian diturunkan type Expr = Fix ExprF. Ini menghemat beberapa pelat ketel di atas (misalnya dua contoh), dengan biaya harus menggunakan Fix (VariableF ...)alih-alih Variable ..., serta analog dengan konstruktor lainnya.

Satu lebih lanjut dapat meringankan yang menggunakan sinonim pola (dengan biaya sedikit lebih boilerplate, meskipun).

Pembaruan: Saya akhirnya menemukan alat automagic, menggunakan template Haskell. Ini membuat seluruh kode cukup pendek. Perhatikan bahwa ExprFfunctor dan dua instance di atas masih ada di bawah tenda, dan kita masih harus menggunakannya. Kami hanya menyimpan kerumitan karena harus mendefinisikannya secara manual, tetapi itu saja menghemat banyak usaha.

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

Apakah Anda benar-benar harus mendefinisikan Exprsecara eksplisit, bukan sesuatu seperti type Expr = Fix ExprF?

— chepner

@ chepner Saya singkat menyebutkan bahwa sebagai alternatif. Agak tidak nyaman harus menggunakan konstruktor ganda untuk semuanya: Fix+ konstruktor nyata. Menggunakan pendekatan terakhir dengan otomatisasi TH lebih baik, IMO.

— chi

Sebagai pendekatan alternatif, ini juga merupakan kasus penggunaan khas untuk uniplatepaket. Itu bisa menggunakan Data.Dataobat generik alih-alih Template Haskell untuk menghasilkan boilerplate, jadi jika Anda membuat Dataturunan untuk Expr:

import Data.Data

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

maka transformfungsi dari Data.Generics.Uniplate.Datamenerapkan fungsi secara rekursif untuk setiap bersarang 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

Perhatikan bahwa secara replaceSubWithAddkhusus, fungsi fini ditulis untuk melakukan subtitusi non-rekursif; transformmembuatnya rekursif x :: Expr, jadi itu melakukan sihir yang sama untuk fungsi pembantu seperti anahalnya dalam jawaban @ 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]
>

Ini tidak lebih pendek dari solusi Template Haskell @ chi. Salah satu keunggulan potensial adalah uniplatemenyediakan beberapa fungsi tambahan yang mungkin bermanfaat. Misalnya, jika Anda menggunakan descenddi tempat transform, itu mengubah hanya langsung anak-anak yang dapat memberikan Anda kontrol atas mana rekursi terjadi, atau Anda dapat menggunakan rewriteuntuk kembali mengubah-hasil transformasi sampai Anda mencapai titik tetap. Salah satu kelemahan potensial adalah bahwa "anamorphism" terdengar jauh lebih keren daripada "uniplate".

Program lengkap:

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