Skip to content
Snippets Groups Projects
Commit 8d8f2640 authored by Thorsten Wißmann's avatar Thorsten Wißmann
Browse files

Make haskell version of maxdisj work

parent a08fbced
No related branches found
No related tags found
No related merge requests found
...@@ -9,21 +9,34 @@ import System.IO ...@@ -9,21 +9,34 @@ import System.IO
-- of sets / / .... all those maximal ones -- of sets / / .... all those maximal ones
-- | | | | / -- | | | | /
maxdisj :: Eq a => [[a]] -> [[[a]]] maxdisj :: Eq a => [[a]] -> [[[a]]]
maxdisj = maxdisj' [] maxdisj = killsubsets . maxdisj' []
-- test it with: -- test it with:
-- flip (>>=) (return . length) $ mapM putStrLn $ map show $ maxdisj [[1,2],[2,3],[3,4]] -- flip (>>=) (return . length) $ mapM putStrLn $ map show $ maxdisj [[1,2],[2,3],[3,4]]
--
killsubsets :: Eq a => [[[a]]] -> [[[a]]]
killsubsets ccc = filter (\m -> not (any (\cc -> m `subset` cc) ccc)) ccc
-- only keep subsets if they intersect with pool -- does not work yet... TODO subset :: Eq a => [a] -> [a] -> Bool
subset a b = (all (`elem` b) a) && ((length a) < (length b))
-- generate all disjoint subsets...
maxdisj' :: Eq a => [[a]] -> [[a]] -> [[[a]]] maxdisj' :: Eq a => [[a]] -> [[a]] -> [[[a]]]
maxdisj' pool (x:xs) = (map (x:) oth') ++ maximal maxdisj' pool (x:xs) = oth2 -- extendable ++ maximal
where oth = maxdisj' (x:pool) xs ++ [[]] where oth = maxdisj' (x:pool) xs
oth' = filter (compatible x) oth oth2 = oth ++ (map (x:) $ filter (all (disjoint x)) oth)
maximal = filter (\s -> all (not . flip compatible s) pool) oth
expandable = filter (\s -> any (flip compatible s) pool) oth
compatible set setset = all (disjoint set) setset
maxdisj' _ [] = [[]] maxdisj' _ [] = [[]]
-- old helper functions:
--(maximal,nonmaximal) = partition isMaximal oth2
--isMaximal cc = let sups = filter (cc `subset`) oth2
-- in all (\p -> ((not . compatible p cc)
-- `or`
-- (flip all sups (not . compatible p)))) pool
--subset a b = all (`elem` a) b `and` (length a) < (length b)
--compatible x cc = all (disjoint x) cc
disjoint :: Eq a => [a] -> [a] -> Bool disjoint :: Eq a => [a] -> [a] -> Bool
disjoint x = all (not . flip elem x) disjoint x = all (not . flip elem x)
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment