命题恒真性检查器

命题恒真性检查器

表达式

data Prop = Const Bool			-- 值
            | Var Char 			-- 变量
            | Not Prop 			-- 否定
            | And Prop Prop 	-- 合取
            | Imply Prop Prop	-- 蕴含

数据准备

graph LR A(表达式) --> B(变量集) --> C(真值集) --> D(输入集)

验证

> isTaut p1
False

> isTaut p2
True

> isTaut p3
False

> isTaut p4
True

代码

import Data.List(nub)

-- 类型
type Subst = [(Char,Bool)]

data Prop = Const Bool
            | Var Char 
            | Not Prop 
            | And Prop Prop 
            | Imply Prop Prop


-- 表达式求值
find :: Ord a => a -> [(a,b)] -> b
find k ((k',v):xs)  | k == k' = v
                    | otherwise = find k xs

eval :: Subst -> Prop -> Bool
eval _ (Const b)    = b
eval s (Var x)      = find x s
eval s (Not p)      = not (eval s p)
eval s (And p q)    = eval s p && eval s q
eval s (Imply p q)  = eval s p <= eval s q


-- 数据准备 
vars :: Prop -> [Char]
vars (Var x)    = [x]
vars (Not p)    = nub $ vars p
vars (And p q)  = nub $ vars p ++ vars q
vars (Imply p q)= nub $ vars p ++ vars q

bools :: Int -> [[Bool]]
bools 0 = [[]]
bools n = map (False:) bss ++ map (True:) bss
        where bss = bools (n-1)

substs :: Prop -> [Subst]
substs p = map (zip vs) (bools $ length vs)
        where vs = vars p


-- 重言式判断
isTaut :: Prop -> Bool
isTaut p = and [eval s p | s <- substs p]


-- 测试数据
p1 :: Prop
p1 = And (Var 'A') (Not (Var 'A'))

p2 :: Prop
p2 = Imply (And (Var 'A') (Var 'B')) (Var 'A')

p3 :: Prop
p3 = Imply (Var 'A') (And (Var 'A') (Var 'B'))

p4 :: Prop
p4 = Imply (And (Var 'A') (Imply (Var 'A') (Var 'B'))) (Var 'B')

参考: Programming in Haskell ch8.6