Haskell：析取范式

Question

I am attempting to create Formulas, from a logical language into Disjunctive Normal Form. What I have so far;

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

From my understanding I need navigate the And and Not inwards and vice versa with the OR, if anyone could help and point out where my flaws are that would help greatly!

Answer 1

For these types of problems, it's easy to descend into special-case hell. Part of the problem is that, as per some comments, your DNF data type is too general. After you've recursively called dnf s1 in one of your cases, you really have no clue what you're looking at. There are lots of potentially valid DNF "forms" expressible with your DNF type, and dnf s1 could be any one of them. That makes it hard to write straightforward recursive operations that handle these subterms.

The type system can help. Consider separating the type that represents the input expression:

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

from a more restrictive type that represents the 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

Now, you can reduce the problem to one pattern for each constructor in Expr . (Though, as we'll see below, the case for Not here is better handled differently than the 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

When you're writing one of these helper functions, say dnfOr , you now know exactly what the two inputs look like and exactly what the output should look like, making some of them particularly trivial:

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

This framework can provide high confidence that your final solution will be correct and won't "miss" any cases, something that's hard to do when you're doing everything with your original expression data type.

If you need more help, a full solution is below.

SPOILERS FOLLOW

.

.

.

.

.

.

The dnfOr function above is straightforward. Some of the others are pretty trivial, too, once you understand the restricted DNF representation:

For example, the case for VarT is a singleton disjunction of a singleton conjunction of the variable:

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

For dnfC , we can eliminate boolean constants from our DNF by using the convention that False is an empty disjunction while True is a singleton disjunction containing an empty conjunction. Thanks to math, these are more than just "conventions". They are sound and consistent DNF representations that will play well with other terms in the recursion:

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

Now we get to the "hard" ones. dnfAnd follows from the distributive law, resulting in a new disjunction of pairwise conjunctions. After I thought about it for a little while, I boiled it down to this one-liner:

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

The hardest of all is dnfNot . It turns out you have to write something like this, which I won't bother explaining:

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

The issue is that Not is the one operation that's most easily resolved using the original Expr type, because it's so easy to "push down" the Not s until they're all next to the variables:

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)

So, instead of handling Not by first getting the DNF of its subterm and then negating that, let's flip things around and pre-process it as an Expr before changing it to DNF with this:

dnf (Not s1) = dnf (notExpr s1)

Note that this recursion will cause an infinite loop unless we add a base case to handle the one type of Not expression that notExpr generates in its output Expr s:

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

The full code is below. Note that my solution produces a less than ideal result in a certain case (see the last example in main ). As an exercise, you might want to try fixing this problem, and maybe think about how you would handle the more general problem of removing redundant terms from the final solution.

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
  ]