{-# LANGUAGE BangPatterns #-}
module Math.Combinat.Sets.VennDiagrams where
import Data.List
import GHC.TypeLits
import Data.Proxy
import qualified Data.Map as Map
import Data.Map (Map)
import Math.Combinat.Compositions
import Math.Combinat.ASCII
newtype VennDiagram a = VennDiagram { vennTable :: Map [Bool] a } deriving (Eq,Ord,Show)
vennDiagramNumberOfSets :: VennDiagram a -> Int
vennDiagramNumberOfSets (VennDiagram table) = length $ fst $ Map.findMin table
vennDiagramNumberOfZones :: VennDiagram a -> Int
vennDiagramNumberOfZones venn = 2 ^ (vennDiagramNumberOfSets venn)
vennDiagramNumberOfNonemptyZones :: VennDiagram Int -> Int
vennDiagramNumberOfNonemptyZones (VennDiagram table) = length $ filter (/=0) $ Map.elems table
unsafeMakeVennDiagram :: [([Bool],a)] -> VennDiagram a
unsafeMakeVennDiagram = VennDiagram . Map.fromList
isTrivialVennDiagram :: VennDiagram Int -> Bool
isTrivialVennDiagram (VennDiagram table) = and [ c == 0 | (bs,c) <- Map.toList table , isIntersection bs ] where
isIntersection bs = case filter id bs of
[] -> False
[_] -> False
_ -> True
printVennDiagram :: Show a => VennDiagram a -> IO ()
printVennDiagram = putStrLn . prettyVennDiagram
prettyVennDiagram :: Show a => VennDiagram a -> String
prettyVennDiagram = unlines . asciiLines . asciiVennDiagram
asciiVennDiagram :: Show a => VennDiagram a -> ASCII
asciiVennDiagram (VennDiagram table) = asciiFromLines $ map f (Map.toList table) where
f (bs,a) = "{" ++ extendTo (length bs) [ if b then z else ' ' | (b,z) <- zip bs abc ] ++ "} -> " ++ show a
extendTo k str = str ++ replicate (k - length str) ' '
abc = ['A'..'Z']
instance Show a => DrawASCII (VennDiagram a) where
ascii = asciiVennDiagram
vennDiagramSetCardinalities :: VennDiagram Int -> [Int]
vennDiagramSetCardinalities (VennDiagram table) = go n list where
list = Map.toList table
n = length $ fst $ head list
go :: Int -> [([Bool],Int)] -> [Int]
go !0 _ = []
go !k xs = this : go (k-1) (map xtail xs) where
this = foldl' (+) 0 [ c | ((True:_) , c) <- xs ]
xtail (bs,c) = (tail bs,c)
enumerateVennDiagrams :: [Int] -> [VennDiagram Int]
enumerateVennDiagrams dims =
case dims of
[] -> []
[d] -> venns1 d
(d:ds) -> concatMap (worker (length ds) d) $ enumerateVennDiagrams ds
where
worker !n !d (VennDiagram table) = result where
list = Map.toList table
falses = replicate n False
comps k = compositions' (map snd list) k
result =
[ unsafeMakeVennDiagram $
[ (False:tfs , m-c) | ((tfs,m),c) <- zip list comp ] ++
[ (True :tfs , c) | ((tfs,m),c) <- zip list comp ] ++
[ (True :falses , d-k) ]
| k <- [0..d]
, comp <- comps k
]
venns1 :: Int -> [VennDiagram Int]
venns1 p = [ theVenn ] where
theVenn = unsafeMakeVennDiagram [ ([True],p) ]