    module Data.Graph.Inductive.Query.ArtPoint(
        ap
    ) where

    import Data.Graph.Inductive.Graph

    ------------------------------------------------------------------------------
    -- Tree for storing the DFS numbers and back edges for each node in the graph.
    -- Each node in this tree is of the form (v,n,b) where v is the vertex number,
    -- n is its DFS number and b is the list of nodes (and their DFS numbers) that
    -- lead to back back edges for that vertex v.
    ------------------------------------------------------------------------------
    data DFSTree a = B (a,a,[(a,a)]) [DFSTree a]
         deriving (DFSTree a -> DFSTree a -> Bool
    (DFSTree a -> DFSTree a -> Bool)
    -> (DFSTree a -> DFSTree a -> Bool) -> Eq (DFSTree a)
    forall a. Eq a => DFSTree a -> DFSTree a -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: forall a. Eq a => DFSTree a -> DFSTree a -> Bool
    == :: DFSTree a -> DFSTree a -> Bool
    $c/= :: forall a. Eq a => DFSTree a -> DFSTree a -> Bool
    /= :: DFSTree a -> DFSTree a -> Bool
    Eq, Int -> DFSTree a -> ShowS
    [DFSTree a] -> ShowS
    DFSTree a -> String
    (Int -> DFSTree a -> ShowS)
    -> (DFSTree a -> String)
    -> ([DFSTree a] -> ShowS)
    -> Show (DFSTree a)
    forall a. Show a => Int -> DFSTree a -> ShowS
    forall a. Show a => [DFSTree a] -> ShowS
    forall a. Show a => DFSTree a -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall a. Show a => Int -> DFSTree a -> ShowS
    showsPrec :: Int -> DFSTree a -> ShowS
    $cshow :: forall a. Show a => DFSTree a -> String
    show :: DFSTree a -> String
    $cshowList :: forall a. Show a => [DFSTree a] -> ShowS
    showList :: [DFSTree a] -> ShowS
    Show, ReadPrec [DFSTree a]
    ReadPrec (DFSTree a)
    Int -> ReadS (DFSTree a)
    ReadS [DFSTree a]
    (Int -> ReadS (DFSTree a))
    -> ReadS [DFSTree a]
    -> ReadPrec (DFSTree a)
    -> ReadPrec [DFSTree a]
    -> Read (DFSTree a)
    forall a. Read a => ReadPrec [DFSTree a]
    forall a. Read a => ReadPrec (DFSTree a)
    forall a. Read a => Int -> ReadS (DFSTree a)
    forall a. Read a => ReadS [DFSTree a]
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: forall a. Read a => Int -> ReadS (DFSTree a)
    readsPrec :: Int -> ReadS (DFSTree a)
    $creadList :: forall a. Read a => ReadS [DFSTree a]
    readList :: ReadS [DFSTree a]
    $creadPrec :: forall a. Read a => ReadPrec (DFSTree a)
    readPrec :: ReadPrec (DFSTree a)
    $creadListPrec :: forall a. Read a => ReadPrec [DFSTree a]
    readListPrec :: ReadPrec [DFSTree a]
    Read)

    ------------------------------------------------------------------------------
    -- Tree for storing the DFS and low numbers for each node in the graph.
    -- Each node in this tree is of the form (v,n,l) where v is the vertex number,
    -- n is its DFS number and l is its low number.
    ------------------------------------------------------------------------------
    data LOWTree a = Brc (a,a,a) [LOWTree a]
         deriving (LOWTree a -> LOWTree a -> Bool
    (LOWTree a -> LOWTree a -> Bool)
    -> (LOWTree a -> LOWTree a -> Bool) -> Eq (LOWTree a)
    forall a. Eq a => LOWTree a -> LOWTree a -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: forall a. Eq a => LOWTree a -> LOWTree a -> Bool
    == :: LOWTree a -> LOWTree a -> Bool
    $c/= :: forall a. Eq a => LOWTree a -> LOWTree a -> Bool
    /= :: LOWTree a -> LOWTree a -> Bool
    Eq, Int -> LOWTree a -> ShowS
    [LOWTree a] -> ShowS
    LOWTree a -> String
    (Int -> LOWTree a -> ShowS)
    -> (LOWTree a -> String)
    -> ([LOWTree a] -> ShowS)
    -> Show (LOWTree a)
    forall a. Show a => Int -> LOWTree a -> ShowS
    forall a. Show a => [LOWTree a] -> ShowS
    forall a. Show a => LOWTree a -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall a. Show a => Int -> LOWTree a -> ShowS
    showsPrec :: Int -> LOWTree a -> ShowS
    $cshow :: forall a. Show a => LOWTree a -> String
    show :: LOWTree a -> String
    $cshowList :: forall a. Show a => [LOWTree a] -> ShowS
    showList :: [LOWTree a] -> ShowS
    Show, ReadPrec [LOWTree a]
    ReadPrec (LOWTree a)
    Int -> ReadS (LOWTree a)
    ReadS [LOWTree a]
    (Int -> ReadS (LOWTree a))
    -> ReadS [LOWTree a]
    -> ReadPrec (LOWTree a)
    -> ReadPrec [LOWTree a]
    -> Read (LOWTree a)
    forall a. Read a => ReadPrec [LOWTree a]
    forall a. Read a => ReadPrec (LOWTree a)
    forall a. Read a => Int -> ReadS (LOWTree a)
    forall a. Read a => ReadS [LOWTree a]
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: forall a. Read a => Int -> ReadS (LOWTree a)
    readsPrec :: Int -> ReadS (LOWTree a)
    $creadList :: forall a. Read a => ReadS [LOWTree a]
    readList :: ReadS [LOWTree a]
    $creadPrec :: forall a. Read a => ReadPrec (LOWTree a)
    readPrec :: ReadPrec (LOWTree a)
    $creadListPrec :: forall a. Read a => ReadPrec [LOWTree a]
    readListPrec :: ReadPrec [LOWTree a]
    Read)

    ------------------------------------------------------------------------------
    -- Finds the back edges for a given node.
    ------------------------------------------------------------------------------
    getBackEdges :: Node -> [[(Node,Int)]] -> [(Node,Int)]
    getBackEdges :: Int -> [[(Int, Int)]] -> [(Int, Int)]
    getBackEdges Int
    _ [] = []
    getBackEdges Int
    v [[(Int, Int)]]
    ls   = ([(Int, Int)] -> (Int, Int)) -> [[(Int, Int)]] -> [(Int, Int)]
    forall a b. (a -> b) -> [a] -> [b]
    map [(Int, Int)] -> (Int, Int)
    forall a. HasCallStack => [a] -> a
    head (([(Int, Int)] -> Bool) -> [[(Int, Int)]] -> [[(Int, Int)]]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((Int, Int) -> [(Int, Int)] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    elem (Int
    v,Int
    0)) ([[(Int, Int)]] -> [[(Int, Int)]]
    forall a. HasCallStack => [a] -> [a]
    tail [[(Int, Int)]]
    ls))

    ------------------------------------------------------------------------------
    -- Builds a DFS tree for a given graph. Each element (v,n,b) in the tree
    -- contains: the node number v, the DFS number n, and a list of backedges b.
    ------------------------------------------------------------------------------
    dfsTree :: (Graph gr) => Int -> Node -> [Node] -> [[(Node,Int)]] ->
                           gr a b -> ([DFSTree Int],gr a b,Int)
    dfsTree :: forall (gr :: * -> * -> *) a b.
    Graph gr =>
    Int
    -> Int
    -> [Int]
    -> [[(Int, Int)]]
    -> gr a b
    -> ([DFSTree Int], gr a b, Int)
    dfsTree Int
    n Int
    _ []      [[(Int, Int)]]
    _ gr a b
    g             = ([],gr a b
    g,Int
    n)
    dfsTree Int
    n Int
    _ [Int]
    _       [[(Int, Int)]]
    _ gr a b
    g | gr a b -> Bool
    forall a b. gr a b -> Bool
    forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Bool
    isEmpty gr a b
    g = ([],gr a b
    g,Int
    n)
    dfsTree Int
    n Int
    u (Int
    v:[Int]
    vs) [[(Int, Int)]]
    ls gr a b
    g = case Int -> gr a b -> Decomp gr a b
    forall a b. Int -> gr a b -> Decomp gr a b
    forall (gr :: * -> * -> *) a b.
    Graph gr =>
    Int -> gr a b -> Decomp gr a b
    match Int
    v gr a b
    g of
                                (Maybe (Context a b)
    Nothing, gr a b
    g1) -> Int
    -> Int
    -> [Int]
    -> [[(Int, Int)]]
    -> gr a b
    -> ([DFSTree Int], gr a b, Int)
    forall (gr :: * -> * -> *) a b.
    Graph gr =>
    Int
    -> Int
    -> [Int]
    -> [[(Int, Int)]]
    -> gr a b
    -> ([DFSTree Int], gr a b, Int)
    dfsTree Int
    n Int
    u [Int]
    vs [[(Int, Int)]]
    ls gr a b
    g1
                                (Just Context a b
    c , gr a b
    g1) -> ((Int, Int, [(Int, Int)]) -> [DFSTree Int] -> DFSTree Int
    forall a. (a, a, [(a, a)]) -> [DFSTree a] -> DFSTree a
    B (Int
    v,Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1,[(Int, Int)]
    bck) [DFSTree Int]
    tsDFSTree Int -> [DFSTree Int] -> [DFSTree Int]
    forall a. a -> [a] -> [a]
    :[DFSTree Int]
    ts', gr a b
    g3, Int
    k)
                                 where  bck :: [(Int, Int)]
    bck        = Int -> [[(Int, Int)]] -> [(Int, Int)]
    getBackEdges Int
    v [[(Int, Int)]]
    ls
                                        ([DFSTree Int]
    ts, gr a b
    g2,Int
    m) = Int
    -> Int
    -> [Int]
    -> [[(Int, Int)]]
    -> gr a b
    -> ([DFSTree Int], gr a b, Int)
    forall (gr :: * -> * -> *) a b.
    Graph gr =>
    Int
    -> Int
    -> [Int]
    -> [[(Int, Int)]]
    -> gr a b
    -> ([DFSTree Int], gr a b, Int)
    dfsTree (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) Int
    v [Int]
    sc [[(Int, Int)]]
    ls' gr a b
    g1
                                        ([DFSTree Int]
    ts',gr a b
    g3,Int
    k) = Int
    -> Int
    -> [Int]
    -> [[(Int, Int)]]
    -> gr a b
    -> ([DFSTree Int], gr a b, Int)
    forall (gr :: * -> * -> *) a b.
    Graph gr =>
    Int
    -> Int
    -> [Int]
    -> [[(Int, Int)]]
    -> gr a b
    -> ([DFSTree Int], gr a b, Int)
    dfsTree Int
    m Int
    v [Int]
    vs [[(Int, Int)]]
    ls gr a b
    g2
                                        ls' :: [[(Int, Int)]]
    ls'        = ((Int
    v,Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1)(Int, Int) -> [(Int, Int)] -> [(Int, Int)]
    forall a. a -> [a] -> [a]
    :[(Int, Int)]
    sc')[(Int, Int)] -> [[(Int, Int)]] -> [[(Int, Int)]]
    forall a. a -> [a] -> [a]
    :[[(Int, Int)]]
    ls
                                        sc' :: [(Int, Int)]
    sc'        = (Int -> (Int, Int)) -> [Int] -> [(Int, Int)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\Int
    x->(Int
    x,Int
    0)) [Int]
    sc
                                        sc :: [Int]
    sc         = Context a b -> [Int]
    forall a b. Context a b -> [Int]
    suc' Context a b
    c

    ------------------------------------------------------------------------------
    -- Finds the minimum between a dfs number and a list of back edges' dfs
    -- numbers.
    ------------------------------------------------------------------------------
    minbckEdge :: Int -> [(Node,Int)] -> Int
    minbckEdge :: Int -> [(Int, Int)] -> Int
    minbckEdge Int
    n [] = Int
    n
    minbckEdge Int
    n [(Int, Int)]
    bs = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min Int
    n ([Int] -> Int
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    minimum (((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int, Int) -> Int
    forall a b. (a, b) -> b
    snd [(Int, Int)]
    bs))

    ------------------------------------------------------------------------------
    -- Returns the low number for a node in a subtree.
    ------------------------------------------------------------------------------
    getLow :: LOWTree Int -> Int
    getLow :: LOWTree Int -> Int
    getLow (Brc (Int
    _,Int
    _,Int
    l) [LOWTree Int]
    _) = Int
    l

    ------------------------------------------------------------------------------
    -- Builds a low tree from a DFS tree. Each element (v,n,low) in the tree
    -- contains: the node number v, the DFS number n, and the low number low.
    ------------------------------------------------------------------------------
    lowTree :: DFSTree Int -> LOWTree Int
    lowTree :: DFSTree Int -> LOWTree Int
    lowTree (B (Int
    v,Int
    n,[]  ) [] ) = (Int, Int, Int) -> [LOWTree Int] -> LOWTree Int
    forall a. (a, a, a) -> [LOWTree a] -> LOWTree a
    Brc (Int
    v,Int
    n,Int
    n) []
    lowTree (B (Int
    v,Int
    n,[(Int, Int)]
    bcks) [] ) = (Int, Int, Int) -> [LOWTree Int] -> LOWTree Int
    forall a. (a, a, a) -> [LOWTree a] -> LOWTree a
    Brc (Int
    v,Int
    n,Int -> [(Int, Int)] -> Int
    minbckEdge Int
    n [(Int, Int)]
    bcks) []
    lowTree (B (Int
    v,Int
    n,[(Int, Int)]
    bcks) [DFSTree Int]
    trs) = (Int, Int, Int) -> [LOWTree Int] -> LOWTree Int
    forall a. (a, a, a) -> [LOWTree a] -> LOWTree a
    Brc (Int
    v,Int
    n,Int
    lowv) [LOWTree Int]
    ts
                                 where lowv :: Int
    lowv     = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min (Int -> [(Int, Int)] -> Int
    minbckEdge Int
    n [(Int, Int)]
    bcks) Int
    lowChild
                                       lowChild :: Int
    lowChild = [Int] -> Int
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    minimum ((LOWTree Int -> Int) -> [LOWTree Int] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map LOWTree Int -> Int
    getLow [LOWTree Int]
    ts)
                                       ts :: [LOWTree Int]
    ts       = (DFSTree Int -> LOWTree Int) -> [DFSTree Int] -> [LOWTree Int]
    forall a b. (a -> b) -> [a] -> [b]
    map DFSTree Int -> LOWTree Int
    lowTree [DFSTree Int]
    trs

    ------------------------------------------------------------------------------
    -- Builds a low tree for a given graph. Each element (v,n,low) in the tree
    -- contains: the node number v, the DFS number n, and the low number low.
    ------------------------------------------------------------------------------
    getLowTree :: (Graph gr) => gr a b -> Node -> LOWTree Int
    getLowTree :: forall (gr :: * -> * -> *) a b.
    Graph gr =>
    gr a b -> Int -> LOWTree Int
    getLowTree gr a b
    g Int
    v = DFSTree Int -> LOWTree Int
    lowTree ([DFSTree Int] -> DFSTree Int
    forall a. HasCallStack => [a] -> a
    head [DFSTree Int]
    dfsf)
                      where ([DFSTree Int]
    dfsf, gr a b
    _, Int
    _) = Int
    -> Int
    -> [Int]
    -> [[(Int, Int)]]
    -> gr a b
    -> ([DFSTree Int], gr a b, Int)
    forall (gr :: * -> * -> *) a b.
    Graph gr =>
    Int
    -> Int
    -> [Int]
    -> [[(Int, Int)]]
    -> gr a b
    -> ([DFSTree Int], gr a b, Int)
    dfsTree Int
    0 Int
    0 [Int
    v] [] gr a b
    g

    ------------------------------------------------------------------------------
    -- Tests if a node in a subtree is an articulation point. An non-root node v
    -- is an articulation point iff there exists at least one child w of v such
    -- that lowNumber(w) >= dfsNumber(v). The root node is an articulation point
    -- iff it has two or more children.
    ------------------------------------------------------------------------------
    isap :: LOWTree Int -> Bool
    isap :: LOWTree Int -> Bool
    isap (Brc (Int
    _,Int
    _,Int
    _) []) = Bool
    False
    isap (Brc (Int
    _,Int
    1,Int
    _) [LOWTree Int]
    ts) = [LOWTree Int] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [LOWTree Int]
    ts Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    1
    isap (Brc (Int
    _,Int
    n,Int
    _) [LOWTree Int]
    ts) = Bool -> Bool
    not ([Int] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Int]
    ch)
                            where ch :: [Int]
    ch = (Int -> Bool) -> [Int] -> [Int]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ( Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >=Int
    n) ((LOWTree Int -> Int) -> [LOWTree Int] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map LOWTree Int -> Int
    getLow [LOWTree Int]
    ts)

    ------------------------------------------------------------------------------
    -- Finds the articulation points by traversing the low tree.
    ------------------------------------------------------------------------------
    arp :: LOWTree Int -> [Node]
    arp :: LOWTree Int -> [Int]
    arp (Brc (Int
    v,Int
    1,Int
    _) [LOWTree Int]
    ts) | [LOWTree Int] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [LOWTree Int]
    ts Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    1         = Int
    vInt -> [Int] -> [Int]
    forall a. a -> [a] -> [a]
    :(LOWTree Int -> [Int]) -> [LOWTree Int] -> [Int]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap LOWTree Int -> [Int]
    arp [LOWTree Int]
    ts
                         | Bool
    otherwise             =   (LOWTree Int -> [Int]) -> [LOWTree Int] -> [Int]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap LOWTree Int -> [Int]
    arp [LOWTree Int]
    ts
    arp (Brc (Int
    v,Int
    n,Int
    l) [LOWTree Int]
    ts) | LOWTree Int -> Bool
    isap ((Int, Int, Int) -> [LOWTree Int] -> LOWTree Int
    forall a. (a, a, a) -> [LOWTree a] -> LOWTree a
    Brc (Int
    v,Int
    n,Int
    l) [LOWTree Int]
    ts) = Int
    vInt -> [Int] -> [Int]
    forall a. a -> [a] -> [a]
    :(LOWTree Int -> [Int]) -> [LOWTree Int] -> [Int]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap LOWTree Int -> [Int]
    arp [LOWTree Int]
    ts
                         | Bool
    otherwise             =   (LOWTree Int -> [Int]) -> [LOWTree Int] -> [Int]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap LOWTree Int -> [Int]
    arp [LOWTree Int]
    ts

    ------------------------------------------------------------------------------
    -- Finds the articulation points of a graph starting at a given node.
    ------------------------------------------------------------------------------
    artpoints :: (Graph gr) => gr a b -> Node -> [Node]
    artpoints :: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> [Int]
    artpoints gr a b
    g Int
    v = LOWTree Int -> [Int]
    arp (gr a b -> Int -> LOWTree Int
    forall (gr :: * -> * -> *) a b.
    Graph gr =>
    gr a b -> Int -> LOWTree Int
    getLowTree gr a b
    g Int
    v)

    {-|
       Finds the articulation points for a connected undirected graph,
       by using the low numbers criteria:

       a) The root node is an articulation point iff it has two or more children.

       b) An non-root node v is an articulation point iff there exists at least
          one child w of v such that lowNumber(w) >= dfsNumber(v).
    -}
    ap :: (Graph gr) => gr a b -> [Node]
    ap :: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [Int]
    ap gr a b
    g = gr a b -> Int -> [Int]
    forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> [Int]
    artpoints gr a b
    g Int
    v where ((Adj b
    _,Int
    v,a
    _,Adj b
    _),gr a b
    _) = gr a b -> (Context a b, gr a b)
    forall a b. gr a b -> GDecomp gr a b
    forall (gr :: * -> * -> *) a b.
    Graph gr =>
    gr a b -> GDecomp gr a b
    matchAny gr a b
    g