在 Haskell 中为逻辑表达式生成真值表
Posted
技术标签:
【中文标题】在 Haskell 中为逻辑表达式生成真值表【英文标题】：Generating truth tables for logic expressions in Haskell 【发布时间】：2010-10-31 18:06:22 【问题描述】：第一部分是具有以下类型签名的评估函数：
evaluate :: Logic Expr -> [(Variable, Bool)] -> Bool
这将一个逻辑表达式和一个赋值对列表作为输入，并根据提供的布尔赋值返回表达式的值。赋值列表是一个不同的对列表，其中每对包含一个变量及其布尔赋值。也就是说，如果您将表达式 A ∧ B 以及赋值 A = 1 和 B = 0 传递给函数，则您的函数必须返回 0（这来自 Digital Logic Design，0 对应于 false，1 对应于 true）。
这是我到目前为止所做的：
type Variable = Char
data LogicExpr = V Variable
| Negation LogicExpr
| Conjunction LogicExpr LogicExpr
| Disjunction LogicExpr LogicExpr
| Implication LogicExpr LogicExpr
evaluate :: LogicExpr -> [(Variable,Bool)] -> Bool
evaluate (V a) ((x1,x2):xs) | a==x1 = x2
| otherwise = (evaluate(V a)xs)
evaluate (Negation a) l | (evaluate a l)==True = False
| otherwise = True
evaluate (Conjunction a b) l = (evaluate a l)&&(evaluate b l)
evaluate (Disjunction a b) l = (evaluate a l)||(evaluate b l)
evaluate (Implication a b) l
| (((evaluate b l)==False)&&((evaluate a l)==True)) = False
| otherwise = True
下一部分是定义generateTruthTable，这是一个函数，它以一个逻辑表达式为输入，以赋值对列表的形式返回表达式的真值表。也就是说，如果将表达式 E = A ∧ B 传递给函数，则函数必须返回 A = 0, B = 0, E = 0 | A = 0, B = 1, E = 0 | A = 1, B = 0, E = 0 | A = 1，B = 1，E = 1。
我对语法不是很熟悉，所以我不知道如何返回列表。
【问题讨论】：
恕我直言，如果您取消 [紧急]，会有更多人关注此内容。 我上大学的时候，我最好的朋友是一个口袋大小的跑者。永远不要忘记家庭作业，按最接近的截止日期排列优先级（他们说这是最有效的）。 请忽略粗鲁的海报。这不是典型体验的代表。 嗯，为家庭作业提问者提供部分答案，这些答案只不过是提示，让 OP 完成大部分工作在 SO 上是很正常的——或者在任何与教育有关的论坛中，真的。回应的粗鲁程度各不相同，但你必须学会在互联网上几乎所有论坛上保持厚脸皮。不要因为人们表达强烈的分歧而太激动。 您正在学习 4 种语言，并且对列表中最酷的语言关注最少。 :\ 【参考方案1】：标准库函数，代码重用。此外，你的括号使用和间距真的很糟糕。
evaluate (V a) l =
case lookup a l
of Just x -> x
Nothing -> error $ "Unbound variable: " ++ show a
-- same as
evaluate (V a) l = maybe (error $ "Unbound variable: " ++ show a) id $ lookup a l
evaluate (Negation a) l = not $ evaluate a l
evaluate (Implication a b) l = evaluate (Negation a `Disjunction` b) l
现在，您想要generateTruthTable？这很简单，只需获取布尔变量的所有可能状态，并将计算后的表达式添加到每个状态的末尾。
generateTruthTable :: [Variable] -> LogicExpr -> [[(Variable, Bool)]]
generateTruthTable vs e = [l ++ [('E', evaluate e l)] | l <- allPossible vs]
如果你有一个函数来生成所有这些可能的状态。
allPossible :: [Variable] -> [[(Variable, Bool)]]
按照我的功能直觉，这感觉应该是一种变态。毕竟，它确实需要查看列表中的所有内容，但返回结构不同的内容，并且它可能可以通过简单的方式进行分解，因为这是一个介绍级的 CS 类。 （我不在乎课程编号是多少，这是介绍性的东西。）
allPossible = foldr step initial where
step v ls = ???; initial = ???
现在是foldr :: (a -> b -> b) -> b -> [a] -> b，所以前两个参数必须是step :: a -> b -> b 和initial :: b。现在，allPossible :: [Variable] -> [[(Variable, Bool)]] = foldr step initial :: [a] -> b。嗯，这一定是指a = Variable和b = [[(Variable, Bool)]]。这对step 和initial 意味着什么？
step :: Variable -> [[(Variable, Bool)]] -> [[(Variable, Bool)]]
initial :: [[(Variable, Bool)]]
有趣。不知何故，需要有一种方法可以从变量状态列表中 step 并向其中添加单个变量，以及一些根本没有变量的 initial 列表。
如果您的大脑已经设法“点击”进入函数式编程范式，那么这应该绰绰有余了。如果没有，那么无论你在这里收到什么指令，你都会在作业到期的几个小时内搞砸。祝你好运，如果你在作业到期后仍然卡住，你应该问你的教授，或者在这里问一个不紧急的问题。
如果您对语言有基本的可用性问题（“语法是什么”、“运行时语义是什么”、“xxx 是否有预先存在的功能”、等）：
Haskell 98 Language and Libraries 是基本语言和库的免费、规范定义。 Haskell wiki 上提供了更多链接。 有关 98 后语言扩展，请参阅GHC documentation。 GHC、Hugs 和其他现代 Haskell 实现还提供了比 Haskell 98 中指定的更丰富的标准库。hierarchical libraries 的完整文档也可在线获取。 Hoogλe 是扩展 Haskell 标准库的专用搜索引擎。 Hayoo! 与此类似，但也涵盖了 HackageDB，这是一系列远远超出标准发行版的 Haskell 库。我希望您的班级提供了类似的资源，但如果没有，以上所有内容都可以通过 Google 搜索轻松找到。
如果有适当的参考，任何值得他或她自己的salt 的程序员都应该能够在几个小时内掌握任何新语言的语法，并在几天内对运行时有一个实际的了解。当然，掌握一种新的范式可能需要很长时间，让学生保持相同的标准有点不公平，但这就是课程的目的。
有关 Stack Overflow 上更高级别问题的问题可能会得到较少的答案，但他们也会得到更少的任性 :) 家庭作业问题被归类为“为我做我的工作！”在大多数人的眼中。
剧透
请不要作弊。但是，只是为了让您体验一下在 Haskell 中可以做的很棒的事情......
-# LANGUAGE FlexibleInstances, UndecidableInstances #-
-# LANGUAGE OverlappingInstances, PatternGuards #-
module Expr (Ring(..), (=:>), Expr(..), vars, eval, evalAll) where
import Control.Monad.Error
infixl 5 =:>, :=>
infixl 6 +:, -:, :+, :-
infixl 7 *:, :*
class (Eq a) => Ring a where
(+:) :: a -> a -> a; (-:) :: a -> a -> a; x -: y = x +: invert y
(*:) :: a -> a -> a; invert :: a -> a; invert x = zero -: x
zero :: a; one :: a
(=:>) :: (Ring a) => a -> a -> a
(=:>) = flip (-:)
instance (Num a) => Ring a where
(+:) = (+); (-:) = (-); (*:) = (*)
invert = negate; zero = 0; one = 1
instance Ring Bool where
(+:) = (||); (*:) = (&&)
invert = not; zero = False; one = True
data Expr a b
= Expr a b :+ Expr a b | Expr a b :- Expr a b
| Expr a b :* Expr a b | Expr a b :=> Expr a b
| Invert (Expr a b) | Var a | Const b
paren :: ShowS -> ShowS
paren ss s = '(' : ss (')' : s)
instance (Show a, Show b) => Show (Expr a b) where
showsPrec _ (Const c) = ('@':) . showsPrec 9 c
showsPrec _ (Var v) = ('$':) . showsPrec 9 v
showsPrec _ (Invert e) = ('!':) . showsPrec 9 e
showsPrec n e@(a:=>b)
| n > 5 = paren $ showsPrec 0 e
| otherwise = showsPrec 7 a . ('=':) . ('>':) . showsPrec 5 b
showsPrec n e@(a:*b)
| n > 7 = paren $ showsPrec 0 e
| otherwise = showsPrec 7 a . ('*':) . showsPrec 7 b
showsPrec n e | n > 6 = paren $ showsPrec 0 e
showsPrec _ (a:+b) = showsPrec 6 a . ('+':) . showsPrec 6 b
showsPrec _ (a:-b) = showsPrec 6 a . ('-':) . showsPrec 6 b
vars :: (Eq a) => Expr a b -> [a]
vars (a:+b) = vars a ++ vars b
vars (a:-b) = vars a ++ vars b
vars (a:*b) = vars a ++ vars b
vars (a:=>b) = vars a ++ vars b
vars (Invert e) = vars e; vars (Var v) = [v]; vars _ = []
eval :: (Eq a, Show a, Ring b, Monad m) => [(a, b)] -> Expr a b -> m b
eval m (a:+b) = return (+:) `ap` eval m a `ap` eval m b
eval m (a:-b) = return (-:) `ap` eval m a `ap` eval m b
eval m (a:*b) = return (*:) `ap` eval m a `ap` eval m b
eval m (a:=>b) = return (=:>) `ap` eval m a `ap` eval m b
eval m (Invert e) = return invert `ap` eval m e
eval m (Var v)
| Just c <- lookup v m = return c
| otherwise = fail $ "Unbound variable: " ++ show v
eval _ (Const c) = return c
namedProduct :: [(a, [b])] -> [[(a, b)]]
namedProduct = foldr (\(v, cs) l -> concatMap (\c -> map ((v, c):) l) cs) [[]]
evalAll :: (Eq a, Show a, Ring b) => [b] -> a -> Expr a b -> [[(a, b)]]
evalAll range name e =
[ vs ++ [(name, either error id $ eval vs e)]
| vs <- namedProduct $ zip (vars e) (repeat range)
]
【讨论】：
【参考方案2】：基本的evaluate 非常简单：
import Data.Maybe (fromJust)
import Data.List (nub)
type Variable = Char
data LogicExpr
= Var Variable
| Neg LogicExpr
| Conj LogicExpr LogicExpr
| Disj LogicExpr LogicExpr
| Impl LogicExpr LogicExpr
deriving (Eq, Ord)
-- evaluates an expression
evaluate :: LogicExpr -> [(Variable, Bool)] -> Bool
evaluate (Var v) bs = fromJust (lookup v bs)
evaluate (Neg e) bs = not (evaluate e bs)
evaluate (Conj e1 e2) bs = evaluate e1 bs && evaluate e2 bs
evaluate (Disj e1 e2) bs = evaluate e1 bs || evaluate e2 bs
evaluate (Impl e1 e2) bs = not (evaluate e1 bs) || evaluate e2 bs
要生成真值表，您首先必须找到表达式中的所有变量，然后为这些变量生成所有可能的赋值。使用已经实现的evaluate 函数可以很容易地确定这些赋值的真值：
-- get variables in an expression
varsp :: LogicExpr -> [Variable]
varsp (Var v) = [v]
varsp (Neg e) = varsp e
varsp (Conj e1 e2) = varsp e1 ++ varsp e2
varsp (Disj e1 e2) = varsp e1 ++ varsp e2
varsp (Impl e1 e2) = varsp e1 ++ varsp e2
-- get variables in an expression without duplicates
vars :: LogicExpr -> [Variable]
vars = nub . varsp
-- possible boolean values
bools = [True, False]
-- all possible combinations of variable assignments
booltable :: [Variable] -> [[(Variable, Bool)]]
booltable [] = [[]]
booltable (a:as) = [(a,b) : r | b <- bools, r <- booltable as]
-- variable assignments and corresponding evaluation of an expression
truthtable :: LogicExpr -> [([(Variable, Bool)], Bool)]
truthtable e = [(bs, evaluate e bs) | bs <- booltable (vars e)]
如果你想探索标准库的阴暗角落，也可以写一个Read实例，方便输入LogicExprs：
-- read a right-associative infix operator
readInfix opprec constr repr prec r
= readParen (prec > opprec)
(\r -> [(constr e1 e2, u) |
(e1,s) <- readsPrec (opprec+1) r,
(op,t) <- lex s,
op == repr,
(e2,u) <- readsPrec (opprec) t]) r
instance Read LogicExpr where
readsPrec prec r
= readInfix 1 Impl "->" prec r
++ readInfix 2 Disj "|" prec r
++ readInfix 3 Conj "&" prec r
++ readParen (prec > 4)
(\r -> [(Neg e, t) |
("!",s) <- lex r,
(e,t) <- readsPrec 4 s]) r
++ readParen (prec > 5)
(\r -> [(Var v, s) |
([v], s) <- lex r]) r
而且真值表可以打印得很漂亮：
showcell :: (Variable, Bool) -> String
showcell (v,b) = v : "=" ++ show b
showrow :: [(Variable, Bool)] -> Bool -> String
showrow [] b = show b
showrow [a] b = showcell a ++ " => " ++ show b
showrow (a:as) b = showcell a ++ " && " ++ showrow as b
printrow :: ([(Variable, Bool)], Bool) -> IO ()
printrow = putStrLn . uncurry showrow
printtbl :: [([(Variable, Bool)], Bool)] -> IO ()
printtbl = mapM_ printrow
所有的真值表可以这样生成：
Prelude Main> printtbl $ truthtable $ read "(a -> b) & (b -> a)"
a=True && b=True => True
a=True && b=False => False
a=False && b=True => False
a=False && b=False => True
Prelude Main> printtbl $ truthtable $ read "(a | b) | (!a & !b)"
a=True && b=True => True
a=True && b=False => True
a=False && b=True => True
a=False && b=False => True
【讨论】：
以上是关于在 Haskell 中为逻辑表达式生成真值表的主要内容，如果未能解决你的问题，请参考以下文章