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

    {-# LANGUAGE NoMonomorphismRestriction #-}

    -- |A module for working with directed graphs (digraphs).
    -- Some of the functions are specifically for working with directed acyclic graphs (DAGs),
    -- that is, directed graphs containing no cycles.
    module Math.Combinatorics.Digraph where

    import Data.List as L
    import qualified Data.Map.Strict as M
    import qualified Data.Set as S

    import Math.Core.Utils (picks, toSet)

    -- |A digraph is represented as DG vs es, where vs is the list of vertices, and es is the list of edges.
    -- Edges are directed: an edge (u,v) means an edge from u to v.
    -- A digraph is considered to be in normal form if both es and vs are in ascending order.
    -- This is the preferred form, and some functions will only work for digraphs in normal form.
    data Digraph v = DG [v] [(v,v)] deriving (Digraph v -> Digraph v -> Bool
    (Digraph v -> Digraph v -> Bool)
    -> (Digraph v -> Digraph v -> Bool) -> Eq (Digraph v)
    forall v. Eq v => Digraph v -> Digraph v -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: Digraph v -> Digraph v -> Bool
    $c/= :: forall v. Eq v => Digraph v -> Digraph v -> Bool
    == :: Digraph v -> Digraph v -> Bool
    $c== :: forall v. Eq v => Digraph v -> Digraph v -> Bool
    Eq,Eq (Digraph v)
    Eq (Digraph v) =>
    (Digraph v -> Digraph v -> Ordering)
    -> (Digraph v -> Digraph v -> Bool)
    -> (Digraph v -> Digraph v -> Bool)
    -> (Digraph v -> Digraph v -> Bool)
    -> (Digraph v -> Digraph v -> Bool)
    -> (Digraph v -> Digraph v -> Digraph v)
    -> (Digraph v -> Digraph v -> Digraph v)
    -> Ord (Digraph v)
    Digraph v -> Digraph v -> Bool
    Digraph v -> Digraph v -> Ordering
    Digraph v -> Digraph v -> Digraph v
    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 v. Ord v => Eq (Digraph v)
    forall v. Ord v => Digraph v -> Digraph v -> Bool
    forall v. Ord v => Digraph v -> Digraph v -> Ordering
    forall v. Ord v => Digraph v -> Digraph v -> Digraph v
    min :: Digraph v -> Digraph v -> Digraph v
    $cmin :: forall v. Ord v => Digraph v -> Digraph v -> Digraph v
    max :: Digraph v -> Digraph v -> Digraph v
    $cmax :: forall v. Ord v => Digraph v -> Digraph v -> Digraph v
    >= :: Digraph v -> Digraph v -> Bool
    $c>= :: forall v. Ord v => Digraph v -> Digraph v -> Bool
    > :: Digraph v -> Digraph v -> Bool
    $c> :: forall v. Ord v => Digraph v -> Digraph v -> Bool
    <= :: Digraph v -> Digraph v -> Bool
    $c<= :: forall v. Ord v => Digraph v -> Digraph v -> Bool
    < :: Digraph v -> Digraph v -> Bool
    $c< :: forall v. Ord v => Digraph v -> Digraph v -> Bool
    compare :: Digraph v -> Digraph v -> Ordering
    $ccompare :: forall v. Ord v => Digraph v -> Digraph v -> Ordering
    $cp1Ord :: forall v. Ord v => Eq (Digraph v)
    Ord,Int -> Digraph v -> ShowS
    [Digraph v] -> ShowS
    Digraph v -> String
    (Int -> Digraph v -> ShowS)
    -> (Digraph v -> String)
    -> ([Digraph v] -> ShowS)
    -> Show (Digraph v)
    forall v. Show v => Int -> Digraph v -> ShowS
    forall v. Show v => [Digraph v] -> ShowS
    forall v. Show v => Digraph v -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [Digraph v] -> ShowS
    $cshowList :: forall v. Show v => [Digraph v] -> ShowS
    show :: Digraph v -> String
    $cshow :: forall v. Show v => Digraph v -> String
    showsPrec :: Int -> Digraph v -> ShowS
    $cshowsPrec :: forall v. Show v => Int -> Digraph v -> ShowS
    Show)

    instance Functor Digraph where
        -- |If f is not order-preserving, then you should call nf afterwards
        fmap :: (a -> b) -> Digraph a -> Digraph b
    fmap f :: a -> b
    f (DG vs :: [a]
    vs es :: [(a, a)]
    es) = [b] -> [(b, b)] -> Digraph b
    forall v. [v] -> [(v, v)] -> Digraph v
    DG ((a -> b) -> [a] -> [b]
    forall a b. (a -> b) -> [a] -> [b]
    map a -> b
    f [a]
    vs) (((a, a) -> (b, b)) -> [(a, a)] -> [(b, b)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(u :: a
    u,v :: a
    v)->(a -> b
    f a
    u, a -> b
    f a
    v)) [(a, a)]
    es)

    nf :: Digraph v -> Digraph v
    nf (DG vs :: [v]
    vs es :: [(v, v)]
    es) = [v] -> [(v, v)] -> Digraph v
    forall v. [v] -> [(v, v)] -> Digraph v
    DG ([v] -> [v]
    forall a. Ord a => [a] -> [a]
    L.sort [v]
    vs) ([(v, v)] -> [(v, v)]
    forall a. Ord a => [a] -> [a]
    L.sort [(v, v)]
    es)

    vertices :: Digraph v -> [v]
    vertices (DG vs :: [v]
    vs _) = [v]
    vs

    edges :: Digraph v -> [(v, v)]
    edges (DG _ es :: [(v, v)]
    es) = [(v, v)]
    es

    -- Is it valid to call them predecessors / successors in the case when the digraph contains cycles?

    predecessors :: Digraph a -> a -> [a]
    predecessors (DG _ es :: [(a, a)]
    es) v :: a
    v = [a
    u | (u :: a
    u,v' :: a
    v') <- [(a, a)]
    es, a
    v' a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    v]

    successors :: Digraph a -> a -> [a]
    successors (DG _ es :: [(a, a)]
    es) u :: a
    u = [a
    v | (u' :: a
    u',v :: a
    v) <- [(a, a)]
    es, a
    u' a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    u]

    -- Calculate maps of predecessor and successor lists for each vertex in a digraph.
    -- If a vertex has no predecessors (respectively successors), then it is left out of the relevant map
    adjLists :: Digraph a -> (Map a [a], Map a [a])
    adjLists (DG vs :: [a]
    vs es :: [(a, a)]
    es) = (Map a [a], Map a [a]) -> [(a, a)] -> (Map a [a], Map a [a])
    forall a k.
    (Ord a, Ord k) =>
    (Map a [k], Map k [a]) -> [(k, a)] -> (Map a [k], Map k [a])
    adjLists' (Map a [a]
    forall k a. Map k a
    M.empty, Map a [a]
    forall k a. Map k a
    M.empty) [(a, a)]
    es
        where adjLists' :: (Map a [k], Map k [a]) -> [(k, a)] -> (Map a [k], Map k [a])
    adjLists' (preds :: Map a [k]
    preds,succs :: Map k [a]
    succs) ((u :: k
    u,v :: a
    v):es :: [(k, a)]
    es) =
                  (Map a [k], Map k [a]) -> [(k, a)] -> (Map a [k], Map k [a])
    adjLists' (([k] -> [k] -> [k]) -> a -> [k] -> Map a [k] -> Map a [k]
    forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
    M.insertWith (([k] -> [k] -> [k]) -> [k] -> [k] -> [k]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip [k] -> [k] -> [k]
    forall a. [a] -> [a] -> [a]
    (++)) a
    v [k
    u] Map a [k]
    preds, ([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]) -> [a] -> [a] -> [a]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    (++)) k
    u [a
    v] Map k [a]
    succs) [(k, a)]
    es
              adjLists' (preds :: Map a [k]
    preds,succs :: Map k [a]
    succs) [] = (Map a [k]
    preds, Map k [a]
    succs)

    digraphIsos1 :: Digraph a -> Digraph a -> [[(a, a)]]
    digraphIsos1 (DG vsa :: [a]
    vsa esa :: [(a, a)]
    esa) (DG vsb :: [a]
    vsb esb :: [(a, a)]
    esb)
        | [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    vsa Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    vsb = []
        | [(a, a)] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [(a, a)]
    esa Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= [(a, a)] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [(a, a)]
    esb = []
        | Bool
    otherwise = [(a, a)] -> [a] -> [a] -> [[(a, a)]]
    digraphIsos' [] [a]
    vsa [a]
    vsb
        where digraphIsos' :: [(a, a)] -> [a] -> [a] -> [[(a, a)]]
    digraphIsos' xys :: [(a, a)]
    xys [] [] = [[(a, a)]
    xys]
              digraphIsos' xys :: [(a, a)]
    xys (x :: a
    x:xs :: [a]
    xs) ys :: [a]
    ys =
                  [[[(a, a)]]] -> [[(a, a)]]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [ [(a, a)] -> [a] -> [a] -> [[(a, a)]]
    digraphIsos' ((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]
    ys, (a, a) -> [(a, a)] -> Bool
    isCompatible (a
    x,a
    y) [(a, a)]
    xys]
              isCompatible :: (a, a) -> [(a, a)] -> Bool
    isCompatible (x :: a
    x,y :: a
    y) xys :: [(a, a)]
    xys = [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    and [ ((a
    x,a
    x') (a, a) -> [(a, a)] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [(a, a)]
    esa) Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == ((a
    y,a
    y') (a, a) -> [(a, a)] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [(a, a)]
    esb)
                                          Bool -> Bool -> Bool
    && ((a
    x',a
    x) (a, a) -> [(a, a)] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [(a, a)]
    esa) Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == ((a
    y',a
    y) (a, a) -> [(a, a)] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [(a, a)]
    esb)
                                           | (x' :: a
    x',y' :: a
    y') <- [(a, a)]
    xys ]

    digraphIsos2 :: Digraph k -> Digraph k -> [[(k, k)]]
    digraphIsos2 a :: Digraph k
    a b :: Digraph k
    b
        | [k] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (Digraph k -> [k]
    forall v. Digraph v -> [v]
    vertices Digraph k
    a) Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= [k] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (Digraph k -> [k]
    forall v. Digraph v -> [v]
    vertices Digraph k
    b) = []
        | [Int] -> [Int]
    forall a. Ord a => [a] -> [a]
    L.sort (Map k Int -> [Int]
    forall k a. Map k a -> [a]
    M.elems Map k Int
    indega) [Int] -> [Int] -> Bool
    forall a. Eq a => a -> a -> Bool
    /= [Int] -> [Int]
    forall a. Ord a => [a] -> [a]
    L.sort (Map k Int -> [Int]
    forall k a. Map k a -> [a]
    M.elems Map k Int
    indegb) = []
        | [Int] -> [Int]
    forall a. Ord a => [a] -> [a]
    L.sort (Map k Int -> [Int]
    forall k a. Map k a -> [a]
    M.elems Map k Int
    outdega) [Int] -> [Int] -> Bool
    forall a. Eq a => a -> a -> Bool
    /= [Int] -> [Int]
    forall a. Ord a => [a] -> [a]
    L.sort (Map k Int -> [Int]
    forall k a. Map k a -> [a]
    M.elems Map k Int
    outdegb) = []
        | Bool
    otherwise = [(k, k)] -> [k] -> [k] -> [[(k, k)]]
    dfs [] (Digraph k -> [k]
    forall v. Digraph v -> [v]
    vertices Digraph k
    a) (Digraph k -> [k]
    forall v. Digraph v -> [v]
    vertices Digraph k
    b)
        where (preda :: Map k [k]
    preda,succa :: Map k [k]
    succa) = Digraph k -> (Map k [k], Map k [k])
    forall a. Ord a => Digraph a -> (Map a [a], Map a [a])
    adjLists Digraph k
    a
              (predb :: Map k [k]
    predb,succb :: Map k [k]
    succb) = Digraph k -> (Map k [k], Map k [k])
    forall a. Ord a => Digraph a -> (Map a [a], Map a [a])
    adjLists Digraph k
    b
              indega :: Map k Int
    indega = ([k] -> Int) -> Map k [k] -> Map k Int
    forall a b k. (a -> b) -> Map k a -> Map k b
    M.map [k] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Map k [k]
    preda
              indegb :: Map k Int
    indegb = ([k] -> Int) -> Map k [k] -> Map k Int
    forall a b k. (a -> b) -> Map k a -> Map k b
    M.map [k] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Map k [k]
    predb
              outdega :: Map k Int
    outdega = ([k] -> Int) -> Map k [k] -> Map k Int
    forall a b k. (a -> b) -> Map k a -> Map k b
    M.map [k] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Map k [k]
    succa
              outdegb :: Map k Int
    outdegb = ([k] -> Int) -> Map k [k] -> Map k Int
    forall a b k. (a -> b) -> Map k a -> Map k b
    M.map [k] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Map k [k]
    succb
              isCompatible :: (k, k) -> [(k, k)] -> Bool
    isCompatible (x :: k
    x,y :: k
    y) xys :: [(k, k)]
    xys = (Int -> k -> Map k Int -> Int
    forall k a. Ord k => a -> k -> Map k a -> a
    M.findWithDefault 0 k
    x Map k Int
    indega) Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == (Int -> k -> Map k Int -> Int
    forall k a. Ord k => a -> k -> Map k a -> a
    M.findWithDefault 0 k
    y Map k Int
    indegb)
                                    Bool -> Bool -> Bool
    && (Int -> k -> Map k Int -> Int
    forall k a. Ord k => a -> k -> Map k a -> a
    M.findWithDefault 0 k
    x Map k Int
    outdega) Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == (Int -> k -> Map k Int -> Int
    forall k a. Ord k => a -> k -> Map k a -> a
    M.findWithDefault 0 k
    y Map k Int
    outdegb)
                                    Bool -> Bool -> Bool
    && [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    and [ (k
    x' k -> [k] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [k]
    predx) Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == (k
    y' k -> [k] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [k]
    predy)
                                          Bool -> Bool -> Bool
    && (k
    x' k -> [k] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [k]
    succx) Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == (k
    y' k -> [k] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [k]
    succy)
                                           | let predx :: [k]
    predx = [k] -> k -> Map k [k] -> [k]
    forall k a. Ord k => a -> k -> Map k a -> a
    M.findWithDefault [] k
    x Map k [k]
    preda, let predy :: [k]
    predy = [k] -> k -> Map k [k] -> [k]
    forall k a. Ord k => a -> k -> Map k a -> a
    M.findWithDefault [] k
    y Map k [k]
    predb,
                                             let succx :: [k]
    succx = [k] -> k -> Map k [k] -> [k]
    forall k a. Ord k => a -> k -> Map k a -> a
    M.findWithDefault [] k
    x Map k [k]
    succa, let succy :: [k]
    succy = [k] -> k -> Map k [k] -> [k]
    forall k a. Ord k => a -> k -> Map k a -> a
    M.findWithDefault [] k
    y Map k [k]
    succb,
                                             (x' :: k
    x',y' :: k
    y') <- [(k, k)]
    xys]
              dfs :: [(k, k)] -> [k] -> [k] -> [[(k, k)]]
    dfs xys :: [(k, k)]
    xys [] [] = [[(k, k)]
    xys]
              dfs xys :: [(k, k)]
    xys (x :: k
    x:xs :: [k]
    xs) ys :: [k]
    ys =
                  [[[(k, k)]]] -> [[(k, k)]]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [ [(k, k)] -> [k] -> [k] -> [[(k, k)]]
    dfs ((k
    x,k
    y)(k, k) -> [(k, k)] -> [(k, k)]
    forall a. a -> [a] -> [a]
    :[(k, k)]
    xys) [k]
    xs [k]
    ys'
                         | (y :: k
    y,ys' :: [k]
    ys') <- [k] -> [(k, [k])]
    forall a. [a] -> [(a, [a])]
    picks [k]
    ys, (k, k) -> [(k, k)] -> Bool
    isCompatible (k
    x,k
    y) [(k, k)]
    xys]

    -- For DAGs, can almost certainly do better than the above by using the height partition
    -- However see remarks in Poset on orderIsos:
    -- What is most efficient will depend on whether you want to list all of them, or just find out whether there are any or not
    -- Could also try refining the height partition by (indegree,outdegree)

    -- doesn't check whether input is a dag
    -- if not, then the output will not contain all the vs
    heightPartitionDAG :: Digraph k -> [[k]]
    heightPartitionDAG dag :: Digraph k
    dag@(DG vs :: [k]
    vs es :: [(k, k)]
    es) = Set k -> [k] -> [[k]]
    heightPartition' Set k
    forall a. Set a
    S.empty [k
    v | k
    v <- [k]
    vs, k
    v k -> Map k [k] -> Bool
    forall k a. Ord k => k -> Map k a -> Bool
    `M.notMember` Map k [k]
    preds] -- ie vertices with no predecessors
        where (preds :: Map k [k]
    preds,succs :: Map k [k]
    succs) = Digraph k -> (Map k [k], Map k [k])
    forall a. Ord a => Digraph a -> (Map a [a], Map a [a])
    adjLists Digraph k
    dag
              heightPartition' :: Set k -> [k] -> [[k]]
    heightPartition' interior :: Set k
    interior boundary :: [k]
    boundary
                  | [k] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [k]
    boundary = []
                  | Bool
    otherwise = let interior' :: Set k
    interior' = Set k -> Set k -> Set k
    forall a. Ord a => Set a -> Set a -> Set a
    S.union Set k
    interior (Set k -> Set k) -> Set k -> Set k
    forall a b. (a -> b) -> a -> b
    $ [k] -> Set k
    forall a. Ord a => [a] -> Set a
    S.fromList [k]
    boundary
                                    boundary' :: [k]
    boundary' = [k] -> [k]
    forall a. Ord a => [a] -> [a]
    toSet [k
    v | k
    u <- [k]
    boundary, k
    v <- [k] -> k -> Map k [k] -> [k]
    forall k a. Ord k => a -> k -> Map k a -> a
    M.findWithDefault [] k
    u Map k [k]
    succs,
                                                           (k -> Bool) -> [k] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (k -> Set k -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `S.member` Set k
    interior') (Map k [k]
    preds Map k [k] -> k -> [k]
    forall k a. Ord k => Map k a -> k -> a
    M.! k
    v) ]
                                in [k]
    boundary [k] -> [[k]] -> [[k]]
    forall a. a -> [a] -> [a]
    : Set k -> [k] -> [[k]]
    heightPartition' Set k
    interior' [k]
    boundary'

    isDAG :: Digraph a -> Bool
    isDAG dag :: Digraph a
    dag@(DG vs :: [a]
    vs _) = [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    vs Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([[a]] -> [a]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat (Digraph a -> [[a]]
    forall k. Ord k => Digraph k -> [[k]]
    heightPartitionDAG Digraph a
    dag))

    -- Only valid for DAGs, not for digraphs in general
    dagIsos :: Digraph a -> Digraph a -> [[(a, a)]]
    dagIsos dagA :: Digraph a
    dagA@(DG vsA :: [a]
    vsA esA :: [(a, a)]
    esA) dagB :: Digraph a
    dagB@(DG vsB :: [a]
    vsB esB :: [(a, a)]
    esB)
        | [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    vsA Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([[a]] -> [a]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[a]]
    heightPartA) = String -> [[(a, a)]]
    forall a. HasCallStack => String -> a
    error "dagIsos: dagA is not a DAG"
        | [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    vsB Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([[a]] -> [a]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[a]]
    heightPartB) = String -> [[(a, a)]]
    forall a. HasCallStack => String -> a
    error "dagIsos: dagB is not a DAG"
        | ([a] -> Int) -> [[a]] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [[a]]
    heightPartA [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]]
    heightPartB = []
        | Bool
    otherwise = [(a, a)] -> [[a]] -> [[a]] -> [[(a, a)]]
    dfs [] [[a]]
    heightPartA [[a]]
    heightPartB
        where heightPartA :: [[a]]
    heightPartA = Digraph a -> [[a]]
    forall k. Ord k => Digraph k -> [[k]]
    heightPartitionDAG Digraph a
    dagA
              heightPartB :: [[a]]
    heightPartB = Digraph a -> [[a]]
    forall k. Ord k => Digraph k -> [[k]]
    heightPartitionDAG Digraph a
    dagB
              (predsA :: Map a [a]
    predsA,_) = Digraph a -> (Map a [a], Map a [a])
    forall a. Ord a => Digraph a -> (Map a [a], Map a [a])
    adjLists Digraph a
    dagA
              (predsB :: Map a [a]
    predsB,_) = Digraph a -> (Map a [a], Map a [a])
    forall a. Ord a => Digraph a -> (Map a [a], Map a [a])
    adjLists Digraph a
    dagB
              dfs :: [(a, a)] -> [[a]] -> [[a]] -> [[(a, a)]]
    dfs xys :: [(a, a)]
    xys [] [] = [[(a, a)]
    xys]
              dfs xys :: [(a, a)]
    xys ([]:las :: [[a]]
    las) ([]:lbs :: [[a]]
    lbs) = [(a, a)] -> [[a]] -> [[a]] -> [[(a, a)]]
    dfs [(a, a)]
    xys [[a]]
    las [[a]]
    lbs
              dfs xys :: [(a, a)]
    xys ((x :: a
    x:xs :: [a]
    xs):las :: [[a]]
    las) (ys :: [a]
    ys:lbs :: [[a]]
    lbs) =
                  [[[(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]
    xs[a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    :[[a]]
    las) ([a]
    ys' [a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    : [[a]]
    lbs)
                         | (y :: a
    y,ys' :: [a]
    ys') <- [a] -> [(a, [a])]
    forall a. [a] -> [(a, [a])]
    picks [a]
    ys, (a, a) -> [(a, a)] -> Bool
    isCompatible (a
    x,a
    y) [(a, a)]
    xys]
              isCompatible :: (a, a) -> [(a, a)] -> Bool
    isCompatible (x :: a
    x,y :: a
    y) xys :: [(a, a)]
    xys =
                  let preds_x :: [a]
    preds_x = [a] -> a -> Map a [a] -> [a]
    forall k a. Ord k => a -> k -> Map k a -> a
    M.findWithDefault [] a
    x Map a [a]
    predsA
                      preds_y :: [a]
    preds_y = [a] -> a -> Map a [a] -> [a]
    forall k a. Ord k => a -> k -> Map k a -> a
    M.findWithDefault [] a
    y Map a [a]
    predsB
                  in [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    and [ (a
    x' a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [a]
    preds_x) Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == (a
    y' a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [a]
    preds_y) | (x' :: a
    x',y' :: a
    y') <- [(a, a)]
    xys]
                  -- and [ ((x',x) `elem` esA) == ((y',y) `elem` esB)
                  --     | (x',y') <- xys ]
              -- we only need to check predecessors, not successors, because we proceeding by height ordering

    -- can probably do better by intersecting the height partition with the (indegree,outdegree) partition
    -- (although on very symmetrical posets such as B n, this won't help at all)

    -- |Are the two DAGs isomorphic?
    isDagIso :: (Ord a, Ord b) => Digraph a -> Digraph b -> Bool
    isDagIso :: Digraph a -> Digraph b -> Bool
    isDagIso dagA :: Digraph a
    dagA dagB :: Digraph b
    dagB = (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) (Digraph a -> Digraph b -> [[(a, b)]]
    forall a a. (Ord a, Ord a) => Digraph a -> Digraph a -> [[(a, a)]]
    dagIsos Digraph a
    dagA Digraph b
    dagB)

    perms :: [a] -> [[a]]
    perms [] = [[]]
    perms (x :: a
    x:xs :: [a]
    xs) = [[a]
    ls [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    ++ [a
    x] [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    ++ [a]
    rs | [a]
    ps <- [a] -> [[a]]
    perms [a]
    xs, (ls :: [a]
    ls,rs :: [a]
    rs) <- [[a]] -> [[a]] -> [([a], [a])]
    forall a b. [a] -> [b] -> [(a, b)]
    zip ([a] -> [[a]]
    forall a. [a] -> [[a]]
    inits [a]
    ps) ([a] -> [[a]]
    forall a. [a] -> [[a]]
    tails [a]
    ps)]
    -- or use L.permutations

    {-
    -- orderings compatible with the height partition
    heightOrderingsDAG dag@(DG vs es) = heightOrderings' [[]] (heightPartitionDAG dag)
        where heightOrderings' initsegs (level:levels) =
                  let addsegs = perms level
                      initsegs' = [init ++ add | init <- initsegs, add <- addsegs]
                  in heightOrderings' initsegs' levels
              heightOrderings' segs [] = segs
    -}

    isoRepDAG1 :: Digraph k -> Digraph Int
    isoRepDAG1 dag :: Digraph k
    dag@(DG vs :: [k]
    vs es :: [(k, k)]
    es) = [Map k Int] -> Int -> [[k]] -> Digraph Int
    isoRepDAG' [Map k Int
    forall k a. Map k a
    M.empty] 1 (Digraph k -> [[k]]
    forall k. Ord k => Digraph k -> [[k]]
    heightPartitionDAG Digraph k
    dag)
        where isoRepDAG' :: [Map k Int] -> Int -> [[k]] -> Digraph Int
    isoRepDAG' initmaps :: [Map k Int]
    initmaps j :: Int
    j (level :: [k]
    level:levels :: [[k]]
    levels) =
                  let j' :: Int
    j' = Int
    j Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + [k] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [k]
    level
                      addmaps :: [Map k Int]
    addmaps = [[(k, Int)] -> Map k Int
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([k] -> [Int] -> [(k, Int)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [k]
    ps [Int
    j..]) | [k]
    ps <- [k] -> [[k]]
    forall a. [a] -> [[a]]
    perms [k]
    level]
                      initmaps' :: [Map k Int]
    initmaps' = [Map k Int
    init Map k Int -> Map k Int -> Map k Int
    forall k a. Ord k => Map k a -> Map k a -> Map k a
    +++ Map k Int
    add | Map k Int
    init <- [Map k Int]
    initmaps, Map k Int
    add <- [Map k Int]
    addmaps]
                  in [Map k Int] -> Int -> [[k]] -> Digraph Int
    isoRepDAG' [Map k Int]
    initmaps' Int
    j' [[k]]
    levels
              isoRepDAG' maps :: [Map k Int]
    maps _ [] = [Int] -> [(Int, Int)] -> Digraph Int
    forall v. [v] -> [(v, v)] -> Digraph v
    DG [1..[k] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [k]
    vs] ([[(Int, Int)]] -> [(Int, Int)]
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    minimum [[(Int, Int)] -> [(Int, Int)]
    forall a. Ord a => [a] -> [a]
    L.sort (((k, k) -> (Int, Int)) -> [(k, k)] -> [(Int, Int)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(u :: k
    u,v :: k
    v) -> (Map k Int
    m Map k Int -> k -> Int
    forall k a. Ord k => Map k a -> k -> a
    M.! k
    u, Map k Int
    m Map k Int -> k -> Int
    forall k a. Ord k => Map k a -> k -> a
    M.! k
    v)) [(k, k)]
    es) | Map k Int
    m <- [Map k Int]
    maps])
              initmap :: Map k a
    initmap +++ :: Map k a -> Map k a -> Map k a
    +++ addmap :: Map k a
    addmap = Map k a -> Map k a -> Map k a
    forall k a. Ord k => Map k a -> Map k a -> Map k a
    M.union Map k a
    initmap Map k a
    addmap

    -- For example
    -- > isoRepDAG1 (DG ['a'..'e'] [('a','c'),('a','d'),('b','d'),('b','e'),('d','e')])
    -- ([1,2,3,4,5],[(1,3),(1,4),(2,3),(2,5),(3,5)])
    -- > isoRepDAG1 (DG ['a'..'e'] [('a','d'),('a','e'),('b','c'),('b','d'),('d','e')])
    -- ([1,2,3,4,5],[(1,3),(1,4),(2,3),(2,5),(3,5)])

    -- Find the minimum height-preserving numberings of the vertices, using dfs
    isoRepDAG2 :: Digraph a -> [(a, b)]
    isoRepDAG2 dag :: Digraph a
    dag@(DG vs :: [a]
    vs es :: [(a, a)]
    es) = [[(a, b)]] -> [(a, b)]
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    minimum ([[(a, b)]] -> [(a, b)]) -> [[(a, b)]] -> [(a, b)]
    forall a b. (a -> b) -> a -> b
    $ [(a, b)] -> [[a]] -> [[b]] -> [[(a, b)]]
    forall a b. [(a, b)] -> [[a]] -> [[b]] -> [[(a, b)]]
    dfs [] [[a]]
    srclevels [[b]]
    forall a. (Num a, Enum a) => [[a]]
    trglevels
        where -- (preds,succs) = adjLists dag
              srclevels :: [[a]]
    srclevels = Digraph a -> [[a]]
    forall k. Ord k => Digraph k -> [[k]]
    heightPartitionDAG Digraph a
    dag
              trglevels :: [[a]]
    trglevels = [[a]] -> [[a]]
    forall a. [a] -> [a]
    reverse ([[a]] -> [[a]]) -> [[a]] -> [[a]]
    forall a b. (a -> b) -> a -> b
    $ ([[a]], [a]) -> [[a]]
    forall a b. (a, b) -> a
    fst (([[a]], [a]) -> [[a]]) -> ([[a]], [a]) -> [[a]]
    forall a b. (a -> b) -> a -> b
    $ (([[a]], [a]) -> [a] -> ([[a]], [a]))
    -> ([[a]], [a]) -> [[a]] -> ([[a]], [a])
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl
                          (\(tls :: [[a]]
    tls,is :: [a]
    is) sl :: [a]
    sl -> let (js :: [a]
    js,ks :: [a]
    ks) = Int -> [a] -> ([a], [a])
    forall a. Int -> [a] -> ([a], [a])
    splitAt ([a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    sl) [a]
    is in ([a]
    js[a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    :[[a]]
    tls,[a]
    ks))
                          ([],[1..]) [[a]]
    srclevels
              dfs :: [(a, b)] -> [[a]] -> [[b]] -> [[(a, b)]]
    dfs xys :: [(a, b)]
    xys [] [] = [[(a, b)]
    xys]
              dfs xys :: [(a, b)]
    xys ([]:sls :: [[a]]
    sls) ([]:tls :: [[b]]
    tls) = [(a, b)] -> [[a]] -> [[b]] -> [[(a, b)]]
    dfs [(a, b)]
    xys [[a]]
    sls [[b]]
    tls
              dfs xys :: [(a, b)]
    xys ((x :: a
    x:xs :: [a]
    xs):sls :: [[a]]
    sls) (ys :: [b]
    ys:tls :: [[b]]
    tls) =
                  [[[(a, b)]]] -> [[(a, b)]]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [ [(a, b)] -> [[a]] -> [[b]] -> [[(a, b)]]
    dfs ((a
    x,b
    y)(a, b) -> [(a, b)] -> [(a, b)]
    forall a. a -> [a] -> [a]
    :[(a, b)]
    xys) ([a]
    xs[a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    :[[a]]
    sls) ([b]
    ys' [b] -> [[b]] -> [[b]]
    forall a. a -> [a] -> [a]
    : [[b]]
    tls) | (y :: b
    y,ys' :: [b]
    ys') <- [b] -> [(b, [b])]
    forall a. [a] -> [(a, [a])]
    picks [b]
    ys]
                  -- not applying any compatibility condition yet

    -- Find the height-respecting numbering of the vertices which leads to the minimal numbering of the edges
    -- So this is calculating the same function as isoRepDAG1, but more efficiently
    -- Uses dfs with pruning, rather than exhaustive search
    isoRepDAG3 :: Digraph v -> Digraph Int
    isoRepDAG3 dag :: Digraph v
    dag@(DG vs :: [v]
    vs es :: [(v, v)]
    es) = ([(Int, Int)], (Int, Int), Map v Int, ([[v]], [[Int]]))
    -> [([(Int, Int)], (Int, Int), Map v Int, ([[v]], [[Int]]))]
    -> Digraph Int
    dfs ([(Int, Int)], (Int, Int), Map v Int, ([[v]], [[Int]]))
    forall a b a a k a.
    (Num a, Num b, Num a, Enum a) =>
    ([a], (a, b), Map k a, ([[v]], [[a]]))
    root [([(Int, Int)], (Int, Int), Map v Int, ([[v]], [[Int]]))
    forall a b a a k a.
    (Num a, Num b, Num a, Enum a) =>
    ([a], (a, b), Map k a, ([[v]], [[a]]))
    root]
        where n :: Int
    n = [v] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [v]
    vs
              root :: ([a], (a, b), Map k a, ([[v]], [[a]]))
    root = ([],(1,0),Map k a
    forall k a. Map k a
    M.empty,([[v]]
    srclevels,[[a]]
    forall a. (Num a, Enum a) => [[a]]
    trglevels)) -- root of the search tree
              (preds :: Map v [v]
    preds,succs :: Map v [v]
    succs) = Digraph v -> (Map v [v], Map v [v])
    forall a. Ord a => Digraph a -> (Map a [a], Map a [a])
    adjLists Digraph v
    dag
              srclevels :: [[v]]
    srclevels = Digraph v -> [[v]]
    forall k. Ord k => Digraph k -> [[k]]
    heightPartitionDAG Digraph v
    dag
              trglevels :: [[a]]
    trglevels = [[a]] -> [[a]]
    forall a. [a] -> [a]
    reverse ([[a]] -> [[a]]) -> [[a]] -> [[a]]
    forall a b. (a -> b) -> a -> b
    $ ([[a]], [a]) -> [[a]]
    forall a b. (a, b) -> a
    fst (([[a]], [a]) -> [[a]]) -> ([[a]], [a]) -> [[a]]
    forall a b. (a -> b) -> a -> b
    $ (([[a]], [a]) -> [v] -> ([[a]], [a]))
    -> ([[a]], [a]) -> [[v]] -> ([[a]], [a])
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl
                          (\(tls :: [[a]]
    tls,is :: [a]
    is) sl :: [v]
    sl -> let (js :: [a]
    js,ks :: [a]
    ks) = Int -> [a] -> ([a], [a])
    forall a. Int -> [a] -> ([a], [a])
    splitAt ([v] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [v]
    sl) [a]
    is in ([a]
    js[a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    :[[a]]
    tls,[a]
    ks))
                          ([],[1..]) [[v]]
    srclevels
              dfs :: ([(Int, Int)], (Int, Int), Map v Int, ([[v]], [[Int]]))
    -> [([(Int, Int)], (Int, Int), Map v Int, ([[v]], [[Int]]))]
    -> Digraph Int
    dfs best :: ([(Int, Int)], (Int, Int), Map v Int, ([[v]], [[Int]]))
    best (node :: ([(Int, Int)], (Int, Int), Map v Int, ([[v]], [[Int]]))
    node:stack :: [([(Int, Int)], (Int, Int), Map v Int, ([[v]], [[Int]]))]
    stack) =
                  -- node : -- for debugging
                  case ([(Int, Int)], (Int, Int), Map v Int, ([[v]], [[Int]]))
    -> ([(Int, Int)], (Int, Int), Map v Int, ([[v]], [[Int]]))
    -> Ordering
    forall a b b c d c d.
    (Ord a, Ord b) =>
    ([(a, b)], b, c, d) -> ([(a, b)], (a, b), c, d) -> Ordering
    cmpPartial ([(Int, Int)], (Int, Int), Map v Int, ([[v]], [[Int]]))
    best ([(Int, Int)], (Int, Int), Map v Int, ([[v]], [[Int]]))
    node of
                  LT -> ([(Int, Int)], (Int, Int), Map v Int, ([[v]], [[Int]]))
    -> [([(Int, Int)], (Int, Int), Map v Int, ([[v]], [[Int]]))]
    -> Digraph Int
    dfs ([(Int, Int)], (Int, Int), Map v Int, ([[v]], [[Int]]))
    best [([(Int, Int)], (Int, Int), Map v Int, ([[v]], [[Int]]))]
    stack                      -- ie prune the search tree at this node
                  GT -> ([(Int, Int)], (Int, Int), Map v Int, ([[v]], [[Int]]))
    -> [([(Int, Int)], (Int, Int), Map v Int, ([[v]], [[Int]]))]
    -> Digraph Int
    dfs ([(Int, Int)], (Int, Int), Map v Int, ([[v]], [[Int]]))
    node (([(Int, Int)], (Int, Int), Map v Int, ([[v]], [[Int]]))
    -> [([(Int, Int)], (Int, Int), Map v Int, ([[v]], [[Int]]))]
    forall a b.
    (Ord a, Num a) =>
    ([(a, a)], (a, b), Map v a, ([[v]], [[a]]))
    -> [([(a, a)], (a, a), Map v a, ([[v]], [[a]]))]
    successors ([(Int, Int)], (Int, Int), Map v Int, ([[v]], [[Int]]))
    node [([(Int, Int)], (Int, Int), Map v Int, ([[v]], [[Int]]))]
    -> [([(Int, Int)], (Int, Int), Map v Int, ([[v]], [[Int]]))]
    -> [([(Int, Int)], (Int, Int), Map v Int, ([[v]], [[Int]]))]
    forall a. [a] -> [a] -> [a]
    ++ [([(Int, Int)], (Int, Int), Map v Int, ([[v]], [[Int]]))]
    stack) -- ie replace best with this node
                  EQ -> ([(Int, Int)], (Int, Int), Map v Int, ([[v]], [[Int]]))
    -> [([(Int, Int)], (Int, Int), Map v Int, ([[v]], [[Int]]))]
    -> Digraph Int
    dfs ([(Int, Int)], (Int, Int), Map v Int, ([[v]], [[Int]]))
    best (([(Int, Int)], (Int, Int), Map v Int, ([[v]], [[Int]]))
    -> [([(Int, Int)], (Int, Int), Map v Int, ([[v]], [[Int]]))]
    forall a b.
    (Ord a, Num a) =>
    ([(a, a)], (a, b), Map v a, ([[v]], [[a]]))
    -> [([(a, a)], (a, a), Map v a, ([[v]], [[a]]))]
    successors ([(Int, Int)], (Int, Int), Map v Int, ([[v]], [[Int]]))
    node [([(Int, Int)], (Int, Int), Map v Int, ([[v]], [[Int]]))]
    -> [([(Int, Int)], (Int, Int), Map v Int, ([[v]], [[Int]]))]
    -> [([(Int, Int)], (Int, Int), Map v Int, ([[v]], [[Int]]))]
    forall a. [a] -> [a] -> [a]
    ++ [([(Int, Int)], (Int, Int), Map v Int, ([[v]], [[Int]]))]
    stack)
              -- dfs best [] = [best] -- !! for debugging
              dfs best :: ([(Int, Int)], (Int, Int), Map v Int, ([[v]], [[Int]]))
    best@(es' :: [(Int, Int)]
    es',_,_,_) [] = [Int] -> [(Int, Int)] -> Digraph Int
    forall v. [v] -> [(v, v)] -> Digraph v
    DG [1..Int
    n] [(Int, Int)]
    es'
              successors :: ([(a, a)], (a, b), Map v a, ([[v]], [[a]]))
    -> [([(a, a)], (a, a), Map v a, ([[v]], [[a]]))]
    successors (es :: [(a, a)]
    es,_,_,([],[])) = []
              successors (es :: [(a, a)]
    es,(i :: a
    i,j :: b
    j),m :: Map v a
    m,([]:sls :: [[v]]
    sls,[]:tls :: [[a]]
    tls)) = ([(a, a)], (a, b), Map v a, ([[v]], [[a]]))
    -> [([(a, a)], (a, a), Map v a, ([[v]], [[a]]))]
    successors ([(a, a)]
    es,(a
    i,b
    j),Map v a
    m,([[v]]
    sls,[[a]]
    tls))
              successors (es :: [(a, a)]
    es,(i :: a
    i,j :: b
    j),m :: Map v a
    m,(xs :: [v]
    xs:sls :: [[v]]
    sls,(y :: a
    y:ys :: [a]
    ys):tls :: [[a]]
    tls)) =
                  [ ([(a, a)]
    es', (a
    i',a
    y), Map v a
    m', (v -> [v] -> [v]
    forall a. Eq a => a -> [a] -> [a]
    L.delete v
    x [v]
    xs [v] -> [[v]] -> [[v]]
    forall a. a -> [a] -> [a]
    : [[v]]
    sls, [a]
    ys [a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    : [[a]]
    tls))
                  | v
    x <- [v]
    xs,
                    let m' :: Map v a
    m' = v -> a -> Map v a -> Map v a
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert v
    x a
    y Map v a
    m,
                    let es' :: [(a, a)]
    es' = [(a, a)] -> [(a, a)]
    forall a. Ord a => [a] -> [a]
    L.sort ([(a, a)] -> [(a, a)]) -> [(a, a)] -> [(a, a)]
    forall a b. (a -> b) -> a -> b
    $ [(a, a)]
    es [(a, a)] -> [(a, a)] -> [(a, a)]
    forall a. [a] -> [a] -> [a]
    ++ [(Map v a
    m Map v a -> v -> a
    forall k a. Ord k => Map k a -> k -> a
    M.! v
    u, a
    y) | v
    u <- [v] -> v -> Map v [v] -> [v]
    forall k a. Ord k => a -> k -> Map k a -> a
    M.findWithDefault [] v
    x Map v [v]
    preds],
                    let i' :: a
    i' = Map v a -> a -> a
    forall t. (Num t, Eq t) => Map v t -> t -> t
    nextunfinished Map v a
    m' a
    i ]
              -- a vertex is considered finished when all its successors have assignments in the map
              nextunfinished :: Map v t -> t -> t
    nextunfinished m :: Map v t
    m i :: t
    i =
                  case [v
    v | (v :: v
    v,i' :: t
    i') <- Map v t -> [(v, t)]
    forall k a. Map k a -> [(k, a)]
    M.assocs Map v t
    m, t
    i' t -> t -> Bool
    forall a. Eq a => a -> a -> Bool
    == t
    i] of
                  [] -> t
    i
                  [u :: v
    u] -> if (v -> Bool) -> [v] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (v -> Map v t -> Bool
    forall k a. Ord k => k -> Map k a -> Bool
    `M.member` Map v t
    m) ([v] -> v -> Map v [v] -> [v]
    forall k a. Ord k => a -> k -> Map k a -> a
    M.findWithDefault [] v
    u Map v [v]
    succs)
                         then Map v t -> t -> t
    nextunfinished Map v t
    m (t
    it -> t -> t
    forall a. Num a => a -> a -> a
    +1) -- i is finished: all successors already have assignments in the map
                         else t
    i
              cmpPartial :: ([(a, b)], b, c, d) -> ([(a, b)], (a, b), c, d) -> Ordering
    cmpPartial (es :: [(a, b)]
    es,_,_,_) (es' :: [(a, b)]
    es',(i' :: a
    i',j' :: b
    j'),_,_) =
                  (a, b) -> [(a, b)] -> [(a, b)] -> Ordering
    forall a b.
    (Ord a, Ord b) =>
    (a, b) -> [(a, b)] -> [(a, b)] -> Ordering
    cmpPartial' (a
    i',b
    j') [(a, b)]
    es [(a, b)]
    es'
                  -- where j' = maximum $ 0 : map snd es'
              cmpPartial' :: (a, b) -> [(a, b)] -> [(a, b)] -> Ordering
    cmpPartial' (i' :: a
    i',j' :: b
    j') ((u :: a
    u,v :: b
    v):es :: [(a, b)]
    es) ((u' :: a
    u',v' :: b
    v'):es' :: [(a, b)]
    es') =
              -- Any new e' that can be added to es' must be greater than (i',j')
              -- (we don't care about possible extensions of es, because we're not extending them)
                  case (a, b) -> (a, b) -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare (a
    u,b
    v) (a
    u',b
    v') of
                  EQ -> (a, b) -> [(a, b)] -> [(a, b)] -> Ordering
    cmpPartial' (a
    i',b
    j') [(a, b)]
    es [(a, b)]
    es'
                  LT -> if (a
    u,b
    v) (a, b) -> (a, b) -> Bool
    forall a. Ord a => a -> a -> Bool
    <= (a
    i',b
    j') then Ordering
    LT else Ordering
    EQ
                  GT -> Ordering
    GT -- always replace best if you beat it
                           -- (even if it could improve, it's not going to as we're not progressing it)
              cmpPartial' (i' :: a
    i',j' :: b
    j') ((u :: a
    u,v :: b
    v):es :: [(a, b)]
    es) [] = if (a
    u,b
    v) (a, b) -> (a, b) -> Bool
    forall a. Ord a => a -> a -> Bool
    <= (a
    i',b
    j') then Ordering
    LT else Ordering
    EQ
              cmpPartial' _ [] ((u' :: a
    u',v' :: b
    v'):es' :: [(a, b)]
    es') = Ordering
    GT -- always extend an existing partial best
              cmpPartial' _ [] [] = Ordering
    EQ

    -- Now we seek a numbering of the vertices which respects height-ordering,
    -- and within each height level respects (indegree,outdegree) ordering.
    -- We seek the numbering which minimises the resulting edge list.

    -- |Given a directed acyclic graph (DAG), return a canonical representative for its isomorphism class.
    -- @isoRepDAG dag@ is isomorphic to @dag@. It follows that if @isoRepDAG dagA == isoRepDAG dagB@ then @dagA@ is isomorphic to @dagB@.
    -- Conversely, @isoRepDAG dag@ is the minimal element in the isomorphism class, subject to some constraints.
    -- It follows that if @dagA@ is isomorphic to @dagB@, then @isoRepDAG dagA == isoRepDAG dagB@.
    --
    -- The algorithm of course is faster on some DAGs than others: roughly speaking,
    -- it prefers \"tall\" DAGs (long chains) to \"wide\" DAGs (long antichains),
    -- and it prefers asymmetric DAGs (ie those with smaller automorphism groups).
    isoRepDAG :: (Ord a) => Digraph a -> Digraph Int
    isoRepDAG :: Digraph a -> Digraph Int
    isoRepDAG dag :: Digraph a
    dag@(DG vs :: [a]
    vs es :: [(a, a)]
    es) = ([(Int, Int)], (Int, Int), Map a Int, ([[a]], [[Int]]))
    -> [([(Int, Int)], (Int, Int), Map a Int, ([[a]], [[Int]]))]
    -> Digraph Int
    dfs ([(Int, Int)], (Int, Int), Map a Int, ([[a]], [[Int]]))
    forall a b a a k a.
    (Num a, Num b, Num a, Enum a) =>
    ([a], (a, b), Map k a, ([[a]], [[a]]))
    root [([(Int, Int)], (Int, Int), Map a Int, ([[a]], [[Int]]))
    forall a b a a k a.
    (Num a, Num b, Num a, Enum a) =>
    ([a], (a, b), Map k a, ([[a]], [[a]]))
    root]
        where n :: Int
    n = [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    vs
              root :: ([a], (a, b), Map k a, ([[a]], [[a]]))
    root = ([],(1,0),Map k a
    forall k a. Map k a
    M.empty,([[a]]
    srclevels,[[a]]
    forall a. (Num a, Enum a) => [[a]]
    trglevels)) -- root of the search tree
              (preds :: Map a [a]
    preds,succs :: Map a [a]
    succs) = Digraph a -> (Map a [a], Map a [a])
    forall a. Ord a => Digraph a -> (Map a [a], Map a [a])
    adjLists Digraph a
    dag
              indegs :: Map a Int
    indegs = ([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]
    preds
              outdegs :: Map a Int
    outdegs = ([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]
    succs
              byDegree :: [a] -> [[a]]
    byDegree vs :: [a]
    vs = (([((Int, Int), a)] -> [a]) -> [[((Int, Int), a)]] -> [[a]]
    forall a b. (a -> b) -> [a] -> [b]
    map (([((Int, Int), a)] -> [a]) -> [[((Int, Int), a)]] -> [[a]])
    -> ((((Int, Int), a) -> a) -> [((Int, Int), a)] -> [a])
    -> (((Int, Int), a) -> a)
    -> [[((Int, Int), a)]]
    -> [[a]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (((Int, Int), a) -> a) -> [((Int, Int), a)] -> [a]
    forall a b. (a -> b) -> [a] -> [b]
    map) ((Int, Int), a) -> a
    forall a b. (a, b) -> b
    snd ([[((Int, Int), a)]] -> [[a]]) -> [[((Int, Int), a)]] -> [[a]]
    forall a b. (a -> b) -> a -> b
    $ (((Int, Int), a) -> ((Int, Int), a) -> Bool)
    -> [((Int, Int), a)] -> [[((Int, Int), a)]]
    forall a. (a -> a -> Bool) -> [a] -> [[a]]
    L.groupBy (\(du :: (Int, Int)
    du,u :: a
    u) (dv :: (Int, Int)
    dv,v :: a
    v) -> (Int, Int)
    du (Int, Int) -> (Int, Int) -> Bool
    forall a. Eq a => a -> a -> Bool
    == (Int, Int)
    dv) ([((Int, Int), a)] -> [[((Int, Int), a)]])
    -> [((Int, Int), a)] -> [[((Int, Int), a)]]
    forall a b. (a -> b) -> a -> b
    $ [((Int, Int), a)] -> [((Int, Int), a)]
    forall a. Ord a => [a] -> [a]
    L.sort
                            [( (Int -> a -> Map a Int -> Int
    forall k a. Ord k => a -> k -> Map k a -> a
    M.findWithDefault 0 a
    v Map a Int
    indegs, Int -> a -> Map a Int -> Int
    forall k a. Ord k => a -> k -> Map k a -> a
    M.findWithDefault 0 a
    v Map a Int
    outdegs), a
    v) | a
    v <- [a]
    vs]
              srclevels :: [[a]]
    srclevels = ([a] -> [[a]]) -> [[a]] -> [[a]]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap [a] -> [[a]]
    byDegree ([[a]] -> [[a]]) -> [[a]] -> [[a]]
    forall a b. (a -> b) -> a -> b
    $ Digraph a -> [[a]]
    forall k. Ord k => Digraph k -> [[k]]
    heightPartitionDAG Digraph a
    dag
              trglevels :: [[a]]
    trglevels = [[a]] -> [[a]]
    forall a. [a] -> [a]
    reverse ([[a]] -> [[a]]) -> [[a]] -> [[a]]
    forall a b. (a -> b) -> a -> b
    $ ([[a]], [a]) -> [[a]]
    forall a b. (a, b) -> a
    fst (([[a]], [a]) -> [[a]]) -> ([[a]], [a]) -> [[a]]
    forall a b. (a -> b) -> a -> b
    $ (([[a]], [a]) -> [a] -> ([[a]], [a]))
    -> ([[a]], [a]) -> [[a]] -> ([[a]], [a])
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl
                          (\(tls :: [[a]]
    tls,is :: [a]
    is) sl :: [a]
    sl -> let (js :: [a]
    js,ks :: [a]
    ks) = Int -> [a] -> ([a], [a])
    forall a. Int -> [a] -> ([a], [a])
    splitAt ([a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    sl) [a]
    is in ([a]
    js[a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    :[[a]]
    tls,[a]
    ks))
                          ([],[1..]) [[a]]
    srclevels
              dfs :: ([(Int, Int)], (Int, Int), Map a Int, ([[a]], [[Int]]))
    -> [([(Int, Int)], (Int, Int), Map a Int, ([[a]], [[Int]]))]
    -> Digraph Int
    dfs best :: ([(Int, Int)], (Int, Int), Map a Int, ([[a]], [[Int]]))
    best (node :: ([(Int, Int)], (Int, Int), Map a Int, ([[a]], [[Int]]))
    node:stack :: [([(Int, Int)], (Int, Int), Map a Int, ([[a]], [[Int]]))]
    stack) =
                  -- node : -- for debugging
                  case ([(Int, Int)], (Int, Int), Map a Int, ([[a]], [[Int]]))
    -> ([(Int, Int)], (Int, Int), Map a Int, ([[a]], [[Int]]))
    -> Ordering
    forall a b b c d c d.
    (Ord a, Ord b) =>
    ([(a, b)], b, c, d) -> ([(a, b)], (a, b), c, d) -> Ordering
    cmpPartial ([(Int, Int)], (Int, Int), Map a Int, ([[a]], [[Int]]))
    best ([(Int, Int)], (Int, Int), Map a Int, ([[a]], [[Int]]))
    node of
                  LT -> ([(Int, Int)], (Int, Int), Map a Int, ([[a]], [[Int]]))
    -> [([(Int, Int)], (Int, Int), Map a Int, ([[a]], [[Int]]))]
    -> Digraph Int
    dfs ([(Int, Int)], (Int, Int), Map a Int, ([[a]], [[Int]]))
    best [([(Int, Int)], (Int, Int), Map a Int, ([[a]], [[Int]]))]
    stack                      -- ie prune the search tree at this node
                  GT -> ([(Int, Int)], (Int, Int), Map a Int, ([[a]], [[Int]]))
    -> [([(Int, Int)], (Int, Int), Map a Int, ([[a]], [[Int]]))]
    -> Digraph Int
    dfs ([(Int, Int)], (Int, Int), Map a Int, ([[a]], [[Int]]))
    node (([(Int, Int)], (Int, Int), Map a Int, ([[a]], [[Int]]))
    -> [([(Int, Int)], (Int, Int), Map a Int, ([[a]], [[Int]]))]
    forall a b.
    (Ord a, Num a) =>
    ([(a, a)], (a, b), Map a a, ([[a]], [[a]]))
    -> [([(a, a)], (a, a), Map a a, ([[a]], [[a]]))]
    successors ([(Int, Int)], (Int, Int), Map a Int, ([[a]], [[Int]]))
    node [([(Int, Int)], (Int, Int), Map a Int, ([[a]], [[Int]]))]
    -> [([(Int, Int)], (Int, Int), Map a Int, ([[a]], [[Int]]))]
    -> [([(Int, Int)], (Int, Int), Map a Int, ([[a]], [[Int]]))]
    forall a. [a] -> [a] -> [a]
    ++ [([(Int, Int)], (Int, Int), Map a Int, ([[a]], [[Int]]))]
    stack) -- ie replace best with this node
                  EQ -> ([(Int, Int)], (Int, Int), Map a Int, ([[a]], [[Int]]))
    -> [([(Int, Int)], (Int, Int), Map a Int, ([[a]], [[Int]]))]
    -> Digraph Int
    dfs ([(Int, Int)], (Int, Int), Map a Int, ([[a]], [[Int]]))
    best (([(Int, Int)], (Int, Int), Map a Int, ([[a]], [[Int]]))
    -> [([(Int, Int)], (Int, Int), Map a Int, ([[a]], [[Int]]))]
    forall a b.
    (Ord a, Num a) =>
    ([(a, a)], (a, b), Map a a, ([[a]], [[a]]))
    -> [([(a, a)], (a, a), Map a a, ([[a]], [[a]]))]
    successors ([(Int, Int)], (Int, Int), Map a Int, ([[a]], [[Int]]))
    node [([(Int, Int)], (Int, Int), Map a Int, ([[a]], [[Int]]))]
    -> [([(Int, Int)], (Int, Int), Map a Int, ([[a]], [[Int]]))]
    -> [([(Int, Int)], (Int, Int), Map a Int, ([[a]], [[Int]]))]
    forall a. [a] -> [a] -> [a]
    ++ [([(Int, Int)], (Int, Int), Map a Int, ([[a]], [[Int]]))]
    stack)
              -- dfs best [] = [best] -- !! for debugging
              dfs best :: ([(Int, Int)], (Int, Int), Map a Int, ([[a]], [[Int]]))
    best@(es' :: [(Int, Int)]
    es',_,_,_) [] = [Int] -> [(Int, Int)] -> Digraph Int
    forall v. [v] -> [(v, v)] -> Digraph v
    DG [1..Int
    n] [(Int, Int)]
    es'
              successors :: ([(a, a)], (a, b), Map a a, ([[a]], [[a]]))
    -> [([(a, a)], (a, a), Map a a, ([[a]], [[a]]))]
    successors (es :: [(a, a)]
    es,_,_,([],[])) = []
              successors (es :: [(a, a)]
    es,(i :: a
    i,j :: b
    j),m :: Map a a
    m,([]:sls :: [[a]]
    sls,[]:tls :: [[a]]
    tls)) = ([(a, a)], (a, b), Map a a, ([[a]], [[a]]))
    -> [([(a, a)], (a, a), Map a a, ([[a]], [[a]]))]
    successors ([(a, a)]
    es,(a
    i,b
    j),Map a a
    m,([[a]]
    sls,[[a]]
    tls))
              successors (es :: [(a, a)]
    es,(i :: a
    i,j :: b
    j),m :: Map a a
    m,(xs :: [a]
    xs:sls :: [[a]]
    sls,(y :: a
    y:ys :: [a]
    ys):tls :: [[a]]
    tls)) =
                  [ ([(a, a)]
    es', (a
    i',a
    y), Map a a
    m', (a -> [a] -> [a]
    forall a. Eq a => a -> [a] -> [a]
    L.delete a
    x [a]
    xs [a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    : [[a]]
    sls, [a]
    ys [a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    : [[a]]
    tls))
                  | a
    x <- [a]
    xs,
                    let m' :: Map a a
    m' = a -> a -> Map a a -> Map a a
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert a
    x a
    y Map a a
    m,
                    let es' :: [(a, a)]
    es' = [(a, a)] -> [(a, a)]
    forall a. Ord a => [a] -> [a]
    L.sort ([(a, a)] -> [(a, a)]) -> [(a, a)] -> [(a, a)]
    forall a b. (a -> b) -> a -> b
    $ [(a, a)]
    es [(a, a)] -> [(a, a)] -> [(a, a)]
    forall a. [a] -> [a] -> [a]
    ++ [(Map a a
    m Map a a -> a -> a
    forall k a. Ord k => Map k a -> k -> a
    M.! a
    u, a
    y) | a
    u <- [a] -> a -> Map a [a] -> [a]
    forall k a. Ord k => a -> k -> Map k a -> a
    M.findWithDefault [] a
    x Map a [a]
    preds],
                    let i' :: a
    i' = Map a a -> a -> a
    forall t. (Num t, Eq t) => Map a t -> t -> t
    nextunfinished Map a a
    m' a
    i ]
              -- a vertex is considered finished when all its successors have assignments in the map
              nextunfinished :: Map a t -> t -> t
    nextunfinished m :: Map a t
    m i :: t
    i =
                  case [a
    v | (v :: a
    v,i' :: t
    i') <- Map a t -> [(a, t)]
    forall k a. Map k a -> [(k, a)]
    M.assocs Map a t
    m, t
    i' t -> t -> Bool
    forall a. Eq a => a -> a -> Bool
    == t
    i] of
                  [] -> t
    i
                  [u :: a
    u] -> if (a -> Bool) -> [a] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (a -> Map a t -> Bool
    forall k a. Ord k => k -> Map k a -> Bool
    `M.member` Map a t
    m) ([a] -> a -> Map a [a] -> [a]
    forall k a. Ord k => a -> k -> Map k a -> a
    M.findWithDefault [] a
    u Map a [a]
    succs)
                         then Map a t -> t -> t
    nextunfinished Map a t
    m (t
    it -> t -> t
    forall a. Num a => a -> a -> a
    +1) -- i is finished: all successors already have assignments in the map
                         else t
    i
              cmpPartial :: ([(a, b)], b, c, d) -> ([(a, b)], (a, b), c, d) -> Ordering
    cmpPartial (es :: [(a, b)]
    es,_,_,_) (es' :: [(a, b)]
    es',(i' :: a
    i',j' :: b
    j'),_,_) =
                  (a, b) -> [(a, b)] -> [(a, b)] -> Ordering
    forall a b.
    (Ord a, Ord b) =>
    (a, b) -> [(a, b)] -> [(a, b)] -> Ordering
    cmpPartial' (a
    i',b
    j') [(a, b)]
    es [(a, b)]
    es'
                  -- where j' = maximum $ 0 : map snd es'
              cmpPartial' :: (a, b) -> [(a, b)] -> [(a, b)] -> Ordering
    cmpPartial' (i' :: a
    i',j' :: b
    j') ((u :: a
    u,v :: b
    v):es :: [(a, b)]
    es) ((u' :: a
    u',v' :: b
    v'):es' :: [(a, b)]
    es') =
              -- Any new e' that can be added to es' must be greater than (i',j')
              -- (we don't care about possible extensions of es, because we're not extending them)
                  case (a, b) -> (a, b) -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare (a
    u,b
    v) (a
    u',b
    v') of
                  EQ -> (a, b) -> [(a, b)] -> [(a, b)] -> Ordering
    cmpPartial' (a
    i',b
    j') [(a, b)]
    es [(a, b)]
    es'
                  LT -> if (a
    u,b
    v) (a, b) -> (a, b) -> Bool
    forall a. Ord a => a -> a -> Bool
    <= (a
    i',b
    j') then Ordering
    LT else Ordering
    EQ
                  GT -> Ordering
    GT -- always replace best if you beat it
                           -- (even if it could improve, it's not going to as we're not progressing it)
              cmpPartial' (i' :: a
    i',j' :: b
    j') ((u :: a
    u,v :: b
    v):es :: [(a, b)]
    es) [] = if (a
    u,b
    v) (a, b) -> (a, b) -> Bool
    forall a. Ord a => a -> a -> Bool
    <= (a
    i',b
    j') then Ordering
    LT else Ordering
    EQ
              cmpPartial' _ [] ((u' :: a
    u',v' :: b
    v'):es' :: [(a, b)]
    es') = Ordering
    GT -- always extend an existing partial best
              cmpPartial' _ [] [] = Ordering
    EQ