root/logic
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

dont use Data.Map

Browse source
This commit is contained in:
hi 2025-07-31 12:21:50 +00:00
parent d7d1e0cb05
commit 5e0827b17d
1 changed files with 4 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

9
Main.hs
View file

@ -3,7 +3,6 @@ import Data.Char (isAlphaNum)
import Data.Functor (Functor) import Data.Functor (Functor)
import Data.List (intercalate) import Data.List (intercalate)
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
import qualified Data.Map as M
import qualified Data.Set as S import qualified Data.Set as S
newtype Parser symbol output = Parser newtype Parser symbol output = Parser
@ -107,17 +106,17 @@ q :: Statement
q = fromJust $ fst <$> runParser stmt "(!a<->((!(p->q)&x)|y))" q = fromJust $ fst <$> runParser stmt "(!a<->((!(p->q)&x)|y))"
atoms :: Statement -> S.Set String atoms :: Statement -> S.Set String
atoms (Atom string) = S.singleton string atoms (Atom key) = S.singleton key
atoms (Not s) = atoms s atoms (Not s) = atoms s
atoms (And s1 s2) = S.union (atoms s1) (atoms s2) atoms (And s1 s2) = S.union (atoms s1) (atoms s2)
atoms (Or s1 s2) = S.union (atoms s1) (atoms s2) atoms (Or s1 s2) = S.union (atoms s1) (atoms s2)
atoms (Implies s1 s2) = S.union (atoms s1) (atoms s2) atoms (Implies s1 s2) = S.union (atoms s1) (atoms s2)
atoms (Iff s1 s2) = S.union (atoms s1) (atoms s2) atoms (Iff s1 s2) = S.union (atoms s1) (atoms s2)
eval :: M.Map String Bool -> Statement -> Maybe Bool eval :: [(String, Bool)] -> Statement -> Maybe Bool
eval assignments = aux eval assignments = aux
where where
aux (Atom string) = M.lookup string assignments aux (Atom key) = lookup key assignments
aux (Not s) = not <$> aux s aux (Not s) = not <$> aux s
aux (And s1 s2) = (&&) <$> aux s1 <*> aux s2 aux (And s1 s2) = (&&) <$> aux s1 <*> aux s2
aux (Or s1 s2) = (||) <$> aux s1 <*> aux s2 aux (Or s1 s2) = (||) <$> aux s1 <*> aux s2
@ -137,7 +136,7 @@ bucket s
| otherwise = Contingent | otherwise = Contingent
where where
atomsList = S.toList $ atoms s atomsList = S.toList $ atoms s
values = [fromJust $ eval (M.fromList assignments) s | assignments <- enumerate $ atomsList] values = [fromJust $ eval assignments s | assignments <- enumerate $ atomsList]
enumerate :: [a] -> [[(a, Bool)]] enumerate :: [a] -> [[(a, Bool)]]
enumerate keys = aux start enumerate keys = aux start