import Data.Set as S ( Set
, delete
, deleteFindMin
, empty
, filter
, fromList
, insert
, map
, member
, null
, singleton
, size
, toList
, union
, unions
)
import Data.List as L ( filter
, null
)
esEstable :: Ord a => Set (Set a) -> Bool
esEstable xss =
and [ys `S.union` zs `member` xss | (ys,yss) <- selecciones xss
, zs <- toList yss]
-- (seleccciones xs) es la lista de los pares formada por un elemento de
-- xs y los restantes elementos. Por ejemplo,
-- λ> selecciones (fromList [3,2,5])
-- [(2,fromList [3,5]),(3,fromList [2,5]),(5,fromList [2,3])]
selecciones :: Ord a => Set a -> [(a,Set a)]
selecciones xs =
[(x,delete x xs) | x <- toList xs]
familiasEstables :: Ord a => Set a -> Set (Set (Set a))
familiasEstables xss =
S.filter esEstable (familias xss)
-- (familias c) es la familia formadas con elementos de c. Por ejemplo,
-- λ> mapM_ print (familias (fromList [1,2]))
-- fromList []
-- fromList [fromList []]
-- fromList [fromList [],fromList [1]]
-- fromList [fromList [],fromList [1],fromList [1,2]]
-- fromList [fromList [],fromList [1],fromList [1,2],fromList [2]]
-- fromList [fromList [],fromList [1],fromList [2]]
-- fromList [fromList [],fromList [1,2]]
-- fromList [fromList [],fromList [1,2],fromList [2]]
-- fromList [fromList [],fromList [2]]
-- fromList [fromList [1]]
-- fromList [fromList [1],fromList [1,2]]
-- fromList [fromList [1],fromList [1,2],fromList [2]]
-- fromList [fromList [1],fromList [2]]
-- fromList [fromList [1,2]]
-- fromList [fromList [1,2],fromList [2]]
-- fromList [fromList [2]]
-- λ> size (familias (fromList [1,2]))
-- 16
-- λ> size (familias (fromList [1,2,3]))
-- 256
-- λ> size (familias (fromList [1,2,3,4]))
-- 65536
familias :: Ord a => Set a -> Set (Set (Set a))
familias c =
subconjuntos (subconjuntos c)
-- (subconjuntos c) es el conjunto de los subconjuntos de c. Por ejemplo,
-- λ> mapM_ print (subconjuntos (fromList [1,2,3]))
-- fromList []
-- fromList [1]
-- fromList [1,2]
-- fromList [1,2,3]
-- fromList [1,3]
-- fromList [2]
-- fromList [2,3]
-- fromList [3]
subconjuntos :: Ord a => Set a -> Set (Set a)
subconjuntos c
| S.null c = singleton empty
| otherwise = S.map (insert x) sr `union` sr
where (x,rc) = deleteFindMin c
sr = subconjuntos rc
-- (elementosFamilia f) es el conjunto de los elementos de los elementos
-- de la familia f. Por ejemplo,
-- λ> elementosFamilia (fromList [empty, fromList [1,2], fromList [2,5]])
-- fromList [1,2,5]
elementosFamilia :: Ord a => Set (Set a) -> Set a
elementosFamilia = unions . toList
-- (nOcurrencias f x) es el número de conjuntos de la familia f a los
-- que pertenece el elemento x. Por ejemplo,
-- nOcurrencias (fromList [empty, fromList [1,3], fromList [3,5]]) 3 == 2
-- nOcurrencias (fromList [empty, fromList [1,3], fromList [3,5]]) 4 == 0
-- nOcurrencias (fromList [empty, fromList [1,3], fromList [3,5]]) 5 == 1
nOcurrencias :: Ord a => Set (Set a) -> a -> Int
nOcurrencias f x =
length (L.filter (x `member`) (toList f))
mayoritarios :: Ord a => Set (Set a) -> [a]
mayoritarios f =
[x | x <- toList (elementosFamilia f)
, nOcurrencias f x >= n]
where n = (1 + size f) `div` 2
conjeturaFrankl :: Int -> Bool
conjeturaFrankl n =
and [ not (L.null (mayoritarios f))
| f <- fs
, f /= fromList []
, f /= fromList [empty]]
where fs = toList (familiasEstables (fromList [1..n]))
-- conjeturaFrankl' :: Int -> Bool
conjeturaFrankl' n =
[f | f <- fs
, L.null (mayoritarios f)
, f /= fromList []
, f /= fromList [empty]]
where fs = toList (familiasEstables (fromList [1..n]))