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!
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
]
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.