Генерация таблиц истинности для логических выражений в Haskell
Первая часть - это функция оценки, которая имеет следующую сигнатуру типа:
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.
Я не совсем знаком с синтаксисом, поэтому не знаю, как вернуть список.
2 ответа
Стандартные библиотечные функции, повторное использование кода. Кроме того, использование скобок и интервал действительно повреждены.
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.
- Для языковых расширений после 98 см. Документацию GHC.
- GHC, Hugs и другие современные реализации Haskell также предоставляют гораздо более богатую стандартную библиотеку, чем указано в Haskell 98. Полная документация по иерархическим библиотекам также доступна онлайн.
- Hoogλe - это специализированная поисковая система для расширенных стандартных библиотек Haskell. Hayoo! аналогичен, но также охватывает HackageDB, набор библиотек Haskell, выходящий далеко за рамки стандартного дистрибутива.
Я надеюсь, что ваш класс предоставил аналогичные ресурсы, но если нет, то все вышеперечисленное легко обнаружить из поиска Google.
При наличии надлежащих ссылок любой программист, достойный своей собственной солидности, должен быть в состоянии подобрать синтаксис любого нового языка в течение нескольких часов и иметь рабочее представление о среде выполнения в течение нескольких дней. Конечно, освоение новой парадигмы может занять много времени, и несколько несправедливо придерживаться учеников по тем же стандартам, но для этого и предназначен класс.
Вопросы о проблемах более высокого уровня в переполнении стека могут вызывать меньше ответов, но они также будут предоставлены с гораздо меньшим раздражением:) Вопросы для домашних заданий относятся к категории "делай мою работу для меня!" в глазах большинства людей.
Спойлер
Пожалуйста, не обманывайте. Тем не менее, просто чтобы дать вам представление о том, как можно делать потрясающие вещи в 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)
]
$ ghci
GHCi, версия 6.10.2: http://www.haskell.org/ghc/:? за помощью
Загрузка пакета ghc-prim ... связывание... сделано.
Загрузка пакета целое число... ссылка... сделано.
Загрузка пакета базы... ссылки... сделано.
Прелюдия>:l Expr.hs
[1 из 1] Compiling Expr ( Expr.hs, интерпретированный)
Хорошо, модули загружены: Expr.
*Expr> mapM_ print . evalAll [1..3] 'C' $ Var 'A':* Var 'B'
Загрузка пакета MTL-1.1.0.2 ... ссылка... сделано.
[('А',1),('В',1),('С',1)]
[('А',1),('В',2),('C',2)]
[('А',1),('В',3),('C',3)]
[('А', 2), ('В',1),('C',2)]
[('А', 2), ('В',2),('C',4)]
[('А', 2), ('В',3),('C',6)]
[('А', 3), ('В',1),('C',3)]
[('А', 3), ('В',2),('C',6)]
[('А', 3), ('В', 3), ('С',9)]
*Expr> let expr = Var 'A':=> (Var 'B':+ Var 'C'):* Var 'D'
*Expr> expr
$'А'=>($'В'+$'С')*$'D'
*Expr> mapM_ print $ evalAll [True, False] 'E' expr
[('А', True), ('В',True),('C',True),('D',True),('E',True)]
[('А', True), ('В',True),('C',True),('D',False),('E',False)]
[('А', True), ('В',True),('C',False),('D',True),('E',True)]
[('А', True), ('В',True),('C',False),('D',False),('E',False)]
[('А', True), ('В',False),('C',True),('D',True),('E',True)]
[('А', True), ('В',False),('C',True),('D',False),('E',False)]
[('А', True), ('В',False),('C',False),('D',True),('E',False)]
[('А', True), ('В',False),('C',False),('D',False),('E',False)]
[('А', False), ('В',True),('C',True),('D',True),('E',True)]
[('А', False), ('В',True),('C',True),('D',False),('E',True)]
[('А', False), ('В',True),('C',False),('D',True),('E',True)]
[('А', False), ('В',True),('C',False),('D',False),('E',True)]
[('А', False), ('В',False),('C',True),('D',True),('E',True)]
[('А', False), ('В',False),('C',True),('D',False),('E',True)]
[('А', False), ('В',False),('C',False),('D',True),('E',True)]
[('А', False), ('В',False),('C',False),('D',False),('E',True)]
Основа evaluate is pretty straight forward:
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