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

    {-# LANGUAGE NoMonomorphismRestriction, TupleSections, DeriveFunctor #-}

    module Math.Combinatorics.GraphAuts (isVertexTransitive, isEdgeTransitive,
                                         isArcTransitive, is2ArcTransitive, is3ArcTransitive, is4ArcTransitive, isnArcTransitive,
                                         isDistanceTransitive,
                                         graphAuts, incidenceAuts, graphAuts7, graphAuts8, incidenceAuts2,
                                         isGraphAut, isIncidenceAut,
                                         graphIsos, incidenceIsos,
                                         isGraphIso, isIncidenceIso) where

    import Data.Either (lefts, rights, partitionEithers)
    import qualified Data.List as L
    import qualified Data.Map.Strict as M
    import qualified Data.Set as S
    import Data.Maybe
    import Data.Ord (comparing)
    import qualified Data.Foldable as Foldable
    import qualified Data.Sequence as Seq

    import Math.Common.ListSet
    import Math.Core.Utils (combinationsOf, intersectAsc, pairs, picks, (^-))
    import Math.Combinatorics.Graph
    -- import Math.Combinatorics.StronglyRegularGraph

    -- import Math.Combinatorics.Hypergraph -- can't import this, creates circular dependency

    import Math.Algebra.Group.PermutationGroup
    import Math.Algebra.Group.SchreierSims as SS

    -- The code for finding automorphisms - "graphAuts" - follows later on in file

    -- TRANSITIVITY PROPERTIES OF GRAPHS

    -- |A graph is vertex-transitive if its automorphism group acts transitively on the vertices. Thus, given any two distinct vertices, there is an automorphism mapping one to the other.

    isVertexTransitive :: (Ord t) => Graph t -> Bool
    isVertexTransitive :: Graph t -> Bool
    isVertexTransitive (G [] []) = Bool
    True -- null graph is trivially vertex transitive

    isVertexTransitive g :: Graph t
    g@(G (v :: t
    v:vs :: [t]
    vs) es :: [[t]]
    es) = [Permutation t] -> t -> [t]
    forall t. Ord t => [Permutation t] -> t -> [t]
    orbitV [Permutation t]
    auts t
    v [t] -> [t] -> Bool
    forall a. Eq a => a -> a -> Bool
    == t
    vt -> [t] -> [t]
    forall a. a -> [a] -> [a]
    :[t]
    vs where
        auts :: [Permutation t]
    auts = Graph t -> [Permutation t]
    forall a. Ord a => Graph a -> [Permutation a]
    graphAuts Graph t
    g

    -- |A graph is edge-transitive if its automorphism group acts transitively on the edges. Thus, given any two distinct edges, there is an automorphism mapping one to the other.

    isEdgeTransitive :: (Ord t) => Graph t -> Bool
    isEdgeTransitive :: Graph t -> Bool
    isEdgeTransitive (G _ []) = Bool
    True
    isEdgeTransitive g :: Graph t
    g@(G vs :: [t]
    vs (e :: [t]
    e:es :: [[t]]
    es)) = [Permutation t] -> [t] -> [[t]]
    forall a. Ord a => [Permutation a] -> [a] -> [[a]]
    orbitE [Permutation t]
    auts [t]
    e [[t]] -> [[t]] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [t]
    e[t] -> [[t]] -> [[t]]
    forall a. a -> [a] -> [a]
    :[[t]]
    es where
        auts :: [Permutation t]
    auts = Graph t -> [Permutation t]
    forall a. Ord a => Graph a -> [Permutation a]
    graphAuts Graph t
    g

    arc :: [b]
    arc ->^ :: [b] -> Permutation b -> [b]
    ->^ g :: Permutation b
    g = (b -> b) -> [b] -> [b]
    forall a b. (a -> b) -> [a] -> [b]
    map (b -> Permutation b -> b
    forall a. Ord a => a -> Permutation a -> a
    .^ Permutation b
    g) [b]
    arc
    -- unlike edges/blocks, arcs are directed, so the action on them does not sort

    -- Godsil & Royle 59-60

    -- |A graph is arc-transitive (or flag-transitive) if its automorphism group acts transitively on arcs. (An arc is an ordered pair of adjacent vertices.)

    isArcTransitive :: (Ord t) => Graph t -> Bool
    isArcTransitive :: Graph t -> Bool
    isArcTransitive (G _ []) = Bool
    True -- empty graphs are trivially arc transitive

    isArcTransitive g :: Graph t
    g@(G vs :: [t]
    vs es :: [[t]]
    es) = ([t] -> Permutation t -> [t]) -> [t] -> [Permutation t] -> [[t]]
    forall t1 t2. Ord t1 => (t1 -> t2 -> t1) -> t1 -> [t2] -> [t1]
    orbit [t] -> Permutation t -> [t]
    forall b. Ord b => [b] -> Permutation b -> [b]
    (->^) [t]
    a [Permutation t]
    auts [[t]] -> [[t]] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [t]
    a[t] -> [[t]] -> [[t]]
    forall a. a -> [a] -> [a]
    :[[t]]
    as where
    -- isArcTransitive g@(G vs es) = closure [a] [ ->^ h | h <- auts] == a:as where

        a :: [t]
    a:as :: [[t]]
    as = [[t]] -> [[t]]
    forall a. Ord a => [a] -> [a]
    L.sort ([[t]] -> [[t]]) -> [[t]] -> [[t]]
    forall a b. (a -> b) -> a -> b
    $ [[t]]
    es [[t]] -> [[t]] -> [[t]]
    forall a. [a] -> [a] -> [a]
    ++ ([t] -> [t]) -> [[t]] -> [[t]]
    forall a b. (a -> b) -> [a] -> [b]
    map [t] -> [t]
    forall a. [a] -> [a]
    reverse [[t]]
    es
        auts :: [Permutation t]
    auts = Graph t -> [Permutation t]
    forall a. Ord a => Graph a -> [Permutation a]
    graphAuts Graph t
    g

    isArcTransitive' :: Graph a -> Bool
    isArcTransitive' g :: Graph a
    g@(G (v :: a
    v:vs :: [a]
    vs) es :: [[a]]
    es) =
        [Permutation a] -> a -> [a]
    forall t. Ord t => [Permutation t] -> t -> [t]
    orbitP [Permutation a]
    auts a
    v [a] -> [a] -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    va -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    vs Bool -> Bool -> Bool
    && -- isVertexTransitive g

        [Permutation a] -> a -> [a]
    forall t. Ord t => [Permutation t] -> t -> [t]
    orbitP [Permutation a]
    stab a
    n [a] -> [a] -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    na -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    ns
        where auts :: [Permutation a]
    auts = Graph a -> [Permutation a]
    forall a. Ord a => Graph a -> [Permutation a]
    graphAuts Graph a
    g
              stab :: [Permutation a]
    stab = (Permutation a -> Bool) -> [Permutation a] -> [Permutation a]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\p :: Permutation a
    p -> a
    v a -> Permutation a -> a
    forall a. Ord a => a -> Permutation a -> a
    .^ Permutation a
    p a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    v) [Permutation a]
    auts -- relies on v being the first base for the SGS returned by graphAuts

              -- stab = dropWhile (\p -> v .^ p /= v) auts -- we know that graphAuts are returned in this order

              n :: a
    n:ns :: [a]
    ns = Graph a -> a -> [a]
    forall a. Eq a => Graph a -> a -> [a]
    nbrs Graph a
    g a
    v

    -- execution time of both of the above is dominated by the time to calculate the graph auts, so their performance is similar

    -- then k n, kb n n, q n, other platonic solids, petersen graph, heawood graph, pappus graph, desargues graph are all arc-transitive

    -- find arcs of length l from x using dfs - results returned in order

    -- an arc is a sequence of vertices connected by edges, no doubling back, but self-crossings allowed

    findArcs :: Graph a -> a -> b -> [[a]]
    findArcs g :: Graph a
    g@(G vs :: [a]
    vs es :: [[a]]
    es) x :: a
    x l :: b
    l = ([a] -> [a]) -> [[a]] -> [[a]]
    forall a b. (a -> b) -> [a] -> [b]
    map [a] -> [a]
    forall a. [a] -> [a]
    reverse ([[a]] -> [[a]]) -> [[a]] -> [[a]]
    forall a b. (a -> b) -> a -> b
    $ [([a], b)] -> [[a]]
    dfs [ ([a
    x],0) ] where
        dfs :: [([a], b)] -> [[a]]
    dfs ( (z1 :: a
    z1:z2 :: a
    z2:zs :: [a]
    zs,l' :: b
    l') : nodes :: [([a], b)]
    nodes)
            | b
    l b -> b -> Bool
    forall a. Eq a => a -> a -> Bool
    == b
    l'   = (a
    z1a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :a
    z2a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    zs) [a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    : [([a], b)] -> [[a]]
    dfs [([a], b)]
    nodes
            | Bool
    otherwise = [([a], b)] -> [[a]]
    dfs ([([a], b)] -> [[a]]) -> [([a], b)] -> [[a]]
    forall a b. (a -> b) -> a -> b
    $ [(a
    wa -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :a
    z1a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :a
    z2a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    zs,b
    l'b -> b -> b
    forall a. Num a => a -> a -> a
    +1) | a
    w <- Graph a -> a -> [a]
    forall a. Eq a => Graph a -> a -> [a]
    nbrs Graph a
    g a
    z1, a
    w a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    /= a
    z2] [([a], b)] -> [([a], b)] -> [([a], b)]
    forall a. [a] -> [a] -> [a]
    ++ [([a], b)]
    nodes
        dfs ( ([z :: a
    z],l' :: b
    l') : nodes :: [([a], b)]
    nodes)
            | b
    l b -> b -> Bool
    forall a. Eq a => a -> a -> Bool
    == b
    l'   = [a
    z] [a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    : [([a], b)] -> [[a]]
    dfs [([a], b)]
    nodes
            | Bool
    otherwise = [([a], b)] -> [[a]]
    dfs ([([a], b)] -> [[a]]) -> [([a], b)] -> [[a]]
    forall a b. (a -> b) -> a -> b
    $ [([a
    w,a
    z],b
    l'b -> b -> b
    forall a. Num a => a -> a -> a
    +1) | a
    w <- Graph a -> a -> [a]
    forall a. Eq a => Graph a -> a -> [a]
    nbrs Graph a
    g a
    z] [([a], b)] -> [([a], b)] -> [([a], b)]
    forall a. [a] -> [a] -> [a]
    ++ [([a], b)]
    nodes
        dfs [] = []

    -- note that a graph with triangles can't be 3-arc transitive, etc, because an aut can't map a self-crossing arc to a non-self-crossing arc

    -- |A graph is n-arc-transitive if its automorphism group is transitive on n-arcs. (An n-arc is an ordered sequence (v0,...,vn) of adjacent vertices, with crossings allowed but not doubling back.)

    isnArcTransitive :: (Ord t) => Int -> Graph t -> Bool
    isnArcTransitive :: Int -> Graph t -> Bool
    isnArcTransitive _ (G [] []) = Bool
    True
    isnArcTransitive n :: Int
    n g :: Graph t
    g@(G (v :: t
    v:vs :: [t]
    vs) es :: [[t]]
    es) =
        [Permutation t] -> t -> [t]
    forall t. Ord t => [Permutation t] -> t -> [t]
    orbitP [Permutation t]
    auts t
    v [t] -> [t] -> Bool
    forall a. Eq a => a -> a -> Bool
    == t
    vt -> [t] -> [t]
    forall a. a -> [a] -> [a]
    :[t]
    vs Bool -> Bool -> Bool
    && -- isVertexTransitive g

        ([t] -> Permutation t -> [t]) -> [t] -> [Permutation t] -> [[t]]
    forall t1 t2. Ord t1 => (t1 -> t2 -> t1) -> t1 -> [t2] -> [t1]
    orbit [t] -> Permutation t -> [t]
    forall b. Ord b => [b] -> Permutation b -> [b]
    (->^) [t]
    a [Permutation t]
    stab [[t]] -> [[t]] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [t]
    a[t] -> [[t]] -> [[t]]
    forall a. a -> [a] -> [a]
    :[[t]]
    as
        -- closure [a] [ ->^ h | h <- stab] == a:as

        where auts :: [Permutation t]
    auts = Graph t -> [Permutation t]
    forall a. Ord a => Graph a -> [Permutation a]
    graphAuts Graph t
    g
              stab :: [Permutation t]
    stab = (Permutation t -> Bool) -> [Permutation t] -> [Permutation t]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\p :: Permutation t
    p -> t
    v t -> Permutation t -> t
    forall a. Ord a => a -> Permutation a -> a
    .^ Permutation t
    p t -> t -> Bool
    forall a. Eq a => a -> a -> Bool
    == t
    v) [Permutation t]
    auts -- relies on v being the first base for the SGS returned by graphAuts

              -- stab = dropWhile (\p -> v .^ p /= v) auts -- we know that graphAuts are returned in this order

              a :: [t]
    a:as :: [[t]]
    as = Graph t -> t -> Int -> [[t]]
    forall b a. (Eq b, Eq a, Num b) => Graph a -> a -> b -> [[a]]
    findArcs Graph t
    g t
    v Int
    n

    is2ArcTransitive :: (Ord t) => Graph t -> Bool
    is2ArcTransitive :: Graph t -> Bool
    is2ArcTransitive g :: Graph t
    g = Int -> Graph t -> Bool
    forall t. Ord t => Int -> Graph t -> Bool
    isnArcTransitive 2 Graph t
    g

    is3ArcTransitive :: (Ord t) => Graph t -> Bool
    is3ArcTransitive :: Graph t -> Bool
    is3ArcTransitive g :: Graph t
    g = Int -> Graph t -> Bool
    forall t. Ord t => Int -> Graph t -> Bool
    isnArcTransitive 3 Graph t
    g

    -- The incidence graphs of the projective planes PG(2,Fq) are 4-arc-transitive

    is4ArcTransitive :: (Ord t) => Graph t -> Bool
    is4ArcTransitive :: Graph t -> Bool
    is4ArcTransitive g :: Graph t
    g = Int -> Graph t -> Bool
    forall t. Ord t => Int -> Graph t -> Bool
    isnArcTransitive 4 Graph t
    g

    -- Godsil & Royle 66-7

    -- |A graph is distance transitive if given any two ordered pairs of vertices (u,u') and (v,v') with d(u,u') == d(v,v'),

    -- there is an automorphism of the graph that takes (u,u') to (v,v')

    isDistanceTransitive :: (Ord t) => Graph t -> Bool
    isDistanceTransitive :: Graph t -> Bool
    isDistanceTransitive (G [] []) = Bool
    True
    isDistanceTransitive g :: Graph t
    g@(G (v :: t
    v:vs :: [t]
    vs) es :: [[t]]
    es)
        | Graph t -> Bool
    forall t. Ord t => Graph t -> Bool
    isConnected Graph t
    g =
            [Permutation t] -> t -> [t]
    forall t. Ord t => [Permutation t] -> t -> [t]
    orbitP [Permutation t]
    auts t
    v [t] -> [t] -> Bool
    forall a. Eq a => a -> a -> Bool
    == t
    vt -> [t] -> [t]
    forall a. a -> [a] -> [a]
    :[t]
    vs Bool -> Bool -> Bool
    && -- isVertexTransitive g

            [[t]] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [[t]]
    stabOrbits Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Graph t -> Int
    forall t. Ord t => Graph t -> Int
    diameter Graph t
    g Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 1 -- the orbits under the stabiliser of v coincide with the distance partition from v

        | Bool
    otherwise = [Char] -> Bool
    forall a. HasCallStack => [Char] -> a
    error "isDistanceTransitive: only implemented for connected graphs"
        where auts :: [Permutation t]
    auts = Graph t -> [Permutation t]
    forall a. Ord a => Graph a -> [Permutation a]
    graphAuts Graph t
    g
              stab :: [Permutation t]
    stab = (Permutation t -> Bool) -> [Permutation t] -> [Permutation t]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\p :: Permutation t
    p -> t
    v t -> Permutation t -> t
    forall a. Ord a => a -> Permutation a -> a
    .^ Permutation t
    p t -> t -> Bool
    forall a. Eq a => a -> a -> Bool
    == t
    v) [Permutation t]
    auts -- relies on v being the first base for the SGS returned by graphAuts

              -- stab = dropWhile (\p -> v .^ p /= v) auts -- we know that graphAuts are returned in this order

              stabOrbits :: [[t]]
    stabOrbits = let os :: [[t]]
    os = [Permutation t] -> [[t]]
    forall a. Ord a => [Permutation a] -> [[a]]
    orbits [Permutation t]
    stab in [[t]]
    os [[t]] -> [[t]] -> [[t]]
    forall a. [a] -> [a] -> [a]
    ++ (t -> [t]) -> [t] -> [[t]]
    forall a b. (a -> b) -> [a] -> [b]
    map (t -> [t] -> [t]
    forall a. a -> [a] -> [a]
    :[]) ((t
    vt -> [t] -> [t]
    forall a. a -> [a] -> [a]
    :[t]
    vs) [t] -> [t] -> [t]
    forall a. Eq a => [a] -> [a] -> [a]
    L.\\ [[t]] -> [t]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[t]]
    os) -- include fixed point orbits

    -- GRAPH AUTOMORPHISMS

    -- |Is the permutation an automorphism of the graph?

    isGraphAut :: Ord t => Graph t -> Permutation t -> Bool
    isGraphAut :: Graph t -> Permutation t -> Bool
    isGraphAut (G vs :: [t]
    vs es :: [[t]]
    es) h :: Permutation t
    h = ([t] -> Bool) -> [[t]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all ([t] -> Set [t] -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `S.member` Set [t]
    es') [[t]
    e [t] -> Permutation t -> [t]
    forall b. Ord b => [b] -> Permutation b -> [b]
    -^ Permutation t
    h | [t]
    e <- [[t]]
    es]
        where es' :: Set [t]
    es' = [[t]] -> Set [t]
    forall a. Ord a => [a] -> Set a
    S.fromList [[t]]
    es
    -- this works best on sparse graphs, where p(edge) < 1/2

    -- if p(edge) > 1/2, it would be better to test on the complement of the graph

    -- |Is the permutation an automorphism of the incidence structure represented by the graph?

    -- (Note that an incidence graph colours points as Left, blocks as Right, and a permutation

    -- that swaps points and blocks, even if it is an automorphism of the graph, does not represent

    -- an automorphism of the incidence structure. Instead, a point-block crossover is called a duality.)

    isIncidenceAut :: (Ord p, Ord b) => Graph (Either p b) -> Permutation (Either p b) -> Bool
    isIncidenceAut :: Graph (Either p b) -> Permutation (Either p b) -> Bool
    isIncidenceAut (G vs :: [Either p b]
    vs es :: [[Either p b]]
    es) h :: Permutation (Either p b)
    h = ([Either p b] -> Bool) -> [[Either p b]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all ([Either p b] -> Set [Either p b] -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `S.member` Set [Either p b]
    es') [[Either p b]
    e [Either p b] -> Permutation (Either p b) -> [Either p b]
    forall b. Ord b => [b] -> Permutation b -> [b]
    ->^ Permutation (Either p b)
    h | [Either p b]
    e <- [[Either p b]]
    es]
        -- using ->^ instead of -^ excludes dualities, since each edge is of the form [Left p, Right b]

        where es' :: Set [Either p b]
    es' = [[Either p b]] -> Set [Either p b]
    forall a. Ord a => [a] -> Set a
    S.fromList [[Either p b]]
    es

    -- Calculate a map consisting of neighbour lists for each vertex in the graph

    -- If a vertex has no neighbours then it is left out of the map

    adjLists :: Graph a -> Map a [a]
    adjLists (G vs :: [a]
    vs es :: [[a]]
    es) = Map a [a] -> [[a]] -> Map a [a]
    forall a. Ord a => Map a [a] -> [[a]] -> Map a [a]
    adjLists' Map a [a]
    forall k a. Map k a
    M.empty [[a]]
    es
        where adjLists' :: Map a [a] -> [[a]] -> Map a [a]
    adjLists' nbrs :: Map a [a]
    nbrs ([u :: a
    u,v :: a
    v]:es :: [[a]]
    es) =
                  Map a [a] -> [[a]] -> Map a [a]
    adjLists' (([a] -> [a] -> [a]) -> a -> [a] -> Map a [a] -> Map a [a]
    forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
    M.insertWith (([a] -> [a] -> [a]) -> [a] -> [a] -> [a]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    (++)) a
    v [a
    u] (Map a [a] -> Map a [a]) -> Map a [a] -> Map a [a]
    forall a b. (a -> b) -> a -> b
    $ ([a] -> [a] -> [a]) -> a -> [a] -> Map a [a] -> Map a [a]
    forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
    M.insertWith (([a] -> [a] -> [a]) -> [a] -> [a] -> [a]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    (++)) a
    u [a
    v] Map a [a]
    nbrs) [[a]]
    es
              adjLists' nbrs :: Map a [a]
    nbrs [] = Map a [a]
    nbrs

    -- ALTERNATIVE VERSIONS OF GRAPH AUTS

    -- (showing how we got to the final version)

    data SearchTree a = T Bool a [SearchTree a] deriving (SearchTree a -> SearchTree a -> Bool
    (SearchTree a -> SearchTree a -> Bool)
    -> (SearchTree a -> SearchTree a -> Bool) -> Eq (SearchTree a)
    forall a. Eq a => SearchTree a -> SearchTree a -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: SearchTree a -> SearchTree a -> Bool
    $c/= :: forall a. Eq a => SearchTree a -> SearchTree a -> Bool
    == :: SearchTree a -> SearchTree a -> Bool
    $c== :: forall a. Eq a => SearchTree a -> SearchTree a -> Bool
    Eq, Eq (SearchTree a)
    Eq (SearchTree a) =>
    (SearchTree a -> SearchTree a -> Ordering)
    -> (SearchTree a -> SearchTree a -> Bool)
    -> (SearchTree a -> SearchTree a -> Bool)
    -> (SearchTree a -> SearchTree a -> Bool)
    -> (SearchTree a -> SearchTree a -> Bool)
    -> (SearchTree a -> SearchTree a -> SearchTree a)
    -> (SearchTree a -> SearchTree a -> SearchTree a)
    -> Ord (SearchTree a)
    SearchTree a -> SearchTree a -> Bool
    SearchTree a -> SearchTree a -> Ordering
    SearchTree a -> SearchTree a -> SearchTree 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 (SearchTree a)
    forall a. Ord a => SearchTree a -> SearchTree a -> Bool
    forall a. Ord a => SearchTree a -> SearchTree a -> Ordering
    forall a. Ord a => SearchTree a -> SearchTree a -> SearchTree a
    min :: SearchTree a -> SearchTree a -> SearchTree a
    $cmin :: forall a. Ord a => SearchTree a -> SearchTree a -> SearchTree a
    max :: SearchTree a -> SearchTree a -> SearchTree a
    $cmax :: forall a. Ord a => SearchTree a -> SearchTree a -> SearchTree a
    >= :: SearchTree a -> SearchTree a -> Bool
    $c>= :: forall a. Ord a => SearchTree a -> SearchTree a -> Bool
    > :: SearchTree a -> SearchTree a -> Bool
    $c> :: forall a. Ord a => SearchTree a -> SearchTree a -> Bool
    <= :: SearchTree a -> SearchTree a -> Bool
    $c<= :: forall a. Ord a => SearchTree a -> SearchTree a -> Bool
    < :: SearchTree a -> SearchTree a -> Bool
    $c< :: forall a. Ord a => SearchTree a -> SearchTree a -> Bool
    compare :: SearchTree a -> SearchTree a -> Ordering
    $ccompare :: forall a. Ord a => SearchTree a -> SearchTree a -> Ordering
    $cp1Ord :: forall a. Ord a => Eq (SearchTree a)
    Ord, Int -> SearchTree a -> ShowS
    [SearchTree a] -> ShowS
    SearchTree a -> [Char]
    (Int -> SearchTree a -> ShowS)
    -> (SearchTree a -> [Char])
    -> ([SearchTree a] -> ShowS)
    -> Show (SearchTree a)
    forall a. Show a => Int -> SearchTree a -> ShowS
    forall a. Show a => [SearchTree a] -> ShowS
    forall a. Show a => SearchTree a -> [Char]
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    showList :: [SearchTree a] -> ShowS
    $cshowList :: forall a. Show a => [SearchTree a] -> ShowS
    show :: SearchTree a -> [Char]
    $cshow :: forall a. Show a => SearchTree a -> [Char]
    showsPrec :: Int -> SearchTree a -> ShowS
    $cshowsPrec :: forall a. Show a => Int -> SearchTree a -> ShowS
    Show, a -> SearchTree b -> SearchTree a
    (a -> b) -> SearchTree a -> SearchTree b
    (forall a b. (a -> b) -> SearchTree a -> SearchTree b)
    -> (forall a b. a -> SearchTree b -> SearchTree a)
    -> Functor SearchTree
    forall a b. a -> SearchTree b -> SearchTree a
    forall a b. (a -> b) -> SearchTree a -> SearchTree b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    <$ :: a -> SearchTree b -> SearchTree a
    $c<$ :: forall a b. a -> SearchTree b -> SearchTree a
    fmap :: (a -> b) -> SearchTree a -> SearchTree b
    $cfmap :: forall a b. (a -> b) -> SearchTree a -> SearchTree b
    Functor)
    -- The boolean indicates whether or not this is a terminal / solution node

    leftDepth :: SearchTree a -> p
    leftDepth (T _ _ []) = 1
    leftDepth (T _ _ (t :: SearchTree a
    t:ts :: [SearchTree a]
    ts)) = 1 p -> p -> p
    forall a. Num a => a -> a -> a
    + SearchTree a -> p
    leftDepth SearchTree a
    t

    leftWidths :: SearchTree a -> [Int]
    leftWidths (T _ _ []) = []
    leftWidths (T _ _ ts :: [SearchTree a]
    ts@(t :: SearchTree a
    t:_)) = [SearchTree a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [SearchTree a]
    ts Int -> [Int] -> [Int]
    forall a. a -> [a] -> [a]
    : SearchTree a -> [Int]
    leftWidths SearchTree a
    t

    graphAutsEdgeSearchTree :: Graph a -> SearchTree [(a, a)]
    graphAutsEdgeSearchTree (G vs :: [a]
    vs es :: [[a]]
    es) = [(a, a)] -> [a] -> [a] -> SearchTree [(a, a)]
    dfs [] [a]
    vs [a]
    vs where
        dfs :: [(a, a)] -> [a] -> [a] -> SearchTree [(a, a)]
    dfs xys :: [(a, a)]
    xys (x :: a
    x:xs :: [a]
    xs) yys :: [a]
    yys = Bool -> [(a, a)] -> [SearchTree [(a, a)]] -> SearchTree [(a, a)]
    forall a. Bool -> a -> [SearchTree a] -> SearchTree a
    T Bool
    False [(a, a)]
    xys [[(a, a)] -> [a] -> [a] -> SearchTree [(a, a)]
    dfs ((a
    x,a
    y)(a, a) -> [(a, a)] -> [(a, a)]
    forall a. a -> [a] -> [a]
    :[(a, a)]
    xys) [a]
    xs [a]
    ys | (y :: a
    y,ys :: [a]
    ys) <- [a] -> [(a, [a])]
    forall a. [a] -> [(a, [a])]
    picks [a]
    yys, [(a, a)] -> (a, a) -> Bool
    isCompatible [(a, a)]
    xys (a
    x,a
    y)]
        dfs xys :: [(a, a)]
    xys [] [] = Bool -> [(a, a)] -> [SearchTree [(a, a)]] -> SearchTree [(a, a)]
    forall a. Bool -> a -> [SearchTree a] -> SearchTree a
    T Bool
    True [(a, a)]
    xys []
        isCompatible :: [(a, a)] -> (a, a) -> Bool
    isCompatible xys :: [(a, a)]
    xys (x' :: a
    x',y' :: a
    y') = [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    and [([a
    x,a
    x'] [a] -> Set [a] -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `S.member` Set [a]
    es') Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == ([a] -> [a]
    forall a. Ord a => [a] -> [a]
    L.sort [a
    y,a
    y'] [a] -> Set [a] -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `S.member` Set [a]
    es') | (x :: a
    x,y :: a
    y) <- [(a, a)]
    xys]
        es' :: Set [a]
    es' = [[a]] -> Set [a]
    forall a. Ord a => [a] -> Set a
    S.fromList [[a]]
    es

    graphAuts1 :: Graph a -> [Permutation a]
    graphAuts1 = ([(a, a)] -> Permutation a) -> [[(a, a)]] -> [Permutation a]
    forall a b. (a -> b) -> [a] -> [b]
    map [(a, a)] -> Permutation a
    forall a. Ord a => [(a, a)] -> Permutation a
    fromPairs ([[(a, a)]] -> [Permutation a])
    -> (Graph a -> [[(a, a)]]) -> Graph a -> [Permutation a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SearchTree [(a, a)] -> [[(a, a)]]
    forall b. SearchTree b -> [b]
    terminals (SearchTree [(a, a)] -> [[(a, a)]])
    -> (Graph a -> SearchTree [(a, a)]) -> Graph a -> [[(a, a)]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Graph a -> SearchTree [(a, a)]
    forall a. Ord a => Graph a -> SearchTree [(a, a)]
    graphAutsEdgeSearchTree

    terminals :: SearchTree b -> [b]
    terminals (T False _ ts :: [SearchTree b]
    ts) = (SearchTree b -> [b]) -> [SearchTree b] -> [b]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap SearchTree b -> [b]
    terminals [SearchTree b]
    ts
    terminals (T True xys :: b
    xys _) = [b
    xys]

    -- Using Lemma 9.1.1 from Seress p203 to prune the search tree

    -- Because auts form a group, it is sufficient to expand only each leftmost branch of the tree in full.

    -- For every other branch, it is sufficient to find a single representative, since the other elements

    -- can then be obtained by multiplication in the group (using the leftmost elements).

    -- In effect, we are finding a transversal generating set.

    -- Note however, that this transversal generating set is relative to whatever base order the tree uses,

    -- so for clarity, the tree should use natural vertex order.

    transversalTerminals :: SearchTree a -> [a]
    transversalTerminals (T False _ (t :: SearchTree a
    t:ts :: [SearchTree a]
    ts)) = (SearchTree a -> [a]) -> [SearchTree a] -> [a]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (Int -> [a] -> [a]
    forall a. Int -> [a] -> [a]
    take 1 ([a] -> [a]) -> (SearchTree a -> [a]) -> SearchTree a -> [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SearchTree a -> [a]
    transversalTerminals) [SearchTree a]
    ts [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    ++ SearchTree a -> [a]
    transversalTerminals SearchTree a
    t
    -- transversalTerminals (T False _ (t:ts)) = transversalTerminals t ++ concatMap (take 1 . transversalTerminals) ts

    transversalTerminals (T True xys :: a
    xys _) = [a
    xys]
    transversalTerminals _ = []

    graphAuts2 :: Graph a -> [Permutation a]
    graphAuts2 = (Permutation a -> Bool) -> [Permutation a] -> [Permutation a]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Permutation a -> Permutation a -> Bool
    forall a. Eq a => a -> a -> Bool
    /=1) ([Permutation a] -> [Permutation a])
    -> (Graph a -> [Permutation a]) -> Graph a -> [Permutation a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([(a, a)] -> Permutation a) -> [[(a, a)]] -> [Permutation a]
    forall a b. (a -> b) -> [a] -> [b]
    map [(a, a)] -> Permutation a
    forall a. Ord a => [(a, a)] -> Permutation a
    fromPairs ([[(a, a)]] -> [Permutation a])
    -> (Graph a -> [[(a, a)]]) -> Graph a -> [Permutation a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SearchTree [(a, a)] -> [[(a, a)]]
    forall b. SearchTree b -> [b]
    transversalTerminals (SearchTree [(a, a)] -> [[(a, a)]])
    -> (Graph a -> SearchTree [(a, a)]) -> Graph a -> [[(a, a)]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Graph a -> SearchTree [(a, a)]
    forall a. Ord a => Graph a -> SearchTree [(a, a)]
    graphAutsEdgeSearchTree
    -- init because last is identity

    isSingleton :: [a] -> Bool
    isSingleton [_] = Bool
    True
    isSingleton _ = Bool
    False

    intersectCells :: [[a]] -> [[a]] -> [[a]]
    intersectCells p1 :: [[a]]
    p1 p2 :: [[a]]
    p2 = [[[a]]] -> [[a]]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [ [[a]
    c1 [a] -> [a] -> [a]
    forall a. Ord a => [a] -> [a] -> [a]
    `intersectAsc` [a]
    c2 | [a]
    c2 <- [[a]]
    p2] | [a]
    c1 <- [[a]]
    p1]
    -- Intersection preserves ordering within cells but not between cells

    -- eg the cell [1,2,3,4] could be refined to [2,4],[1,3]

    graphAutsDistancePartitionSearchTree :: Graph a -> SearchTree [(a, a)]
    graphAutsDistancePartitionSearchTree g :: Graph a
    g@(G vs :: [a]
    vs es :: [[a]]
    es) = [(a, a)] -> ([[a]], [[a]]) -> SearchTree [(a, a)]
    dfs [] ([[a]
    vs],[[a]
    vs]) where
        dfs :: [(a, a)] -> ([[a]], [[a]]) -> SearchTree [(a, a)]
    dfs xys :: [(a, a)]
    xys (srcPart :: [[a]]
    srcPart,trgPart :: [[a]]
    trgPart)
            | ([a] -> Bool) -> [[a]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all [a] -> Bool
    forall a. [a] -> Bool
    isSingleton [[a]]
    srcPart =
                 let xys' :: [(a, a)]
    xys' = [a] -> [a] -> [(a, a)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip ([[a]] -> [a]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[a]]
    srcPart) ([[a]] -> [a]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[a]]
    trgPart)
                 in Bool -> [(a, a)] -> [SearchTree [(a, a)]] -> SearchTree [(a, a)]
    forall a. Bool -> a -> [SearchTree a] -> SearchTree a
    T ([(a, a)] -> Bool
    isCompatible [(a, a)]
    xys') ([(a, a)]
    xys[(a, a)] -> [(a, a)] -> [(a, a)]
    forall a. [a] -> [a] -> [a]
    ++[(a, a)]
    xys') []
                 -- Since the xys' are distance-compatible with the xys, they are certainly edge-compatible.

                 -- However, we do need to check that the xys' are edge-compatible with each other.

            | Bool
    otherwise = let (x :: a
    x:xs :: [a]
    xs):srcCells :: [[a]]
    srcCells = [[a]]
    srcPart
                              yys :: [a]
    yys   :trgCells :: [[a]]
    trgCells = [[a]]
    trgPart
                              srcPart' :: [[a]]
    srcPart' = [[a]] -> [[a]] -> [[a]]
    forall a. Ord a => [[a]] -> [[a]] -> [[a]]
    intersectCells ([a]
    xs [a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    : [[a]]
    srcCells) (Map a [[a]]
    dps Map a [[a]] -> a -> [[a]]
    forall k a. Ord k => Map k a -> k -> a
    M.! a
    x)
                          in Bool -> [(a, a)] -> [SearchTree [(a, a)]] -> SearchTree [(a, a)]
    forall a. Bool -> a -> [SearchTree a] -> SearchTree a
    T Bool
    False [(a, a)]
    xys -- the L.sort in the following line is so that we traverse vertices in natural order

                             [[(a, a)] -> ([[a]], [[a]]) -> SearchTree [(a, a)]
    dfs ((a
    x,a
    y)(a, a) -> [(a, a)] -> [(a, a)]
    forall a. a -> [a] -> [a]
    :[(a, a)]
    xys) (([([a], [a])] -> ([[a]], [[a]])
    forall a b. [(a, b)] -> ([a], [b])
    unzip ([([a], [a])] -> ([[a]], [[a]]))
    -> ([([a], [a])] -> [([a], [a])]) -> [([a], [a])] -> ([[a]], [[a]])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [([a], [a])] -> [([a], [a])]
    forall a. Ord a => [a] -> [a]
    L.sort) ([[a]] -> [[a]] -> [([a], [a])]
    forall a b. [a] -> [b] -> [(a, b)]
    zip (([a] -> Bool) -> [[a]] -> [[a]]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (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]]
    srcPart') (([a] -> Bool) -> [[a]] -> [[a]]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (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]]
    trgPart')))
                             | (y :: a
    y,ys :: [a]
    ys) <- [a] -> [(a, [a])]
    forall a. [a] -> [(a, [a])]
    picks [a]
    yys,
                               let trgPart' :: [[a]]
    trgPart' = [[a]] -> [[a]] -> [[a]]
    forall a. Ord a => [[a]] -> [[a]] -> [[a]]
    intersectCells ([a]
    ys [a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    : [[a]]
    trgCells) (Map a [[a]]
    dps Map a [[a]] -> a -> [[a]]
    forall k a. Ord k => Map k a -> k -> a
    M.! a
    y),
                               ([a] -> Int) -> [[a]] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [[a]]
    srcPart' [Int] -> [Int] -> Bool
    forall a. Eq a => a -> a -> Bool
    == ([a] -> Int) -> [[a]] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [[a]]
    trgPart']
        isCompatible :: [(a, a)] -> Bool
    isCompatible xys :: [(a, a)]
    xys = [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    and [([a
    x,a
    x'] [a] -> Set [a] -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `S.member` Set [a]
    es') Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == ([a] -> [a]
    forall a. Ord a => [a] -> [a]
    L.sort [a
    y,a
    y'] [a] -> Set [a] -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `S.member` Set [a]
    es') | (x :: a
    x,y :: a
    y) <- [(a, a)]
    xys, (x' :: a
    x',y' :: a
    y') <- [(a, a)]
    xys, a
    x a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    < a
    x']
        es' :: Set [a]
    es' = [[a]] -> Set [a]
    forall a. Ord a => [a] -> Set a
    S.fromList [[a]]
    es
        dps :: Map a [[a]]
    dps = [(a, [[a]])] -> Map a [[a]]
    forall k a. Eq k => [(k, a)] -> Map k a
    M.fromAscList [(a
    v, [a] -> Set [a] -> a -> [[a]]
    forall a. Ord a => [a] -> Set [a] -> a -> [[a]]
    distancePartitionS [a]
    vs Set [a]
    es' a
    v) | a
    v <- [a]
    vs]

    graphAuts3 :: Graph a -> [Permutation a]
    graphAuts3 = (Permutation a -> Bool) -> [Permutation a] -> [Permutation a]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Permutation a -> Permutation a -> Bool
    forall a. Eq a => a -> a -> Bool
    /=1) ([Permutation a] -> [Permutation a])
    -> (Graph a -> [Permutation a]) -> Graph a -> [Permutation a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([(a, a)] -> Permutation a) -> [[(a, a)]] -> [Permutation a]
    forall a b. (a -> b) -> [a] -> [b]
    map [(a, a)] -> Permutation a
    forall a. Ord a => [(a, a)] -> Permutation a
    fromPairs ([[(a, a)]] -> [Permutation a])
    -> (Graph a -> [[(a, a)]]) -> Graph a -> [Permutation a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SearchTree [(a, a)] -> [[(a, a)]]
    forall b. SearchTree b -> [b]
    transversalTerminals (SearchTree [(a, a)] -> [[(a, a)]])
    -> (Graph a -> SearchTree [(a, a)]) -> Graph a -> [[(a, a)]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Graph a -> SearchTree [(a, a)]
    forall a. Ord a => Graph a -> SearchTree [(a, a)]
    graphAutsDistancePartitionSearchTree

    -- Whereas transversalTerminals produced a transversal generating set, here we produce a strong generating set.

    -- In particular, if we have already found (3 4), and then we find (1 2 3),

    -- then there is no need to look for (1 3 ...) or (1 4 ...), since it is clear that such elements exist

    -- as products of those we have already found.

    strongTerminals :: SearchTree [(a, a)] -> [Permutation a]
    strongTerminals = [Permutation a] -> SearchTree [(a, a)] -> [Permutation a]
    forall a.
    Ord a =>
    [Permutation a] -> SearchTree [(a, a)] -> [Permutation a]
    strongTerminals' [] where
        strongTerminals' :: [Permutation a] -> SearchTree [(a, a)] -> [Permutation a]
    strongTerminals' gs :: [Permutation a]
    gs (T False xys :: [(a, a)]
    xys ts :: [SearchTree [(a, a)]]
    ts) =
            case [(a, a)] -> Maybe (a, a)
    forall a. [a] -> Maybe a
    listToMaybe ([(a, a)] -> Maybe (a, a)) -> [(a, a)] -> Maybe (a, a)
    forall a b. (a -> b) -> a -> b
    $ [(a, a)] -> [(a, a)]
    forall a. [a] -> [a]
    reverse ([(a, a)] -> [(a, a)]) -> [(a, a)] -> [(a, a)]
    forall a b. (a -> b) -> a -> b
    $ ((a, a) -> Bool) -> [(a, a)] -> [(a, a)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\(x :: a
    x,y :: a
    y) -> a
    x a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    /= a
    y) [(a, a)]
    xys of -- the first vertex that isn't fixed

            Nothing -> ([Permutation a] -> SearchTree [(a, a)] -> [Permutation a])
    -> [Permutation a] -> [SearchTree [(a, a)]] -> [Permutation a]
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    L.foldl' (\hs :: [Permutation a]
    hs t :: SearchTree [(a, a)]
    t -> [Permutation a] -> SearchTree [(a, a)] -> [Permutation a]
    strongTerminals' [Permutation a]
    hs SearchTree [(a, a)]
    t) [Permutation a]
    gs [SearchTree [(a, a)]]
    ts
            Just (x :: a
    x,y :: a
    y) -> if a
    y a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` (a
    x a -> [Permutation a] -> [a]
    forall a. Ord a => a -> [Permutation a] -> [a]
    .^^ [Permutation a]
    gs)
                          then [Permutation a]
    gs
                          -- Since we're not on the leftmost spine, we can stop as soon as we find one new element

                          else [Permutation a] -> [SearchTree [(a, a)]] -> [Permutation a]
    find1New [Permutation a]
    gs [SearchTree [(a, a)]]
    ts
                          -- else L.foldl' (\hs t -> if hs /= gs then hs else strongTerminals' hs t) gs ts

        strongTerminals' gs :: [Permutation a]
    gs (T True xys :: [(a, a)]
    xys []) = [(a, a)] -> Permutation a
    forall a. Ord a => [(a, a)] -> Permutation a
    fromPairs [(a, a)]
    xys Permutation a -> [Permutation a] -> [Permutation a]
    forall a. a -> [a] -> [a]
    : [Permutation a]
    gs
        find1New :: [Permutation a] -> [SearchTree [(a, a)]] -> [Permutation a]
    find1New gs :: [Permutation a]
    gs (t :: SearchTree [(a, a)]
    t:ts :: [SearchTree [(a, a)]]
    ts) = let hs :: [Permutation a]
    hs = [Permutation a] -> SearchTree [(a, a)] -> [Permutation a]
    strongTerminals' [Permutation a]
    gs SearchTree [(a, a)]
    t
                             in if Int -> [Permutation a] -> [Permutation a]
    forall a. Int -> [a] -> [a]
    take 1 [Permutation a]
    gs [Permutation a] -> [Permutation a] -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int -> [Permutation a] -> [Permutation a]
    forall a. Int -> [a] -> [a]
    take 1 [Permutation a]
    hs -- we know a new element would be placed at the front

                                then [Permutation a]
    hs
                                else [Permutation a] -> [SearchTree [(a, a)]] -> [Permutation a]
    find1New [Permutation a]
    gs [SearchTree [(a, a)]]
    ts
        find1New gs :: [Permutation a]
    gs [] = [Permutation a]
    gs

    -- |Given a graph g, @graphAuts g@ returns a strong generating set for the automorphism group of g.

    graphAuts :: (Ord a) => Graph a -> [Permutation a]
    graphAuts :: Graph a -> [Permutation a]
    graphAuts = (Permutation a -> Bool) -> [Permutation a] -> [Permutation a]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Permutation a -> Permutation a -> Bool
    forall a. Eq a => a -> a -> Bool
    /=1) ([Permutation a] -> [Permutation a])
    -> (Graph a -> [Permutation a]) -> Graph a -> [Permutation a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SearchTree [(a, a)] -> [Permutation a]
    forall a. Ord a => SearchTree [(a, a)] -> [Permutation a]
    strongTerminals (SearchTree [(a, a)] -> [Permutation a])
    -> (Graph a -> SearchTree [(a, a)]) -> Graph a -> [Permutation a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Graph a -> SearchTree [(a, a)]
    forall a. Ord a => Graph a -> SearchTree [(a, a)]
    graphAutsDistancePartitionSearchTree

    -- Using colourings (M.Map vertex colour, M.Map colour [vertex]), in place of partitions ([[vertex]])

    -- This turns out to be slower than using partitions.

    -- Updating the colour partition incrementally seems to be much less efficient than just recalculating it each time

    -- (Recalculating each time is O(n), incrementally updating is O(n^2)?)

    graphAutsDistanceColouringSearchTree :: Graph a -> SearchTree [(a, a)]
    graphAutsDistanceColouringSearchTree g :: Graph a
    g@(G vs :: [a]
    vs es :: [[a]]
    es) = [(a, a)]
    -> (Map a [Integer], Map [Integer] [a])
    -> (Map a [Integer], Map [Integer] [a])
    -> SearchTree [(a, a)]
    forall a.
    (Num a, Enum a, Ord a) =>
    [(a, a)]
    -> (Map a [a], Map [a] [a])
    -> (Map a [a], Map [a] [a])
    -> SearchTree [(a, a)]
    dfs [] (Map a [Integer], Map [Integer] [a])
    forall a a. (Map a [a], Map [a] [a])
    unitCol (Map a [Integer], Map [Integer] [a])
    forall a a. (Map a [a], Map [a] [a])
    unitCol where
        unitCol :: (Map a [a], Map [a] [a])
    unitCol = ([(a, [a])] -> Map a [a]
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([(a, [a])] -> Map a [a]) -> [(a, [a])] -> Map a [a]
    forall a b. (a -> b) -> a -> b
    $ (a -> (a, [a])) -> [a] -> [(a, [a])]
    forall a b. (a -> b) -> [a] -> [b]
    map (,[]) [a]
    vs, [a] -> [a] -> Map [a] [a]
    forall k a. k -> a -> Map k a
    M.singleton [] [a]
    vs) -- "unit colouring"

        dfs :: [(a, a)]
    -> (Map a [a], Map [a] [a])
    -> (Map a [a], Map [a] [a])
    -> SearchTree [(a, a)]
    dfs xys :: [(a, a)]
    xys srcColouring :: (Map a [a], Map [a] [a])
    srcColouring@(srcVmap :: Map a [a]
    srcVmap,srcCmap :: Map [a] [a]
    srcCmap) trgColouring :: (Map a [a], Map [a] [a])
    trgColouring@(trgVmap :: Map a [a]
    trgVmap,trgCmap :: Map [a] [a]
    trgCmap)
            -- ( | M.map length srcCmap /= M.map length trgCmap = T False xys [] )

            | ([a] -> Bool) -> [[a]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all [a] -> Bool
    forall a. [a] -> Bool
    isSingleton (Map [a] [a] -> [[a]]
    forall k a. Map k a -> [a]
    M.elems Map [a] [a]
    srcCmap) = -- discrete colouring

                 let xys' :: [(a, a)]
    xys' = [a] -> [a] -> [(a, a)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip ([[a]] -> [a]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[a]] -> [a]) -> [[a]] -> [a]
    forall a b. (a -> b) -> a -> b
    $ Map [a] [a] -> [[a]]
    forall k a. Map k a -> [a]
    M.elems Map [a] [a]
    srcCmap) ([[a]] -> [a]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[a]] -> [a]) -> [[a]] -> [a]
    forall a b. (a -> b) -> a -> b
    $ Map [a] [a] -> [[a]]
    forall k a. Map k a -> [a]
    M.elems Map [a] [a]
    trgCmap)
                 in Bool -> [(a, a)] -> [SearchTree [(a, a)]] -> SearchTree [(a, a)]
    forall a. Bool -> a -> [SearchTree a] -> SearchTree a
    T ([(a, a)] -> Bool
    isCompatible [(a, a)]
    xys') ([(a, a)] -> [(a, a)]
    forall a. [a] -> [a]
    reverse [(a, a)]
    xys'[(a, a)] -> [(a, a)] -> [(a, a)]
    forall a. [a] -> [a] -> [a]
    ++[(a, a)]
    xys) []
                 -- Since the xys' are distance-compatible with the xys, they are certainly edge-compatible.

                 -- However, we do need to check that the xys' are edge-compatible with each other.

            | Bool
    otherwise = let (x :: a
    x,c :: [a]
    c) = Map a [a] -> (a, [a])
    forall k a. Map k a -> (k, a)
    M.findMin Map a [a]
    srcVmap
                              (xVmap :: Map a [a]
    xVmap,xCmap :: Map [a] [a]
    xCmap) = Map a (Map a [a], Map [a] [a])
    forall a a.
    (Ord a, Num a, Num a, Enum a, Enum a) =>
    Map a (Map a [a], Map [a] [a])
    dcs Map a (Map a [a], Map [a] [a]) -> a -> (Map a [a], Map [a] [a])
    forall k a. Ord k => Map k a -> k -> a
    M.! a
    x
                              ys :: [a]
    ys = Map [a] [a]
    trgCmap Map [a] [a] -> [a] -> [a]
    forall k a. Ord k => Map k a -> k -> a
    M.! [a]
    c
                              srcVmap' :: Map a [a]
    srcVmap' = a -> Map a [a] -> Map a [a]
    forall k a. Ord k => k -> Map k a -> Map k a
    M.delete a
    x (Map a [a] -> Map a [a] -> Map a [a]
    forall k a. Ord k => Map k [a] -> Map k [a] -> Map k [a]
    intersectColouring Map a [a]
    srcVmap Map a [a]
    forall a. (Num a, Enum a) => Map a [a]
    xVmap)
                              srcCmap' :: Map [a] [a]
    srcCmap' = Map a [a] -> Map [a] [a]
    forall k a. Ord k => Map a k -> Map k [a]
    colourPartition Map a [a]
    srcVmap'
                              -- srcCmap' = M.fromAscList [(c1++c2, cell) | (c1,srcCell) <- M.assocs srcCmap, (c2,xCell) <- M.assocs xCmap,

                              --                                            let cell = L.delete x (intersectAsc srcCell xCell),

                              --                                            (not . null) cell]

                          in Bool -> [(a, a)] -> [SearchTree [(a, a)]] -> SearchTree [(a, a)]
    forall a. Bool -> a -> [SearchTree a] -> SearchTree a
    T Bool
    False [(a, a)]
    xys
                             [[(a, a)]
    -> (Map a [a], Map [a] [a])
    -> (Map a [a], Map [a] [a])
    -> SearchTree [(a, a)]
    dfs ((a
    x,a
    y)(a, a) -> [(a, a)] -> [(a, a)]
    forall a. a -> [a] -> [a]
    :[(a, a)]
    xys) (Map a [a]
    srcVmap',Map [a] [a]
    srcCmap') (Map a [a]
    trgVmap',Map [a] [a]
    trgCmap')
                             | a
    y <- [a]
    ys,
                               let (yVmap :: Map a [a]
    yVmap,yCmap :: Map [a] [a]
    yCmap) = Map a (Map a [a], Map [a] [a])
    forall a a.
    (Ord a, Num a, Num a, Enum a, Enum a) =>
    Map a (Map a [a], Map [a] [a])
    dcs Map a (Map a [a], Map [a] [a]) -> a -> (Map a [a], Map [a] [a])
    forall k a. Ord k => Map k a -> k -> a
    M.! a
    y,
                               let trgVmap' :: Map a [a]
    trgVmap' = a -> Map a [a] -> Map a [a]
    forall k a. Ord k => k -> Map k a -> Map k a
    M.delete a
    y (Map a [a] -> Map a [a] -> Map a [a]
    forall k a. Ord k => Map k [a] -> Map k [a] -> Map k [a]
    intersectColouring Map a [a]
    trgVmap Map a [a]
    forall a. (Num a, Enum a) => Map a [a]
    yVmap),
                               let trgCmap' :: Map [a] [a]
    trgCmap' = Map a [a] -> Map [a] [a]
    forall k a. Ord k => Map a k -> Map k [a]
    colourPartition Map a [a]
    trgVmap',
                               -- let trgCmap' = M.fromAscList [(c1++c2, cell) | (c1,trgCell) <- M.assocs trgCmap, (c2,yCell) <- M.assocs yCmap,

                               --                                                let cell = L.delete y (intersectAsc trgCell yCell),

                               --                                                (not . null) cell],

                               ([a] -> Int) -> Map [a] [a] -> Map [a] Int
    forall a b k. (a -> b) -> Map k a -> Map k b
    M.map [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Map [a] [a]
    srcCmap' Map [a] Int -> Map [a] Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == ([a] -> Int) -> Map [a] [a] -> Map [a] Int
    forall a b k. (a -> b) -> Map k a -> Map k b
    M.map [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Map [a] [a]
    trgCmap' ]
        isCompatible :: [(a, a)] -> Bool
    isCompatible xys :: [(a, a)]
    xys = [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    and [([a
    x,a
    x'] [a] -> Set [a] -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `S.member` Set [a]
    es') Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == ([a] -> [a]
    forall a. Ord a => [a] -> [a]
    L.sort [a
    y,a
    y'] [a] -> Set [a] -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `S.member` Set [a]
    es') | (x :: a
    x,y :: a
    y) <- [(a, a)]
    xys, (x' :: a
    x',y' :: a
    y') <- [(a, a)]
    xys, a
    x a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    < a
    x']
        es' :: Set [a]
    es' = [[a]] -> Set [a]
    forall a. Ord a => [a] -> Set a
    S.fromList [[a]]
    es
        dcs :: Map a (Map a [a], Map [a] [a])
    dcs = [(a, (Map a [a], Map [a] [a]))] -> Map a (Map a [a], Map [a] [a])
    forall k a. Eq k => [(k, a)] -> Map k a
    M.fromAscList [(a
    v, a -> (Map a [a], Map [a] [a])
    forall a a.
    (Ord a, Num a, Num a, Enum a, Enum a) =>
    a -> (Map a [a], Map [a] [a])
    distanceColouring a
    v) | a
    v <- [a]
    vs]
        distanceColouring :: a -> (Map a [a], Map [a] [a])
    distanceColouring u :: a
    u = let dp :: [[a]]
    dp = [a] -> Set [a] -> a -> [[a]]
    forall a. Ord a => [a] -> Set [a] -> a -> [[a]]
    distancePartitionS [a]
    vs Set [a]
    es' a
    u
                                  vmap :: Map a [a]
    vmap = [(a, [a])] -> Map a [a]
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList [(a
    v,[a
    c]) | (cell :: [a]
    cell,c :: a
    c) <- [[a]] -> [a] -> [([a], a)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [[a]]
    dp [0..], a
    v <- [a]
    cell]
                                  cmap :: Map [a] [a]
    cmap = [([a], [a])] -> Map [a] [a]
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([([a], [a])] -> Map [a] [a]) -> [([a], [a])] -> Map [a] [a]
    forall a b. (a -> b) -> a -> b
    $ [[a]] -> [[a]] -> [([a], [a])]
    forall a b. [a] -> [b] -> [(a, b)]
    zip ((a -> [a]) -> [a] -> [[a]]
    forall a b. (a -> b) -> [a] -> [b]
    map (a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[]) [0..]) [[a]]
    dp
                              in (Map a [a]
    forall a. (Num a, Enum a) => Map a [a]
    vmap, Map [a] [a]
    forall a. (Ord a, Num a, Enum a) => Map [a] [a]
    cmap)

    {-
    -- If we are going to recalculate the colour partition each time anyway,
    -- then we don't need to carry it around, and can simplify the code
    graphAutsDistanceColouringSearchTree g@(G vs es) = dfs [] initCol initCol where
        initCol = M.fromList $ map (,[]) vs
        dfs xys srcCol trgCol
            | M.map length srcPart /= M.map length trgPart = T False xys []
            | all isSingleton (M.elems srcPart) =
                 let xys' = zip (concat $ M.elems srcPart) (concat $ M.elems trgPart)
                 in T (isCompatible xys') (reverse xys'++xys) []
                 -- Since the xys' are distance-compatible with the xys, they are certainly edge-compatible.
                 -- However, we do need to check that the xys' are edge-compatible with each other.
            | otherwise = let (x,c) = M.findMin srcCol
                              ys = trgPart M.! c
                              srcCol' = M.delete x $ intersectColouring srcCol (dcs M.! x)
                          in T False xys
                             [dfs ((x,y):xys) srcCol' trgCol'
                             | y <- ys,
                               let trgCol' = M.delete y (intersectColouring trgCol (dcs M.! y))]
            where srcPart = colourPartition srcCol
                  trgPart = colourPartition trgCol
        isCompatible xys = and [([x,x'] `S.member` es') == (L.sort [y,y'] `S.member` es') | (x,y) <- xys, (x',y') <- xys, x < x']
        es' = S.fromList es
        dcs = M.fromAscList [(v, distanceColouring v) | v <- vs]
        distanceColouring u = M.fromList [(v,[c]) | (cell,c) <- zip (distancePartitionS vs es' u) [0..], v <- cell]
    -}
    distanceColouring :: Graph k -> k -> Map k [a]
    distanceColouring (G vs :: [k]
    vs es :: [[k]]
    es) u :: k
    u = [(k, [a])] -> Map k [a]
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList [(k
    v,[a
    c]) | (cell :: [k]
    cell,c :: a
    c) <- [[k]] -> [a] -> [([k], a)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip ([k] -> Set [k] -> k -> [[k]]
    forall a. Ord a => [a] -> Set [a] -> a -> [[a]]
    distancePartitionS [k]
    vs Set [k]
    es' k
    u) [0..], k
    v <- [k]
    cell]
        where es' :: Set [k]
    es' = [[k]] -> Set [k]
    forall a. Ord a => [a] -> Set a
    S.fromList [[k]]
    es

    intersectColouring :: Map k [a] -> Map k [a] -> Map k [a]
    intersectColouring c1 :: Map k [a]
    c1 c2 :: Map k [a]
    c2 = ([a] -> [a] -> [a]) -> Map k [a] -> Map k [a] -> Map k [a]
    forall k a b c.
    Ord k =>
    (a -> b -> c) -> Map k a -> Map k b -> Map k c
    M.intersectionWith [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    (++) Map k [a]
    c1 Map k [a]
    c2

    colourPartition :: Map a k -> Map k [a]
    colourPartition c :: Map a k
    c = ((a, k) -> Map k [a] -> Map k [a])
    -> Map k [a] -> [(a, k)] -> Map k [a]
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    L.foldr (\(k :: a
    k,v :: k
    v) m :: Map k [a]
    m -> ([a] -> [a] -> [a]) -> k -> [a] -> Map k [a] -> Map k [a]
    forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
    M.insertWith [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    (++) k
    v [a
    k] Map k [a]
    m) Map k [a]
    forall k a. Map k a
    M.empty (Map a k -> [(a, k)]
    forall k a. Map k a -> [(k, a)]
    M.assocs Map a k
    c)

    -- Based on McKay’s Canonical Graph Labeling Algorithm, by Stephen G. Hartke and A. J. Radcliffe

    -- (http://www.math.unl.edu/~aradcliffe1/Papers/Canonical.pdf)

    equitableRefinement :: Graph a -> [[a]] -> [[a]]
    equitableRefinement g :: Graph a
    g@(G vs :: [a]
    vs es :: [[a]]
    es) p :: [[a]]
    p = Set [a] -> [[a]] -> [[a]]
    forall a. Ord a => Set [a] -> [[a]] -> [[a]]
    equitableRefinement' ([[a]] -> Set [a]
    forall a. Ord a => [a] -> Set a
    S.fromList [[a]]
    es) [[a]]
    p

    equitableRefinement' :: Set [a] -> [[a]] -> [[a]]
    equitableRefinement' edgeset :: Set [a]
    edgeset partition :: [[a]]
    partition = [[a]] -> [[a]]
    go [[a]]
    partition where
        go :: [[a]] -> [[a]]
    go cells :: [[a]]
    cells = let splits :: [([[a]], [[a]])]
    splits = [[[a]]] -> [[[a]]] -> [([[a]], [[a]])]
    forall a b. [a] -> [b] -> [(a, b)]
    L.zip ([[a]] -> [[[a]]]
    forall a. [a] -> [[a]]
    L.inits [[a]]
    cells) ([[a]] -> [[[a]]]
    forall a. [a] -> [[a]]
    L.tails [[a]]
    cells)
                       shatterPairs :: [([(a, Int)], [[a]], [[a]])]
    shatterPairs = [([a] -> [Int] -> [(a, Int)]
    forall a b. [a] -> [b] -> [(a, b)]
    L.zip [a]
    ci [Int]
    counts,[[a]]
    ls,[[a]]
    rs) | (ls :: [[a]]
    ls,ci :: [a]
    ci:rs :: [[a]]
    rs) <- [([[a]], [[a]])]
    splits, [a]
    cj <- [[a]]
    cells,
                                                                 let counts :: [Int]
    counts = (a -> Int) -> [a] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map ([a] -> a -> Int
    nbrCount [a]
    cj) [a]
    ci, [Int] -> Bool
    forall a. Eq a => [a] -> Bool
    isShatter [Int]
    counts]
                   in case [([(a, Int)], [[a]], [[a]])]
    shatterPairs of -- by construction, the lexicographic least (i,j) comes first

                      [] -> [[a]]
    cells
                      (vcs :: [(a, Int)]
    vcs,ls :: [[a]]
    ls,rs :: [[a]]
    rs):_ -> let fragments :: [[a]]
    fragments = [(a, Int)] -> [[a]]
    forall b b. Ord b => [(b, b)] -> [[b]]
    shatter [(a, Int)]
    vcs
                                       in [[a]] -> [[a]]
    go ([[a]]
    ls [[a]] -> [[a]] -> [[a]]
    forall a. [a] -> [a] -> [a]
    ++ [[a]]
    fragments [[a]] -> [[a]] -> [[a]]
    forall a. [a] -> [a] -> [a]
    ++ [[a]]
    rs)
        isShatter :: [a] -> Bool
    isShatter (c :: a
    c:cs :: [a]
    cs) = (a -> Bool) -> [a] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    /= a
    c) [a]
    cs
        shatter :: [(b, b)] -> [[b]]
    shatter vcs :: [(b, b)]
    vcs = ([(b, b)] -> [b]) -> [[(b, b)]] -> [[b]]
    forall a b. (a -> b) -> [a] -> [b]
    map (((b, b) -> b) -> [(b, b)] -> [b]
    forall a b. (a -> b) -> [a] -> [b]
    map (b, b) -> b
    forall a b. (a, b) -> a
    fst) ([[(b, b)]] -> [[b]]) -> [[(b, b)]] -> [[b]]
    forall a b. (a -> b) -> a -> b
    $ ((b, b) -> (b, b) -> Bool) -> [(b, b)] -> [[(b, b)]]
    forall a. (a -> a -> Bool) -> [a] -> [[a]]
    L.groupBy (\x :: (b, b)
    x y :: (b, b)
    y -> (b, b) -> b
    forall a b. (a, b) -> b
    snd (b, b)
    x b -> b -> Bool
    forall a. Eq a => a -> a -> Bool
    == (b, b) -> b
    forall a b. (a, b) -> b
    snd (b, b)
    y) ([(b, b)] -> [[(b, b)]]) -> [(b, b)] -> [[(b, b)]]
    forall a b. (a -> b) -> a -> b
    $ ((b, b) -> (b, b) -> Ordering) -> [(b, b)] -> [(b, b)]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    L.sortBy (((b, b) -> b) -> (b, b) -> (b, b) -> Ordering
    forall a b. Ord a => (b -> a) -> b -> b -> Ordering
    comparing (b, b) -> b
    forall a b. (a, b) -> b
    snd) ([(b, b)] -> [(b, b)]) -> [(b, b)] -> [(b, b)]
    forall a b. (a -> b) -> a -> b
    $ [(b, b)]
    vcs
        -- Memoizing here results in about 10% speed improvement. Not worth it for loss of generality (ie requiring HasTrie instances)

        -- nbrCount = memo2 nbrCount'

        -- How many neighbours in cell does vertex have

        nbrCount :: [a] -> a -> Int
    nbrCount cell :: [a]
    cell vertex :: a
    vertex = [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ((a -> Bool) -> [a] -> [a]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (a -> a -> Bool
    isEdge a
    vertex) [a]
    cell)
        isEdge :: a -> a -> Bool
    isEdge u :: a
    u v :: a
    v = [a] -> [a]
    forall a. Ord a => [a] -> [a]
    L.sort [a
    u,a
    v] [a] -> Set [a] -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `S.member` Set [a]
    edgeset

    equitablePartitionSearchTree :: Graph a -> [[a]] -> SearchTree ([[a]], [a])
    equitablePartitionSearchTree g :: Graph a
    g@(G vs :: [a]
    vs es :: [[a]]
    es) p :: [[a]]
    p = [a] -> [[a]] -> SearchTree ([[a]], [a])
    dfs [] [[a]]
    p where
        dfs :: [a] -> [[a]] -> SearchTree ([[a]], [a])
    dfs bs :: [a]
    bs p :: [[a]]
    p = let p' :: [[a]]
    p' = Set [a] -> [[a]] -> [[a]]
    forall a. Ord a => Set [a] -> [[a]] -> [[a]]
    equitableRefinement' Set [a]
    es' [[a]]
    p in
                   if ([a] -> Bool) -> [[a]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all [a] -> Bool
    forall a. [a] -> Bool
    isSingleton [[a]]
    p'
                   then Bool
    -> ([[a]], [a])
    -> [SearchTree ([[a]], [a])]
    -> SearchTree ([[a]], [a])
    forall a. Bool -> a -> [SearchTree a] -> SearchTree a
    T Bool
    True ([[a]]
    p',[a]
    bs) []
                   else Bool
    -> ([[a]], [a])
    -> [SearchTree ([[a]], [a])]
    -> SearchTree ([[a]], [a])
    forall a. Bool -> a -> [SearchTree a] -> SearchTree a
    T Bool
    False ([[a]]
    p',[a]
    bs) [[a] -> [[a]] -> SearchTree ([[a]], [a])
    dfs (a
    ba -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    bs) [[a]]
    p'' | (b :: a
    b,p'' :: [[a]]
    p'') <- [[a]] -> [[a]] -> [(a, [[a]])]
    forall a. [[a]] -> [[a]] -> [(a, [[a]])]
    splits [] [[a]]
    p']
        -- For now, we just split the first non-singleton cell we find

        splits :: [[a]] -> [[a]] -> [(a, [[a]])]
    splits ls :: [[a]]
    ls (r :: [a]
    r:rs :: [[a]]
    rs) | [a] -> Bool
    forall a. [a] -> Bool
    isSingleton [a]
    r = [[a]] -> [[a]] -> [(a, [[a]])]
    splits ([a]
    r[a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    :[[a]]
    ls) [[a]]
    rs
                         | Bool
    otherwise = let ls' :: [[a]]
    ls' = [[a]] -> [[a]]
    forall a. [a] -> [a]
    reverse [[a]]
    ls in [(a
    x, [[a]]
    ls' [[a]] -> [[a]] -> [[a]]
    forall a. [a] -> [a] -> [a]
    ++ [a
    x][a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    :[a]
    xs[a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    :[[a]]
    rs) | (x :: a
    x,xs :: [a]
    xs) <- [a] -> [(a, [a])]
    forall a. [a] -> [(a, [a])]
    picks [a]
    r]
        es' :: Set [a]
    es' = [[a]] -> Set [a]
    forall a. Ord a => [a] -> Set a
    S.fromList [[a]]
    es

    {-
    -- Using Data.Sequence instead of list for the partitions
    -- Makes no difference to speed (in fact slightly slower)
    equitableRefinementSeq' edgeset partition = go partition where
        go cells = let splits = Seq.zip (Seq.inits cells) (Seq.tails cells)
                       shatterPairs = [(L.zip ci counts,ls,rs') | (ls,rs) <- Foldable.toList splits, (not . Seq.null) rs, let ci Seq.:< rs' = Seq.viewl rs,
                                                                  cj <- Foldable.toList cells,
                                                                  let counts = map (nbrCount cj) ci, isShatter counts]
                   in case shatterPairs of -- by construction, the lexicographic least (i,j) comes first
                      [] -> cells
                      (vcs,ls,rs):_ -> let fragments = Seq.fromList (shatter vcs)
                                       in go (ls Seq.>< fragments Seq.>< rs)
        isShatter (c:cs) = any (/= c) cs
        shatter vcs = map (map fst) $ L.groupBy (\x y -> snd x == snd y) $ L.sortBy (comparing snd) $ vcs
        -- How many neighbours in cell does vertex have
        nbrCount cell vertex = length (filter (isEdge vertex) cell)
        isEdge u v = L.sort [u,v] `S.member` edgeset

    equitablePartitionSeqSearchTree g@(G vs es) p = dfs [] (Seq.fromList p) where
        dfs bs p = let p' = equitableRefinementSeq' es' p in
                   if Foldable.all isSingleton p'
                   then T True (Foldable.toList p',bs) []
                   else T False (Foldable.toList p',bs) [dfs (b:bs) p'' | (b,p'') <- splits p']
        -- For now, we just split the first non-singleton cell we find
        splits cells = case Seq.findIndexL (not . isSingleton) cells of
                       Just i -> let (ls,rs) = Seq.splitAt i cells
                                     r Seq.:< rs' = Seq.viewl rs
                                 in [(x, ls Seq.>< ([x] Seq.<| xs Seq.<| rs')) | (x,xs) <- picks r]
                       Nothing -> error "Not possible, as we know there are non-singleton cells"
        es' = S.fromList es
    -}

    -- In this version, whenever we have an equitable partition, we separate out all the singleton cells and put them to one side.

    -- (Since the partition is equitable, singleton cells have already done any work they are going to do in shattering other cells,

    -- so they will no longer play any part.)

    -- This seems to result in about 20% speedup.

    equitablePartitionSearchTree2 :: Graph a -> [[a]] -> SearchTree ([[a]], [a])
    equitablePartitionSearchTree2 g :: Graph a
    g@(G vs :: [a]
    vs es :: [[a]]
    es) p :: [[a]]
    p = [a] -> ([[a]], [[a]]) -> SearchTree ([[a]], [a])
    dfs [] ([],[[a]]
    p) where
        dfs :: [a] -> ([[a]], [[a]]) -> SearchTree ([[a]], [a])
    dfs bs :: [a]
    bs (ss :: [[a]]
    ss,cs :: [[a]]
    cs) = let (ss' :: [[a]]
    ss',cs' :: [[a]]
    cs') = ([a] -> Bool) -> [[a]] -> ([[a]], [[a]])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    L.partition [a] -> Bool
    forall a. [a] -> Bool
    isSingleton ([[a]] -> ([[a]], [[a]])) -> [[a]] -> ([[a]], [[a]])
    forall a b. (a -> b) -> a -> b
    $ Set [a] -> [[a]] -> [[a]]
    forall a. Ord a => Set [a] -> [[a]] -> [[a]]
    equitableRefinement' Set [a]
    es' [[a]]
    cs
                             ss'' :: [[a]]
    ss'' = [[a]]
    ss[[a]] -> [[a]] -> [[a]]
    forall a. [a] -> [a] -> [a]
    ++[[a]]
    ss'
                         in case [[a]]
    cs' of
                            [] -> Bool
    -> ([[a]], [a])
    -> [SearchTree ([[a]], [a])]
    -> SearchTree ([[a]], [a])
    forall a. Bool -> a -> [SearchTree a] -> SearchTree a
    T Bool
    True ([[a]]
    ss'',[a]
    bs) []
                            -- We just split the first non-singleton cell

                            -- c:cs'' -> T False (ss''++cs',bs) [dfs (x:bs) (ss'',[x]:xs:cs'') | (x,xs) <- picks c]

                            c :: [a]
    c:cs'' :: [[a]]
    cs'' -> Bool
    -> ([[a]], [a])
    -> [SearchTree ([[a]], [a])]
    -> SearchTree ([[a]], [a])
    forall a. Bool -> a -> [SearchTree a] -> SearchTree a
    T Bool
    False ([[a]]
    cs'[[a]] -> [[a]] -> [[a]]
    forall a. [a] -> [a] -> [a]
    ++[[a]]
    ss'',[a]
    bs) [[a] -> ([[a]], [[a]]) -> SearchTree ([[a]], [a])
    dfs (a
    xa -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    bs) ([[a]]
    ss'',[a
    x][a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    :[a]
    xs[a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    :[[a]]
    cs'') | (x :: a
    x,xs :: [a]
    xs) <- [a] -> [(a, [a])]
    forall a. [a] -> [(a, [a])]
    picks [a]
    c]
        es' :: Set [a]
    es' = [[a]] -> Set [a]
    forall a. Ord a => [a] -> Set a
    S.fromList [[a]]
    es
    -- TODO: On the first level, we can use a stronger partitioning function (eg distance partitions, + see nauty manual, vertex invariants)

    equitableDistancePartitionSearchTree :: Graph a -> [[a]] -> SearchTree ([[a]], [a])
    equitableDistancePartitionSearchTree g :: Graph a
    g@(G vs :: [a]
    vs es :: [[a]]
    es) p :: [[a]]
    p = [a] -> [[a]] -> SearchTree ([[a]], [a])
    dfs [] [[a]]
    p where
        dfs :: [a] -> [[a]] -> SearchTree ([[a]], [a])
    dfs bs :: [a]
    bs p :: [[a]]
    p = let p' :: [[a]]
    p' = Set [a] -> [[a]] -> [[a]]
    forall a. Ord a => Set [a] -> [[a]] -> [[a]]
    equitableRefinement' Set [a]
    es' [[a]]
    p in
                   if ([a] -> Bool) -> [[a]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all [a] -> Bool
    forall a. [a] -> Bool
    isSingleton [[a]]
    p'
                   then Bool
    -> ([[a]], [a])
    -> [SearchTree ([[a]], [a])]
    -> SearchTree ([[a]], [a])
    forall a. Bool -> a -> [SearchTree a] -> SearchTree a
    T Bool
    True ([[a]]
    p',[a]
    bs) []
                   else Bool
    -> ([[a]], [a])
    -> [SearchTree ([[a]], [a])]
    -> SearchTree ([[a]], [a])
    forall a. Bool -> a -> [SearchTree a] -> SearchTree a
    T Bool
    False ([[a]]
    p',[a]
    bs) [[a] -> [[a]] -> SearchTree ([[a]], [a])
    dfs (a
    ba -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    bs) [[a]]
    p'' | (b :: a
    b,p'' :: [[a]]
    p'') <- [[a]] -> [[a]] -> [(a, [[a]])]
    splits [] [[a]]
    p']
        -- For now, we just split the first non-singleton cell we find

        splits :: [[a]] -> [[a]] -> [(a, [[a]])]
    splits ls :: [[a]]
    ls (r :: [a]
    r:rs :: [[a]]
    rs) | [a] -> Bool
    forall a. [a] -> Bool
    isSingleton [a]
    r = [[a]] -> [[a]] -> [(a, [[a]])]
    splits ([a]
    r[a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    :[[a]]
    ls) [[a]]
    rs
                         | Bool
    otherwise = [(a
    x, [[a]]
    p'') | let ls' :: [[a]]
    ls' = [[a]] -> [[a]]
    forall a. [a] -> [a]
    reverse [[a]]
    ls,
                                                   (x :: a
    x,xs :: [a]
    xs) <- [a] -> [(a, [a])]
    forall a. [a] -> [(a, [a])]
    picks [a]
    r,
                                                   let p' :: [[a]]
    p' = [[a]]
    ls' [[a]] -> [[a]] -> [[a]]
    forall a. [a] -> [a] -> [a]
    ++ [a
    x][a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    :[a]
    xs[a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    :[[a]]
    rs,
                                                   let p'' :: [[a]]
    p'' = ([a] -> Bool) -> [[a]] -> [[a]]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (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]] -> [[a]] -> [[a]]
    forall a. Ord a => [[a]] -> [[a]] -> [[a]]
    intersectCells [[a]]
    p' (Map a [[a]]
    dps Map a [[a]] -> a -> [[a]]
    forall k a. Ord k => Map k a -> k -> a
    M.! a
    x))]
        es' :: Set [a]
    es' = [[a]] -> Set [a]
    forall a. Ord a => [a] -> Set a
    S.fromList [[a]]
    es
        dps :: Map a [[a]]
    dps = [(a, [[a]])] -> Map a [[a]]
    forall k a. Eq k => [(k, a)] -> Map k a
    M.fromAscList [(a
    v, [a] -> Set [a] -> a -> [[a]]
    forall a. Ord a => [a] -> Set [a] -> a -> [[a]]
    distancePartitionS [a]
    vs Set [a]
    es' a
    v) | a
    v <- [a]
    vs]

    {-
    -- This is just fmap (\(p,bs) -> (p,bs,trace p)) t
    equitablePartitionTracedSearchTree g@(G vs es) trace p = dfs [] p where
        dfs bs p = let p' = equitableRefinement' es' p
                   in if all isSingleton p'
                      then T True (p',bs,trace p') []
                      else T False (p',bs,trace p') [dfs (b:bs) p'' | (b,p'') <- splits [] p']
        -- For now, we just split the first non-singleton cell we find
        splits ls (r:rs) | isSingleton r = splits (r:ls) rs
                         | otherwise = let ls' = reverse ls in [(x, ls' ++ [x]:xs:rs) | (x,xs) <- picks r]
        es' = S.fromList es
    -}

    -- Intended as a node invariant

    trace1 :: [t a] -> [(Int, Int)]
    trace1 p :: [t a]
    p = ([Int] -> (Int, Int)) -> [[Int]] -> [(Int, Int)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\xs :: [Int]
    xs@(x :: Int
    x:_) -> (Int
    x, [Int] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Int]
    xs)) ([[Int]] -> [(Int, Int)]) -> [[Int]] -> [(Int, Int)]
    forall a b. (a -> b) -> a -> b
    $ [Int] -> [[Int]]
    forall a. Eq a => [a] -> [[a]]
    L.group ([Int] -> [[Int]]) -> [Int] -> [[Int]]
    forall a b. (a -> b) -> a -> b
    $ [Int] -> [Int]
    forall a. Ord a => [a] -> [a]
    L.sort ([Int] -> [Int]) -> [Int] -> [Int]
    forall a b. (a -> b) -> a -> b
    $ (t a -> Int) -> [t a] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map t a -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [t a]
    p

    equitablePartitionGraphSearchTree :: Graph a -> SearchTree ([[a]], [a])
    equitablePartitionGraphSearchTree g :: Graph a
    g@(G vs :: [a]
    vs es :: [[a]]
    es) = Graph a -> [[a]] -> SearchTree ([[a]], [a])
    forall a. Ord a => Graph a -> [[a]] -> SearchTree ([[a]], [a])
    equitablePartitionSearchTree Graph a
    g [[a]]
    unitPartition
        where unitPartition :: [[a]]
    unitPartition = [[a]
    vs]

    -- The incidence graph has vertices that are coloured left (points) or right (blocks).

    -- We are not interested in dualities (automorphisms that swap points and blocks), so we look for colour-preserving automorphisms

    equitablePartitionIncidenceSearchTree :: Graph (Either a b) -> SearchTree ([[Either a b]], [Either a b])
    equitablePartitionIncidenceSearchTree g :: Graph (Either a b)
    g@(G vs :: [Either a b]
    vs es :: [[Either a b]]
    es) = Graph (Either a b)
    -> [[Either a b]] -> SearchTree ([[Either a b]], [Either a b])
    forall a. Ord a => Graph a -> [[a]] -> SearchTree ([[a]], [a])
    equitablePartitionSearchTree Graph (Either a b)
    g [[Either a b]]
    lrPartition
        where (lefts :: [a]
    lefts, rights :: [b]
    rights) = [Either a b] -> ([a], [b])
    forall a b. [Either a b] -> ([a], [b])
    partitionEithers [Either a b]
    vs
              lrPartition :: [[Either a b]]
    lrPartition = [(a -> Either a b) -> [a] -> [Either a b]
    forall a b. (a -> b) -> [a] -> [b]
    map a -> Either a b
    forall a b. a -> Either a b
    Left [a]
    lefts, (b -> Either a b) -> [b] -> [Either a b]
    forall a b. (a -> b) -> [a] -> [b]
    map b -> Either a b
    forall a b. b -> Either a b
    Right [b]
    rights]

    leftLeaf :: SearchTree (t [a], [a]) -> ([a], [a])
    leftLeaf (T False _ (t :: SearchTree (t [a], [a])
    t:ts :: [SearchTree (t [a], [a])]
    ts)) = SearchTree (t [a], [a]) -> ([a], [a])
    leftLeaf SearchTree (t [a], [a])
    t
    leftLeaf (T True (p :: t [a]
    p,bs :: [a]
    bs) []) = (t [a] -> [a]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat t [a]
    p, [a] -> [a]
    forall a. [a] -> [a]
    reverse [a]
    bs)
    {-
    leftSpine (T False x (t:ts)) = x : leftSpine t
    leftSpine (T True x []) = [x]
    -}
    allLeaves :: SearchTree (t [a], [a]) -> [([a], [a])]
    allLeaves (T False _ ts :: [SearchTree (t [a], [a])]
    ts) = (SearchTree (t [a], [a]) -> [([a], [a])])
    -> [SearchTree (t [a], [a])] -> [([a], [a])]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap SearchTree (t [a], [a]) -> [([a], [a])]
    allLeaves [SearchTree (t [a], [a])]
    ts
    allLeaves (T True (p :: t [a]
    p,bs :: [a]
    bs) []) = [(t [a] -> [a]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat t [a]
    p, [a] -> [a]
    forall a. [a] -> [a]
    reverse [a]
    bs)]

    {-
    partitionTransversals tree = [fromPairs (zip canonical partition) | partition <- findTransversals tree] where
        (_,canonical) = leftLeaf tree
        findTransversals (T False _ (t:ts)) = concatMap (take 1 . findTransversals) ts ++ findTransversals t
        findTransversals (T True (_,partition) []) = [concat partition]

    graphAuts5 = partitionTransversals . equitablePartitionGraphSearchTree
    -}
    -- NOT WORKING

    partitionBSGS0 :: Graph a -> SearchTree ([[a]], [a]) -> ([a], [Permutation a])
    partitionBSGS0 g :: Graph a
    g@(G vs :: [a]
    vs es :: [[a]]
    es) t :: SearchTree ([[a]], [a])
    t = ([a]
    bs, SearchTree ([[a]], [a]) -> [Permutation a]
    forall b. SearchTree ([[a]], b) -> [Permutation a]
    findLevels SearchTree ([[a]], [a])
    t) where
        (p1 :: [a]
    p1,bs :: [a]
    bs) = SearchTree ([[a]], [a]) -> ([a], [a])
    forall (t :: * -> *) a a.
    Foldable t =>
    SearchTree (t [a], [a]) -> ([a], [a])
    leftLeaf SearchTree ([[a]], [a])
    t
        g1 :: Permutation a
    g1 = [(a, a)] -> Permutation a
    forall a. Ord a => [(a, a)] -> Permutation a
    fromPairs ([(a, a)] -> Permutation a) -> [(a, a)] -> Permutation a
    forall a b. (a -> b) -> a -> b
    $ [a] -> [a] -> [(a, a)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [a]
    p1 [a]
    vs
        g1' :: Permutation a
    g1' = Permutation a
    g1Permutation a -> Integer -> Permutation a
    forall a b. (Num a, HasInverses a, Integral b) => a -> b -> a
    ^-1
        es1 :: Set [a]
    es1 = [[a]] -> Set [a]
    forall a. Ord a => [a] -> Set a
    S.fromList ([[a]] -> Set [a]) -> [[a]] -> Set [a]
    forall a b. (a -> b) -> a -> b
    $ Graph a -> [[a]]
    forall a. Graph a -> [[a]]
    edges (Graph a -> [[a]]) -> Graph a -> [[a]]
    forall a b. (a -> b) -> a -> b
    $ (a -> a) -> Graph a -> Graph a
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (a -> Permutation a -> a
    forall a. Ord a => a -> Permutation a -> a
    .^ Permutation a
    g1) Graph a
    g -- the edges of the isomorph corresponding to p1. (S.fromList makes it unnecessary to call nf.)

        findLevels :: SearchTree ([[a]], b) -> [Permutation a]
    findLevels (T True (partition :: [[a]]
    partition,_) []) = []
        findLevels (T False (partition :: [[a]]
    partition,_) (t :: SearchTree ([[a]], b)
    t:ts :: [SearchTree ([[a]], b)]
    ts)) =
            let hs :: [Permutation a]
    hs = SearchTree ([[a]], b) -> [Permutation a]
    findLevels SearchTree ([[a]], b)
    t
                -- TODO: It might be better to use the b that is added in t to find the cell that splits

                cell :: [a]
    cell@(v :: a
    v:vs :: [a]
    vs) = [[a]] -> [a]
    forall a. [a] -> a
    head ([[a]] -> [a]) -> [[a]] -> [a]
    forall a b. (a -> b) -> a -> b
    $ ([a] -> Bool) -> [[a]] -> [[a]]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [a] -> Bool
    forall a. [a] -> Bool
    isSingleton) [[a]]
    partition -- the cell that is going to split

            in a
    -> [Permutation a]
    -> [(a, SearchTree ([[a]], b))]
    -> [Permutation a]
    forall (t :: * -> *) b.
    Foldable t =>
    a
    -> [Permutation a]
    -> [(a, SearchTree (t [a], b))]
    -> [Permutation a]
    findLevel a
    v [Permutation a]
    hs ([a] -> [SearchTree ([[a]], b)] -> [(a, SearchTree ([[a]], b))]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [a]
    vs [SearchTree ([[a]], b)]
    ts)
        findLevel :: a
    -> [Permutation a]
    -> [(a, SearchTree (t [a], b))]
    -> [Permutation a]
    findLevel v :: a
    v hs :: [Permutation a]
    hs ((v' :: a
    v',t' :: SearchTree (t [a], b)
    t'):vts :: [(a, SearchTree (t [a], b))]
    vts) = if a
    v' a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` a
    v a -> [Permutation a] -> [a]
    forall a. Ord a => a -> [Permutation a] -> [a]
    .^^ [Permutation a]
    hs
                                       then a
    -> [Permutation a]
    -> [(a, SearchTree (t [a], b))]
    -> [Permutation a]
    findLevel a
    v [Permutation a]
    hs [(a, SearchTree (t [a], b))]
    vts
                                       else let h :: [Permutation a]
    h = SearchTree (t [a], b) -> [Permutation a]
    forall (t :: * -> *) b.
    Foldable t =>
    SearchTree (t [a], b) -> [Permutation a]
    find1New SearchTree (t [a], b)
    t' in a
    -> [Permutation a]
    -> [(a, SearchTree (t [a], b))]
    -> [Permutation a]
    findLevel a
    v ([Permutation a]
    h[Permutation a] -> [Permutation a] -> [Permutation a]
    forall a. [a] -> [a] -> [a]
    ++[Permutation a]
    hs) [(a, SearchTree (t [a], b))]
    vts
        findLevel _ hs :: [Permutation a]
    hs [] = [Permutation a]
    hs
        find1New :: SearchTree (t [a], b) -> [Permutation a]
    find1New (T False _ ts :: [SearchTree (t [a], b)]
    ts) = Int -> [Permutation a] -> [Permutation a]
    forall a. Int -> [a] -> [a]
    take 1 ([Permutation a] -> [Permutation a])
    -> [Permutation a] -> [Permutation a]
    forall a b. (a -> b) -> a -> b
    $ (SearchTree (t [a], b) -> [Permutation a])
    -> [SearchTree (t [a], b)] -> [Permutation a]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap SearchTree (t [a], b) -> [Permutation a]
    find1New [SearchTree (t [a], b)]
    ts
        -- There is a leaf for every aut, but not necessarily an aut for every leaf, so we must check we have an aut

        -- (For example, incidenceGraphPG 2 f8 has leaf nodes which do not correspond to auts.)

        find1New (T True (partition :: t [a]
    partition,_) []) = let h :: Permutation a
    h = [(a, a)] -> Permutation a
    forall a. Ord a => [(a, a)] -> Permutation a
    fromPairs ([(a, a)] -> Permutation a) -> [(a, a)] -> Permutation a
    forall a b. (a -> b) -> a -> b
    $ [a] -> [a] -> [(a, a)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip (t [a] -> [a]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat t [a]
    partition) [a]
    vs
                                                 g' :: Graph a
    g' = (a -> a) -> Graph a -> Graph a
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (a -> Permutation a -> a
    forall a. Ord a => a -> Permutation a -> a
    .^ Permutation a
    h) Graph a
    g
                                             in if ([a] -> Bool) -> [[a]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all ([a] -> Set [a] -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `S.member` Set [a]
    es1) (Graph a -> [[a]]
    forall a. Graph a -> [[a]]
    edges Graph a
    g') then [Permutation a
    hPermutation a -> Permutation a -> Permutation a
    forall a. Num a => a -> a -> a
    *Permutation a
    g1'] else []
        -- isAut h = all (`S.member` es') [e -^ h | e <- es]

        -- es' = S.fromList es

    -- Given a partition search tree, return a base and strong generating set for graph automorphism group.

    partitionBSGS :: Graph a -> SearchTree ([[a]], [a]) -> ([a], [Permutation a])
    partitionBSGS g :: Graph a
    g@(G vs :: [a]
    vs es :: [[a]]
    es) t :: SearchTree ([[a]], [a])
    t = ([a]
    bs, SearchTree ([[a]], [a]) -> [Permutation a]
    forall b. SearchTree ([[a]], b) -> [Permutation a]
    findLevels SearchTree ([[a]], [a])
    t) where
        (canonical :: [a]
    canonical,bs :: [a]
    bs) = SearchTree ([[a]], [a]) -> ([a], [a])
    forall (t :: * -> *) a a.
    Foldable t =>
    SearchTree (t [a], [a]) -> ([a], [a])
    leftLeaf SearchTree ([[a]], [a])
    t
        findLevels :: SearchTree ([[a]], b) -> [Permutation a]
    findLevels (T True (partition :: [[a]]
    partition,_) []) = []
        findLevels (T False (partition :: [[a]]
    partition,_) (t :: SearchTree ([[a]], b)
    t:ts :: [SearchTree ([[a]], b)]
    ts)) =
            let hs :: [Permutation a]
    hs = SearchTree ([[a]], b) -> [Permutation a]
    findLevels SearchTree ([[a]], b)
    t
                -- TODO: It might be better to use the b that is added in t to find the cell that splits

                cell :: [a]
    cell@(v :: a
    v:vs :: [a]
    vs) = [[a]] -> [a]
    forall a. [a] -> a
    head ([[a]] -> [a]) -> [[a]] -> [a]
    forall a b. (a -> b) -> a -> b
    $ ([a] -> Bool) -> [[a]] -> [[a]]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [a] -> Bool
    forall a. [a] -> Bool
    isSingleton) [[a]]
    partition -- the cell that is going to split

            in a
    -> [Permutation a]
    -> [(a, SearchTree ([[a]], b))]
    -> [Permutation a]
    forall (t :: * -> *) b.
    Foldable t =>
    a
    -> [Permutation a]
    -> [(a, SearchTree (t [a], b))]
    -> [Permutation a]
    findLevel a
    v [Permutation a]
    hs ([a] -> [SearchTree ([[a]], b)] -> [(a, SearchTree ([[a]], b))]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [a]
    vs [SearchTree ([[a]], b)]
    ts)
        findLevel :: a
    -> [Permutation a]
    -> [(a, SearchTree (t [a], b))]
    -> [Permutation a]
    findLevel v :: a
    v hs :: [Permutation a]
    hs ((v' :: a
    v',t' :: SearchTree (t [a], b)
    t'):vts :: [(a, SearchTree (t [a], b))]
    vts) = if a
    v' a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` a
    v a -> [Permutation a] -> [a]
    forall a. Ord a => a -> [Permutation a] -> [a]
    .^^ [Permutation a]
    hs -- TODO: Memoize this orbit

                                       then a
    -> [Permutation a]
    -> [(a, SearchTree (t [a], b))]
    -> [Permutation a]
    findLevel a
    v [Permutation a]
    hs [(a, SearchTree (t [a], b))]
    vts
                                       else let h :: [Permutation a]
    h = SearchTree (t [a], b) -> [Permutation a]
    forall (t :: * -> *) b.
    Foldable t =>
    SearchTree (t [a], b) -> [Permutation a]
    find1New SearchTree (t [a], b)
    t' in a
    -> [Permutation a]
    -> [(a, SearchTree (t [a], b))]
    -> [Permutation a]
    findLevel a
    v ([Permutation a]
    h[Permutation a] -> [Permutation a] -> [Permutation a]
    forall a. [a] -> [a] -> [a]
    ++[Permutation a]
    hs) [(a, SearchTree (t [a], b))]
    vts
        findLevel _ hs :: [Permutation a]
    hs [] = [Permutation a]
    hs
        find1New :: SearchTree (t [a], b) -> [Permutation a]
    find1New (T False _ ts :: [SearchTree (t [a], b)]
    ts) = Int -> [Permutation a] -> [Permutation a]
    forall a. Int -> [a] -> [a]
    take 1 ([Permutation a] -> [Permutation a])
    -> [Permutation a] -> [Permutation a]
    forall a b. (a -> b) -> a -> b
    $ (SearchTree (t [a], b) -> [Permutation a])
    -> [SearchTree (t [a], b)] -> [Permutation a]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap SearchTree (t [a], b) -> [Permutation a]
    find1New [SearchTree (t [a], b)]
    ts
        -- Some leaf nodes correspond to different isomorphs of the graph, and hence don't yield automorphisms

        find1New (T True (partition :: t [a]
    partition,_) []) = let h :: Permutation a
    h = [(a, a)] -> Permutation a
    forall a. Ord a => [(a, a)] -> Permutation a
    fromPairs ([(a, a)] -> Permutation a) -> [(a, a)] -> Permutation a
    forall a b. (a -> b) -> a -> b
    $ [a] -> [a] -> [(a, a)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [a]
    canonical (t [a] -> [a]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat t [a]
    partition)
                                             in (Permutation a -> Bool) -> [Permutation a] -> [Permutation a]
    forall a. (a -> Bool) -> [a] -> [a]
    filter Permutation a -> Bool
    isAut [Permutation a
    h]
        isAut :: Permutation a -> Bool
    isAut h :: Permutation a
    h = ([a] -> Bool) -> [[a]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all ([a] -> Set [a] -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `S.member` Set [a]
    es') [[a]
    e [a] -> Permutation a -> [a]
    forall b. Ord b => [b] -> Permutation b -> [b]
    -^ Permutation a
    h | [a]
    e <- [[a]]
    es]
        es' :: Set [a]
    es' = [[a]] -> Set [a]
    forall a. Ord a => [a] -> Set a
    S.fromList [[a]]
    es
    -- The tree for g1 has leaf nodes of two different isomorphs, as does the tree for incidenceGraphPG 2 f8

    -- Returns auts as Right, different isomorphs as Left

    -- (Must be used with the tree which doesn't put singletons to end)

    partitionBSGS3 :: Graph a
    -> SearchTree ([[a]], [a])
    -> ([a], [Either (Permutation a) (Permutation a)])
    partitionBSGS3 g :: Graph a
    g@(G vs :: [a]
    vs es :: [[a]]
    es) t :: SearchTree ([[a]], [a])
    t = ([a]
    bs, SearchTree ([[a]], [a]) -> [Either (Permutation a) (Permutation a)]
    forall b.
    SearchTree ([[a]], b) -> [Either (Permutation a) (Permutation a)]
    findLevels SearchTree ([[a]], [a])
    t) where
        (p1 :: [a]
    p1,bs :: [a]
    bs) = SearchTree ([[a]], [a]) -> ([a], [a])
    forall (t :: * -> *) a a.
    Foldable t =>
    SearchTree (t [a], [a]) -> ([a], [a])
    leftLeaf SearchTree ([[a]], [a])
    t
        findLevels :: SearchTree ([[a]], b) -> [Either (Permutation a) (Permutation a)]
    findLevels (T True (partition :: [[a]]
    partition,_) []) = []
        findLevels (T False (partition :: [[a]]
    partition,_) (t :: SearchTree ([[a]], b)
    t:ts :: [SearchTree ([[a]], b)]
    ts)) =
            let hs :: [Either (Permutation a) (Permutation a)]
    hs = SearchTree ([[a]], b) -> [Either (Permutation a) (Permutation a)]
    findLevels SearchTree ([[a]], b)
    t
                -- TODO: It might be better to use the b that is added in t to find the cell that splits

                cell :: [a]
    cell@(v :: a
    v:vs :: [a]
    vs) = [[a]] -> [a]
    forall a. [a] -> a
    head ([[a]] -> [a]) -> [[a]] -> [a]
    forall a b. (a -> b) -> a -> b
    $ ([a] -> Bool) -> [[a]] -> [[a]]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [a] -> Bool
    forall a. [a] -> Bool
    isSingleton) [[a]]
    partition -- the cell that is going to split

            in a
    -> [Either (Permutation a) (Permutation a)]
    -> [(a, SearchTree ([[a]], b))]
    -> [Either (Permutation a) (Permutation a)]
    forall (t :: * -> *) b.
    Foldable t =>
    a
    -> [Either (Permutation a) (Permutation a)]
    -> [(a, SearchTree (t [a], b))]
    -> [Either (Permutation a) (Permutation a)]
    findLevel a
    v [Either (Permutation a) (Permutation a)]
    hs ([a] -> [SearchTree ([[a]], b)] -> [(a, SearchTree ([[a]], b))]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [a]
    vs [SearchTree ([[a]], b)]
    ts)
        findLevel :: a
    -> [Either (Permutation a) (Permutation a)]
    -> [(a, SearchTree (t [a], b))]
    -> [Either (Permutation a) (Permutation a)]
    findLevel v :: a
    v hs :: [Either (Permutation a) (Permutation a)]
    hs ((v' :: a
    v',t' :: SearchTree (t [a], b)
    t'):vts :: [(a, SearchTree (t [a], b))]
    vts) = if a
    v' a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` a
    v a -> [Permutation a] -> [a]
    forall a. Ord a => a -> [Permutation a] -> [a]
    .^^ [Either (Permutation a) (Permutation a)] -> [Permutation a]
    forall a b. [Either a b] -> [b]
    rights [Either (Permutation a) (Permutation a)]
    hs
                                       then a
    -> [Either (Permutation a) (Permutation a)]
    -> [(a, SearchTree (t [a], b))]
    -> [Either (Permutation a) (Permutation a)]
    findLevel a
    v [Either (Permutation a) (Permutation a)]
    hs [(a, SearchTree (t [a], b))]
    vts
                                       else let h :: [Either (Permutation a) (Permutation a)]
    h = SearchTree (t [a], b) -> [Either (Permutation a) (Permutation a)]
    forall (t :: * -> *) b.
    Foldable t =>
    SearchTree (t [a], b) -> [Either (Permutation a) (Permutation a)]
    find1New SearchTree (t [a], b)
    t' in a
    -> [Either (Permutation a) (Permutation a)]
    -> [(a, SearchTree (t [a], b))]
    -> [Either (Permutation a) (Permutation a)]
    findLevel a
    v ([Either (Permutation a) (Permutation a)]
    h[Either (Permutation a) (Permutation a)]
    -> [Either (Permutation a) (Permutation a)]
    -> [Either (Permutation a) (Permutation a)]
    forall a. [a] -> [a] -> [a]
    ++[Either (Permutation a) (Permutation a)]
    hs) [(a, SearchTree (t [a], b))]
    vts
        findLevel _ hs :: [Either (Permutation a) (Permutation a)]
    hs [] = [Either (Permutation a) (Permutation a)]
    hs
        find1New :: SearchTree (t [a], b) -> [Either (Permutation a) (Permutation a)]
    find1New (T False _ ts :: [SearchTree (t [a], b)]
    ts) = Int
    -> [Either (Permutation a) (Permutation a)]
    -> [Either (Permutation a) (Permutation a)]
    forall a. Int -> [a] -> [a]
    take 1 ([Either (Permutation a) (Permutation a)]
     -> [Either (Permutation a) (Permutation a)])
    -> [Either (Permutation a) (Permutation a)]
    -> [Either (Permutation a) (Permutation a)]
    forall a b. (a -> b) -> a -> b
    $ (SearchTree (t [a], b) -> [Either (Permutation a) (Permutation a)])
    -> [SearchTree (t [a], b)]
    -> [Either (Permutation a) (Permutation a)]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap SearchTree (t [a], b) -> [Either (Permutation a) (Permutation a)]
    find1New [SearchTree (t [a], b)]
    ts
        -- There is a leaf for every aut, but not necessarily an aut for every leaf, so we must check we have an aut

        -- (For example, incidenceGraphPG 2 f8 has leaf nodes which do not correspond to auts.)

        find1New (T True (partition :: t [a]
    partition,_) []) = let h :: Permutation a
    h = [(a, a)] -> Permutation a
    forall a. Ord a => [(a, a)] -> Permutation a
    fromPairs ([(a, a)] -> Permutation a) -> [(a, a)] -> Permutation a
    forall a b. (a -> b) -> a -> b
    $ [a] -> [a] -> [(a, a)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [a]
    p1 (t [a] -> [a]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat t [a]
    partition)
                                             in if Permutation a -> Bool
    isAut Permutation a
    h then [Permutation a -> Either (Permutation a) (Permutation a)
    forall a b. b -> Either a b
    Right Permutation a
    h] else [Permutation a -> Either (Permutation a) (Permutation a)
    forall a b. a -> Either a b
    Left Permutation a
    h]
        isAut :: Permutation a -> Bool
    isAut h :: Permutation a
    h = ([a] -> Bool) -> [[a]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all ([a] -> Set [a] -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `S.member` Set [a]
    es') [[a]
    e [a] -> Permutation a -> [a]
    forall b. Ord b => [b] -> Permutation b -> [b]
    -^ Permutation a
    h | [a]
    e <- [[a]]
    es]
        es' :: Set [a]
    es' = [[a]] -> Set [a]
    forall a. Ord a => [a] -> Set a
    S.fromList [[a]]
    es
    -- TODO: I think we are only justified in doing find1New (ie only finding 1) if we *do* find an aut.

    -- If we don't, we should potentially keep looking in that subtree

    -- (See section 6 of paper. If we find isomorphic leaves, then the two subtrees of their common parent are isomorphic,

    -- so no need to continue searching the second.)

    -- This is using a node invariant to do more pruning.

    -- However, seems to be much slower on very regular graphs (where perhaps there is no pruning to be done)

    -- (This suggests that perhaps using fmap is not good - perhaps a space leak?)

    -- (Or perhaps it's just that calculating and comparing the node invariants is expensive)

    -- TODO: Perhaps use something simpler, like just the number of cells in the partition

    partitionBSGS2 :: Graph a -> SearchTree ([[a]], [a]) -> ([a], [Permutation a])
    partitionBSGS2 g :: Graph a
    g@(G vs :: [a]
    vs es :: [[a]]
    es) t :: SearchTree ([[a]], [a])
    t = ([a]
    bs, SearchTree ([[a]], [a], Int) -> [Permutation a]
    forall c b. Eq c => SearchTree ([[a]], b, c) -> [Permutation a]
    findLevels SearchTree ([[a]], [a], Int)
    t') where
        t' :: SearchTree ([[a]], [a], Int)
    t' = (([[a]], [a]) -> ([[a]], [a], Int))
    -> SearchTree ([[a]], [a]) -> SearchTree ([[a]], [a], Int)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\(p :: [[a]]
    p,bs :: [a]
    bs) -> ([[a]]
    p,[a]
    bs,[[a]] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    trace1 [[a]]
    p)) SearchTree ([[a]], [a])
    t
        trace1 :: t a -> Int
    trace1 = t a -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length -- the number of cells in the partition

        (canonical :: [a]
    canonical,bs :: [a]
    bs) = SearchTree ([[a]], [a]) -> ([a], [a])
    forall (t :: * -> *) a a.
    Foldable t =>
    SearchTree (t [a], [a]) -> ([a], [a])
    leftLeaf SearchTree ([[a]], [a])
    t
        findLevels :: SearchTree ([[a]], b, c) -> [Permutation a]
    findLevels (T True (partition :: [[a]]
    partition,_,_) []) = []
        findLevels (T False (partition :: [[a]]
    partition,_,_) (t :: SearchTree ([[a]], b, c)
    t:ts :: [SearchTree ([[a]], b, c)]
    ts)) =
            let (T _ (_,_,trace :: c
    trace) _) = SearchTree ([[a]], b, c)
    t
                hs :: [Permutation a]
    hs = SearchTree ([[a]], b, c) -> [Permutation a]
    findLevels SearchTree ([[a]], b, c)
    t
                -- TODO: It might be better to use the b that is added in t to find the cell that splits

                cell :: [a]
    cell@(v :: a
    v:vs :: [a]
    vs) = [[a]] -> [a]
    forall a. [a] -> a
    head ([[a]] -> [a]) -> [[a]] -> [a]
    forall a b. (a -> b) -> a -> b
    $ ([a] -> Bool) -> [[a]] -> [[a]]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [a] -> Bool
    forall a. [a] -> Bool
    isSingleton) [[a]]
    partition -- the cell that is going to split

                vts :: [(a, SearchTree ([[a]], b, c))]
    vts = ((a, SearchTree ([[a]], b, c)) -> Bool)
    -> [(a, SearchTree ([[a]], b, c))]
    -> [(a, SearchTree ([[a]], b, c))]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\(_,T _ (_,_,trace' :: c
    trace') _) -> c
    trace c -> c -> Bool
    forall a. Eq a => a -> a -> Bool
    == c
    trace') ([(a, SearchTree ([[a]], b, c))]
     -> [(a, SearchTree ([[a]], b, c))])
    -> [(a, SearchTree ([[a]], b, c))]
    -> [(a, SearchTree ([[a]], b, c))]
    forall a b. (a -> b) -> a -> b
    $ [a]
    -> [SearchTree ([[a]], b, c)] -> [(a, SearchTree ([[a]], b, c))]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [a]
    vs [SearchTree ([[a]], b, c)]
    ts
            in a
    -> [Permutation a]
    -> [(a, SearchTree ([[a]], b, c))]
    -> [Permutation a]
    forall (t :: * -> *) b c.
    Foldable t =>
    a
    -> [Permutation a]
    -> [(a, SearchTree (t [a], b, c))]
    -> [Permutation a]
    findLevel a
    v [Permutation a]
    hs [(a, SearchTree ([[a]], b, c))]
    vts
        findLevel :: a
    -> [Permutation a]
    -> [(a, SearchTree (t [a], b, c))]
    -> [Permutation a]
    findLevel v :: a
    v hs :: [Permutation a]
    hs ((v' :: a
    v',t' :: SearchTree (t [a], b, c)
    t'):vts :: [(a, SearchTree (t [a], b, c))]
    vts) = if a
    v' a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` a
    v a -> [Permutation a] -> [a]
    forall a. Ord a => a -> [Permutation a] -> [a]
    .^^ [Permutation a]
    hs
                                       then a
    -> [Permutation a]
    -> [(a, SearchTree (t [a], b, c))]
    -> [Permutation a]
    findLevel a
    v [Permutation a]
    hs [(a, SearchTree (t [a], b, c))]
    vts
                                       else let h :: [Permutation a]
    h = SearchTree (t [a], b, c) -> [Permutation a]
    forall (t :: * -> *) b c.
    Foldable t =>
    SearchTree (t [a], b, c) -> [Permutation a]
    find1New SearchTree (t [a], b, c)
    t' in a
    -> [Permutation a]
    -> [(a, SearchTree (t [a], b, c))]
    -> [Permutation a]
    findLevel a
    v ([Permutation a]
    h[Permutation a] -> [Permutation a] -> [Permutation a]
    forall a. [a] -> [a] -> [a]
    ++[Permutation a]
    hs) [(a, SearchTree (t [a], b, c))]
    vts
        findLevel _ hs :: [Permutation a]
    hs [] = [Permutation a]
    hs
        find1New :: SearchTree (t [a], b, c) -> [Permutation a]
    find1New (T False _ ts :: [SearchTree (t [a], b, c)]
    ts) = Int -> [Permutation a] -> [Permutation a]
    forall a. Int -> [a] -> [a]
    take 1 ([Permutation a] -> [Permutation a])
    -> [Permutation a] -> [Permutation a]
    forall a b. (a -> b) -> a -> b
    $ (SearchTree (t [a], b, c) -> [Permutation a])
    -> [SearchTree (t [a], b, c)] -> [Permutation a]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap SearchTree (t [a], b, c) -> [Permutation a]
    find1New [SearchTree (t [a], b, c)]
    ts
        -- There is a leaf for every aut, but not necessarily an aut for every leaf, so we must check we have an aut

        -- (For example, incidenceGraphPG 2 f8 has leaf nodes which do not correspond to auts.)

        -- (The graph g1, below, shows a simple example where this will happen.)

        find1New (T True (partition :: t [a]
    partition,_,_) []) = let h :: Permutation a
    h = [(a, a)] -> Permutation a
    forall a. Ord a => [(a, a)] -> Permutation a
    fromPairs ([(a, a)] -> Permutation a) -> [(a, a)] -> Permutation a
    forall a b. (a -> b) -> a -> b
    $ [a] -> [a] -> [(a, a)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [a]
    canonical (t [a] -> [a]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat t [a]
    partition)
                                               in (Permutation a -> Bool) -> [Permutation a] -> [Permutation a]
    forall a. (a -> Bool) -> [a] -> [a]
    filter Permutation a -> Bool
    isAut [Permutation a
    h]
        isAut :: Permutation a -> Bool
    isAut h :: Permutation a
    h = ([a] -> Bool) -> [[a]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all ([a] -> Set [a] -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `S.member` Set [a]
    es') [[a]
    e [a] -> Permutation a -> [a]
    forall b. Ord b => [b] -> Permutation b -> [b]
    -^ Permutation a
    h | [a]
    e <- [[a]]
    es]
        es' :: Set [a]
    es' = [[a]] -> Set [a]
    forall a. Ord a => [a] -> Set a
    S.fromList [[a]]
    es

    graphAuts7 :: Graph a -> ([a], [Permutation a])
    graphAuts7 g :: Graph a
    g = (Graph a -> SearchTree ([[a]], [a]) -> ([a], [Permutation a])
    forall a a.
    Ord a =>
    Graph a -> SearchTree ([[a]], [a]) -> ([a], [Permutation a])
    partitionBSGS Graph a
    g) (Graph a -> SearchTree ([[a]], [a])
    forall a. Ord a => Graph a -> SearchTree ([[a]], [a])
    equitablePartitionGraphSearchTree Graph a
    g)

    -- This is faster on kneser graphs, but slower on incidenceGraphPG

    graphAuts8 :: Graph a -> ([a], [Permutation a])
    graphAuts8 g :: Graph a
    g = (Graph a -> SearchTree ([[a]], [a]) -> ([a], [Permutation a])
    forall a a.
    Ord a =>
    Graph a -> SearchTree ([[a]], [a]) -> ([a], [Permutation a])
    partitionBSGS Graph a
    g) (Graph a -> [[a]] -> SearchTree ([[a]], [a])
    forall a. Ord a => Graph a -> [[a]] -> SearchTree ([[a]], [a])
    equitableDistancePartitionSearchTree Graph a
    g [Graph a -> [a]
    forall a. Graph a -> [a]
    vertices Graph a
    g])

    -- This is a graph where the node invariant should cause pruning.

    -- The initial equitable partition will be [[1..8],[9,10]], because it can do no better than distinguish by degree

    -- However, vertices 1..4 and vertices 5..8 are in fact different (there is no aut that takes one set to the other),

    -- so the subtrees starting 1..4 have a different invariant to those starting 5..8

    g1 :: Graph a
    g1 = [a] -> [[a]] -> Graph a
    forall a. [a] -> [[a]] -> Graph a
    G [1..10] [[1,2],[1,3],[1,9],[2,4],[2,10],[3,4],[3,9],[4,10],[5,6],[5,8],[5,9],[6,7],[6,10],[7,8],[7,9],[8,10]]

    g1' :: Graph a
    g1' = Graph a -> Graph a
    forall a. Ord a => Graph a -> Graph a
    nf (Graph a -> Graph a) -> Graph a -> Graph a
    forall a b. (a -> b) -> a -> b
    $ (a -> a) -> Graph a -> Graph a
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\x :: a
    x -> if a
    x a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    <= 4 then a
    xa -> a -> a
    forall a. Num a => a -> a -> a
    +4 else if a
    x a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    <= 8 then a
    xa -> a -> a
    forall a. Num a => a -> a -> a
    -4 else a
    x) Graph a
    forall a. (Num a, Enum a) => Graph a
    g1
    -- G [1..10] [[1,2],[1,4],[1,9],[2,3],[2,10],[3,4],[3,9],[4,10],[5,6],[5,7],[5,9],[6,8],[6,10],[7,8],[7,9],[8,10]]

    g2 :: Graph a
    g2 = [a] -> [[a]] -> Graph a
    forall a. [a] -> [[a]] -> Graph a
    G [1..12] [[1,2],[1,4],[1,11],[2,3],[2,12],[3,4],[3,11],[4,12],[5,6],[5,8],[5,11],[6,9],[6,12],[7,8],[7,10],[7,11],[8,12],[9,10],[9,11],[10,12]]

    -- NOT WORKING: This fails to find the isomorphism between g1 and g1' above.

    -- Instead of using left leaf, we need to find the canonical isomorph, as described in the paper.

    -- (In a graph where not all leaves lead to automorphisms, we might happen to end up with non-isomorphic left leaves)

    maybeGraphIso :: Graph k -> Graph a -> Maybe (Map k a)
    maybeGraphIso g1 :: Graph k
    g1 g2 :: Graph a
    g2 = let (vs1 :: [k]
    vs1,_) = (SearchTree ([[k]], [k]) -> ([k], [k])
    forall (t :: * -> *) a a.
    Foldable t =>
    SearchTree (t [a], [a]) -> ([a], [a])
    leftLeaf (SearchTree ([[k]], [k]) -> ([k], [k]))
    -> (Graph k -> SearchTree ([[k]], [k])) -> Graph k -> ([k], [k])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Graph k -> SearchTree ([[k]], [k])
    forall a. Ord a => Graph a -> SearchTree ([[a]], [a])
    equitablePartitionGraphSearchTree) Graph k
    g1
                              (vs2 :: [a]
    vs2,_) = (SearchTree ([[a]], [a]) -> ([a], [a])
    forall (t :: * -> *) a a.
    Foldable t =>
    SearchTree (t [a], [a]) -> ([a], [a])
    leftLeaf (SearchTree ([[a]], [a]) -> ([a], [a]))
    -> (Graph a -> SearchTree ([[a]], [a])) -> Graph a -> ([a], [a])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Graph a -> SearchTree ([[a]], [a])
    forall a. Ord a => Graph a -> SearchTree ([[a]], [a])
    equitablePartitionGraphSearchTree) Graph a
    g2
                              f :: Map k a
    f = [(k, a)] -> Map k a
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([k] -> [a] -> [(k, a)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [k]
    vs1 [a]
    vs2)
                          in if [k] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [k]
    vs1 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    vs2 Bool -> Bool -> Bool
    && (Graph a -> Graph a
    forall a. Ord a => Graph a -> Graph a
    nf (Graph a -> Graph a) -> (Graph k -> Graph a) -> Graph k -> Graph a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (k -> a) -> Graph k -> Graph a
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Map k a
    f Map k a -> k -> a
    forall k a. Ord k => Map k a -> k -> a
    M.!)) Graph k
    g1 Graph a -> Graph a -> Bool
    forall a. Eq a => a -> a -> Bool
    == Graph a
    g2 then Map k a -> Maybe (Map k a)
    forall a. a -> Maybe a
    Just Map k a
    f else Maybe (Map k a)
    forall a. Maybe a
    Nothing

    -- AUTS OF INCIDENCE STRUCTURE VIA INCIDENCE GRAPH

    -- This code is nearly identical to the corresponding graphAuts code, with two exceptions:

    -- 1. We start by partitioning into lefts and rights.

    -- This avoids left-right crossover auts, which while they are auts of the graph,

    -- are not auts of the incidence structure

    -- 2. When labelling the nodes, we filter out Right blocks, and unLeft the Left points

    incidenceAutsDistancePartitionSearchTree :: Graph (Either b b) -> SearchTree [(b, b)]
    incidenceAutsDistancePartitionSearchTree g :: Graph (Either b b)
    g@(G vs :: [Either b b]
    vs es :: [[Either b b]]
    es) = [(Either b b, Either b b)]
    -> ([[Either b b]], [[Either b b]]) -> SearchTree [(b, b)]
    dfs [] ([[Either b b]]
    lrPart, [[Either b b]]
    lrPart) where
        dfs :: [(Either b b, Either b b)]
    -> ([[Either b b]], [[Either b b]]) -> SearchTree [(b, b)]
    dfs xys :: [(Either b b, Either b b)]
    xys (srcPart :: [[Either b b]]
    srcPart,trgPart :: [[Either b b]]
    trgPart)
            | ([Either b b] -> Bool) -> [[Either b b]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all [Either b b] -> Bool
    forall a. [a] -> Bool
    isSingleton [[Either b b]]
    srcPart =
                 let xys' :: [(Either b b, Either b b)]
    xys' = [Either b b] -> [Either b b] -> [(Either b b, Either b b)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip ([[Either b b]] -> [Either b b]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[Either b b]]
    srcPart) ([[Either b b]] -> [Either b b]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[Either b b]]
    trgPart)
                 in Bool -> [(b, b)] -> [SearchTree [(b, b)]] -> SearchTree [(b, b)]
    forall a. Bool -> a -> [SearchTree a] -> SearchTree a
    T ([(Either b b, Either b b)] -> Bool
    isCompatible [(Either b b, Either b b)]
    xys') ([(Either b b, Either b b)] -> [(b, b)]
    forall a b b b. [(Either a b, Either b b)] -> [(a, b)]
    unLeft ([(Either b b, Either b b)] -> [(b, b)])
    -> [(Either b b, Either b b)] -> [(b, b)]
    forall a b. (a -> b) -> a -> b
    $ [(Either b b, Either b b)]
    xys[(Either b b, Either b b)]
    -> [(Either b b, Either b b)] -> [(Either b b, Either b b)]
    forall a. [a] -> [a] -> [a]
    ++[(Either b b, Either b b)]
    xys') []
                 -- Since the xys' are distance-compatible with the xys, they are certainly edge-compatible.

                 -- However, we do need to check that the xys' are edge-compatible with each other.

            | Bool
    otherwise = let (x :: Either b b
    x:xs :: [Either b b]
    xs):srcCells :: [[Either b b]]
    srcCells = [[Either b b]]
    srcPart
                              yys :: [Either b b]
    yys   :trgCells :: [[Either b b]]
    trgCells = [[Either b b]]
    trgPart
                              srcPart' :: [[Either b b]]
    srcPart' = [[Either b b]] -> [[Either b b]] -> [[Either b b]]
    forall a. Ord a => [[a]] -> [[a]] -> [[a]]
    intersectCells ([Either b b]
    xs [Either b b] -> [[Either b b]] -> [[Either b b]]
    forall a. a -> [a] -> [a]
    : [[Either b b]]
    srcCells) (Map (Either b b) [[Either b b]]
    dps Map (Either b b) [[Either b b]] -> Either b b -> [[Either b b]]
    forall k a. Ord k => Map k a -> k -> a
    M.! Either b b
    x)
                          in Bool -> [(b, b)] -> [SearchTree [(b, b)]] -> SearchTree [(b, b)]
    forall a. Bool -> a -> [SearchTree a] -> SearchTree a
    T Bool
    False ([(Either b b, Either b b)] -> [(b, b)]
    forall a b b b. [(Either a b, Either b b)] -> [(a, b)]
    unLeft [(Either b b, Either b b)]
    xys) -- the L.sort in the following line is so that we traverse vertices in natural order

                             [[(Either b b, Either b b)]
    -> ([[Either b b]], [[Either b b]]) -> SearchTree [(b, b)]
    dfs ((Either b b
    x,Either b b
    y)(Either b b, Either b b)
    -> [(Either b b, Either b b)] -> [(Either b b, Either b b)]
    forall a. a -> [a] -> [a]
    :[(Either b b, Either b b)]
    xys) (([([Either b b], [Either b b])] -> ([[Either b b]], [[Either b b]])
    forall a b. [(a, b)] -> ([a], [b])
    unzip ([([Either b b], [Either b b])]
     -> ([[Either b b]], [[Either b b]]))
    -> ([([Either b b], [Either b b])]
        -> [([Either b b], [Either b b])])
    -> [([Either b b], [Either b b])]
    -> ([[Either b b]], [[Either b b]])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [([Either b b], [Either b b])] -> [([Either b b], [Either b b])]
    forall a. Ord a => [a] -> [a]
    L.sort) ([[Either b b]] -> [[Either b b]] -> [([Either b b], [Either b b])]
    forall a b. [a] -> [b] -> [(a, b)]
    zip (([Either b b] -> Bool) -> [[Either b b]] -> [[Either b b]]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> ([Either b b] -> Bool) -> [Either b b] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Either b b] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null) [[Either b b]]
    srcPart') (([Either b b] -> Bool) -> [[Either b b]] -> [[Either b b]]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> ([Either b b] -> Bool) -> [Either b b] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Either b b] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null) [[Either b b]]
    trgPart')))
                             | (y :: Either b b
    y,ys :: [Either b b]
    ys) <- [Either b b] -> [(Either b b, [Either b b])]
    forall a. [a] -> [(a, [a])]
    picks [Either b b]
    yys,
                               let trgPart' :: [[Either b b]]
    trgPart' = [[Either b b]] -> [[Either b b]] -> [[Either b b]]
    forall a. Ord a => [[a]] -> [[a]] -> [[a]]
    intersectCells ([Either b b]
    ys [Either b b] -> [[Either b b]] -> [[Either b b]]
    forall a. a -> [a] -> [a]
    : [[Either b b]]
    trgCells) (Map (Either b b) [[Either b b]]
    dps Map (Either b b) [[Either b b]] -> Either b b -> [[Either b b]]
    forall k a. Ord k => Map k a -> k -> a
    M.! Either b b
    y),
                               ([Either b b] -> Int) -> [[Either b b]] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map [Either b b] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [[Either b b]]
    srcPart' [Int] -> [Int] -> Bool
    forall a. Eq a => a -> a -> Bool
    == ([Either b b] -> Int) -> [[Either b b]] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map [Either b b] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [[Either b b]]
    trgPart']
        isCompatible :: [(Either b b, Either b b)] -> Bool
    isCompatible xys :: [(Either b b, Either b b)]
    xys = [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    and [([Either b b
    x,Either b b
    x'] [Either b b] -> Set [Either b b] -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `S.member` Set [Either b b]
    es') Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == ([Either b b] -> [Either b b]
    forall a. Ord a => [a] -> [a]
    L.sort [Either b b
    y,Either b b
    y'] [Either b b] -> Set [Either b b] -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `S.member` Set [Either b b]
    es') | (x :: Either b b
    x,y :: Either b b
    y) <- [(Either b b, Either b b)]
    xys, (x' :: Either b b
    x',y' :: Either b b
    y') <- [(Either b b, Either b b)]
    xys, Either b b
    x Either b b -> Either b b -> Bool
    forall a. Ord a => a -> a -> Bool
    < Either b b
    x']
        (lefts :: [b]
    lefts, rights :: [b]
    rights) = [Either b b] -> ([b], [b])
    forall a b. [Either a b] -> ([a], [b])
    partitionEithers [Either b b]
    vs
        lrPart :: [[Either b b]]
    lrPart = [(b -> Either b b) -> [b] -> [Either b b]
    forall a b. (a -> b) -> [a] -> [b]
    map b -> Either b b
    forall a b. a -> Either a b
    Left [b]
    lefts, (b -> Either b b) -> [b] -> [Either b b]
    forall a b. (a -> b) -> [a] -> [b]
    map b -> Either b b
    forall a b. b -> Either a b
    Right [b]
    rights] -- Partition the vertices into left and right, to exclude crossover auts

        unLeft :: [(Either a b, Either b b)] -> [(a, b)]
    unLeft xys :: [(Either a b, Either b b)]
    xys = [(a
    x,b
    y) | (Left x :: a
    x, Left y :: b
    y) <- [(Either a b, Either b b)]
    xys] -- also filters out Rights

        es' :: Set [Either b b]
    es' = [[Either b b]] -> Set [Either b b]
    forall a. Ord a => [a] -> Set a
    S.fromList [[Either b b]]
    es
        dps :: Map (Either b b) [[Either b b]]
    dps = [(Either b b, [[Either b b]])] -> Map (Either b b) [[Either b b]]
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList [(Either b b
    v, [Either b b] -> Set [Either b b] -> Either b b -> [[Either b b]]
    forall a. Ord a => [a] -> Set [a] -> a -> [[a]]
    distancePartitionS [Either b b]
    vs Set [Either b b]
    es' Either b b
    v) | Either b b
    v <- [Either b b]
    vs]

    -- |Given the incidence graph of an incidence structure between points and blocks

    -- (for example, a set system),

    -- @incidenceAuts g@ returns a strong generating set for the automorphism group of the incidence structure.

    -- The generators are represented as permutations of the points.

    -- The incidence graph should be represented with the points on the left and the blocks on the right.

    incidenceAuts :: (Ord p, Ord b) => Graph (Either p b) -> [Permutation p]
    incidenceAuts :: Graph (Either p b) -> [Permutation p]
    incidenceAuts = (Permutation p -> Bool) -> [Permutation p] -> [Permutation p]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Permutation p -> Permutation p -> Bool
    forall a. Eq a => a -> a -> Bool
    /= [[p]] -> Permutation p
    forall a. Ord a => [[a]] -> Permutation a
    p []) ([Permutation p] -> [Permutation p])
    -> (Graph (Either p b) -> [Permutation p])
    -> Graph (Either p b)
    -> [Permutation p]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SearchTree [(p, p)] -> [Permutation p]
    forall a. Ord a => SearchTree [(a, a)] -> [Permutation a]
    strongTerminals (SearchTree [(p, p)] -> [Permutation p])
    -> (Graph (Either p b) -> SearchTree [(p, p)])
    -> Graph (Either p b)
    -> [Permutation p]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Graph (Either p b) -> SearchTree [(p, p)]
    forall b b.
    (Ord b, Ord b) =>
    Graph (Either b b) -> SearchTree [(b, b)]
    incidenceAutsDistancePartitionSearchTree

    -- TODO: Filter out rights, map unLeft - to bs and gs

    incidenceAuts2 :: Graph (Either a b) -> ([Either a b], [Permutation (Either a b)])
    incidenceAuts2 g :: Graph (Either a b)
    g = (Graph (Either a b)
    -> SearchTree ([[Either a b]], [Either a b])
    -> ([Either a b], [Permutation (Either a b)])
    forall a a.
    Ord a =>
    Graph a -> SearchTree ([[a]], [a]) -> ([a], [Permutation a])
    partitionBSGS Graph (Either a b)
    g) (Graph (Either a b) -> SearchTree ([[Either a b]], [Either a b])
    forall a b.
    (Ord a, Ord b) =>
    Graph (Either a b) -> SearchTree ([[Either a b]], [Either a b])
    equitablePartitionIncidenceSearchTree Graph (Either a b)
    g)
        where unLeft :: Either a b -> a
    unLeft (Left x :: a
    x) = a
    x
              -- map (\g -> fromPairs . map (\(Left x, Left y) -> (x,y)) . filter (\(x,y) -> isLeft x) . toPairs) gs

    -- GRAPH ISOMORPHISMS

    -- !! not yet using equitable partitions, so could probably be more efficient

    -- graphIsos :: (Ord a, Ord b) => Graph a -> Graph b -> [[(a,b)]]

    graphIsos :: Graph a -> Graph a -> [[(a, a)]]
    graphIsos g1 :: Graph a
    g1 g2 :: Graph a
    g2
        | [Graph a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Graph a]
    cs1 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= [Graph a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Graph a]
    cs2 = []
        | Bool
    otherwise = [Graph a] -> [Graph a] -> [[(a, a)]]
    forall a a. (Ord a, Ord a) => [Graph a] -> [Graph a] -> [[(a, a)]]
    graphIsos' [Graph a]
    cs1 [Graph a]
    cs2
        where cs1 :: [Graph a]
    cs1 = ([a] -> Graph a) -> [[a]] -> [Graph a]
    forall a b. (a -> b) -> [a] -> [b]
    map (Graph a -> [a] -> Graph a
    forall a. Eq a => Graph a -> [a] -> Graph a
    inducedSubgraph Graph a
    g1) (Graph a -> [[a]]
    forall a. Ord a => Graph a -> [[a]]
    components Graph a
    g1)
              cs2 :: [Graph a]
    cs2 = ([a] -> Graph a) -> [[a]] -> [Graph a]
    forall a b. (a -> b) -> [a] -> [b]
    map (Graph a -> [a] -> Graph a
    forall a. Eq a => Graph a -> [a] -> Graph a
    inducedSubgraph Graph a
    g2) (Graph a -> [[a]]
    forall a. Ord a => Graph a -> [[a]]
    components Graph a
    g2)
              graphIsos' :: [Graph a] -> [Graph a] -> [[(a, a)]]
    graphIsos' (ci :: Graph a
    ci:cis :: [Graph a]
    cis) cjs :: [Graph a]
    cjs =
                  [[(a, a)]
    iso [(a, a)] -> [(a, a)] -> [(a, a)]
    forall a. [a] -> [a] -> [a]
    ++ [(a, a)]
    iso' | (cj :: Graph a
    cj,cjs' :: [Graph a]
    cjs') <- [Graph a] -> [(Graph a, [Graph a])]
    forall a. [a] -> [(a, [a])]
    picks [Graph a]
    cjs,
                                 [(a, a)]
    iso <- Graph a -> Graph a -> [[(a, a)]]
    forall a a. (Ord a, Ord a) => Graph a -> Graph a -> [[(a, a)]]
    graphIsosCon Graph a
    ci Graph a
    cj,
                                 [(a, a)]
    iso' <- [Graph a] -> [Graph a] -> [[(a, a)]]
    graphIsos' [Graph a]
    cis [Graph a]
    cjs']
              graphIsos' [] [] = [[]]

    -- isos between connected graphs

    graphIsosCon :: Graph a -> Graph a -> [[(a, a)]]
    graphIsosCon g1 :: Graph a
    g1 g2 :: Graph a
    g2
        | Graph a -> Bool
    forall t. Ord t => Graph t -> Bool
    isConnected Graph a
    g1 Bool -> Bool -> Bool
    && Graph a -> Bool
    forall t. Ord t => Graph t -> Bool
    isConnected Graph a
    g2
            = [[[(a, a)]]] -> [[(a, a)]]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[(a, a)] -> [[a]] -> [[a]] -> [[(a, a)]]
    dfs [] (Graph a -> a -> [[a]]
    forall a. Ord a => Graph a -> a -> [[a]]
    distancePartition Graph a
    g1 a
    v1) (Graph a -> a -> [[a]]
    forall a. Ord a => Graph a -> a -> [[a]]
    distancePartition Graph a
    g2 a
    v2)
                     | a
    v1 <- Int -> [a] -> [a]
    forall a. Int -> [a] -> [a]
    take 1 (Graph a -> [a]
    forall a. Graph a -> [a]
    vertices Graph a
    g1), a
    v2 <- Graph a -> [a]
    forall a. Graph a -> [a]
    vertices Graph a
    g2]
                     -- the take 1 handles the case where g1 is the null graph

        | Bool
    otherwise = [Char] -> [[(a, a)]]
    forall a. HasCallStack => [Char] -> a
    error "graphIsosCon: either or both graphs are not connected"
        where dfs :: [(a, a)] -> [[a]] -> [[a]] -> [[(a, a)]]
    dfs xys :: [(a, a)]
    xys p1 :: [[a]]
    p1 p2 :: [[a]]
    p2
                  | ([a] -> Int) -> [[a]] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [[a]]
    p1 [Int] -> [Int] -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ([a] -> Int) -> [[a]] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [[a]]
    p2 = []
                  | Bool
    otherwise =
                      let p1' :: [[a]]
    p1' = ([a] -> Bool) -> [[a]] -> [[a]]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (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]]
    p1
                          p2' :: [[a]]
    p2' = ([a] -> Bool) -> [[a]] -> [[a]]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (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]]
    p2
                      in if ([a] -> Bool) -> [[a]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all [a] -> Bool
    forall a. [a] -> Bool
    isSingleton [[a]]
    p1'
                         then let xys' :: [(a, a)]
    xys' = [(a, a)]
    xys [(a, a)] -> [(a, a)] -> [(a, a)]
    forall a. [a] -> [a] -> [a]
    ++ [a] -> [a] -> [(a, a)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip ([[a]] -> [a]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[a]]
    p1') ([[a]] -> [a]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[a]]
    p2')
                              in if [(a, a)] -> Bool
    isCompatible [(a, a)]
    xys' then [[(a, a)]
    xys'] else []
                         else let (x :: a
    x:xs :: [a]
    xs):p1'' :: [[a]]
    p1'' = [[a]]
    p1'
                                  ys :: [a]
    ys:p2'' :: [[a]]
    p2'' = [[a]]
    p2'
                              in [[[(a, a)]]] -> [[(a, a)]]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[(a, a)] -> [[a]] -> [[a]] -> [[(a, a)]]
    dfs ((a
    x,a
    y)(a, a) -> [(a, a)] -> [(a, a)]
    forall a. a -> [a] -> [a]
    :[(a, a)]
    xys)
                                             ([[a]] -> [[a]] -> [[a]]
    forall a. Ord a => [[a]] -> [[a]] -> [[a]]
    intersectCells ([a]
    xs [a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    : [[a]]
    p1'') (Map a [[a]]
    dps1 Map a [[a]] -> a -> [[a]]
    forall k a. Ord k => Map k a -> k -> a
    M.! a
    x))
                                             ([[a]] -> [[a]] -> [[a]]
    forall a. Ord a => [[a]] -> [[a]] -> [[a]]
    intersectCells ([a]
    ys'[a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    : [[a]]
    p2'') (Map a [[a]]
    dps2 Map a [[a]] -> a -> [[a]]
    forall k a. Ord k => Map k a -> k -> a
    M.! a
    y))
                                             | (y :: a
    y,ys' :: [a]
    ys') <- [a] -> [(a, [a])]
    forall a. [a] -> [(a, [a])]
    picks [a]
    ys]
              isCompatible :: [(a, a)] -> Bool
    isCompatible xys :: [(a, a)]
    xys = [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    and [([a
    x,a
    x'] [a] -> Set [a] -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `S.member` Set [a]
    es1) Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == ([a] -> [a]
    forall a. Ord a => [a] -> [a]
    L.sort [a
    y,a
    y'] [a] -> Set [a] -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `S.member` Set [a]
    es2) | (x :: a
    x,y :: a
    y) <- [(a, a)]
    xys, (x' :: a
    x',y' :: a
    y') <- [(a, a)]
    xys, a
    x a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    < a
    x']
              dps1 :: Map a [[a]]
    dps1 = [(a, [[a]])] -> Map a [[a]]
    forall k a. Eq k => [(k, a)] -> Map k a
    M.fromAscList [(a
    v, [a] -> Set [a] -> a -> [[a]]
    forall a. Ord a => [a] -> Set [a] -> a -> [[a]]
    distancePartitionS [a]
    vs1 Set [a]
    es1 a
    v) | a
    v <- [a]
    vs1]
              dps2 :: Map a [[a]]
    dps2 = [(a, [[a]])] -> Map a [[a]]
    forall k a. Eq k => [(k, a)] -> Map k a
    M.fromAscList [(a
    v, [a] -> Set [a] -> a -> [[a]]
    forall a. Ord a => [a] -> Set [a] -> a -> [[a]]
    distancePartitionS [a]
    vs2 Set [a]
    es2 a
    v) | a
    v <- [a]
    vs2]
              -- dps1 = M.fromList [(v, distancePartition g1 v) | v <- vertices g1]

              -- dps2 = M.fromList [(v, distancePartition g2 v) | v <- vertices g2]

              vs1 :: [a]
    vs1 = Graph a -> [a]
    forall a. Graph a -> [a]
    vertices Graph a
    g1
              vs2 :: [a]
    vs2 = Graph a -> [a]
    forall a. Graph a -> [a]
    vertices Graph a
    g2
              es1 :: Set [a]
    es1 = [[a]] -> Set [a]
    forall a. Ord a => [a] -> Set a
    S.fromList ([[a]] -> Set [a]) -> [[a]] -> Set [a]
    forall a b. (a -> b) -> a -> b
    $ Graph a -> [[a]]
    forall a. Graph a -> [[a]]
    edges Graph a
    g1
              es2 :: Set [a]
    es2 = [[a]] -> Set [a]
    forall a. Ord a => [a] -> Set a
    S.fromList ([[a]] -> Set [a]) -> [[a]] -> Set [a]
    forall a b. (a -> b) -> a -> b
    $ Graph a -> [[a]]
    forall a. Graph a -> [[a]]
    edges Graph a
    g2

    -- |Are the two graphs isomorphic?

    isGraphIso :: (Ord a, Ord b) => Graph a -> Graph b -> Bool
    isGraphIso :: Graph a -> Graph b -> Bool
    isGraphIso g1 :: Graph a
    g1 g2 :: Graph b
    g2 = (Bool -> Bool
    not (Bool -> Bool) -> ([[(a, b)]] -> Bool) -> [[(a, b)]] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [[(a, b)]] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null) (Graph a -> Graph b -> [[(a, b)]]
    forall a a. (Ord a, Ord a) => Graph a -> Graph a -> [[(a, a)]]
    graphIsos Graph a
    g1 Graph b
    g2)
    -- !! If we're only interested in seeing whether or not two graphs are iso,

    -- !! then the cost of calculating distancePartitions may not be warranted

    -- !! (see Math.Combinatorics.Poset: orderIsos01 versus orderIsos)

    -- the following differs from graphIsos in only two ways

    -- we avoid Left, Right crossover isos, by insisting that a Left is taken to a Left (first two lines)

    -- we return only the action on the Lefts, and unLeft it

    -- incidenceIsos :: (Ord p1, Ord b1, Ord p2, Ord b2) =>

    --     Graph (Either p1 b1) -> Graph (Either p2 b2) -> [[(p1,p2)]]

    incidenceIsos :: Graph (Either a b) -> Graph (Either b b) -> [[(a, b)]]
    incidenceIsos g1 :: Graph (Either a b)
    g1 g2 :: Graph (Either b b)
    g2
        | [Graph (Either a b)] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Graph (Either a b)]
    cs1 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= [Graph (Either b b)] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Graph (Either b b)]
    cs2 = []
        | Bool
    otherwise = [Graph (Either a b)] -> [Graph (Either b b)] -> [[(a, b)]]
    forall a b b b.
    (Ord a, Ord b, Ord b, Ord b) =>
    [Graph (Either a b)] -> [Graph (Either b b)] -> [[(a, b)]]
    incidenceIsos' [Graph (Either a b)]
    cs1 [Graph (Either b b)]
    cs2
        where cs1 :: [Graph (Either a b)]
    cs1 = ([Either a b] -> Graph (Either a b))
    -> [[Either a b]] -> [Graph (Either a b)]
    forall a b. (a -> b) -> [a] -> [b]
    map (Graph (Either a b) -> [Either a b] -> Graph (Either a b)
    forall a. Eq a => Graph a -> [a] -> Graph a
    inducedSubgraph Graph (Either a b)
    g1) (([Either a b] -> Bool) -> [[Either a b]] -> [[Either a b]]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> ([Either a b] -> Bool) -> [Either a b] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ([a] -> Bool) -> ([Either a b] -> [a]) -> [Either a b] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Either a b] -> [a]
    forall a b. [Either a b] -> [a]
    lefts) ([[Either a b]] -> [[Either a b]])
    -> [[Either a b]] -> [[Either a b]]
    forall a b. (a -> b) -> a -> b
    $ Graph (Either a b) -> [[Either a b]]
    forall a. Ord a => Graph a -> [[a]]
    components Graph (Either a b)
    g1)
              cs2 :: [Graph (Either b b)]
    cs2 = ([Either b b] -> Graph (Either b b))
    -> [[Either b b]] -> [Graph (Either b b)]
    forall a b. (a -> b) -> [a] -> [b]
    map (Graph (Either b b) -> [Either b b] -> Graph (Either b b)
    forall a. Eq a => Graph a -> [a] -> Graph a
    inducedSubgraph Graph (Either b b)
    g2) (([Either b b] -> Bool) -> [[Either b b]] -> [[Either b b]]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> ([Either b b] -> Bool) -> [Either b b] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [b] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ([b] -> Bool) -> ([Either b b] -> [b]) -> [Either b b] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Either b b] -> [b]
    forall a b. [Either a b] -> [a]
    lefts) ([[Either b b]] -> [[Either b b]])
    -> [[Either b b]] -> [[Either b b]]
    forall a b. (a -> b) -> a -> b
    $ Graph (Either b b) -> [[Either b b]]
    forall a. Ord a => Graph a -> [[a]]
    components Graph (Either b b)
    g2)
              incidenceIsos' :: [Graph (Either a b)] -> [Graph (Either b b)] -> [[(a, b)]]
    incidenceIsos' (ci :: Graph (Either a b)
    ci:cis :: [Graph (Either a b)]
    cis) cjs :: [Graph (Either b b)]
    cjs =
                  [[(a, b)]
    iso [(a, b)] -> [(a, b)] -> [(a, b)]
    forall a. [a] -> [a] -> [a]
    ++ [(a, b)]
    iso' | (cj :: Graph (Either b b)
    cj,cjs' :: [Graph (Either b b)]
    cjs') <- [Graph (Either b b)]
    -> [(Graph (Either b b), [Graph (Either b b)])]
    forall a. [a] -> [(a, [a])]
    picks [Graph (Either b b)]
    cjs,
                                 [(a, b)]
    iso <- Graph (Either a b) -> Graph (Either b b) -> [[(a, b)]]
    forall a b b b.
    (Ord a, Ord b, Ord b, Ord b) =>
    Graph (Either a b) -> Graph (Either b b) -> [[(a, b)]]
    incidenceIsosCon Graph (Either a b)
    ci Graph (Either b b)
    cj,
                                 [(a, b)]
    iso' <- [Graph (Either a b)] -> [Graph (Either b b)] -> [[(a, b)]]
    incidenceIsos' [Graph (Either a b)]
    cis [Graph (Either b b)]
    cjs']
              incidenceIsos' [] [] = [[]]

    incidenceIsosCon :: Graph (Either a b) -> Graph (Either b b) -> [[(a, b)]]
    incidenceIsosCon g1 :: Graph (Either a b)
    g1 g2 :: Graph (Either b b)
    g2
        | Graph (Either a b) -> Bool
    forall t. Ord t => Graph t -> Bool
    isConnected Graph (Either a b)
    g1 Bool -> Bool -> Bool
    && Graph (Either b b) -> Bool
    forall t. Ord t => Graph t -> Bool
    isConnected Graph (Either b b)
    g2
            = [[[(a, b)]]] -> [[(a, b)]]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[(Either a b, Either b b)]
    -> [[Either a b]] -> [[Either b b]] -> [[(a, b)]]
    dfs [] (Graph (Either a b) -> Either a b -> [[Either a b]]
    forall a. Ord a => Graph a -> a -> [[a]]
    distancePartition Graph (Either a b)
    g1 Either a b
    v1) (Graph (Either b b) -> Either b b -> [[Either b b]]
    forall a. Ord a => Graph a -> a -> [[a]]
    distancePartition Graph (Either b b)
    g2 Either b b
    v2)
                     | v1 :: Either a b
    v1@(Left _) <- Int -> [Either a b] -> [Either a b]
    forall a. Int -> [a] -> [a]
    take 1 (Graph (Either a b) -> [Either a b]
    forall a. Graph a -> [a]
    vertices Graph (Either a b)
    g1), v2 :: Either b b
    v2@(Left _) <- Graph (Either b b) -> [Either b b]
    forall a. Graph a -> [a]
    vertices Graph (Either b b)
    g2]
                     -- g1 may have no vertices

        | Bool
    otherwise = [Char] -> [[(a, b)]]
    forall a. HasCallStack => [Char] -> a
    error "incidenceIsos: one or both graphs not connected"
        where dfs :: [(Either a b, Either b b)]
    -> [[Either a b]] -> [[Either b b]] -> [[(a, b)]]
    dfs xys :: [(Either a b, Either b b)]
    xys p1 :: [[Either a b]]
    p1 p2 :: [[Either b b]]
    p2
                  | ([Either a b] -> Int) -> [[Either a b]] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map [Either a b] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [[Either a b]]
    p1 [Int] -> [Int] -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ([Either b b] -> Int) -> [[Either b b]] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map [Either b b] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [[Either b b]]
    p2 = []
                  | Bool
    otherwise =
                      let p1' :: [[Either a b]]
    p1' = ([Either a b] -> Bool) -> [[Either a b]] -> [[Either a b]]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> ([Either a b] -> Bool) -> [Either a b] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Either a b] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null) [[Either a b]]
    p1
                          p2' :: [[Either b b]]
    p2' = ([Either b b] -> Bool) -> [[Either b b]] -> [[Either b b]]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> ([Either b b] -> Bool) -> [Either b b] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Either b b] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null) [[Either b b]]
    p2
                      in if ([Either a b] -> Bool) -> [[Either a b]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all [Either a b] -> Bool
    forall a. [a] -> Bool
    isSingleton [[Either a b]]
    p1'
                         then let xys' :: [(Either a b, Either b b)]
    xys' = [(Either a b, Either b b)]
    xys [(Either a b, Either b b)]
    -> [(Either a b, Either b b)] -> [(Either a b, Either b b)]
    forall a. [a] -> [a] -> [a]
    ++ [Either a b] -> [Either b b] -> [(Either a b, Either b b)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip ([[Either a b]] -> [Either a b]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[Either a b]]
    p1') ([[Either b b]] -> [Either b b]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[Either b b]]
    p2')
                              in if [(Either a b, Either b b)] -> Bool
    isCompatible [(Either a b, Either b b)]
    xys' then [[(a
    x,b
    y) | (Left x, Left y) <- [(Either a b, Either b b)]
    xys']] else []
                         else let (x :: Either a b
    x:xs :: [Either a b]
    xs):p1'' :: [[Either a b]]
    p1'' = [[Either a b]]
    p1'
                                  ys :: [Either b b]
    ys:p2'' :: [[Either b b]]
    p2'' = [[Either b b]]
    p2'
                              in [[[(a, b)]]] -> [[(a, b)]]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[(Either a b, Either b b)]
    -> [[Either a b]] -> [[Either b b]] -> [[(a, b)]]
    dfs ((Either a b
    x,Either b b
    y)(Either a b, Either b b)
    -> [(Either a b, Either b b)] -> [(Either a b, Either b b)]
    forall a. a -> [a] -> [a]
    :[(Either a b, Either b b)]
    xys)
                                             ([[Either a b]] -> [[Either a b]] -> [[Either a b]]
    forall a. Ord a => [[a]] -> [[a]] -> [[a]]
    intersectCells ([Either a b]
    xs [Either a b] -> [[Either a b]] -> [[Either a b]]
    forall a. a -> [a] -> [a]
    : [[Either a b]]
    p1'') (Map (Either a b) [[Either a b]]
    dps1 Map (Either a b) [[Either a b]] -> Either a b -> [[Either a b]]
    forall k a. Ord k => Map k a -> k -> a
    M.! Either a b
    x))
                                             ([[Either b b]] -> [[Either b b]] -> [[Either b b]]
    forall a. Ord a => [[a]] -> [[a]] -> [[a]]
    intersectCells ([Either b b]
    ys'[Either b b] -> [[Either b b]] -> [[Either b b]]
    forall a. a -> [a] -> [a]
    : [[Either b b]]
    p2'') (Map (Either b b) [[Either b b]]
    dps2 Map (Either b b) [[Either b b]] -> Either b b -> [[Either b b]]
    forall k a. Ord k => Map k a -> k -> a
    M.! Either b b
    y))
                                             | (y :: Either b b
    y,ys' :: [Either b b]
    ys') <- [Either b b] -> [(Either b b, [Either b b])]
    forall a. [a] -> [(a, [a])]
    picks [Either b b]
    ys]
              isCompatible :: [(Either a b, Either b b)] -> Bool
    isCompatible xys :: [(Either a b, Either b b)]
    xys = [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    and [([Either a b
    x,Either a b
    x'] [Either a b] -> Set [Either a b] -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `S.member` Set [Either a b]
    es1) Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == ([Either b b] -> [Either b b]
    forall a. Ord a => [a] -> [a]
    L.sort [Either b b
    y,Either b b
    y'] [Either b b] -> Set [Either b b] -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `S.member` Set [Either b b]
    es2) | (x :: Either a b
    x,y :: Either b b
    y) <- [(Either a b, Either b b)]
    xys, (x' :: Either a b
    x',y' :: Either b b
    y') <- [(Either a b, Either b b)]
    xys, Either a b
    x Either a b -> Either a b -> Bool
    forall a. Ord a => a -> a -> Bool
    < Either a b
    x']
              dps1 :: Map (Either a b) [[Either a b]]
    dps1 = [(Either a b, [[Either a b]])] -> Map (Either a b) [[Either a b]]
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList [(Either a b
    v, Graph (Either a b) -> Either a b -> [[Either a b]]
    forall a. Ord a => Graph a -> a -> [[a]]
    distancePartition Graph (Either a b)
    g1 Either a b
    v) | Either a b
    v <- Graph (Either a b) -> [Either a b]
    forall a. Graph a -> [a]
    vertices Graph (Either a b)
    g1]
              dps2 :: Map (Either b b) [[Either b b]]
    dps2 = [(Either b b, [[Either b b]])] -> Map (Either b b) [[Either b b]]
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList [(Either b b
    v, Graph (Either b b) -> Either b b -> [[Either b b]]
    forall a. Ord a => Graph a -> a -> [[a]]
    distancePartition Graph (Either b b)
    g2 Either b b
    v) | Either b b
    v <- Graph (Either b b) -> [Either b b]
    forall a. Graph a -> [a]
    vertices Graph (Either b b)
    g2]
              es1 :: Set [Either a b]
    es1 = [[Either a b]] -> Set [Either a b]
    forall a. Ord a => [a] -> Set a
    S.fromList ([[Either a b]] -> Set [Either a b])
    -> [[Either a b]] -> Set [Either a b]
    forall a b. (a -> b) -> a -> b
    $ Graph (Either a b) -> [[Either a b]]
    forall a. Graph a -> [[a]]
    edges Graph (Either a b)
    g1
              es2 :: Set [Either b b]
    es2 = [[Either b b]] -> Set [Either b b]
    forall a. Ord a => [a] -> Set a
    S.fromList ([[Either b b]] -> Set [Either b b])
    -> [[Either b b]] -> Set [Either b b]
    forall a b. (a -> b) -> a -> b
    $ Graph (Either b b) -> [[Either b b]]
    forall a. Graph a -> [[a]]
    edges Graph (Either b b)
    g2

    -- |Are the two incidence structures represented by these incidence graphs isomorphic?

    isIncidenceIso :: (Ord p1, Ord b1, Ord p2, Ord b2) =>
         Graph (Either p1 b1) -> Graph (Either p2 b2) -> Bool
    isIncidenceIso :: Graph (Either p1 b1) -> Graph (Either p2 b2) -> Bool
    isIncidenceIso g1 :: Graph (Either p1 b1)
    g1 g2 :: Graph (Either p2 b2)
    g2 = (Bool -> Bool
    not (Bool -> Bool) -> ([[(p1, p2)]] -> Bool) -> [[(p1, p2)]] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [[(p1, p2)]] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null) (Graph (Either p1 b1) -> Graph (Either p2 b2) -> [[(p1, p2)]]
    forall a b b b.
    (Ord b, Ord b, Ord a, Ord b) =>
    Graph (Either a b) -> Graph (Either b b) -> [[(a, b)]]
    incidenceIsos Graph (Either p1 b1)
    g1 Graph (Either p2 b2)
    g2)