## cool / playground.hs @ master

History | View | Annotate | Download (1.42 KB)

1 | 999ced14 | Thorsten Wißmann | |
---|---|---|---|

2 | import Control.Monad |
||

3 | import Data.List |
||

4 | import System.IO |
||

5 | |||

6 | -- some example functions which will be adapted to ocaml |
||

7 | |||

8 | -- mutliset -> disjoint subset |
||

9 | -- of sets / / .... all those maximal ones |
||

10 | -- | | | | / |
||

11 | maxdisj :: Eq a => [[a]] -> [[[a]]] |
||

12 | 8d8f2640 | Thorsten Wißmann | maxdisj = killsubsets . maxdisj' [] |

13 | 999ced14 | Thorsten Wißmann | |

14 | -- test it with: |
||

15 | -- flip (>>=) (return . length) $ mapM putStrLn $ map show $ maxdisj [[1,2],[2,3],[3,4]] |
||

16 | 8d8f2640 | Thorsten Wißmann | -- |

17 | killsubsets :: Eq a => [[[a]]] -> [[[a]]] |
||

18 | killsubsets ccc = filter (\m -> not (any (\cc -> m `subset` cc) ccc)) ccc |
||

19 | 999ced14 | Thorsten Wißmann | |

20 | 8d8f2640 | Thorsten Wißmann | subset :: Eq a => [a] -> [a] -> Bool |

21 | subset a b = (all (`elem` b) a) && ((length a) < (length b)) |
||

22 | |||

23 | |||

24 | -- generate all disjoint subsets... |
||

25 | 999ced14 | Thorsten Wißmann | maxdisj' :: Eq a => [[a]] -> [[a]] -> [[[a]]] |

26 | 8d8f2640 | Thorsten Wißmann | maxdisj' pool (x:xs) = oth2 -- extendable ++ maximal |

27 | where oth = maxdisj' (x:pool) xs |
||

28 | oth2 = oth ++ (map (x:) $ filter (all (disjoint x)) oth) |
||

29 | 999ced14 | Thorsten Wißmann | maxdisj' _ [] = [[]] |

30 | |||

31 | 8d8f2640 | Thorsten Wißmann | -- old helper functions: |

32 | --(maximal,nonmaximal) = partition isMaximal oth2 |
||

33 | --isMaximal cc = let sups = filter (cc `subset`) oth2 |
||

34 | -- in all (\p -> ((not . compatible p cc) |
||

35 | -- `or` |
||

36 | -- (flip all sups (not . compatible p)))) pool |
||

37 | --subset a b = all (`elem` a) b `and` (length a) < (length b) |
||

38 | --compatible x cc = all (disjoint x) cc |
||

39 | |||

40 | 999ced14 | Thorsten Wißmann | disjoint :: Eq a => [a] -> [a] -> Bool |

41 | disjoint x = all (not . flip elem x) |