真理値表

30分プログラム、その759。真理値表を作ってみよう。
[mixi]初心者です。 - Javaの課題丸投げ | mixiコミュニティにインスパイアされました。要するに、適当な論理式を与えると真理値表を出力するプログラムです。
出力の整形は、けっこう適当です。

使い方

*Main Data.List> example
(Var "x" `And` Not (Var "y")) `Or` (Not (Var "x") `And` Var "y")
*Main Data.List>

*Main Data.List> mapM_ print $ table example
([False,False],False)
([False,True],True)
([True,False],True)
([True,True],False)

ソースコード

import Data.List
import Data.Maybe
import Control.Monad.List

data Expr = Var String
          | Expr `And` Expr
          | Expr `Or`  Expr
          | Not Expr deriving Show

vars    :: Expr -> [ String ]
pattern :: [ String ] -> [ [(String, Bool)] ]
assign  :: Expr -> [(String,Bool)] -> Bool
table   :: Expr -> [([Bool], Bool)]
format  :: ([Bool], Bool) -> String

vars (Var x)         = [ x ]
vars (lhs `And` rhs) = vars lhs ++ vars rhs
vars (lhs `Or` rhs)  = vars lhs ++ vars rhs
vars (Not e)         = vars e

pattern [] = [ [] ]
pattern (x:xs) = do y  <- [False, True]
                    ys <- pattern xs
                    return $ (x,y):ys


assign (lhs `And` rhs) vars = (assign lhs vars) && (assign rhs vars)
assign (lhs `Or` rhs)  vars = (assign lhs vars) || (assign rhs vars)
assign (Var x) vars = fromJust $ lookup x vars
assign (Not e) vars = not (assign e vars)

table e = map (\vars -> (map snd vars, assign e vars)) (pattern $ nub $ vars e)

x = Var "x"
y = Var "y"
example = x `And` (Not y) `Or` ((Not x) `And` y)