Data commit

Task/Truth-table/Haskell/truth-table-1.hs

@@ -0,0 +1,34 @@
+import Control.Monad (mapM, foldM, forever)
+import Data.List (unwords, unlines, nub)
+import Data.Maybe (fromJust)
+
+truthTable expr = let
+    tokens = words expr
+    operators = ["&", "|", "!", "^", "=>"]
+    variables = nub $ filter (not . (`elem` operators)) tokens
+    table = zip variables <$> mapM (const [True,False]) variables
+    results = map (\r -> (map snd r) ++ (calculate tokens) r) table
+    header = variables ++ ["result"]
+    in
+      showTable $ header : map (map show) results
+
+-- Performs evaluation of token sequence in a given context.
+-- The context is an assoc-list, which binds variable and it's value.
+-- Here the monad is simple ((->) r).
+calculate :: [String] -> [(String, Bool)] -> [Bool]
+calculate = foldM interprete []
+  where
+    interprete (x:y:s) "&"  = (: s) <$> pure (x && y)
+    interprete (x:y:s) "|"  = (: s) <$> pure (x || y)
+    interprete (x:y:s) "^"  = (: s) <$> pure (x /= y)
+    interprete (x:y:s) "=>" = (: s) <$> pure (not y || x)
+    interprete (x:s)   "!"  = (: s) <$> pure (not x)
+    interprete s var        = (: s) <$> fromJust . lookup var
+
+-- pretty printing
+showTable tbl = unlines $ map (unwords . map align) tbl
+  where
+    align txt = take colWidth $ txt ++ repeat ' '
+    colWidth = max 6 $ maximum $ map length (head tbl)
+
+main = forever $ getLine >>= putStrLn . truthTable

Task/Truth-table/Haskell/truth-table-2.hs

@@ -0,0 +1,13 @@
+{-# LANGUAGE FlexibleContexts #-}
+import Text.Parsec
+
+toRPN = parse impl "expression" . filter (/= ' ')
+  where
+    impl = chainl1 disj (op2 "=>")
+    disj = chainl1 conj (op2 "|"  <|>  op2 "^")
+    conj = chainl1 term (op2 "&")
+    term = string "(" *> impl <* string ")" <|>
+           op1 "!" <*> term <|>
+           many1 alphaNum
+    op1 s = (\x -> unwords [x, s])      <$ string s
+    op2 s = (\x y -> unwords [x, y, s]) <$ string s

Task/Truth-table/Haskell/truth-table-3.hs

@@ -0,0 +1,11 @@
+λ> putStr $ truthTable $ toRPN "(Human => Mortal) & (Socratus => Human) => (Socratus => Mortal)"
+
+Human  Mortal Socratus result
+True   True   True     True
+True   True   False    True
+True   False  True     True
+True   False  False    True
+False  True   True     True
+False  True   False    True
+False  False  True     True
+False  False  False    True