Cách giảm trùng lặp mã khi xử lý các loại tổng đệ quy

Tôi hiện đang làm việc với một trình thông dịch đơn giản cho ngôn ngữ lập trình và tôi có kiểu dữ liệu như thế này:

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

Và tôi có nhiều chức năng làm những việc đơn giản như:

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

Nhưng trong mỗi hàm này, tôi phải lặp lại phần gọi mã theo cách đệ quy chỉ với một thay đổi nhỏ đối với một phần của hàm. Có cách nào để làm điều này rộng rãi hơn không? Tôi thà không phải sao chép và dán phần này:

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

Và chỉ thay đổi một trường hợp duy nhất mỗi lần vì có vẻ không hiệu quả để sao chép mã như thế này.

Giải pháp duy nhất tôi có thể đưa ra là có một hàm gọi hàm đầu tiên trên toàn bộ cấu trúc dữ liệu và sau đó đệ quy về kết quả như sau:

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

Nhưng tôi cảm thấy có lẽ nên có một cách đơn giản hơn để làm điều này rồi. Tui bỏ lỡ điều gì vậy?

Xin chúc mừng, bạn vừa khám phá lại sự biến thái!

Đây là mã của bạn, được chỉnh sửa lại để nó hoạt động với recursion-schemesgói. Than ôi, nó không ngắn hơn, vì chúng ta cần một số nồi hơi để làm cho máy móc hoạt động. (Có thể có một số cách tự động để tránh nồi hơi, ví dụ như sử dụng thuốc generic. Đơn giản là tôi không biết.)

Dưới đây, của bạn recurseAfterđược thay thế với tiêu chuẩn ana.

Trước tiên chúng tôi xác định loại đệ quy của bạn, cũng như functor, đây là điểm cố định của.

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

Sau đó, chúng tôi kết nối cả hai với một vài trường hợp để chúng tôi có thể mở ra Exprthành đẳng cấuExprF Expr , và gấp nó lại.

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

Cuối cùng, chúng tôi điều chỉnh mã gốc của bạn và thêm một vài thử nghiệm.

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

Một sự thay thế có thể chỉ là định nghĩa ExprF a, và sau đó rút ra type Expr = Fix ExprF. Điều này giúp tiết kiệm một số bản tóm tắt ở trên (ví dụ: hai trường hợp), với chi phí phải sử dụng Fix (VariableF ...)thay vì Variable ..., cũng như tương tự cho các nhà xây dựng khác.

Người ta có thể làm giảm thêm rằng bằng cách sử dụng các từ đồng nghĩa mẫu (mặc dù chi phí của một cái nồi hơi nhiều hơn).

Cập nhật: Cuối cùng tôi đã tìm thấy công cụ tự động, sử dụng mẫu Haskell. Điều này làm cho toàn bộ mã ngắn hợp lý. Lưu ý rằng ExprFfunctor và hai trường hợp trên vẫn tồn tại dưới mui xe và chúng ta vẫn phải sử dụng chúng. Chúng tôi chỉ tiết kiệm rắc rối khi phải xác định chúng theo cách thủ công, nhưng điều đó một mình tiết kiệm rất nhiều nỗ lực.

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

Là một cách tiếp cận khác, đây cũng là trường hợp sử dụng điển hình cho uniplategói. Nó có thể sử dụng Data.Datathuốc generic chứ không phải Mẫu Haskell để tạo bản tóm tắt, vì vậy nếu bạn lấy được các Datathể hiện cho Expr:

import Data.Data

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

sau đó transformhàm từ Data.Generics.Uniplate.Dataáp dụng một hàm đệ quy cho từng lồng nhau 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

Lưu ý rằng replaceSubWithAdd, đặc biệt, hàm fđược viết để thực hiện thay thế không đệ quy; transformlàm cho nó đệ quy trong x :: Expr, do đó, nó thực hiện phép thuật tương tự với chức năng của trình trợ giúp như anatrong câu trả lời của @ 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]
> 

Điều này không ngắn hơn giải pháp Haskell Mẫu của @ chi. Một lợi thế tiềm năng là uniplatecung cấp một số chức năng bổ sung có thể hữu ích. Ví dụ: nếu bạn sử dụng descendthay thế transform, nó chỉ biến đổi ngay lập tức đứa trẻ có thể cho phép bạn kiểm soát nơi đệ quy xảy ra hoặc bạn có thể sử dụng rewriteđể chuyển đổi lại kết quả của các phép biến đổi cho đến khi bạn đạt đến một điểm cố định. Một nhược điểm tiềm năng là "sự biến thái" nghe có vẻ hay hơn "vô kỷ luật".

Chương trình đầy đủ:

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