Haskell中广泛模式匹配的清洁替代方案

Question

现在，我有一些基本上像这样的代码：

data Expression 
    = Literal Bool 
    | Variable String
    | Not Expression 
    | Or Expression Expression 
    | And Expression Expression
    deriving Eq

simplify :: Expression -> Expression
simplify (Literal b) = Literal b
simplify (Variable s) = Variable s
simplify (Not e) = case simplify e of
    (Literal b) -> Literal (not b)
    e'          -> Not e'
simplify (And a b) = case (simplify a, simplify b) of
    (Literal False, _) -> Literal False
    (_, Literal False) -> Literal False
    (a', b')           -> And a' b'
simplify (Or a b) = case (simplify a, simplify b) of
    (Literal True, _) -> Literal True
    (_, Literal True) -> Literal True
    (a', b')          -> Or a' b'

还有更多关于可以简化布尔表达式的所有方式的模式。然而，随着我添加更多运营商和规则，这种情况越来越大，感觉很笨拙。特别是因为一些规则需要加两次来解释交换性。

我怎样才能很好地重构许多模式，其中一些（我说的大多数）甚至是对称的（例如，采用And和Or模式）？

现在，添加规则以简化And (Variable "x") (Not (Variable "x"))到Literal False要求我添加两个嵌套规则，这些规则几乎都是最优的。

Answer 1

基本上问题是你必须一遍又一遍地在每个子句中写出simplify个子表达式。在考虑涉及顶级运营商的法律之前，首先完成所有子表达式会更好。一种简单的方法是添加一个simplify的辅助版本，它不会被递归：

simplify :: Expression -> Expression
simplify (Literal b) = Literal b
simplify (Variable s) = Variable s
simplify (Not e) = simplify' . Not $ simplify e
simplify (And a b) = simplify' $ And (simplify a) (simplify b)
simplify (Or a b) = simplify' $ Or (simplify a) (simplify b)

simplify' :: Expression -> Expression
simplify' (Not (Literal b)) = Literal $ not b
simplify' (And (Literal False) _) = Literal False
...

由于您在布尔值中只进行了少量操作，这可能是最明智的做法。但是，如果有更多操作，simplify中的重复可能仍值得避免。为此，您可以将一元和二元操作混合到一个公共构造函数：

data Expression 
    = Literal Bool 
    | Variable String
    | BoolPrefix BoolPrefix Expression 
    | BoolInfix BoolInfix Expression Expression 
    deriving Eq

data BoolPrefix = Negation
data BoolInfix  = AndOp | OrOp

然后你就

了

simplify (Literal b) = Literal b
simplify (Variable s) = Variable s
simplify (BoolPrefix bpf e) = simplify' . BoolPrefix bpf $ simplify e
simplify (BoolInfix bifx a b) = simplify' $ BoolInfix bifx (simplify a) (simplify b)

显然这会让simplify'更加尴尬，所以也许不是一个好主意。但是，您可以通过定义专门的pattern synonyms：

来解决这种语法开销

{-# LANGUAGE PatternSynonyms #-}

pattern Not :: Expression -> Expression
pattern Not x = BoolPrefix Negation x

infixr 3 :∧
pattern (:∧) :: Expression -> Expression -> Expression
pattern a:∧b = BoolInfix AndOp a b

infixr 2 :∨
pattern (:∨) :: Expression -> Expression -> Expression
pattern a:∨b = BoolInfix OrOp a b

就此而言，也许

pattern F, T :: Expression
pattern F = Literal False
pattern T = Literal True

然后，你可以写

simplify' :: Expression -> Expression
simplify' (Not (Literal b)) = Literal $ not b
simplify' (F :∧ _) = F
simplify' (_ :∧ F) = F
simplify' (T :∨ _) = T
simplify' (a :∧ Not b) | a==b  = T
...

我应该添加一个警告：when I tried something similar to those pattern synonyms, not for booleans but affine mappings, it made the compiler extremely slow。 （另外，GHC-7.10还没有支持多态模式同义词;截至目前，这已经发生了很大变化。）

另请注意，所有这些通常不会产生最简单的形式 - 为此，您需要找到simplify的固定点。

Answer 2

你可以做的一件事是在你构造时简化，而不是先构建然后重复破坏。所以：

module Simple (Expression, true, false, var, not, or, and) where

import Prelude hiding (not, or, and)

data Expression
    = Literal Bool
    | Variable String
    | Not Expression
    | Or Expression Expression
    | And Expression Expression
    deriving (Eq, Ord, Read, Show)

true = Literal True
false = Literal False
var = Variable

not (Literal True) = false
not (Literal False) = true
not x = Not x

or (Literal True) _ = true
or _ (Literal True) = true
or x y = Or x y

and (Literal False) _ = false
and _ (Literal False) = false
and x y = And x y

我们可以在ghci中尝试：

> and (var "x") (and (var "y") false)
Literal False

请注意，不会导出构造函数：这可以确保构建其中一个的人无法避免简化过程。实际上，这可能是一个缺点;有时很高兴看到＆＃34;完整＆＃34;形成。处理此问题的标准方法是使导出的智能构造函数成为类类的一部分;你可以用它们来构建一个完整的＆＃34;形式或简化的＆＃34;办法。为了避免必须两次定义类型，我们可以使用newtype或phantom参数;我在这里选择后者来减少模式匹配中的噪音。

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
module Simple (Format(..), true, false, var, not, or, and) where

import Prelude hiding (not, or, and)

data Format = Explicit | Simplified

data Expression (a :: Format)
    = Literal Bool
    | Variable String
    | Not (Expression a)
    | Or (Expression a) (Expression a)
    | And (Expression a) (Expression a)
    deriving (Eq, Ord, Read, Show)

class Expr e where
    true, false :: e
    var :: String -> e
    not :: e -> e
    or, and :: e -> e -> e

instance Expr (Expression Explicit) where
    true = Literal True
    false = Literal False
    var = Variable
    not = Not
    or = Or
    and = And

instance Expr (Expression Simplified) where
    true = Literal True
    false = Literal False
    var = Variable

    not (Literal True) = false
    not (Literal False) = true
    not x = Not x

    or (Literal True) _ = true
    or _ (Literal True) = true
    or x y = Or x y

    and (Literal False) _ = false
    and _ (Literal False) = false
    and x y = And x y

现在我们可以＆＃34;运行＆＃34;相同的术语有两种不同的方式：

> :set -XDataKinds
> and (var "x") (and (var "y") false) :: Expression Explicit
And (Variable "x") (And (Variable "y") (Literal False))
> and (var "x") (and (var "y") false) :: Expression Simplified
Literal False

您可能希望稍后添加更多规则;例如，也许你想要：

and (Variable x) (Not (Variable y)) | x == y = false
and (Not (Variable x)) (Variable y) | x == y = false

必须重复＆＃34;命令＆＃34;模式有点烦人。我们应该抽象一下！数据声明和类将是相同的，但我们将添加辅助函数eitherOrder并在and和or的定义中使用它。这是使用这个想法（以及我们模块的最终版本）的更完整的简化集：

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
module Simple (Format(..), true, false, var, not, or, and) where

import Data.Maybe
import Data.Monoid
import Prelude hiding (not, or, and)
import Control.Applicative ((<|>))

data Format = Explicit | Simplified

data Expression (a :: Format)
    = Literal Bool
    | Variable String
    | Not (Expression a)
    | Or (Expression a) (Expression a)
    | And (Expression a) (Expression a)
    deriving (Eq, Ord, Read, Show)

class Expr e where
    true, false :: e
    var :: String -> e
    not :: e -> e
    or, and :: e -> e -> e

instance Expr (Expression Explicit) where
    true = Literal True
    false = Literal False
    var = Variable
    not = Not
    or = Or
    and = And

eitherOrder :: (e -> e -> e)
            -> (e -> e -> Maybe e)
            -> e -> e -> e
eitherOrder fExplicit fSimplified x y = fromMaybe
    (fExplicit x y)
    (fSimplified x y <|> fSimplified y x)

instance Expr (Expression Simplified) where
    true = Literal True
    false = Literal False
    var = Variable

    not (Literal True) = false
    not (Literal False) = true
    not (Not x) = x
    not x = Not x

    or = eitherOrder Or go where
        go (Literal True) _ = Just true
        go (Literal False) x = Just x
        go (Variable x) (Variable y) | x == y = Just (var x)
        go (Variable x) (Not (Variable y)) | x == y = Just true
        go _ _ = Nothing

    and = eitherOrder And go where
        go (Literal True) x = Just x
        go (Literal False) _ = Just false
        go (Variable x) (Variable y) | x == y = Just (var x)
        go (Variable x) (Not (Variable y)) | x == y = Just false
        go _ _ = Nothing

现在在ghci中我们可以进行更复杂的简化，例如：

> and (not (not (var "x"))) (var "x") :: Expression Simplified
Variable "x"

即使我们只写了一个重写规则的订单，但两个订单都能正常工作：

> and (not (var "x")) (var "x") :: Expression Simplified
Literal False
> and (var "x") (not (var "x")) :: Expression Simplified
Literal False

Answer 3

我认为爱因斯坦说：“尽可能地简化，但不能再简化。”你有一个复杂的数据类型和相应复杂的概念，所以我认为任何技术只能对手头的问题更加清晰。

也就是说，第一种选择是使用案例结构。

simplify x = case x of
   Literal _  -> x
   Variable _ -> x
   Not e      -> simplifyNot $ simplify e
   ...
   where
     sharedFunc1 = ...
     sharedFunc2 = ...

这具有包括共享功能的额外好处，所有共享功能可用于所有情况但不能用于顶级命名空间。我也喜欢这些案例如何从括号中解脱出来。 （另请注意，在前两种情况下，我只返回原始术语，而不是创建新术语）。我经常使用这种结构来突破其他简化函数，就像Not一样。

特别是这个问题可能会使Expression基于底层仿函数，因此您可以fmap简化子表达式，然后执行给定案例的特定组合。它看起来如下所示：

simplify :: Expression' -> Expression'
simplify = Exp . reduce . fmap simplify . unExp

这里的步骤是将Expression'展开到底层仿函数表示中，映射底层术语的简化，然后减少简化并重新包装到新的Expression'

{-# Language DeriveFunctor #-}

newtype Expression' = Exp { unExp :: ExpressionF Expression' }

data ExpressionF e
  = Literal Bool 
  | Variable String
  | Not e 
  | Or e e
  | And e e
  deriving (Eq,Functor)

现在，我已经将复杂性推到reduce函数中，这只是稍微复杂一点，因为它不必担心首先减少子项。但它现在只包含将一个术语与另一个术语合并的业务逻辑。

这对您来说可能是一种很好的技术，但它可能会使一些增强功能更容易。例如，如果可以在您的语言中形成无效表达式，则可以使用Maybe值失败来简化该表达式。

simplifyMb :: Expression' -> Maybe Expression'
simplifyMb = fmap Exp . reduceMb <=< traverse simplifyMb . unExp

此处traverse会将simplfyMb应用于ExpressionF的子标题，从而生成Maybe个子句点ExpressionF (Maybe Expression')的表达式，如果有的话子标题为Nothing，它将返回Nothing，如果全部为Just x，则返回Just (e::ExpressionF Expression')。 Traverse实际上并没有像这样分成不同的阶段，但它更容易解释，就好像它一样。另请注意，您需要DeriveTraversable和DeriveFoldable的语言编译指示，以及ExpressionF数据类型的派生语句。

缺点？好吧，对于其中一个，你的代码的污垢将随处可见一堆Exp包装器。考虑以下简单术语simplfyMb的应用：

simplifyMb (Exp $ Not (Exp $ Literal True))

要理解这一点也很重要，但如果你理解上面的traverse和fmap模式，你可以在很多地方重复使用它，这样做很好。我也相信以这种方式定义简化使得它对于特定ExpressionF结构可能变成的任何内容都更加健壮。它没有提到它们，所以深度简化不会受到重构的影响。另一方面，reduce函数将是。

Answer 4

继续您的Binary Op Expression Expression想法，我们可以使用数据类型：

data Expression
    = Literal Bool
    | Variable String
    | Not Expression
    | Binary Op Expression Expression
    deriving Eq

data Op = Or | And deriving Eq

辅助功能

{-# LANGUAGE ViewPatterns #-}

simplifyBinary  :: Op -> Expression -> Expression -> Expression
simplifyBinary  binop (simplify -> leftexp) (simplify -> rightexp) =
    case oneway binop leftexp rightexp ++ oneway binop rightexp leftexp of
        simplified : _ -> simplified
        []             -> Binary binop leftexp rightexp
  where
    oneway :: Op -> Expression -> Expression -> [Expression]
    oneway And (Literal False) _ = [Literal False]
    oneway Or  (Literal True)  _ = [Literal True]
    -- more cases here
    oneway _   _               _ = []

这个想法是你将简化案例放在oneway中，然后simplifyBinary将负责反转参数，以避免编写对称案例。

Answer 5

您可以为所有二进制操作编写通用的简化器：

simplifyBinWith :: (Bool -> Bool -> Bool) -- the boolean operation
                -> (Expression -> Expression -> Expression) -- the constructor
                -> Expression -> Expression -- the two operands
                -> Expression) -- the simplified result
simplifyBinWith op cons a b = case (simplify a, simplify b) of
    (Literal x, Literal y) -> Literal (op x y)
    (Literal x, b')        -> tryAll (x `op`) b'
    (a',        Literal y) -> tryAll (`op` y) a'
    (a',        b')        -> cons a' b'
  where
    tryAll f term = case (f True, f False) of -- what would f do if term was true of false
      (True,  True)  -> Literal True
      (True,  False) -> term
      (False, True)  -> Not term
      (False, False) -> Literal False

这样，您的simplify功能就会变成

simplify :: Expression -> Expression
simplify (Not e)   = case simplify e of
    (Literal b) -> Literal (not b)
    e'          -> Not e'
simplify (And a b) = simplifyBinWith (&&) And a b
simplify (Or a b)  = simplifyBinWith (||) Or a b
simplify t         = t

可以很容易地扩展到更多二进制操作。它也适用于Binary Op Expression Expression这个想法，您将Op而不是Expression构造函数传递给simplifyBinWith，simplify中的模式可以概括：

simplify :: Expression -> Expression
simplify (Not e)         = case simplify e of
    (Literal b) -> Literal (not b)
    e'          -> Not e'
simplify (Binary op a b) = simplifyBinWith (case op of
    And -> (&&)
    Or -> (||)
    Xor -> (/=)
    Implies -> (<=)
    Equals -> (==)
    …
  ) op a b
simplify t               = t
  where
    simplifyBinWith f op a b = case (simplify a, simplify b) of
      (Literal x, Literal y) -> Literal (f x y)
      …
      (a',        b')        -> Binary op a' b'