命题恒真性检查器
命题恒真性检查器
表达式
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