joshua/ons-hs
1
Fork 0
mirror of https://github.com/Jaxan/ons-hs.git synced 2025-04-27 06:37:44 +02:00
Code Issues Releases Activity

Made it much faster

Browse source
This commit is contained in:
Joshua Moerman 2024-11-06 16:42:07 +01:00
parent 2e913bd666
commit b39ba8b5d5
2 changed files with 11 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
app/LStarPerm.hs
View file

@ -50,12 +50,12 @@ deriving instance Ord (Orbit k) => Monoid (PermEquivariantMap k v)
deriving instance Ord (Orbit k) => Semigroup (PermEquivariantMap k v)
lookupP :: (Permutable k, Nominal k, Nominal v, _) => k -> PermEquivariantMap k v -> Maybe v
lookupP x (PEqMap m) = case catMaybes [Map.lookup (act px) m | px <- allPermuted x] of
[] -> Nothing
(v:_) -> Just v -- take first hit, maybe this is wrong? I guess for v ~ Bool it's fine?
lookupP x (PEqMap m) = Map.lookup x m
-- For this algorithm, we do more lookups than inserts, so we make the insert
-- handle the permutations (at the cost of memory).
insertP :: (Nominal k, Nominal v, _) => k -> v -> PermEquivariantMap k v -> PermEquivariantMap k v
insertP k v = PEqMap . Map.insert k v . unPEqMap
insertP k v = PEqMap . flip (Prelude.foldr (\(pk, pv) -> Map.insert pk pv)) [(pk, pv) | pkv <- allPermuted (k, v), let (pk, pv) = act pkv] . unPEqMap
(!~) :: (Permutable k, Nominal k, Nominal v, _) => PermEquivariantMap k v -> k -> v
(!~) m k = case lookupP k m of

7
src/Permutable.hs
View file

@ -78,5 +78,12 @@ instance Permutable (Permuted a) where
instance Permutable Rat where
act (Permuted (Perm m) p) = Map.findWithDefault p p m
-- TODO: make all this generic
instance Permutable a => Permutable [a] where
act (Permuted f ls) = fmap (\x -> act (Permuted f x)) ls
instance (Permutable a, Permutable b) => Permutable (a, b) where
act (Permuted f (a, b)) = (act (Permuted f a), act (Permuted f b))
instance Permutable Bool where
act (Permuted _ b) = b