在Haskell中生成逻辑表达式的真值表
第一部分是具有以下类型签名的求值函数:在Haskell中生成逻辑表达式的真值表,haskell,logic,boolean-logic,boolean-expression,Haskell,Logic,Boolean Logic,Boolean Expression,第一部分是具有以下类型签名的求值函数: evaluate :: Logic Expr -> [(Variable, Bool)] -> Bool 它将逻辑表达式和赋值对列表作为输入,并根据提供的布尔赋值返回表达式的值。赋值列表是一个不同的对列表,其中每对包含一个变量及其布尔赋值。也就是说,如果将表达式A传递给函数∧ 当赋值A=1和B=0时,函数必须返回0(这来自数字逻辑设计,0对应于false,1对应于true) 到目前为止,我做到了这一点: type Variable = Ch
evaluate :: Logic Expr -> [(Variable, Bool)] -> Bool
它将逻辑表达式和赋值对列表作为输入,并根据提供的布尔赋值返回表达式的值。赋值列表是一个不同的对列表,其中每对包含一个变量及其布尔赋值。也就是说,如果将表达式A传递给函数∧ 当赋值A=1和B=0时,函数必须返回0(这来自数字逻辑设计,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
下一部分是定义generateTrustTable
,该函数以逻辑表达式作为输入,并以赋值对列表的形式返回表达式的真值表。也就是说,如果将表达式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
我不太熟悉语法,所以不知道如何返回列表。标准库函数,代码重用。此外,括号的用法和间距也确实有问题
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
现在,您想要一个generateTrustTable
?这很简单,只需获取布尔变量的所有可能状态,并将求值表达式固定到每个变量的末尾
generateTruthTable :: [Variable] -> LogicExpr -> [[(Variable, Bool)]]
generateTruthTable vs e = [l ++ [('E', evaluate e l)] | l <- allPossible vs]
根据我的直觉,这感觉应该是一种变形。毕竟,它确实需要查看列表中的所有内容,但返回的是不同结构的内容,并且它可能可以用一种简单的方式进行分解,因为这是一个介绍级CS类。(我不在乎课程号是多少,这是介绍性的东西。)
现在,foldr::(a->b->b)->b->[a]->b
,因此前两个参数必须是step::a->b->b
和initial::b
。现在,所有可能的::[Variable]->[[(Variable,Bool)]]=foldr步骤初始::[a]->b
。嗯,这一定意味着a=Variable
和b=[[(Variable,Bool)]]
。这对于步骤
和初始
意味着什么
step :: Variable -> [[(Variable, Bool)]] -> [[(Variable, Bool)]]
initial :: [[(Variable, Bool)]]
有趣。不知何故,需要有一种方法从变量状态列表中step
并向其中添加单个变量,以及一些初始
列表中完全没有变量
如果您的大脑已经成功地“点击”到函数式编程范式中,那么这就足够了。如果没有,那么在作业到期的几小时内,不管你在这里收到了什么指示,你都会被搞砸。祝你好运,如果作业到期后你还没做完,你应该问你的教授,或者在这里问一个非紧急问题
如果您对该语言存在基本的可用性问题(“语法是什么”、“运行时语义是什么”、“xxx是否已有功能”等):
- 是对基础语言和库的免费、规范的定义。网站上提供了更多链接
- 有关98年后的语言扩展,请参阅
- GHC、Hugs和其他现代Haskell实现也提供了比Haskell 98中指定的更丰富的标准库。的完整文档也可在线获取
- 是扩展Haskell标准库的专用搜索引擎。与此类似,但也涵盖了Haskell库的集合,远远超出了标准发行版
扰流器 请不要作弊。然而,只是想让你尝一尝在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)
]
{-#语言灵活实例,不可判定实例#-}
{-#语言重叠实例,PatternGuards}
模块Expr(环(..),(=:>),Expr(..),vars,eval,evalAll)其中
导入控制.Monad.Error
infixl 5=:>,:=>
infixl 6+:,-:,:+,:-
infixl 7*:,:*
类别(等式a)=>环a,其中
(+:)::a->a->a;(-)::a->a->a;x-:y=x+:反向y
(*:)::a->a->a;反转::a->a;反转x=零-:x
零::a;a::a
(=:>)::(环a)=>a->a->a
(=:>)=翻转(-:)
实例(Num a)=>环a,其中
(+:) = (+); (-:) = (-); (*:) = (*)
倒置=否定;零=0;一=1
实例环布尔在哪里
(+:) = (||); (*:) = (&&)
反转=不;零=假;一=真
数据表达式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
|反向(表达式a b)|变量a |常数b
paren::ShowS->ShowS
paren ss s='(':ss(')':s)
实例(Show a,Show b)=>Show(Expr a b)其中
showsPrec(Const c)=(@:)。showsPrec 9 c
showsPrec(Var v)=(“$”:)。showsPrec 9 v
showsPrec(倒e)=(“!”:)。showsPrec 9 e
showsPrec n e@(a:=>b)
|n>5=价格$showsPrec 0 e
|否则=显示建议7 a。('=':) . ('>':) . showsPrec 5 b
展品展览(a:*b)
|n>7=paren$showsPrec 0 e
|否则=显示建议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。('-':) . 表演
step :: Variable -> [[(Variable, Bool)]] -> [[(Variable, Bool)]]
initial :: [[(Variable, Bool)]]
{-# 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)
]
$ ghci
GHCi, version 6.10.2: http://www.haskell.org/ghc/ :? for help
Loading package ghc-prim ... linking ... done.
Loading package integer ... linking ... done.
Loading package base ... linking ... done.
Prelude> :l Expr.hs
[1 of 1] Compiling Expr ( Expr.hs, interpreted )
Ok, modules loaded: Expr.
*Expr> mapM_ print . evalAll [1..3] 'C' $ Var 'A' :* Var 'B'
Loading package mtl-1.1.0.2 ... linking ... done.
[('A',1),('B',1),('C',1)]
[('A',1),('B',2),('C',2)]
[('A',1),('B',3),('C',3)]
[('A',2),('B',1),('C',2)]
[('A',2),('B',2),('C',4)]
[('A',2),('B',3),('C',6)]
[('A',3),('B',1),('C',3)]
[('A',3),('B',2),('C',6)]
[('A',3),('B',3),('C',9)]
*Expr> let expr = Var 'A' :=> (Var 'B' :+ Var 'C') :* Var 'D'
*Expr> expr
$'A'=>($'B'+$'C')*$'D'
*Expr> mapM_ print $ evalAll [True, False] 'E' expr
[('A',True),('B',True),('C',True),('D',True),('E',True)]
[('A',True),('B',True),('C',True),('D',False),('E',False)]
[('A',True),('B',True),('C',False),('D',True),('E',True)]
[('A',True),('B',True),('C',False),('D',False),('E',False)]
[('A',True),('B',False),('C',True),('D',True),('E',True)]
[('A',True),('B',False),('C',True),('D',False),('E',False)]
[('A',True),('B',False),('C',False),('D',True),('E',False)]
[('A',True),('B',False),('C',False),('D',False),('E',False)]
[('A',False),('B',True),('C',True),('D',True),('E',True)]
[('A',False),('B',True),('C',True),('D',False),('E',True)]
[('A',False),('B',True),('C',False),('D',True),('E',True)]
[('A',False),('B',True),('C',False),('D',False),('E',True)]
[('A',False),('B',False),('C',True),('D',True),('E',True)]
[('A',False),('B',False),('C',True),('D',False),('E',True)]
[('A',False),('B',False),('C',False),('D',True),('E',True)]
[('A',False),('B',False),('C',False),('D',False),('E',True)]
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
-- 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 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