Haskell 中广泛模式匹配的更清洁替代方案
Cleaner Alternative to Extensive Pattern Matching in Haskell
现在,我有一些代码基本上是这样工作的:
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
需要我添加两个嵌套规则,这几乎是最佳的。
基本上,问题是您必须一遍又一遍地写出每个子句中的 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
.
的不动点
我想 Einstein 说过,"Simplify as much as possible, but no more." 你自己有一个复杂的数据类型,以及一个相应的复杂概念,所以我认为任何技术都只能使手头的问题更清晰。
也就是说,第一个选项是使用格结构。
simplify x = case x of
Literal _ -> x
Variable _ -> x
Not e -> simplifyNot $ simplify e
...
where
sharedFunc1 = ...
sharedFunc2 = ...
这具有包含共享函数的额外好处,这些函数将在所有情况下都可用,但不能在顶级命名空间中使用。我也喜欢这些案例如何摆脱括号。 (另请注意,在前两种情况下,我只是 return 原始术语,而不是创建新术语)。我经常使用这种结构来分解其他简化函数,例如 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
,它将 return Nothing
,如果所有子项都是 Just x
,它将 return Just (e::ExpressionF Expression')
。 Traverse 实际上并没有像那样被分成不同的阶段,但这样更容易解释。另请注意,您将需要 DeriveTraversable 和 DeriveFoldable 的语言编译指示,以及 ExpressionF
数据类型的派生语句。
缺点是什么?好吧,对于一个人来说,代码的污垢将随处可见一堆 Exp
包装器。考虑以下简单项的 simplfyMb
的应用:
simplifyMb (Exp $ Not (Exp $ Literal True))
脑洞大开也有很多,但如果你理解上面的 traverse
和 fmap
模式,你可以在很多地方重用它,这很好。我还相信,以这种方式定义 simplify 会使它对任何特定的 ExpressionF
结构可能变成的东西都更加健壮。它没有提及它们,因此深度简化将不受重构的影响。另一方面,reduce 函数将是。
继续您的 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
会负责反转参数,以避免必须编写对称案例。
您可以做的一件事是在构造时进行简化,而不是先构造然后反复破坏。所以:
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
请注意,构造函数未导出:这确保构造其中之一的人无法避免简化过程。实际上,这可能是一个缺点;偶尔很高兴看到 "full" 形式。处理此问题的标准方法是使导出的智能构造函数成为类型-class 的一部分;您可以使用它们来构建 "full" 表单或 "simplified" 方式。为了避免必须定义类型两次,我们可以使用新类型或幻像参数;我会在这里选择后者以减少模式匹配中的噪音。
{-# 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
现在在 ghci 中我们可以 "run" 以两种不同的方式使用相同的术语:
> :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
必须重复两个 "orders" 模式有点烦人。我们应该对此进行抽象!数据声明和 classes 将是相同的,但我们将添加辅助函数 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
您可以为所有二元运算编写通用简化器:
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'
现在,我有一些代码基本上是这样工作的:
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
需要我添加两个嵌套规则,这几乎是最佳的。
基本上,问题是您必须一遍又一遍地写出每个子句中的 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
.
我想 Einstein 说过,"Simplify as much as possible, but no more." 你自己有一个复杂的数据类型,以及一个相应的复杂概念,所以我认为任何技术都只能使手头的问题更清晰。
也就是说,第一个选项是使用格结构。
simplify x = case x of
Literal _ -> x
Variable _ -> x
Not e -> simplifyNot $ simplify e
...
where
sharedFunc1 = ...
sharedFunc2 = ...
这具有包含共享函数的额外好处,这些函数将在所有情况下都可用,但不能在顶级命名空间中使用。我也喜欢这些案例如何摆脱括号。 (另请注意,在前两种情况下,我只是 return 原始术语,而不是创建新术语)。我经常使用这种结构来分解其他简化函数,例如 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
,它将 return Nothing
,如果所有子项都是 Just x
,它将 return Just (e::ExpressionF Expression')
。 Traverse 实际上并没有像那样被分成不同的阶段,但这样更容易解释。另请注意,您将需要 DeriveTraversable 和 DeriveFoldable 的语言编译指示,以及 ExpressionF
数据类型的派生语句。
缺点是什么?好吧,对于一个人来说,代码的污垢将随处可见一堆 Exp
包装器。考虑以下简单项的 simplfyMb
的应用:
simplifyMb (Exp $ Not (Exp $ Literal True))
脑洞大开也有很多,但如果你理解上面的 traverse
和 fmap
模式,你可以在很多地方重用它,这很好。我还相信,以这种方式定义 simplify 会使它对任何特定的 ExpressionF
结构可能变成的东西都更加健壮。它没有提及它们,因此深度简化将不受重构的影响。另一方面,reduce 函数将是。
继续您的 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
会负责反转参数,以避免必须编写对称案例。
您可以做的一件事是在构造时进行简化,而不是先构造然后反复破坏。所以:
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
请注意,构造函数未导出:这确保构造其中之一的人无法避免简化过程。实际上,这可能是一个缺点;偶尔很高兴看到 "full" 形式。处理此问题的标准方法是使导出的智能构造函数成为类型-class 的一部分;您可以使用它们来构建 "full" 表单或 "simplified" 方式。为了避免必须定义类型两次,我们可以使用新类型或幻像参数;我会在这里选择后者以减少模式匹配中的噪音。
{-# 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
现在在 ghci 中我们可以 "run" 以两种不同的方式使用相同的术语:
> :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
必须重复两个 "orders" 模式有点烦人。我们应该对此进行抽象!数据声明和 classes 将是相同的,但我们将添加辅助函数 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
您可以为所有二元运算编写通用简化器:
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'