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

    module Math.Projects.MiniquaternionGeometry where

    import Prelude hiding (  (<*), (*>) )

    import qualified Data.List as L

    import Math.Common.ListSet as LS
    import Math.Core.Utils (combinationsOf)

    import Math.Algebra.Field.Base
    import Math.Combinatorics.FiniteGeometry (pnf, ispnf, orderPGL)
    -- import Math.Combinatorics.Graph
    import Math.Combinatorics.GraphAuts
    import Math.Algebra.Group.PermutationGroup hiding (order)
    import qualified Math.Algebra.Group.SchreierSims as SS
    import Math.Algebra.Group.RandomSchreierSims
    import Math.Combinatorics.Design as D
    import Math.Algebra.LinearAlgebra -- ( (<.>), (<+>) )

    import Math.Projects.ChevalleyGroup.Classical

    -- Sources:
    -- Miniquaternion Geometry, Room & Kirkpatrick
    -- Survey of Non-Desarguesian Planes, Charles Weibel

    -- F9, defined by adding sqrt of -1 to F3. (The Conway poly for F9 is not so convenient for us here)
    data F9 = F9 F3 F3 deriving (F9 -> F9 -> Bool
    (F9 -> F9 -> Bool) -> (F9 -> F9 -> Bool) -> Eq F9
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: F9 -> F9 -> Bool
    $c/= :: F9 -> F9 -> Bool
    == :: F9 -> F9 -> Bool
    $c== :: F9 -> F9 -> Bool
    Eq,Eq F9
    Eq F9 =>
    (F9 -> F9 -> Ordering)
    -> (F9 -> F9 -> Bool)
    -> (F9 -> F9 -> Bool)
    -> (F9 -> F9 -> Bool)
    -> (F9 -> F9 -> Bool)
    -> (F9 -> F9 -> F9)
    -> (F9 -> F9 -> F9)
    -> Ord F9
    F9 -> F9 -> Bool
    F9 -> F9 -> Ordering
    F9 -> F9 -> F9
    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
    min :: F9 -> F9 -> F9
    $cmin :: F9 -> F9 -> F9
    max :: F9 -> F9 -> F9
    $cmax :: F9 -> F9 -> F9
    >= :: F9 -> F9 -> Bool
    $c>= :: F9 -> F9 -> Bool
    > :: F9 -> F9 -> Bool
    $c> :: F9 -> F9 -> Bool
    <= :: F9 -> F9 -> Bool
    $c<= :: F9 -> F9 -> Bool
    < :: F9 -> F9 -> Bool
    $c< :: F9 -> F9 -> Bool
    compare :: F9 -> F9 -> Ordering
    $ccompare :: F9 -> F9 -> Ordering
    $cp1Ord :: Eq F9
    Ord)

    instance Show F9 where
        show :: F9 -> String
    show (F9 0 0) = "0"
        show (F9 0 1) = "e"
        show (F9 0 2) = "-e"
        show (F9 1 0) = "1"
        show (F9 1 1) = "1+e"
        show (F9 1 2) = "1-e"
        show (F9 2 0) = "-1"
        show (F9 2 1) = "-1+e"
        show (F9 2 2) = "-1-e"

    e :: F9
    e = F3 -> F3 -> F9
    F9 0 1 -- sqrt of -1

    instance Num F9 where
        F9 a1 :: F3
    a1 b1 :: F3
    b1 + :: F9 -> F9 -> F9
    + F9 a2 :: F3
    a2 b2 :: F3
    b2 = F3 -> F3 -> F9
    F9 (F3
    a1F3 -> F3 -> F3
    forall a. Num a => a -> a -> a
    +F3
    a2) (F3
    b1F3 -> F3 -> F3
    forall a. Num a => a -> a -> a
    +F3
    b2)
        F9 a1 :: F3
    a1 b1 :: F3
    b1 * :: F9 -> F9 -> F9
    * F9 a2 :: F3
    a2 b2 :: F3
    b2 = F3 -> F3 -> F9
    F9 (F3
    a1F3 -> F3 -> F3
    forall a. Num a => a -> a -> a
    *F3
    a2F3 -> F3 -> F3
    forall a. Num a => a -> a -> a
    -F3
    b1F3 -> F3 -> F3
    forall a. Num a => a -> a -> a
    *F3
    b2) (F3
    a1F3 -> F3 -> F3
    forall a. Num a => a -> a -> a
    *F3
    b2F3 -> F3 -> F3
    forall a. Num a => a -> a -> a
    +F3
    a2F3 -> F3 -> F3
    forall a. Num a => a -> a -> a
    *F3
    b1)
        negate :: F9 -> F9
    negate (F9 a :: F3
    a b :: F3
    b) = F3 -> F3 -> F9
    F9 (F3 -> F3
    forall a. Num a => a -> a
    negate F3
    a) (F3 -> F3
    forall a. Num a => a -> a
    negate F3
    b)
        fromInteger :: Integer -> F9
    fromInteger n :: Integer
    n = F3 -> F3 -> F9
    F9 (Integer -> F3
    forall a. Num a => Integer -> a
    fromInteger Integer
    n) 0

    f9 :: [F9]
    f9 = [F3 -> F3 -> F9
    F9 F3
    a F3
    b | F3
    a <- [F3]
    f3, F3
    b <- [F3]
    f3]

    w :: F9
    w = 1F9 -> F9 -> F9
    forall a. Num a => a -> a -> a
    -F9
    e -- a primitive element - generates the multiplicative group

    conj :: F9 -> F9
    conj (F9 a :: F3
    a b :: F3
    b) = F3 -> F3 -> F9
    F9 F3
    a (-F3
    b)
    -- This is just the Frobenius aut x -> x^3

    norm :: F9 -> F3
    norm (F9 a :: F3
    a b :: F3
    b) = F3
    aF3 -> Integer -> F3
    forall a b. (Num a, Integral b) => a -> b -> a
    ^2 F3 -> F3 -> F3
    forall a. Num a => a -> a -> a
    + F3
    bF3 -> Integer -> F3
    forall a b. (Num a, Integral b) => a -> b -> a
    ^2
    -- == x * conj x

    instance Fractional F9 where
        recip :: F9 -> F9
    recip x :: F9
    x@(F9 a :: F3
    a b :: F3
    b) = F3 -> F3 -> F9
    F9 (F3
    aF3 -> F3 -> F3
    forall a. Fractional a => a -> a -> a
    /F3
    n) (-F3
    bF3 -> F3 -> F3
    forall a. Fractional a => a -> a -> a
    /F3
    n) where n :: F3
    n = F9 -> F3
    norm F9
    x

    instance FiniteField F9 where
        basisFq :: F9 -> [F9]
    basisFq _ = [1,F9
    e]

    -- J9, or Q, defined by modifying the multiplication in F9
    data J9 = J9 F9 deriving (J9 -> J9 -> Bool
    (J9 -> J9 -> Bool) -> (J9 -> J9 -> Bool) -> Eq J9
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: J9 -> J9 -> Bool
    $c/= :: J9 -> J9 -> Bool
    == :: J9 -> J9 -> Bool
    $c== :: J9 -> J9 -> Bool
    Eq,Eq J9
    Eq J9 =>
    (J9 -> J9 -> Ordering)
    -> (J9 -> J9 -> Bool)
    -> (J9 -> J9 -> Bool)
    -> (J9 -> J9 -> Bool)
    -> (J9 -> J9 -> Bool)
    -> (J9 -> J9 -> J9)
    -> (J9 -> J9 -> J9)
    -> Ord J9
    J9 -> J9 -> Bool
    J9 -> J9 -> Ordering
    J9 -> J9 -> J9
    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
    min :: J9 -> J9 -> J9
    $cmin :: J9 -> J9 -> J9
    max :: J9 -> J9 -> J9
    $cmax :: J9 -> J9 -> J9
    >= :: J9 -> J9 -> Bool
    $c>= :: J9 -> J9 -> Bool
    > :: J9 -> J9 -> Bool
    $c> :: J9 -> J9 -> Bool
    <= :: J9 -> J9 -> Bool
    $c<= :: J9 -> J9 -> Bool
    < :: J9 -> J9 -> Bool
    $c< :: J9 -> J9 -> Bool
    compare :: J9 -> J9 -> Ordering
    $ccompare :: J9 -> J9 -> Ordering
    $cp1Ord :: Eq J9
    Ord)

    instance Show J9 where
        show :: J9 -> String
    show (J9 (F9 0 0)) = "0"
        show (J9 (F9 0 1)) = "-j"
        show (J9 (F9 0 2)) = "j"
        show (J9 (F9 1 0)) = "1"
        show (J9 (F9 1 1)) = "-k"
        show (J9 (F9 1 2)) = "i"
        show (J9 (F9 2 0)) = "-1"
        show (J9 (F9 2 1)) = "-i"
        show (J9 (F9 2 2)) = "k"

    squaresF9 :: [F9]
    squaresF9 = [1,F9
    wF9 -> Integer -> F9
    forall a b. (Num a, Integral b) => a -> b -> a
    ^2,F9
    wF9 -> Integer -> F9
    forall a b. (Num a, Integral b) => a -> b -> a
    ^4,F9
    wF9 -> Integer -> F9
    forall a b. (Num a, Integral b) => a -> b -> a
    ^6] -- and 0, but not needed here

    instance Num J9 where
        J9 x :: F9
    x + :: J9 -> J9 -> J9
    + J9 y :: F9
    y = F9 -> J9
    J9 (F9
    xF9 -> F9 -> F9
    forall a. Num a => a -> a -> a
    +F9
    y)
        0 * :: J9 -> J9 -> J9
    * _ = 0
        _ * 0 = 0
        J9 x :: F9
    x * J9 y :: F9
    y =
            if F9
    y F9 -> [F9] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [F9]
    squaresF9
            then F9 -> J9
    J9 (F9
    xF9 -> F9 -> F9
    forall a. Num a => a -> a -> a
    *F9
    y)
            else F9 -> J9
    J9 (F9 -> F9
    conj F9
    x F9 -> F9 -> F9
    forall a. Num a => a -> a -> a
    * F9
    y)
        negate :: J9 -> J9
    negate (J9 x :: F9
    x) = F9 -> J9
    J9 (F9 -> F9
    forall a. Num a => a -> a
    negate F9
    x)
        fromInteger :: Integer -> J9
    fromInteger n :: Integer
    n = F9 -> J9
    J9 (Integer -> F9
    forall a. Num a => Integer -> a
    fromInteger Integer
    n)

    i :: J9
    i = F9 -> J9
    J9 F9
    w
    j :: J9
    j = F9 -> J9
    J9 (F9
    wF9 -> Integer -> F9
    forall a b. (Num a, Integral b) => a -> b -> a
    ^6) -- == i-1
    k :: J9
    k = F9 -> J9
    J9 (F9
    wF9 -> Integer -> F9
    forall a b. (Num a, Integral b) => a -> b -> a
    ^7) -- == i+1

    j9 :: [J9]
    j9 = [F9 -> J9
    J9 F9
    x | F9
    x <- [F9]
    f9]

    -- the aut of J9 that sends i to x
    autJ9 :: J9 -> Permutation J9
    autJ9 x :: J9
    x = [(J9, J9)] -> Permutation J9
    forall a. Ord a => [(a, a)] -> Permutation a
    fromPairs [ (J9
    aJ9 -> J9 -> J9
    forall a. Num a => a -> a -> a
    +J9
    bJ9 -> J9 -> J9
    forall a. Num a => a -> a -> a
    *J9
    i, J9
    aJ9 -> J9 -> J9
    forall a. Num a => a -> a -> a
    +J9
    bJ9 -> J9 -> J9
    forall a. Num a => a -> a -> a
    *J9
    x) | J9
    a <- [0,1,-1], J9
    b <- [1,-1] ]

    autA :: Permutation J9
    autA = J9 -> Permutation J9
    autJ9 (-J9
    i) -- sends i -> -i
    autB :: Permutation J9
    autB = J9 -> Permutation J9
    autJ9 (-J9
    k) -- sends j -> -j
    autC :: Permutation J9
    autC = J9 -> Permutation J9
    autJ9 (-J9
    j) -- sends k -> -k

    autsJ9 :: [Permutation J9]
    autsJ9 = [Permutation J9
    autA, Permutation J9
    autC]
    -- these two auts generate the group, which is isomorphic to S3
    -- indeed, the auts permute the pairs {i,-i}, {j,-j}, {k,-k}

    conj' :: J9 -> J9
    conj' (J9 x :: F9
    x) = F9 -> J9
    J9 (F9 -> F9
    conj F9
    x)
    -- Note that conj' x == x .^ autB

    isAut :: [a] -> (a -> a) -> Bool
    isAut k :: [a]
    k sigma :: a -> a
    sigma = [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    and [a -> a
    sigma a
    x a -> a -> a
    forall a. Num a => a -> a -> a
    + a -> a
    sigma a
    y a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a -> a
    sigma (a
    xa -> a -> a
    forall a. Num a => a -> a -> a
    +a
    y) | a
    x <- [a]
    k, a
    y <- [a]
    k]
                 Bool -> Bool -> Bool
    && [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    and [a -> a
    sigma a
    x a -> a -> a
    forall a. Num a => a -> a -> a
    * a -> a
    sigma a
    y a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a -> a
    sigma (a
    xa -> a -> a
    forall a. Num a => a -> a -> a
    *a
    y) | a
    x <- [a]
    k, a
    y <- [a]
    k]

    isReal :: a -> Bool
    isReal x :: a
    x = a
    x a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [0,1,-1]
    isComplex :: J9 -> Bool
    isComplex = Bool -> Bool
    not (Bool -> Bool) -> (J9 -> Bool) -> J9 -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . J9 -> Bool
    forall a. (Eq a, Num a) => a -> Bool
    isReal

    instance Fractional J9 where
        recip :: J9 -> J9
    recip 0 = String -> J9
    forall a. HasCallStack => String -> a
    error "J9.recip: 0"
        recip x :: J9
    x | J9 -> Bool
    forall a. (Eq a, Num a) => a -> Bool
    isReal J9
    x  = J9
    x
                | Bool
    otherwise = -J9
    x

    instance FiniteField J9 where
        basisFq :: J9 -> [J9]
    basisFq _ = [1,J9
    i,J9
    j,J9
    k]
        eltsFq :: J9 -> [J9]
    eltsFq _ = [J9]
    j9

    -- PROJECTIVE PLANES

    ptsPG2 :: [a] -> [[a]]
    ptsPG2 r :: [a]
    r =  [ [0,0,1] ] [[a]] -> [[a]] -> [[a]]
    forall a. [a] -> [a] -> [a]
    ++ [ [0,1,a
    x] | a
    x <- [a]
    r ] [[a]] -> [[a]] -> [[a]]
    forall a. [a] -> [a] -> [a]
    ++ [ [1,a
    x,a
    y] | a
    x <- [a]
    r, a
    y <- [a]
    r ]
    -- if r is sorted, then so is the result

    orthogonalLinesPG2 :: [[a]] -> [[[a]]]
    orthogonalLinesPG2 xs :: [[a]]
    xs = [[[a]]] -> [[[a]]]
    forall a. Ord a => [a] -> [a]
    L.sort [ [[a]
    x | [a]
    x <- [[a]]
    xs, [a]
    u [a] -> [a] -> a
    forall a. Num a => [a] -> [a] -> a
    <.> [a]
    x a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0] | [a]
    u <- [[a]]
    xs ]

    rightLinesPG2 :: [t] -> [[[t]]]
    rightLinesPG2 r :: [t]
    r =
        [ [0,0,1] [t] -> [[t]] -> [[t]]
    forall a. a -> [a] -> [a]
    : [ [0,1,t
    x] | t
    x <- [t]
    r] ] [[[t]]] -> [[[t]]] -> [[[t]]]
    forall a. [a] -> [a] -> [a]
    ++ -- line at infinity
        [ [0,0,1] [t] -> [[t]] -> [[t]]
    forall a. a -> [a] -> [a]
    : [ [1,t
    x,t
    y] | t
    y <- [t]
    r] | t
    x <- [t]
    r ] [[[t]]] -> [[[t]]] -> [[[t]]]
    forall a. [a] -> [a] -> [a]
    ++ -- vertical lines
        [ [0,1,t
    a] [t] -> [[t]] -> [[t]]
    forall a. a -> [a] -> [a]
    : [ [1,t
    x,t
    y] | t
    x <- [t]
    r, t
    y <- [t
    xt -> t -> t
    forall a. Num a => a -> a -> a
    *t
    at -> t -> t
    forall a. Num a => a -> a -> a
    +t
    b] ] | t
    a <- [t]
    r, t
    b <- [t]
    r ] -- slope multiplies on the right
    -- if r is sorted, then so is the result, and each line in the result

    leftLinesPG2 :: [t] -> [[[t]]]
    leftLinesPG2 r :: [t]
    r =
        [ [0,0,1] [t] -> [[t]] -> [[t]]
    forall a. a -> [a] -> [a]
    : [ [0,1,t
    x] | t
    x <- [t]
    r] ] [[[t]]] -> [[[t]]] -> [[[t]]]
    forall a. [a] -> [a] -> [a]
    ++ -- line at infinity
        [ [0,0,1] [t] -> [[t]] -> [[t]]
    forall a. a -> [a] -> [a]
    : [ [1,t
    x,t
    y] | t
    y <- [t]
    r] | t
    x <- [t]
    r ] [[[t]]] -> [[[t]]] -> [[[t]]]
    forall a. [a] -> [a] -> [a]
    ++ -- vertical lines
        [ [0,1,t
    a] [t] -> [[t]] -> [[t]]
    forall a. a -> [a] -> [a]
    : [ [1,t
    x,t
    y] | t
    x <- [t]
    r, t
    y <- [t
    at -> t -> t
    forall a. Num a => a -> a -> a
    *t
    xt -> t -> t
    forall a. Num a => a -> a -> a
    +t
    b] ] | t
    a <- [t]
    r, t
    b <- [t]
    r ] -- slope multiplies on the left

    -- Projective plane PG2(F9)
    phi :: Design [F9]
    phi = ([[F9]], [[[F9]]]) -> Design [F9]
    forall a. Ord a => ([a], [[a]]) -> Design a
    design ([[F9]]
    xs,[[[F9]]]
    bs) where
        xs :: [[F9]]
    xs = [F9] -> [[F9]]
    forall a. Num a => [a] -> [[a]]
    ptsPG2 [F9]
    f9
        bs :: [[[F9]]]
    bs = [[F9]] -> [[[F9]]]
    forall a. (Ord a, Num a) => [[a]] -> [[[a]]]
    orthogonalLinesPG2 [[F9]]
    xs -- L.sort [ [x | x <- xs, u <.> x == 0] | u <- xs ]

    -- Then the collineations of phi consist of projective transformations,
    -- together with a conjugacy collineation induced by the Frobenius aut

    -- alternative construction of PG2(F9) - gives same result
    phi' :: Design [F9]
    phi' = ([[F9]], [[[F9]]]) -> Design [F9]
    forall a. Ord a => ([a], [[a]]) -> Design a
    design ([[F9]]
    xs,[[[F9]]]
    bs) where
        xs :: [[F9]]
    xs = [F9] -> [[F9]]
    forall a. Num a => [a] -> [[a]]
    ptsPG2 [F9]
    f9
        bs :: [[[F9]]]
    bs = [F9] -> [[[F9]]]
    forall t. Num t => [t] -> [[[t]]]
    rightLinesPG2 [F9]
    f9

    collineationsPhi :: [Permutation [F9]]
    collineationsPhi = Int -> [F9] -> [Permutation [F9]]
    forall k. (FiniteField k, Ord k) => Int -> [k] -> [Permutation [k]]
    l 3 [F9]
    f9 [Permutation [F9]] -> [Permutation [F9]] -> [Permutation [F9]]
    forall a. [a] -> [a] -> [a]
    ++ [Permutation [F9]
    fieldAut] where
        D xs :: [[F9]]
    xs bs :: [[[F9]]]
    bs = Design [F9]
    phi
        fieldAut :: Permutation [F9]
    fieldAut = [([F9], [F9])] -> Permutation [F9]
    forall a. Ord a => [(a, a)] -> Permutation a
    fromPairs [ ([F9]
    x , (F9 -> F9) -> [F9] -> [F9]
    forall a b. (a -> b) -> [a] -> [b]
    map F9 -> F9
    conj [F9]
    x) | [F9]
    x <- [[F9]]
    xs ]
    -- in general, this would be PSigmaL(n,Fq), whereas we want PGammaL(n,Fq). However, for F9 they coincide.
    -- order 84913920

    liftToGraph :: Design a -> Permutation a -> Permutation (Either a [a])
    liftToGraph (D xs :: [a]
    xs bs :: [[a]]
    bs) g :: Permutation a
    g = [(Either a [a], Either a [a])] -> Permutation (Either a [a])
    forall a. Ord a => [(a, a)] -> Permutation a
    fromPairs ([(Either a [a], Either a [a])] -> Permutation (Either a [a]))
    -> [(Either a [a], Either a [a])] -> Permutation (Either a [a])
    forall a b. (a -> b) -> a -> b
    $ [(a -> Either a [a]
    forall a b. a -> Either a b
    Left a
    x, a -> Either a [a]
    forall a b. a -> Either a b
    Left (a
    x a -> Permutation a -> a
    forall a. Ord a => a -> Permutation a -> a
    .^ Permutation a
    g)) | a
    x <- [a]
    xs] [(Either a [a], Either a [a])]
    -> [(Either a [a], Either a [a])] -> [(Either a [a], Either a [a])]
    forall a. [a] -> [a] -> [a]
    ++ [([a] -> Either a [a]
    forall a b. b -> Either a b
    Right [a]
    b, [a] -> Either a [a]
    forall a b. b -> Either a b
    Right ([a]
    b [a] -> Permutation a -> [a]
    forall a. Ord a => [a] -> Permutation a -> [a]
    -^ Permutation a
    g)) | [a]
    b <- [[a]]
    bs]

    -- This construction appears to produce a projective plane
    -- (However, Room & Kirkpatrick point out that it's not really well-defined
    -- - if we had chosen different quasi-homogeneous coords, we would have got different results)
    -- However, it's not the same as either omega or omegaD below
    omega0 :: Design [J9]
    omega0 = ([[J9]], [[[J9]]]) -> Design [J9]
    forall a. Ord a => ([a], [[a]]) -> Design a
    design ([[J9]]
    xs,[[[J9]]]
    bs) where
        xs :: [[J9]]
    xs = [J9] -> [[J9]]
    forall a. Num a => [a] -> [[a]]
    ptsPG2 [J9]
    j9
        bs :: [[[J9]]]
    bs = [[J9]] -> [[[J9]]]
    forall a. (Ord a, Num a) => [[a]] -> [[[a]]]
    orthogonalLinesPG2 [[J9]]
    xs -- L.sort [ [x | x <- xs, u <.> x == 0] | u <- xs ]

    -- Room & Kirkpatrick, p103
    omega :: Design [J9]
    omega = ([[J9]], [[[J9]]]) -> Design [J9]
    forall a. Ord a => ([a], [[a]]) -> Design a
    design ([[J9]]
    xs,[[[J9]]]
    bs) where
        xs :: [[J9]]
    xs = [J9] -> [[J9]]
    forall a. Num a => [a] -> [[a]]
    ptsPG2 [J9]
    j9
        bs :: [[[J9]]]
    bs = [J9] -> [[[J9]]]
    forall t. Num t => [t] -> [[[t]]]
    rightLinesPG2 [J9]
    j9

    -- another construction that produces same result (but slower)
    omega2 :: Design [J9]
    omega2 = ([[J9]], [[[J9]]]) -> Design [J9]
    forall a. Ord a => ([a], [[a]]) -> Design a
    design ([[J9]]
    xs,[[[J9]]]
    bs) where
        xs :: [[J9]]
    xs = [J9] -> [[J9]]
    forall a. Num a => [a] -> [[a]]
    ptsPG2 [J9]
    j9
        bs :: [[[J9]]]
    bs =  [ [[J9]]
    l | [p :: [J9]
    p,q :: [J9]
    q] <- Int -> [[J9]] -> [[[J9]]]
    forall a. Int -> [a] -> [[a]]
    combinationsOf 2 [[J9]]
    xs, [[J9]]
    l <- [[J9] -> [J9] -> [[J9]]
    line [J9]
    p [J9]
    q], [[J9]
    p,[J9]
    q] [[J9]] -> [[J9]] -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int -> [[J9]] -> [[J9]]
    forall a. Int -> [a] -> [a]
    take 2 [[J9]]
    l]
        line :: [J9] -> [J9] -> [[J9]]
    line p :: [J9]
    p q :: [J9]
    q = [[J9]] -> [[J9]]
    forall a. Ord a => [a] -> [a]
    toListSet ([[J9]] -> [[J9]]) -> [[J9]] -> [[J9]]
    forall a b. (a -> b) -> a -> b
    $ ([J9] -> Bool) -> [[J9]] -> [[J9]]
    forall a. (a -> Bool) -> [a] -> [a]
    filter [J9] -> Bool
    forall a. (Eq a, Num a) => [a] -> Bool
    ispnf [(J9
    a J9 -> [J9] -> [J9]
    forall a. Num a => a -> [a] -> [a]
    *> [J9]
    p) [J9] -> [J9] -> [J9]
    forall a. Num a => [a] -> [a] -> [a]
    <+> (J9
    b J9 -> [J9] -> [J9]
    forall a. Num a => a -> [a] -> [a]
    *> [J9]
    q) | J9
    a <- [J9]
    j9, J9
    b <- [J9]
    j9]

    -- Room & Kirkpatrick, p107, p114
    collineationsOmega :: [Permutation [J9]]
    collineationsOmega =
        [Permutation [J9]
    r]
     [Permutation [J9]] -> [Permutation [J9]] -> [Permutation [J9]]
    forall a. [a] -> [a] -> [a]
    ++ [J9 -> J9 -> Permutation [J9]
    s J9
    rho J9
    sigma | J9
    rho <- [J9]
    j9 [J9] -> [J9] -> [J9]
    forall a. Ord a => [a] -> [a] -> [a]
    \\ [0], J9
    sigma <- [J9]
    j9 [J9] -> [J9] -> [J9]
    forall a. Ord a => [a] -> [a] -> [a]
    \\ [0], J9
    rho J9 -> J9 -> Bool
    forall a. Eq a => a -> a -> Bool
    == 1 Bool -> Bool -> Bool
    || J9
    sigma J9 -> J9 -> Bool
    forall a. Eq a => a -> a -> Bool
    == 1]
     [Permutation [J9]] -> [Permutation [J9]] -> [Permutation [J9]]
    forall a. [a] -> [a] -> [a]
    ++ [J9 -> J9 -> Permutation [J9]
    t J9
    delta J9
    epsilon | J9
    delta <- [J9]
    j9, J9
    epsilon <- [J9]
    j9, J9
    delta J9 -> J9 -> J9
    forall a. Num a => a -> a -> a
    * J9
    epsilon J9 -> J9 -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0] -- for generators sufficient to have only one non-zero
     [Permutation [J9]] -> [Permutation [J9]] -> [Permutation [J9]]
    forall a. [a] -> [a] -> [a]
    ++ [Permutation [J9]
    u]
     [Permutation [J9]] -> [Permutation [J9]] -> [Permutation [J9]]
    forall a. [a] -> [a] -> [a]
    ++ [Permutation J9 -> Permutation [J9]
    a Permutation J9
    lambda | Permutation J9
    lambda <- [Permutation J9]
    autsJ9] where
        D xs :: [[J9]]
    xs bs :: [[[J9]]]
    bs = Design [J9]
    omega
        fromMatrix :: [[J9]] -> Permutation [J9]
    fromMatrix m :: [[J9]]
    m = [([J9], [J9])] -> Permutation [J9]
    forall a. Ord a => [(a, a)] -> Permutation a
    fromPairs [ ([J9]
    x, [J9] -> [J9]
    forall a. (Eq a, Fractional a) => [a] -> [a]
    pnf ([J9]
    x [J9] -> [[J9]] -> [J9]
    forall a. Num a => [a] -> [[a]] -> [a]
    <*>> [[J9]]
    m)) | [J9]
    x <- [[J9]]
    xs]
        r :: Permutation [J9]
    r = [[J9]] -> Permutation [J9]
    fromMatrix [[1,0,0],[0,0,1],[0,1,0]] -- reflect in the line x = y in the affine subplane
        s :: J9 -> J9 -> Permutation [J9]
    s rho :: J9
    rho sigma :: J9
    sigma = [([J9], [J9])] -> Permutation [J9]
    forall a. Ord a => [(a, a)] -> Permutation a
    fromPairs ([([J9], [J9])] -> Permutation [J9])
    -> [([J9], [J9])] -> Permutation [J9]
    forall a b. (a -> b) -> a -> b
    $ [([1,J9
    x,J9
    y], [1,J9
    xJ9 -> J9 -> J9
    forall a. Num a => a -> a -> a
    *J9
    rho,J9
    yJ9 -> J9 -> J9
    forall a. Num a => a -> a -> a
    *J9
    sigma]) | J9
    x <- [J9]
    j9, J9
    y <- [J9]
    j9]
                               [([J9], [J9])] -> [([J9], [J9])] -> [([J9], [J9])]
    forall a. [a] -> [a] -> [a]
    ++ [([0,1,J9
    mu],[0,1,(J9 -> J9
    forall a. Fractional a => a -> a
    recip J9
    rho)J9 -> J9 -> J9
    forall a. Num a => a -> a -> a
    *J9
    muJ9 -> J9 -> J9
    forall a. Num a => a -> a -> a
    *J9
    sigma]) | J9
    mu <- [J9]
    j9]
                               [([J9], [J9])] -> [([J9], [J9])] -> [([J9], [J9])]
    forall a. [a] -> [a] -> [a]
    ++ [([0,0,1],[0,0,1])] -- leaves "Y" fixed
        -- fromMatrix [[1,0,0],[0,rho,0],[0,0,sigma]] -- scale x,y -> rho x, sigma y
        t :: J9 -> J9 -> Permutation [J9]
    t delta :: J9
    delta epsilon :: J9
    epsilon = [[J9]] -> Permutation [J9]
    fromMatrix [[1,J9
    delta,J9
    epsilon],[0,1,0],[0,0,1]] -- translation x,y -> x+delta, y+epsilon
        u :: Permutation [J9]
    u = [([J9], [J9])] -> Permutation [J9]
    forall a. Ord a => [(a, a)] -> Permutation a
    fromPairs ([([J9], [J9])] -> Permutation [J9])
    -> [([J9], [J9])] -> Permutation [J9]
    forall a b. (a -> b) -> a -> b
    $ [([1,J9
    x,J9
    y], [1,J9
    xJ9 -> J9 -> J9
    forall a. Num a => a -> a -> a
    +J9
    y,J9
    xJ9 -> J9 -> J9
    forall a. Num a => a -> a -> a
    -J9
    y]) | J9
    x <- [J9]
    j9, J9
    y <- [J9]
    j9]
                               [([J9], [J9])] -> [([J9], [J9])] -> [([J9], [J9])]
    forall a. [a] -> [a] -> [a]
    ++ [([0,1,J9
    mu],[0,1,-J9
    mu]) | J9
    mu <- (J9 -> Bool) -> [J9] -> [J9]
    forall a. (a -> Bool) -> [a] -> [a]
    filter J9 -> Bool
    isComplex [J9]
    j9]
                               [([J9], [J9])] -> [([J9], [J9])] -> [([J9], [J9])]
    forall a. [a] -> [a] -> [a]
    ++ [([0,1,0],[0,1,1]), ([0,1,1],[0,1,0]), ([0,1,-1],[0,0,1]), ([0,0,1],[0,1,-1])]
        -- fromMatrix [[1,0,0],[0,1,-1],[0,1,1]]
        a :: Permutation J9 -> Permutation [J9]
    a lambda :: Permutation J9
    lambda = [([J9], [J9])] -> Permutation [J9]
    forall a. Ord a => [(a, a)] -> Permutation a
    fromPairs [ ([J9]
    x, (J9 -> J9) -> [J9] -> [J9]
    forall a b. (a -> b) -> [a] -> [b]
    map (J9 -> Permutation J9 -> J9
    forall a. Ord a => a -> Permutation a -> a
    .^ Permutation J9
    lambda) [J9]
    x) | [J9]
    x <- [[J9]]
    xs]
    -- order 311040
    -- (which means this is also the plane constructed in Weibel?)

    -- dual plane of omega
    omegaD :: Design [J9]
    omegaD = ([[J9]], [[[J9]]]) -> Design [J9]
    forall a. Ord a => ([a], [[a]]) -> Design a
    design ([[J9]]
    xs,[[[J9]]]
    bs) where
        xs :: [[J9]]
    xs = [J9] -> [[J9]]
    forall a. Num a => [a] -> [[a]]
    ptsPG2 [J9]
    j9
        bs :: [[[J9]]]
    bs = [J9] -> [[[J9]]]
    forall t. Num t => [t] -> [[[t]]]
    leftLinesPG2 [J9]
    j9

    omegaD1 :: Design Integer
    omegaD1 = Design [[J9]] -> Design Integer
    forall a1 a2. (Num a2, Enum a2, Ord a1) => Design a1 -> Design a2
    D.to1n (Design [[J9]] -> Design Integer)
    -> Design [[J9]] -> Design Integer
    forall a b. (a -> b) -> a -> b
    $ Design [J9] -> Design [[J9]]
    forall t. Ord t => Design t -> Design [t]
    dual Design [J9]
    omega
    -- need proof omega /~= omegaD

    omegaD2 :: Design [J9]
    omegaD2 = ([[J9]], [[[J9]]]) -> Design [J9]
    forall a. Ord a => ([a], [[a]]) -> Design a
    design ([[J9]]
    xs,[[[J9]]]
    bs) where
        xs :: [[J9]]
    xs = [J9] -> [[J9]]
    forall a. Num a => [a] -> [[a]]
    ptsPG2 [J9]
    j9
        bs :: [[[J9]]]
    bs =  [ [[J9]]
    l | [p :: [J9]
    p,q :: [J9]
    q] <- Int -> [[J9]] -> [[[J9]]]
    forall a. Int -> [a] -> [[a]]
    combinationsOf 2 [[J9]]
    xs, [[J9]]
    l <- [[J9] -> [J9] -> [[J9]]
    line [J9]
    p [J9]
    q], [[J9]
    p,[J9]
    q] [[J9]] -> [[J9]] -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int -> [[J9]] -> [[J9]]
    forall a. Int -> [a] -> [a]
    take 2 [[J9]]
    l]
        line :: [J9] -> [J9] -> [[J9]]
    line p :: [J9]
    p q :: [J9]
    q = [[J9]] -> [[J9]]
    forall a. Ord a => [a] -> [a]
    toListSet ([[J9]] -> [[J9]]) -> [[J9]] -> [[J9]]
    forall a b. (a -> b) -> a -> b
    $ ([J9] -> Bool) -> [[J9]] -> [[J9]]
    forall a. (a -> Bool) -> [a] -> [a]
    filter [J9] -> Bool
    forall a. (Eq a, Num a) => [a] -> Bool
    ispnf [([J9]
    p [J9] -> J9 -> [J9]
    forall b. Num b => [b] -> b -> [b]
    <* J9
    a) [J9] -> [J9] -> [J9]
    forall a. Num a => [a] -> [a] -> [a]
    <+> ([J9]
    q [J9] -> J9 -> [J9]
    forall b. Num b => [b] -> b -> [b]
    <* J9
    b) | J9
    a <- [J9]
    j9, J9
    b <- [J9]
    j9]

    us :: [b]
    us <* :: [b] -> b -> [b]
    <* x :: b
    x = (b -> b) -> [b] -> [b]
    forall a b. (a -> b) -> [a] -> [b]
    map (b -> b -> b
    forall a. Num a => a -> a -> a
    *b
    x) [b]
    us

    -- Room and Kirkpatrick p130
    psi :: Design [J9]
    psi = ([[J9]], [[[J9]]]) -> Design [J9]
    forall a. Ord a => ([a], [[a]]) -> Design a
    design ([[J9]]
    xs,[[[J9]]]
    bs) where
        xs :: [[J9]]
    xs = [J9] -> [[J9]]
    forall a. Num a => [a] -> [[a]]
    ptsPG2 [J9]
    j9
        isReal :: t a -> Bool
    isReal x :: t a
    x = (a -> Bool) -> t a -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [0,1,-1]) t a
    x
        xrs :: [[J9]]
    xrs = [J9] -> [[J9]]
    forall a. Num a => [a] -> [[a]]
    ptsPG2 [0,1,-1] -- the thirteen real points, a copy of PG2(F3) within psi
        bs :: [[[J9]]]
    bs = [[[J9]]] -> [[[J9]]]
    forall a. Ord a => [a] -> [a]
    toListSet [[J9] -> [J9] -> [[J9]]
    line [J9]
    p [J9]
    q | [J9]
    p <- [[J9]]
    xrs, [J9]
    q <- [[J9]]
    xs, [J9]
    q [J9] -> [J9] -> Bool
    forall a. Eq a => a -> a -> Bool
    /= [J9]
    p]
        line :: [J9] -> [J9] -> [[J9]]
    line p :: [J9]
    p q :: [J9]
    q = [[J9]] -> [[J9]]
    forall a. Ord a => [a] -> [a]
    L.sort ([[J9]] -> [[J9]]) -> [[J9]] -> [[J9]]
    forall a b. (a -> b) -> a -> b
    $ [J9]
    p [J9] -> [[J9]] -> [[J9]]
    forall a. a -> [a] -> [a]
    : [[J9] -> [J9]
    forall a. (Eq a, Fractional a) => [a] -> [a]
    pnf ( ([J9]
    p [J9] -> J9 -> [J9]
    forall b. Num b => [b] -> b -> [b]
    <* J9
    a) [J9] -> [J9] -> [J9]
    forall a. Num a => [a] -> [a] -> [a]
    <+> [J9]
    q) | J9
    a <- [J9]
    j9]

    -- Room & Kirkpatrick p137
    psi2 :: Design [J9]
    psi2 = ([[J9]], [[[J9]]]) -> Design [J9]
    forall a. Ord a => ([a], [[a]]) -> Design a
    design ([[J9]]
    xs,[[[J9]]]
    bs) where
        xs :: [[J9]]
    xs = [J9] -> [[J9]]
    forall a. Num a => [a] -> [[a]]
    ptsPG2 [J9]
    j9
        bs :: [[[J9]]]
    bs = [[[J9]]] -> [[[J9]]]
    forall a. Ord a => [a] -> [a]
    L.sort ([[[J9]]] -> [[[J9]]]) -> [[[J9]]] -> [[[J9]]]
    forall a b. (a -> b) -> a -> b
    $
             [ [0,0,1] [J9] -> [[J9]] -> [[J9]]
    forall a. a -> [a] -> [a]
    : [ [0,1,J9
    x] | J9
    x <- [J9]
    j9] ] [[[J9]]] -> [[[J9]]] -> [[[J9]]]
    forall a. [a] -> [a] -> [a]
    ++ -- line at infinity, z=0
             [ [0,0,1] [J9] -> [[J9]] -> [[J9]]
    forall a. a -> [a] -> [a]
    : [ [1,J9
    kappa,J9
    y] | J9
    y <- [J9]
    j9] | J9
    kappa <- [J9]
    j9 ] [[[J9]]] -> [[[J9]]] -> [[[J9]]]
    forall a. [a] -> [a] -> [a]
    ++ -- vertical lines x = kappa
             [ [0,1,J9
    m] [J9] -> [[J9]] -> [[J9]]
    forall a. a -> [a] -> [a]
    : [ [1,J9
    x,J9
    mJ9 -> J9 -> J9
    forall a. Num a => a -> a -> a
    *J9
    xJ9 -> J9 -> J9
    forall a. Num a => a -> a -> a
    +J9
    kappa] | J9
    x <- [J9]
    j9 ] | J9
    m <- [0,1,-1], J9
    kappa <- [J9]
    j9 ] [[[J9]]] -> [[[J9]]] -> [[[J9]]]
    forall a. [a] -> [a] -> [a]
    ++ -- lines with real slope
             [ [0,1,J9
    kappa] [J9] -> [[J9]] -> [[J9]]
    forall a. a -> [a] -> [a]
    : [ [1,J9
    x,J9
    kappaJ9 -> J9 -> J9
    forall a. Num a => a -> a -> a
    *(J9
    xJ9 -> J9 -> J9
    forall a. Num a => a -> a -> a
    -J9
    r)J9 -> J9 -> J9
    forall a. Num a => a -> a -> a
    +J9
    s] | J9
    x <- [J9]
    j9 ] | J9
    r <- [0,1,-1], J9
    s <- [0,1,-1], J9
    kappa <- [J9]
    j9 [J9] -> [J9] -> [J9]
    forall a. Ord a => [a] -> [a] -> [a]
    \\ [0,1,-1] ]
             -- lines with complex slope

    -- Room & Kirkpatrick p134-6
    collineationsPsi :: [Permutation [J9]]
    collineationsPsi = [Permutation [J9]]
    realProjectivities -- real transvections, generating real projectivities
                    [Permutation [J9]] -> [Permutation [J9]] -> [Permutation [J9]]
    forall a. [a] -> [a] -> [a]
    ++ [Permutation J9 -> Permutation [J9]
    a Permutation J9
    lambda | Permutation J9
    lambda <- [Permutation J9]
    autsJ9] where
        D xs :: [[J9]]
    xs bs :: [[[J9]]]
    bs = Design [J9]
    psi
        n :: Integer
    n = 3
        realTransvections :: [[[J9]]]
    realTransvections = [Integer -> (Integer, Integer) -> J9 -> [[J9]]
    forall b a.
    (Enum b, Eq b, Num b, Num a) =>
    b -> (b, b) -> a -> [[a]]
    elemTransvection Integer
    n (Integer
    r,Integer
    c) J9
    l | Integer
    r <- [1..Integer
    n], Integer
    c <- [1..Integer
    n], Integer
    r Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Integer
    c, J9
    l <- [1]]
        realProjectivities :: [Permutation [J9]]
    realProjectivities = [[([J9], [J9])] -> Permutation [J9]
    forall a. Ord a => [(a, a)] -> Permutation a
    fromPairs ([([J9], [J9])] -> Permutation [J9])
    -> [([J9], [J9])] -> Permutation [J9]
    forall a b. (a -> b) -> a -> b
    $ [([J9]
    x, [J9] -> [J9]
    forall a. (Eq a, Fractional a) => [a] -> [a]
    pnf ([J9]
    x [J9] -> [[J9]] -> [J9]
    forall a. Num a => [a] -> [[a]] -> [a]
    <*>> [[J9]]
    m)) | [J9]
    x <- [[J9]]
    xs] | [[J9]]
    m <- [[[J9]]]
    realTransvections]
        a :: Permutation J9 -> Permutation [J9]
    a lambda :: Permutation J9
    lambda = [([J9], [J9])] -> Permutation [J9]
    forall a. Ord a => [(a, a)] -> Permutation a
    fromPairs [ ([J9]
    x, (J9 -> J9) -> [J9] -> [J9]
    forall a b. (a -> b) -> [a] -> [b]
    map (J9 -> Permutation J9 -> J9
    forall a. Ord a => a -> Permutation a -> a
    .^ Permutation J9
    lambda) [J9]
    x) | [J9]
    x <- [[J9]]
    xs]
    -- order 33696

    -- The order of a projective plane
    order :: Design a -> Int
    order (D xs :: [a]
    xs bs :: [[a]]
    bs) = [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([[a]] -> [a]
    forall a. [a] -> a
    head [[a]]
    bs) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - 1

    isProjectivePlane :: Design a -> Bool
    isProjectivePlane pi :: Design a
    pi = Design a -> Maybe (Int, (Int, Int, Int))
    forall a. Eq a => Design a -> Maybe (Int, (Int, Int, Int))
    designParams Design a
    pi Maybe (Int, (Int, Int, Int))
    -> Maybe (Int, (Int, Int, Int)) -> Bool
    forall a. Eq a => a -> a -> Bool
    == (Int, (Int, Int, Int)) -> Maybe (Int, (Int, Int, Int))
    forall a. a -> Maybe a
    Just (2,(Int
    qInt -> Integer -> Int
    forall a b. (Num a, Integral b) => a -> b -> a
    ^2Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    qInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +1,Int
    q,1))
        where q :: Int
    q = Design a -> Int
    forall a. Design a -> Int
    order Design a
    pi

    collinear :: Design a -> t a -> Bool
    collinear (D xs :: [a]
    xs bs :: [[a]]
    bs) ys :: t a
    ys = (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]
    b | [a]
    b <- [[a]]
    bs, (a -> Bool) -> t a -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [a]
    b) t a
    ys]

    -- assume p1..4 are distinct
    isQuadrangle :: Design a -> [a] -> Bool
    isQuadrangle plane :: Design a
    plane ps :: [a]
    ps@[p1 :: a
    p1,p2 :: a
    p2,p3 :: a
    p3,p4 :: a
    p4] =
        ([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
    . Design a -> [a] -> Bool
    forall (t :: * -> *) a.
    (Foldable t, Eq a) =>
    Design a -> t a -> Bool
    collinear Design a
    plane) (Int -> [a] -> [[a]]
    forall a. Int -> [a] -> [[a]]
    combinationsOf 3 [a]
    ps)

    concurrent :: Design a -> t (t a) -> Bool
    concurrent (D xs :: [a]
    xs bs :: [[a]]
    bs) ls :: t (t a)
    ls = (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
    x | a
    x <- [a]
    xs, (t a -> Bool) -> t (t a) -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (a
    x a -> t a -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem`) t (t a)
    ls]

    isQuadrilateral :: Design a -> [t a] -> Bool
    isQuadrilateral plane :: Design a
    plane ls :: [t a]
    ls@[l1 :: t a
    l1,l2 :: t a
    l2,l3 :: t a
    l3,l4 :: t a
    l4] =
        ([t a] -> Bool) -> [[t a]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (Bool -> Bool
    not (Bool -> Bool) -> ([t a] -> Bool) -> [t a] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Design a -> [t a] -> Bool
    forall (t :: * -> *) (t :: * -> *) a.
    (Foldable t, Foldable t, Eq a) =>
    Design a -> t (t a) -> Bool
    concurrent Design a
    plane) (Int -> [t a] -> [[t a]]
    forall a. Int -> [a] -> [[a]]
    combinationsOf 3 [t a]
    ls)

    isOval :: Design a -> [a] -> Bool
    isOval pi :: Design a
    pi ps :: [a]
    ps = [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    ps Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Design a -> Int
    forall a. Design a -> Int
    order Design a
    piInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +1
                Bool -> Bool -> Bool
    && ([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
    . Design a -> [a] -> Bool
    forall (t :: * -> *) a.
    (Foldable t, Eq a) =>
    Design a -> t a -> Bool
    collinear Design a
    pi) (Int -> [a] -> [[a]]
    forall a. Int -> [a] -> [[a]]
    combinationsOf 3 [a]
    ps)

    findOvals1 :: Design a -> [[a]]
    findOvals1 pi :: Design a
    pi = Int -> ([a], [a]) -> [[a]]
    findOvals' 0 ([], Design a -> [a]
    forall a. Design a -> [a]
    points Design a
    pi) where
        n :: Int
    n = Design a -> Int
    forall a. Design a -> Int
    order Design a
    pi
        findOvals' :: Int -> ([a], [a]) -> [[a]]
    findOvals' i :: Int
    i (ls :: [a]
    ls,rs :: [a]
    rs)
            | Int
    i Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +1 = [[a] -> [a]
    forall a. [a] -> [a]
    reverse [a]
    ls]
            | Bool
    otherwise = (([a], [a]) -> [[a]]) -> [([a], [a])] -> [[a]]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (Int -> ([a], [a]) -> [[a]]
    findOvals' (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +1))
                          [ (a
    ra -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    ls, [a]
    rs') | r :: a
    r:rs' :: [a]
    rs' <- [a] -> [[a]]
    forall a. [a] -> [[a]]
    L.tails [a]
    rs, ([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
    . Design a -> [a] -> Bool
    forall (t :: * -> *) a.
    (Foldable t, Eq a) =>
    Design a -> t a -> Bool
    collinear Design a
    pi) (([a] -> [a]) -> [[a]] -> [[a]]
    forall a b. (a -> b) -> [a] -> [b]
    map (a
    ra -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :) (Int -> [a] -> [[a]]
    forall a. Int -> [a] -> [[a]]
    combinationsOf 2 [a]
    ls)) ]
    -- if we have a function to quickly generate the line through two points,
    -- then we just need to see whether the third point is on it, which is much faster than testing collinearity

    findQuadrangles :: Design a -> [[a]]
    findQuadrangles pi :: Design a
    pi = Integer -> ([a], [a]) -> [[a]]
    forall t. (Num t, Eq t) => t -> ([a], [a]) -> [[a]]
    findQuadrangles' 0 ([], Design a -> [a]
    forall a. Design a -> [a]
    points Design a
    pi) where
        findQuadrangles' :: t -> ([a], [a]) -> [[a]]
    findQuadrangles' i :: t
    i (ls :: [a]
    ls,rs :: [a]
    rs)
            | t
    i t -> t -> Bool
    forall a. Eq a => a -> a -> Bool
    == 4 = [[a] -> [a]
    forall a. [a] -> [a]
    reverse [a]
    ls]
            | Bool
    otherwise = (([a], [a]) -> [[a]]) -> [([a], [a])] -> [[a]]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (t -> ([a], [a]) -> [[a]]
    findQuadrangles' (t
    it -> t -> t
    forall a. Num a => a -> a -> a
    +1))
                          [ (a
    ra -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    ls, [a]
    rs') | r :: a
    r:rs' :: [a]
    rs' <- [a] -> [[a]]
    forall a. [a] -> [[a]]
    L.tails [a]
    rs, ([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
    . Design a -> [a] -> Bool
    forall (t :: * -> *) a.
    (Foldable t, Eq a) =>
    Design a -> t a -> Bool
    collinear Design a
    pi) (([a] -> [a]) -> [[a]] -> [[a]]
    forall a b. (a -> b) -> [a] -> [b]
    map (a
    ra -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :) (Int -> [a] -> [[a]]
    forall a. Int -> [a] -> [[a]]
    combinationsOf 2 [a]
    ls)) ]

    findOvals :: Design a -> [[a]]
    findOvals pi :: Design a
    pi@(D xs :: [a]
    xs bs :: [[a]]
    bs) = Int -> ([a], [a]) -> [[a]] -> [[a]]
    forall a. Ord a => Int -> ([a], [a]) -> [[a]] -> [[a]]
    findOvals' 0 ([],[a]
    xs) [[a]]
    bs where
        n :: Int
    n = Design a -> Int
    forall a. Design a -> Int
    order Design a
    pi
        findOvals' :: Int -> ([a], [a]) -> [[a]] -> [[a]]
    findOvals' i :: Int
    i (ls :: [a]
    ls,rs :: [a]
    rs) bs :: [[a]]
    bs
            | Int
    i Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +1 = [[a] -> [a]
    forall a. [a] -> [a]
    reverse [a]
    ls]
            | Bool
    otherwise = [[[a]]] -> [[a]]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
                          [let rls :: [a]
    rls = [a] -> [a]
    forall a. [a] -> [a]
    reverse (a
    ra -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    ls)
                               (notchords :: [[a]]
    notchords, chords :: [[a]]
    chords) = ([a] -> Bool) -> [[a]] -> ([[a]], [[a]])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    L.partition (\b :: [a]
    b -> [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([a]
    rls [a] -> [a] -> [a]
    forall a. Ord a => [a] -> [a] -> [a]
    `LS.intersect` [a]
    b) Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < 2) [[a]]
    bs
                               rs'' :: [a]
    rs'' = ([a] -> [a] -> [a]) -> [a] -> [[a]] -> [a]
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl [a] -> [a] -> [a]
    forall a. Ord a => [a] -> [a] -> [a]
    (\\) [a]
    rs' [[a]]
    chords
                               -- if any line is already a chord, remove remaining points on it from further consideration
                           in Int -> ([a], [a]) -> [[a]] -> [[a]]
    findOvals' (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +1) (a
    ra -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    ls, [a]
    rs'') [[a]]
    notchords
                           | r :: a
    r:rs' :: [a]
    rs' <- [a] -> [[a]]
    forall a. [a] -> [[a]]
    L.tails [a]
    rs]

    -- Todo:
    -- Code that shows that phi is Desarguesian, and omega, omegaD and psi are not
    {-
    -- !! NOT WORKING
    -- finds apparent counterexamples in phi too
    findNonDesarguesian pi@(D xs bs) =
        [ [p,x,y,z,x',y',z',k,l,m] | p <- xs,
                                     x <- xs \\ [p],
                                     y <- xs \\ [p,x],
                                     z <- xs \\ [p,x,y],
                                     (not . collinear pi) [x,y,z],
                                     x' <- line p x \\ L.sort [p,x],
                                     y' <- line p y \\ L.sort [p,y],
                                     z' <- line p z \\ L.sort [p,z],
                                     (not . collinear pi) [x',y',z'],
                                     k <- line x y `intersect` line x' y', -- will only have one element
                                     l <- line x z `intersect` line x' z',
                                     m <- line y z `intersect` line y' z',
                                     (not . collinear pi) [k,l,m]  ]
        where line p q = head [b | b <- bs, p `elem` b, q `elem` b]
    -}