    -- Copyright (c) 2009, David Amos. All rights reserved.

    -- |A module defining a type for hypergraphs.

    module Math.Combinatorics.Hypergraph where

    import qualified Data.List as L
    import Math.Common.ListSet
    import Math.Core.Utils (combinationsOf)
    import Math.Combinatorics.Graph hiding (incidenceMatrix)
    import Math.Algebra.Group.PermutationGroup (orbitB, p) -- needed for construction of Coxeter group

    -- not used in this module, only in GHCi

    import Math.Algebra.Field.Base
    import Math.Algebra.Field.Extension
    import Math.Combinatorics.Design hiding (incidenceMatrix, incidenceGraph, dual, isSubset, fanoPlane)

    -- set system or hypergraph

    data Hypergraph a = H [a] [[a]] deriving (Hypergraph a -> Hypergraph a -> Bool
    (Hypergraph a -> Hypergraph a -> Bool)
    -> (Hypergraph a -> Hypergraph a -> Bool) -> Eq (Hypergraph a)
    forall a. Eq a => Hypergraph a -> Hypergraph a -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: Hypergraph a -> Hypergraph a -> Bool
    $c/= :: forall a. Eq a => Hypergraph a -> Hypergraph a -> Bool
    == :: Hypergraph a -> Hypergraph a -> Bool
    $c== :: forall a. Eq a => Hypergraph a -> Hypergraph a -> Bool
    Eq,Eq (Hypergraph a)
    Eq (Hypergraph a) =>
    (Hypergraph a -> Hypergraph a -> Ordering)
    -> (Hypergraph a -> Hypergraph a -> Bool)
    -> (Hypergraph a -> Hypergraph a -> Bool)
    -> (Hypergraph a -> Hypergraph a -> Bool)
    -> (Hypergraph a -> Hypergraph a -> Bool)
    -> (Hypergraph a -> Hypergraph a -> Hypergraph a)
    -> (Hypergraph a -> Hypergraph a -> Hypergraph a)
    -> Ord (Hypergraph a)
    Hypergraph a -> Hypergraph a -> Bool
    Hypergraph a -> Hypergraph a -> Ordering
    Hypergraph a -> Hypergraph a -> Hypergraph a
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    forall a. Ord a => Eq (Hypergraph a)
    forall a. Ord a => Hypergraph a -> Hypergraph a -> Bool
    forall a. Ord a => Hypergraph a -> Hypergraph a -> Ordering
    forall a. Ord a => Hypergraph a -> Hypergraph a -> Hypergraph a
    min :: Hypergraph a -> Hypergraph a -> Hypergraph a
    $cmin :: forall a. Ord a => Hypergraph a -> Hypergraph a -> Hypergraph a
    max :: Hypergraph a -> Hypergraph a -> Hypergraph a
    $cmax :: forall a. Ord a => Hypergraph a -> Hypergraph a -> Hypergraph a
    >= :: Hypergraph a -> Hypergraph a -> Bool
    $c>= :: forall a. Ord a => Hypergraph a -> Hypergraph a -> Bool
    > :: Hypergraph a -> Hypergraph a -> Bool
    $c> :: forall a. Ord a => Hypergraph a -> Hypergraph a -> Bool
    <= :: Hypergraph a -> Hypergraph a -> Bool
    $c<= :: forall a. Ord a => Hypergraph a -> Hypergraph a -> Bool
    < :: Hypergraph a -> Hypergraph a -> Bool
    $c< :: forall a. Ord a => Hypergraph a -> Hypergraph a -> Bool
    compare :: Hypergraph a -> Hypergraph a -> Ordering
    $ccompare :: forall a. Ord a => Hypergraph a -> Hypergraph a -> Ordering
    $cp1Ord :: forall a. Ord a => Eq (Hypergraph a)
    Ord,Int -> Hypergraph a -> ShowS
    [Hypergraph a] -> ShowS
    Hypergraph a -> String
    (Int -> Hypergraph a -> ShowS)
    -> (Hypergraph a -> String)
    -> ([Hypergraph a] -> ShowS)
    -> Show (Hypergraph a)
    forall a. Show a => Int -> Hypergraph a -> ShowS
    forall a. Show a => [Hypergraph a] -> ShowS
    forall a. Show a => Hypergraph a -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [Hypergraph a] -> ShowS
    $cshowList :: forall a. Show a => [Hypergraph a] -> ShowS
    show :: Hypergraph a -> String
    $cshow :: forall a. Show a => Hypergraph a -> String
    showsPrec :: Int -> Hypergraph a -> ShowS
    $cshowsPrec :: forall a. Show a => Int -> Hypergraph a -> ShowS
    Show)

    hypergraph :: [a] -> [[a]] -> Hypergraph a
    hypergraph xs :: [a]
    xs bs :: [[a]]
    bs | [a] -> [[a]] -> Bool
    forall a. Ord a => [a] -> [[a]] -> Bool
    isSetSystem [a]
    xs [[a]]
    bs = [a] -> [[a]] -> Hypergraph a
    forall a. [a] -> [[a]] -> Hypergraph a
    H [a]
    xs [[a]]
    bs

    toHypergraph :: [a] -> [[a]] -> Hypergraph a
    toHypergraph xs :: [a]
    xs bs :: [[a]]
    bs = [a] -> [[a]] -> Hypergraph a
    forall a. [a] -> [[a]] -> Hypergraph a
    H [a]
    xs' [[a]]
    bs' where
        xs' :: [a]
    xs' = [a] -> [a]
    forall a. Ord a => [a] -> [a]
    L.sort [a]
    xs
        bs' :: [[a]]
    bs' = [[a]] -> [[a]]
    forall a. Ord a => [a] -> [a]
    L.sort ([[a]] -> [[a]]) -> [[a]] -> [[a]]
    forall a b. (a -> b) -> a -> b
    $ ([a] -> [a]) -> [[a]] -> [[a]]
    forall a b. (a -> b) -> [a] -> [b]
    map [a] -> [a]
    forall a. Ord a => [a] -> [a]
    L.sort [[a]]
    bs
    -- this still doesn't guarantee that all bs are subset of xs

    -- |Is this hypergraph uniform - meaning that all blocks are of the same size

    isUniform :: (Ord a) => Hypergraph a -> Bool
    isUniform :: Hypergraph a -> Bool
    isUniform h :: Hypergraph a
    h@(H xs :: [a]
    xs bs :: [[a]]
    bs) = [a] -> [[a]] -> Bool
    forall a. Ord a => [a] -> [[a]] -> Bool
    isSetSystem [a]
    xs [[a]]
    bs Bool -> Bool -> Bool
    && [Int] -> Bool
    forall a. Eq a => [a] -> Bool
    same (([a] -> Int) -> [[a]] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [[a]]
    bs)

    same :: [a] -> Bool
    same (x :: a
    x:xs :: [a]
    xs) = (a -> Bool) -> [a] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    ==a
    x) [a]
    xs
    same [] = Bool
    True

    fromGraph :: Graph a -> Hypergraph a
    fromGraph (G vs :: [a]
    vs es :: [[a]]
    es) = [a] -> [[a]] -> Hypergraph a
    forall a. [a] -> [[a]] -> Hypergraph a
    H [a]
    vs [[a]]
    es
    fromDesign :: Design a -> Hypergraph a
    fromDesign (D xs :: [a]
    xs bs :: [[a]]
    bs) = [a] -> [[a]] -> Hypergraph a
    forall a. [a] -> [[a]] -> Hypergraph a
    H [a]
    xs ([[a]] -> [[a]]
    forall a. Ord a => [a] -> [a]
    L.sort [[a]]
    bs)
    -- !! should insist that designs have blocks in order

    -- !! dual probably doesn't guarantee this at present

    {-
    dual (H xs bs) = toHypergraph (bs, map beta xs) where
        beta x = filter (x `elem`) bs
    -}

    -- INCIDENCE GRAPH

    -- data Incidence a = P a | B [a] deriving (Eq, Ord, Show)

    -- compare Design, where we just use Left, Right

    -- Also called the Levi graph

    incidenceGraph :: (Ord a) => Hypergraph a -> Graph (Either a [a])
    incidenceGraph :: Hypergraph a -> Graph (Either a [a])
    incidenceGraph (H xs :: [a]
    xs bs :: [[a]]
    bs) = [Either a [a]] -> [[Either a [a]]] -> Graph (Either a [a])
    forall a. [a] -> [[a]] -> Graph a
    G [Either a [a]]
    vs [[Either a [a]]]
    es where
        vs :: [Either a [a]]
    vs = (a -> Either a [a]) -> [a] -> [Either a [a]]
    forall a b. (a -> b) -> [a] -> [b]
    map a -> Either a [a]
    forall a b. a -> Either a b
    Left [a]
    xs [Either a [a]] -> [Either a [a]] -> [Either a [a]]
    forall a. [a] -> [a] -> [a]
    ++ ([a] -> Either a [a]) -> [[a]] -> [Either a [a]]
    forall a b. (a -> b) -> [a] -> [b]
    map [a] -> Either a [a]
    forall a b. b -> Either a b
    Right [[a]]
    bs
        es :: [[Either a [a]]]
    es = [[Either a [a]]] -> [[Either a [a]]]
    forall a. Ord a => [a] -> [a]
    L.sort [ [a -> Either a [a]
    forall a b. a -> Either a b
    Left a
    x, [a] -> Either a [a]
    forall a b. b -> Either a b
    Right [a]
    b] | [a]
    b <- [[a]]
    bs, a
    x <- [a]
    b]

    -- INCIDENCE MATRIX

    -- !! why are we doing this the other way round to the literature ??

    -- incidence matrix of a hypergraph

    -- (rows and columns indexed by edges and vertices respectively)

    -- (warning: in the literature it is often the other way round)

    incidenceMatrix :: Hypergraph a -> [[a]]
    incidenceMatrix (H vs :: [a]
    vs es :: [[a]]
    es) = [ [if a
    v a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [a]
    e then 1 else 0 | a
    v <- [a]
    vs] | [a]
    e <- [[a]]
    es]

    fromIncidenceMatrix :: [[a]] -> Hypergraph a
    fromIncidenceMatrix m :: [[a]]
    m = [a] -> [[a]] -> Hypergraph a
    forall a. [a] -> [[a]] -> Hypergraph a
    H [a]
    vs [[a]]
    es where
        n :: a
    n = [a] -> a
    forall i a. Num i => [a] -> i
    L.genericLength ([a] -> a) -> [a] -> a
    forall a b. (a -> b) -> a -> b
    $ [[a]] -> [a]
    forall a. [a] -> a
    head [[a]]
    m
        vs :: [a]
    vs = [1..a
    n]
        es :: [[a]]
    es = [[a]] -> [[a]]
    forall a. Ord a => [a] -> [a]
    L.sort ([[a]] -> [[a]]) -> [[a]] -> [[a]]
    forall a b. (a -> b) -> a -> b
    $ ([a] -> [a]) -> [[a]] -> [[a]]
    forall a b. (a -> b) -> [a] -> [b]
    map [a] -> [a]
    forall a. (Eq a, Num a) => [a] -> [a]
    edge [[a]]
    m
        edge :: [a] -> [a]
    edge row :: [a]
    row = [a
    v | (1,v :: a
    v) <- [a] -> [a] -> [(a, a)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [a]
    row [a]
    vs]

    -- isTwoGraph

    -- We can represent various incidence structures as hypergraphs,

    -- by identifying the lines with the sets of points that they contain

    isPartialLinearSpace :: (Ord a) => Hypergraph a -> Bool
    isPartialLinearSpace :: Hypergraph a -> Bool
    isPartialLinearSpace h :: Hypergraph a
    h@(H ps :: [a]
    ps ls :: [[a]]
    ls) =
        [a] -> [[a]] -> Bool
    forall a. Ord a => [a] -> [[a]] -> Bool
    isSetSystem [a]
    ps [[a]]
    ls Bool -> Bool -> Bool
    &&
        ([[a]] -> Bool) -> [[[a]]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all ( (Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <=1) (Int -> Bool) -> ([[a]] -> Int) -> [[a]] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [[a]] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ) [([a] -> Bool) -> [[a]] -> [[a]]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ([a]
    pair [a] -> [a] -> Bool
    forall a. Ord a => [a] -> [a] -> Bool
    `isSubset`) [[a]]
    ls | [a]
    pair <- Int -> [a] -> [[a]]
    forall a. Int -> [a] -> [[a]]
    combinationsOf 2 [a]
    ps]
        -- any two points are incident with at most one line

    -- Godsil & Royle, p79

    -- |Is this hypergraph a projective plane - meaning that any two lines meet in a unique point,

    -- and any two points lie on a unique line

    isProjectivePlane :: (Ord a) => Hypergraph a -> Bool
    isProjectivePlane :: Hypergraph a -> Bool
    isProjectivePlane h :: Hypergraph a
    h@(H ps :: [a]
    ps ls :: [[a]]
    ls) =
        [a] -> [[a]] -> Bool
    forall a. Ord a => [a] -> [[a]] -> Bool
    isSetSystem [a]
    ps [[a]]
    ls Bool -> Bool -> Bool
    &&
        ([a] -> Bool) -> [[a]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all ( (Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    ==1) (Int -> Bool) -> ([a] -> Int) -> [a] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length) [[a] -> [a] -> [a]
    forall a. Ord a => [a] -> [a] -> [a]
    intersect [a]
    l1 [a]
    l2 | [l1 :: [a]
    l1,l2 :: [a]
    l2] <- Int -> [[a]] -> [[[a]]]
    forall a. Int -> [a] -> [[a]]
    combinationsOf 2 [[a]]
    ls] Bool -> Bool -> Bool
    && -- any two lines meet in a unique point

        ([[a]] -> Bool) -> [[[a]]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all ( (Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    ==1) (Int -> Bool) -> ([[a]] -> Int) -> [[a]] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [[a]] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length) [ ([a] -> Bool) -> [[a]] -> [[a]]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ([a
    p1,a
    p2] [a] -> [a] -> Bool
    forall a. Ord a => [a] -> [a] -> Bool
    `isSubset`) [[a]]
    ls | [p1 :: a
    p1,p2 :: a
    p2] <- Int -> [a] -> [[a]]
    forall a. Int -> [a] -> [[a]]
    combinationsOf 2 [a]
    ps] -- any two points lie in a unique line

    -- |Is this hypergraph a projective plane with a triangle.

    -- This is a weak non-degeneracy condition, which eliminates all points on the same line, or all lines through the same point.

    isProjectivePlaneTri :: (Ord a) => Hypergraph a -> Bool
    isProjectivePlaneTri :: Hypergraph a -> Bool
    isProjectivePlaneTri h :: Hypergraph a
    h@(H ps :: [a]
    ps ls :: [[a]]
    ls) =
        Hypergraph a -> Bool
    forall a. Ord a => Hypergraph a -> Bool
    isProjectivePlane Hypergraph a
    h Bool -> Bool -> Bool
    && ([a] -> Bool) -> [[a]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any [a] -> Bool
    triangle (Int -> [a] -> [[a]]
    forall a. Int -> [a] -> [[a]]
    combinationsOf 3 [a]
    ps)
        where triangle :: [a] -> Bool
    triangle t :: [a]
    t@[p1 :: a
    p1,p2 :: a
    p2,p3 :: a
    p3] =
                       (Bool -> Bool
    not (Bool -> Bool) -> ([[a]] -> Bool) -> [[a]] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [[a]] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null) [[a]
    l | [a]
    l <- [[a]]
    ls, [a
    p1,a
    p2] [a] -> [a] -> Bool
    forall a. Ord a => [a] -> [a] -> Bool
    `isSubset` [a]
    l, a
    p3 a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [a]
    l] Bool -> Bool -> Bool
    && -- there is a line containing p1,p2 but not p3

                       (Bool -> Bool
    not (Bool -> Bool) -> ([[a]] -> Bool) -> [[a]] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [[a]] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null) [[a]
    l | [a]
    l <- [[a]]
    ls, [a
    p1,a
    p3] [a] -> [a] -> Bool
    forall a. Ord a => [a] -> [a] -> Bool
    `isSubset` [a]
    l, a
    p2 a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [a]
    l] Bool -> Bool -> Bool
    &&
                       (Bool -> Bool
    not (Bool -> Bool) -> ([[a]] -> Bool) -> [[a]] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [[a]] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null) [[a]
    l | [a]
    l <- [[a]]
    ls, [a
    p2,a
    p3] [a] -> [a] -> Bool
    forall a. Ord a => [a] -> [a] -> Bool
    `isSubset` [a]
    l, a
    p1 a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [a]
    l]

    -- |Is this hypergraph a projective plane with a quadrangle.

    -- This is a stronger non-degeneracy condition.

    isProjectivePlaneQuad :: (Ord a) => Hypergraph a -> Bool
    isProjectivePlaneQuad :: Hypergraph a -> Bool
    isProjectivePlaneQuad h :: Hypergraph a
    h@(H ps :: [a]
    ps ls :: [[a]]
    ls) =
        Hypergraph a -> Bool
    forall a. Ord a => Hypergraph a -> Bool
    isProjectivePlane Hypergraph a
    h Bool -> Bool -> Bool
    && ([a] -> Bool) -> [[a]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any [a] -> Bool
    quadrangle (Int -> [a] -> [[a]]
    forall a. Int -> [a] -> [[a]]
    combinationsOf 4 [a]
    ps)
        where quadrangle :: [a] -> Bool
    quadrangle q :: [a]
    q = ([a] -> Bool) -> [[a]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (Bool -> Bool
    not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [a] -> Bool
    collinear) (Int -> [a] -> [[a]]
    forall a. Int -> [a] -> [[a]]
    combinationsOf 3 [a]
    q) -- no three points collinear

              collinear :: [a] -> Bool
    collinear ps :: [a]
    ps = ([a] -> Bool) -> [[a]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any ([a]
    ps [a] -> [a] -> Bool
    forall a. Ord a => [a] -> [a] -> Bool
    `isSubset`) [[a]]
    ls

    -- > isProjectivePlaneQuad $ fromDesign $ pg2 f2

    -- True

    -- GENERALIZED QUADRANGLES

    -- Godsil & Royle p81

    isGeneralizedQuadrangle :: (Ord a) => Hypergraph a -> Bool
    isGeneralizedQuadrangle :: Hypergraph a -> Bool
    isGeneralizedQuadrangle h :: Hypergraph a
    h@(H ps :: [a]
    ps ls :: [[a]]
    ls) =
        Hypergraph a -> Bool
    forall a. Ord a => Hypergraph a -> Bool
    isPartialLinearSpace Hypergraph a
    h Bool -> Bool -> Bool
    &&
        (([a], a) -> Bool) -> [([a], a)] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (\(l :: [a]
    l,p :: a
    p) -> [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    unique [a
    p' | a
    p' <- [a]
    l, [a] -> Bool
    collinear (a -> a -> [a]
    forall a. Ord a => a -> a -> [a]
    pair a
    p a
    p')]) [([a]
    l,a
    p) | [a]
    l <- [[a]]
    ls, a
    p <- [a]
    ps, a
    p a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [a]
    l] Bool -> Bool -> Bool
    &&
        -- given any line l and point p not on l, there is a unique point p' on l with p and p' collinear

        ([a] -> Bool) -> [[a]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Bool -> Bool
    not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [a] -> Bool
    collinear) ([a] -> [[a]]
    forall a. [a] -> [[a]]
    powerset [a]
    ps) Bool -> Bool -> Bool
    && -- there are non collinear points

        ([[a]] -> Bool) -> [[[a]]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Bool -> Bool
    not (Bool -> Bool) -> ([[a]] -> Bool) -> [[a]] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [[a]] -> Bool
    forall (t :: * -> *) (t :: * -> *).
    (Foldable t, Foldable t) =>
    t (t a) -> Bool
    concurrent) ([[a]] -> [[[a]]]
    forall a. [a] -> [[a]]
    powerset [[a]]
    ls) -- there are non concurrent lines

        where unique :: t a -> Bool
    unique xs :: t a
    xs = t a -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length t a
    xs Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 1
              pair :: a -> a -> [a]
    pair x :: a
    x y :: a
    y = if a
    x a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    < a
    y then [a
    x,a
    y] else [a
    y,a
    x]
              collinear :: [a] -> Bool
    collinear ps :: [a]
    ps = ([a] -> Bool) -> [[a]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any ([a]
    ps [a] -> [a] -> Bool
    forall a. Ord a => [a] -> [a] -> Bool
    `isSubset`) [[a]]
    ls
              concurrent :: t (t a) -> Bool
    concurrent ls :: t (t a)
    ls = (a -> Bool) -> [a] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (\p :: a
    p -> (t a -> Bool) -> t (t a) -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (a
    p a -> t a -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem`) t (t a)
    ls) [a]
    ps

    grid :: a -> b -> Hypergraph (a, b)
    grid m :: a
    m n :: b
    n = [(a, b)] -> [[(a, b)]] -> Hypergraph (a, b)
    forall a. [a] -> [[a]] -> Hypergraph a
    H [(a, b)]
    ps [[(a, b)]]
    ls where
        ps :: [(a, b)]
    ps = [(a
    i,b
    j) | a
    i <- [1..a
    m], b
    j <- [1..b
    n] ]
        ls :: [[(a, b)]]
    ls = [[(a, b)]] -> [[(a, b)]]
    forall a. Ord a => [a] -> [a]
    L.sort ([[(a, b)]] -> [[(a, b)]]) -> [[(a, b)]] -> [[(a, b)]]
    forall a b. (a -> b) -> a -> b
    $ [ [(a
    i,b
    j) | a
    i <- [1..a
    m] ] | b
    j <- [1..b
    n] ] -- horizontal lines

                   [[(a, b)]] -> [[(a, b)]] -> [[(a, b)]]
    forall a. [a] -> [a] -> [a]
    ++ [ [(a
    i,b
    j) | b
    j <- [1..b
    n] ] | a
    i <- [1..a
    m] ] -- vertical lines

    dualGrid :: a -> a -> Hypergraph a
    dualGrid m :: a
    m n :: a
    n = Graph a -> Hypergraph a
    forall a. Graph a -> Hypergraph a
    fromGraph (Graph a -> Hypergraph a) -> Graph a -> Hypergraph a
    forall a b. (a -> b) -> a -> b
    $ a -> a -> Graph a
    forall t. Integral t => t -> t -> Graph t
    kb a
    m a
    n
    -- the lines of the grid are the points of the dual, and the points of the grid are the lines of the dual

    isGenQuadrangle' :: Hypergraph a -> Bool
    isGenQuadrangle' h :: Hypergraph a
    h = Graph (Either a [a]) -> Int
    forall t. Ord t => Graph t -> Int
    diameter Graph (Either a [a])
    g Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 4 Bool -> Bool -> Bool
    && Graph (Either a [a]) -> Int
    forall t. Eq t => Graph t -> Int
    girth Graph (Either a [a])
    g Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 8 -- !! plus non-degeneracy conditions

        where g :: Graph (Either a [a])
    g = Hypergraph a -> Graph (Either a [a])
    forall a. Ord a => Hypergraph a -> Graph (Either a [a])
    incidenceGraph Hypergraph a
    h

    -- CONFIGURATIONS

    -- http://en.wikipedia.org/wiki/Projective_configuration

    -- |Is this hypergraph a (projective) configuration.

    isConfiguration :: (Ord a) => Hypergraph a -> Bool
    isConfiguration :: Hypergraph a -> Bool
    isConfiguration h :: Hypergraph a
    h@(H ps :: [a]
    ps ls :: [[a]]
    ls) =
        Hypergraph a -> Bool
    forall a. Ord a => Hypergraph a -> Bool
    isUniform Hypergraph a
    h Bool -> Bool -> Bool
    && -- a set system, with each line incident with the same number of points

        [Int] -> Bool
    forall a. Eq a => [a] -> Bool
    same [[[a]] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (([a] -> Bool) -> [[a]] -> [[a]]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (a
    p a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem`) [[a]]
    ls) | a
    p <- [a]
    ps] -- each point is incident with the same number of lines

    fanoPlane :: Hypergraph Integer
    fanoPlane :: Hypergraph Integer
    fanoPlane = [Integer] -> [[Integer]] -> Hypergraph Integer
    forall a. Ord a => [a] -> [[a]] -> Hypergraph a
    toHypergraph [1..7] [[1,2,4],[2,3,5],[3,4,6],[4,5,7],[5,6,1],[6,7,2],[7,1,3]]

    -- |The Heawood graph is the incidence graph of the Fano plane

    heawoodGraph :: Graph (Either Integer [Integer])
    heawoodGraph :: Graph (Either Integer [Integer])
    heawoodGraph = Hypergraph Integer -> Graph (Either Integer [Integer])
    forall a. Ord a => Hypergraph a -> Graph (Either a [a])
    incidenceGraph Hypergraph Integer
    fanoPlane

    desarguesConfiguration :: Hypergraph [Integer]
    desarguesConfiguration :: Hypergraph [Integer]
    desarguesConfiguration = [[Integer]] -> [[[Integer]]] -> Hypergraph [Integer]
    forall a. [a] -> [[a]] -> Hypergraph a
    H [[Integer]]
    xs [[[Integer]]]
    bs where
        xs :: [[Integer]]
    xs = Int -> [Integer] -> [[Integer]]
    forall a. Int -> [a] -> [[a]]
    combinationsOf 2 [1..5]
        bs :: [[[Integer]]]
    bs = [ [[Integer]
    x | [Integer]
    x <- [[Integer]]
    xs, [Integer]
    x [Integer] -> [Integer] -> Bool
    forall a. Ord a => [a] -> [a] -> Bool
    `isSubset` [Integer]
    b] | [Integer]
    b <- Int -> [Integer] -> [[Integer]]
    forall a. Int -> [a] -> [[a]]
    combinationsOf 3 [1..5] ]

    desarguesGraph :: Graph (Either [Integer] [[Integer]])
    desarguesGraph :: Graph (Either [Integer] [[Integer]])
    desarguesGraph = Hypergraph [Integer] -> Graph (Either [Integer] [[Integer]])
    forall a. Ord a => Hypergraph a -> Graph (Either a [a])
    incidenceGraph Hypergraph [Integer]
    desarguesConfiguration

    pappusConfiguration :: Hypergraph Integer
    pappusConfiguration :: Hypergraph Integer
    pappusConfiguration = [Integer] -> [[Integer]] -> Hypergraph Integer
    forall a. [a] -> [[a]] -> Hypergraph a
    H [Integer]
    xs [[Integer]]
    bs where
        xs :: [Integer]
    xs = [1..9]
        bs :: [[Integer]]
    bs = [[Integer]] -> [[Integer]]
    forall a. Ord a => [a] -> [a]
    L.sort [ [1,2,3], [4,5,6], [7,8,9], [1,5,9], [1,6,8], [2,4,9], [3,4,8], [2,6,7], [3,5,7] ]

    pappusGraph :: Graph (Either Integer [Integer])
    pappusGraph :: Graph (Either Integer [Integer])
    pappusGraph = Hypergraph Integer -> Graph (Either Integer [Integer])
    forall a. Ord a => Hypergraph a -> Graph (Either a [a])
    incidenceGraph Hypergraph Integer
    pappusConfiguration

    -- !! no particular reason why the following is here rather than elsewhere

    {-
    triples = combinationsOf 3 [1..7]

    heptads = [ [a,b,c,d,e,f,g] | a <- triples,
                                  b <- triples, a < b, meetOne b a,
                                  c <- triples, b < c, all (meetOne c) [a,b],
                                  d <- triples, c < d, all (meetOne d) [a,b,c],
                                  e <- triples, d < e, all (meetOne e) [a,b,c,d],
                                  f <- triples, e < f, all (meetOne f) [a,b,c,d,e],
                                  g <- triples, f < g, all (meetOne g) [a,b,c,d,e,f],
                                  foldl intersect [1..7] [a,b,c,d,e,f,g] == [] ]
        where meetOne x y = length (intersect x y) == 1
        -- each pair of triples meet in exactly one point, and there is no point in all of them - Godsil & Royle p69
        -- (so these are the projective planes over 7 points)
    -}
    -- Godsil & Royle p69

    coxeterGraph :: Graph [Integer]
    coxeterGraph :: Graph [Integer]
    coxeterGraph = [[Integer]] -> [[[Integer]]] -> Graph [Integer]
    forall a. [a] -> [[a]] -> Graph a
    G [[Integer]]
    vs [[[Integer]]]
    es where
        g :: Permutation Integer
    g = [[Integer]] -> Permutation Integer
    forall a. Ord a => [[a]] -> Permutation a
    p [[1..7]]
        vs :: [[Integer]]
    vs = [[Integer]] -> [[Integer]]
    forall a. Ord a => [a] -> [a]
    L.sort ([[Integer]] -> [[Integer]]) -> [[Integer]] -> [[Integer]]
    forall a b. (a -> b) -> a -> b
    $ ([Integer] -> [[Integer]]) -> [[Integer]] -> [[Integer]]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ([Permutation Integer] -> [Integer] -> [[Integer]]
    forall a. Ord a => [Permutation a] -> [a] -> [[a]]
    orbitB [Permutation Integer
    g]) [[1,2,4],[3,5,7],[3,6,7],[5,6,7]]
        es :: [[[Integer]]]
    es = [ [[Integer]]
    e | e :: [[Integer]]
    e@[v1 :: [Integer]
    v1,v2 :: [Integer]
    v2] <- Int -> [[Integer]] -> [[[Integer]]]
    forall a. Int -> [a] -> [[a]]
    combinationsOf 2 [[Integer]]
    vs, [Integer] -> [Integer] -> Bool
    forall a. Ord a => [a] -> [a] -> Bool
    disjoint [Integer]
    v1 [Integer]
    v2]

    -- is this the incidence graph of a hypergraph involving heptads over triples?

    -- edges of K6

    duads :: [[Integer]]
    duads = Int -> [Integer] -> [[Integer]]
    forall a. Int -> [a] -> [[a]]
    combinationsOf 2 [1..6]

    -- 1-factors of K6

    -- 15 different ways to pick three disjoint duads from [1..6]

    synthemes :: [[[Integer]]]
    synthemes = [ [[Integer]
    d1,[Integer]
    d2,[Integer]
    d3] | [Integer]
    d1 <- [[Integer]]
    duads,
                               [Integer]
    d2 <- [[Integer]]
    duads, [Integer]
    d2 [Integer] -> [Integer] -> Bool
    forall a. Ord a => a -> a -> Bool
    > [Integer]
    d1, [Integer] -> [Integer] -> Bool
    forall a. Ord a => [a] -> [a] -> Bool
    disjoint [Integer]
    d1 [Integer]
    d2,
                               [Integer]
    d3 <- [[Integer]]
    duads, [Integer]
    d3 [Integer] -> [Integer] -> Bool
    forall a. Ord a => a -> a -> Bool
    > [Integer]
    d2, [Integer] -> [Integer] -> Bool
    forall a. Ord a => [a] -> [a] -> Bool
    disjoint [Integer]
    d1 [Integer]
    d3, [Integer] -> [Integer] -> Bool
    forall a. Ord a => [a] -> [a] -> Bool
    disjoint [Integer]
    d2 [Integer]
    d3 ]

    -- |The Tutte-Coxeter graph, also called the Tutte 8-cage

    tutteCoxeterGraph :: Graph (Either [Integer] [[Integer]])
    tutteCoxeterGraph :: Graph (Either [Integer] [[Integer]])
    tutteCoxeterGraph = Hypergraph [Integer] -> Graph (Either [Integer] [[Integer]])
    forall a. Ord a => Hypergraph a -> Graph (Either a [a])
    incidenceGraph (Hypergraph [Integer] -> Graph (Either [Integer] [[Integer]]))
    -> Hypergraph [Integer] -> Graph (Either [Integer] [[Integer]])
    forall a b. (a -> b) -> a -> b
    $ [[Integer]] -> [[[Integer]]] -> Hypergraph [Integer]
    forall a. [a] -> [[a]] -> Hypergraph a
    H [[Integer]]
    duads [[[Integer]]]
    synthemes

    -- Also known as line graph

    intersectionGraph :: Hypergraph a -> Graph [a]
    intersectionGraph (H xs :: [a]
    xs bs :: [[a]]
    bs) = [[a]] -> [[[a]]] -> Graph [a]
    forall a. [a] -> [[a]] -> Graph a
    G [[a]]
    vs [[[a]]]
    es where
        vs :: [[a]]
    vs = [[a]]
    bs
        es :: [[[a]]]
    es = [[[a]]
    pair | pair :: [[a]]
    pair@[b1 :: [a]
    b1,b2 :: [a]
    b2] <- Int -> [[a]] -> [[[a]]]
    forall a. Int -> [a] -> [[a]]
    combinationsOf 2 [[a]]
    bs, Bool -> Bool
    not ([a] -> [a] -> Bool
    forall a. Ord a => [a] -> [a] -> Bool
    disjoint [a]
    b1 [a]
    b2)]