Partial DS

eds.hs

{-# LANGUAGE OverloadedLists #-}

import Data.IntMap ((!?)) -- safe lookup
import qualified Data.IntMap as M -- data structure for assignments
import qualified Data.Set as S
import Control.Applicative
import Data.Maybe
import Control.Monad (replicateM)

newtype E = E Char deriving (Eq,Show,Ord) -- type for individuals

type G = M.IntMap E -- type for assignments

type S = G -> S.Set G -- type for sentence meanings

type Var = Int -- type for variables

dom :: S.Set E
dom = S.fromList $ E <$> ['a'..'c'] ++ ['w','y'] -- the domain of individuals

vars :: S.Set Var
vars = [0..3] -- the set of variables

_vowel :: E -> Bool
_vowel (E c) = c `elem` "aeiouyw"

_consonant :: E -> Bool
_consonant (E c) = c `notElem` "aeiou"


data Formula = Vowel Var | Consonant Var | Not Formula | Formula `And` Formula | Formula `Or` Formula | Rand Var | Clo Formula deriving (Eq,Show)
    
ex :: Var -> Formula -> Formula
ex x p = Clo (Rand x `And` p)

(*>) :: Formula -> Formula -> Formula
p *> q = Not p `Or` q
    
eval :: Maybe Bool -> Formula -> S
eval t p g = case t of
    Just True -> case p of
        (Vowel x) -> if (_vowel <$> g !? x) == Just True then S.singleton g else S.empty
        (Consonant x) -> if (_consonant <$> g !? x) == Just True then S.singleton g else S.empty
        (Rand x) -> S.fromList [ M.insert x a g | a <- S.toList dom ]
        (Not p) -> eval (Just False) p g
        (p `And` q) -> relComp (p,Just True) (q,Just True) g
        (p `Or` q) -> S.unions [relComp (p,Just True) (q,Just True) g
            , relComp (p,Just True) (q,Just False) g
            , relComp (p,Just True) (q,Nothing) g
            , relComp (p,Just False) (q,Just True) g
            , relComp (p,Nothing) (q,Just True) g]
        (Clo p) -> eval (Just True) p g
    Just False -> case p of
        (Vowel x) -> if (_vowel <$> g !? x) == Just False then S.singleton g else S.empty
        (Consonant x) -> if (_consonant <$> g !? x) == Just False then S.singleton g else S.empty
        (Rand x) -> S.empty
        (Not p) -> eval (Just True) p g
        (p `And` q) -> S.unions [relComp (p,Just False) (q,Just True) g
            , relComp (p,Just False) (q,Nothing) g
            , relComp (p,Just False) (q,Just False) g
            , relComp (p,Just True) (q,Just False) g
            , relComp (p,Nothing) (q,Just False) g]
        (p `Or` q) -> relComp (p,Just False) (q,Just False) g
        (Clo p) -> if truthVal p g == Just False then S.singleton g else S.empty
    Nothing -> if posEval p g == S.empty && negEval p g == S.empty then S.singleton g else S.empty
    where
        posEval = eval (Just True) 
        negEval = eval (Just False)
        relComp (p,t) (q,u) g = S.unions [ eval u q h | h <- S.toList $ eval t p g ]
        truthVal p g
            | not . null $ eval (Just True) p g = Just True
            | null (eval (Just True) p g) && (not . null) (eval Nothing p g) = Nothing
            | otherwise = Just False