Haskell：析取范式

Question

我正在尝试创建公式，从逻辑语言到析取范式。 到目前为止我所拥有的；

data DNF = Var String| C Bool | Not DNF | And DNF DNF | Or DNF DNF 

toDNF :: DNF -> DNF
dnf (And (Or s1 s2) s3) = Or (And (dnf s1) (dnf s3)) (And (dnf s2) (dnf s3))
dnf (And s1 (Or s2 s3)) = Or (And (dnf s1) (dnf s2)) (And (dnf s1) (dnf s3))

dnf (And s1 s2) = And (dnf s1) (dnf s2)
dnf (Or s1 s2) = Or (dnf s1) (dnf s2)

dnf (Not (Not d)) = dnf d
dnf (Not (And s1 s2)) = Or (Not (dnf s1)) (Not (dnf s2))
dnf (Not (Or s1 s2)) = And (Not (dnf s1)) (Not (dnf s2))

dnf s = s

根据我的理解，我需要使用 OR 向内导航 And 和 Not，反之亦然，如果有人可以提供帮助并指出我的缺陷所在，那将大有帮助！

Answer 1

对于这些类型的问题，很容易陷入特例地狱。 部分问题在于，根据一些评论，您的 DNF 数据类型过于笼统。 在你的一个案例中递归调用dnf s1之后，你真的不知道你在看什么。 有许多可用DNF类型表达的潜在有效 DNF“形式”， dnf s1可以是其中任何一种。 这使得编写处理这些子项的直接递归操作变得困难。

类型系统可以提供帮助。 考虑分离表示输入表达式的类型：

data Expr = Var String | C Bool | Not Expr | And Expr Expr | Or Expr Expr

来自代表 DNF output 的更具限制性的类型：

newtype DNF  = Disj [Conj]             -- DNF is a disjuction
newtype Conj = Conj [Term]             -- of conjunctions
data    Term = JustT VarT | NotT VarT  -- of possibly negated
newtype VarT = VarT String             -- variables

现在，您可以将问题简化为Expr中每个构造函数的一种模式。 （不过，正如我们将在下面看到的，此处Not的情况与 rest 的处理方式不同。）

dnf :: Expr -> DNF
dnf (And s1 s2) = dnfAnd (dnf s1) (dnf s2)
dnf (Or s1 s2)  = dnfOr (dnf s1) (dnf s2)
dnf (Not s1)    = dnfNot (dnf s1)
dnf (C b)       = dnfC b
dnf (Var x)     = dnfVar x

当您编写这些辅助函数之一时，比如dnfOr ，您现在确切地知道两个输入是什么样子以及 output 应该是什么样子，使其中一些特别微不足道：

dnfOr (Disj conjs1) (Disj conjs2) = Disj (conjs1 ++ conjs2)

该框架可以让您确信您的最终解决方案是正确的，并且不会“遗漏”任何情况，而当您使用原始表达式数据类型执行所有操作时，这是很难做到的。

如果您需要更多帮助，下面是完整的解决方案。

剧透如下

.

.

.

.

.

.

上面的dnfOr function 很简单。 一旦你理解了受限的DNF表示，其他一些也很微不足道：

例如， VarT的情况是变量的 singleton 合取的 singleton 析取：

dnfVar x = Disj [Conj [JustT (VarT x)]]

对于dnfC ，我们可以通过使用False是空析取而True是包含空合取的 singleton 析取的约定从 DNF 中消除 boolean 常量。 多亏了数学，这些不仅仅是“约定”。 它们是可靠且一致的 DNF 表示，可以与递归中的其他项很好地配合使用：

dnfC False = Disj []
dnfC True = Disj [Conj []]

现在我们进入“困难”的部分。 dnfAnd遵循分配律，导致成对连词的新析取。 在我想了一会儿之后，我把它归结为一行：

dnfAnd (Disj conjs1) (Disj conjs2) = Disj [c1 ++ c2 | c1 <- conjs1, c2 <- conjs2]

最难的是dnfNot 。 事实证明你必须写这样的东西，我不会费心解释：

dnfNot (Disj conjs) = foldr dnfAnd (dnfC True) [conjNot c | c <- conjs]
  where
    conjNot (Conj ts) = Disj [Conj [termNot t] | t <- ts]
    termNot (JustT v) = NotT v
    termNot (NotT v) = JustT v

问题是Not是使用原始Expr类型最容易解决的一个操作，因为很容易“下推” Not直到它们都在变量旁边：

notExpr (And e1 e2) = (Or (notExpr e1) (notExpr e2))
notExpr (Or e1 e2) = (And (notExpr e1) (notExpr e2))
notExpr (Not e1) = e1
notExpr (C b) = C (not b)
notExpr (Var e1) = Not (Var e1)

因此，不是通过首先获取其子项的 DNF 然后取反来处理Not ，而是让我们翻转一下并将其预处理为Expr ，然后再将其更改为 DNF：

dnf (Not s1) = dnf (notExpr s1)

请注意，此递归将导致无限循环，除非我们添加一个基本情况来处理notExpr在其 output Expr中生成的一种类型的Not表达式：

-- handle the base case produced by `notExpr`
dnf (Not (Var x)) = Disj [Conj [NotT (VarT x)]]
-- every other occurrence of `Not` gets processed by `notExpr`
dnf (Not s)       = dnf (notExpr s)

完整代码如下。 请注意，我的解决方案在某些情况下产生的结果不太理想（请参阅main中的最后一个示例）。 作为练习，您可能想尝试解决此问题，并且可能会考虑如何处理从最终解决方案中删除冗余项的更普遍的问题。

import Data.List

data Expr = Var String | C Bool | Not Expr | And Expr Expr | Or Expr Expr
  deriving (Show)
infixl 3 `And`
infixl 2 `Or`

newtype DNF  = Disj [Conj] deriving (Show)  -- DNF is a disjuction
newtype Conj = Conj [Term] deriving (Show)  -- of conjunctions
data    Term = JustT VarT
             | NotT VarT   deriving (Show)  -- of possibly negated
newtype VarT = VarT String deriving (Show)  -- variables

prettyDNF :: DNF -> String
prettyDNF (Disj conjs)
  = [parens (map prettyTerm ts `sepBy` "∧") | Conj ts <- conjs] `sepBy` "∨"
  where prettyTerm (JustT (VarT x)) = x
        prettyTerm (NotT (VarT x)) = "¬" ++ x

        xs `sepBy` sep = intercalate sep xs
        parens str = "(" ++ str ++ ")"

dnf :: Expr -> DNF

dnf (And s1 s2) = dnfAnd (dnf s1) (dnf s2)
  where
    dnfAnd :: DNF -> DNF -> DNF
    dnfAnd (Disj conjs1) (Disj conjs2) = Disj [Conj (c1 ++ c2) | Conj c1 <- conjs1, Conj c2 <- conjs2]

dnf (Or s1 s2)  = dnfOr (dnf s1) (dnf s2)
  where
    dnfOr :: DNF -> DNF -> DNF
    dnfOr (Disj d1) (Disj d2) = Disj (d1 ++ d2)

dnf (Not (Var x)) = Disj [Conj [NotT (VarT x)]]
dnf (Not s)       = dnf (notExpr s)
  where
    notExpr :: Expr -> Expr
    notExpr (And e1 e2) = (Or (notExpr e1) (notExpr e2))
    notExpr (Or e1 e2) = (And (notExpr e1) (notExpr e2))
    notExpr (Not e1) = e1
    notExpr (C b) = C (not b)
    notExpr (Var e1) = Not (Var e1)

dnf (C b)       = dnfC b
  where
    dnfC :: Bool -> DNF
    dnfC False = Disj []
    dnfC True = Disj [Conj []]

dnf (Var x)     = dnfVar x
  where
    dnfVar :: String -> DNF
    dnfVar x = Disj [Conj [JustT (VarT x)]]

main = mapM_ (putStrLn . prettyDNF . dnf)
  [ (Var "a" `Or` Var "b") `And` (Var "c" `Or` Var "d")
  , Not ((Var "a" `Or` Var "b") `And` (Var "c" `Or` Var "d"))
  , Not (Var "a" `And` Var "b") `Or` (Var "c" `And` Var "d")
  -- This last case prints (a)∨() which is technically correct
  -- but can be further simplified to (), the singleton
  -- disjunction of an empty conjunction representing "true"
  , Var "a" `Or` C True
  ]