ModnumStatic.hs

import           Data.List
import           Prelude   hiding (max)

powerset :: [t] -> [[t]]
powerset []     = [[]]
powerset (x:xs) = powerset xs ++ map (x:) (powerset xs)

powersetPlus :: Eq t => [t] -> [[t]]
powersetPlus = filter (/= []) . powerset

type EBase = String
type E = [EBase]
type T = Bool

--
--
domainBase :: [EBase]
domainBase = ["B1","B2","B3","B4",
              "M1","M2","M3","M4","M5","M6"]

domain :: [E]
domain = powersetPlus domainBase

boyBase, movieBase :: [EBase]
boyBase   = filter (\(x:xs) -> x == 'B') domainBase
movieBase = filter (\(x:xs) -> x == 'M') domainBase

seeBase :: [(EBase,EBase)]
seeBase = [("B1","M1"),
           ("B2","M2"), ("B2","M3"),
           ("B3","M3"), ("B3","M4"), ("B3","M5"),
           ("B4","M6")]

boys, movies :: [E]
boys   = [xs | xs <- domain, all (`elem` boyBase  ) xs]
movies = [xs | xs <- domain, all (`elem` movieBase) xs]

see :: (E,E) -> T
see (xs,ys) = all (\x -> any (\y -> (x,y) `elem` seeBase) ys) xs &&
              all (\y -> any (\x -> (x,y) `elem` seeBase) xs) ys

max :: [E] -> (E -> T) -> E -> T
max np k xs = k xs && all (\ys -> not (k ys) || ys `intersect` xs == ys) np

exists :: (E -> T) -> T
exists f = any f domain

exThreeBoysHO, exFiveMoviesHO :: (((E -> T) -> T) -> T) -> T
exThreeBoysHO  c = exists $ \xs -> c (\k -> max boys   k xs) && length xs == 3
exFiveMoviesHO c = exists $ \xs -> c (\k -> max movies k xs) && length xs == 5

--
--
testCum :: T
testCum = exThreeBoysHO (\m -> exFiveMoviesHO (\n -> m (\x -> n (\y -> see (x,y)))))

testPseudCum :: T
testPseudCum = exThreeBoysHO (\m -> m (\x -> exFiveMoviesHO (\n -> n (\y -> see (x,y)))))

witnesses :: [(E,E)]
witnesses = sort [(xs,ys) | xs <- domain, ys <- domain,
                            max boys (\x -> max movies (\y -> see (x,y)) ys) xs]

main :: IO ()
main = print witnesses