From 8d8f264055a2d4a1474763024d4d16a986fc6a8d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Thorsten=20Wi=C3=9Fmann?= <uni@thorsten-wissmann.de>
Date: Sun, 12 Jan 2014 23:16:52 +0100
Subject: [PATCH] Make haskell version of maxdisj work

---
 playground.hs | 29 +++++++++++++++++++++--------
 1 file changed, 21 insertions(+), 8 deletions(-)

diff --git a/playground.hs b/playground.hs
index 0f394ff..76a12c4 100644
--- a/playground.hs
+++ b/playground.hs
@@ -9,21 +9,34 @@ import System.IO
 --                 of sets      /   / .... all those maximal ones
 --                 |   |       |   | /
 maxdisj :: Eq a => [[a]]   -> [[[a]]]
-maxdisj = maxdisj' []
+maxdisj = killsubsets . maxdisj' []
 
 -- test it with:
 -- 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' pool (x:xs) = (map (x:) oth') ++ maximal
-  where oth  = maxdisj' (x:pool) xs ++ [[]]
-        oth' = filter (compatible 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' pool (x:xs) = oth2 -- extendable ++ maximal
+  where oth = maxdisj' (x:pool) xs
+        oth2 = oth ++ (map (x:) $ filter (all (disjoint x)) oth)
 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 x = all (not . flip elem x)
 
-- 
GitLab