{-# LANGUAGE BangPatterns, CPP, ScopedTypeVariables #-}
#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE DeriveGeneric #-}
#endif

-- |An efficient implementation of 'Data.Graph.Inductive.Graph.Graph'
-- using big-endian patricia tree (i.e. "Data.IntMap").
--
-- This module provides the following specialised functions to gain
-- more performance, using GHC's RULES pragma:
--
-- * 'Data.Graph.Inductive.Graph.insNode'
--
-- * 'Data.Graph.Inductive.Graph.insEdge'
--
-- * 'Data.Graph.Inductive.Graph.gmap'
--
-- * 'Data.Graph.Inductive.Graph.nmap'
--
-- * 'Data.Graph.Inductive.Graph.emap'

module Data.Graph.Inductive.PatriciaTree
    ( Gr
    , UGr
    )
    where

import Data.Graph.Inductive.Graph

import           Control.Applicative (liftA2)
import           Data.IntMap         (IntMap)
import qualified Data.IntMap         as IM
import           Data.List           (foldl', sort)
import           Data.Maybe          (fromMaybe)
import           Data.Tuple          (swap)

#if MIN_VERSION_containers (0,4,2)
import Control.DeepSeq (NFData(..))
#endif

#if MIN_VERSION_containers(0,5,0)
import qualified Data.IntMap.Strict as IMS
#else
import qualified Data.IntMap as IMS
#endif

#if __GLASGOW_HASKELL__ >= 702
import GHC.Generics (Generic)
#endif

#if MIN_VERSION_base (4,8,0)
import Data.Bifunctor
#else
import Control.Arrow (second)
#endif

----------------------------------------------------------------------
-- GRAPH REPRESENTATION
----------------------------------------------------------------------

newtype Gr a b = Gr (GraphRep a b)
#if __GLASGOW_HASKELL__ >= 702
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b x. Rep (Gr a b) x -> Gr a b
forall a b x. Gr a b -> Rep (Gr a b) x
$cto :: forall a b x. Rep (Gr a b) x -> Gr a b
$cfrom :: forall a b x. Gr a b -> Rep (Gr a b) x
Generic)
#endif

type GraphRep a b = IntMap (Context' a b)
type Context' a b = (IntMap [b], a, IntMap [b])

type UGr = Gr () ()

----------------------------------------------------------------------
-- CLASS INSTANCES
----------------------------------------------------------------------

instance (Eq a, Ord b) => Eq (Gr a b) where
  (Gr IntMap (IntMap [b], a, IntMap [b])
g1) == :: Gr a b -> Gr a b -> Bool
== (Gr IntMap (IntMap [b], a, IntMap [b])
g2) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {f :: * -> *} {f :: * -> *} {a} {a} {b}.
(Functor f, Functor f, Ord a, Ord a) =>
(f [a], b, f [a]) -> (f [a], b, f [a])
sortAdj IntMap (IntMap [b], a, IntMap [b])
g1 forall a. Eq a => a -> a -> Bool
== forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {f :: * -> *} {f :: * -> *} {a} {a} {b}.
(Functor f, Functor f, Ord a, Ord a) =>
(f [a], b, f [a]) -> (f [a], b, f [a])
sortAdj IntMap (IntMap [b], a, IntMap [b])
g2
    where
      sortAdj :: (f [a], b, f [a]) -> (f [a], b, f [a])
sortAdj (f [a]
p,b
n,f [a]
s) = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Ord a => [a] -> [a]
sort f [a]
p,b
n,forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Ord a => [a] -> [a]
sort f [a]
s)

instance (Show a, Show b) => Show (Gr a b) where
  showsPrec :: Int -> Gr a b -> ShowS
showsPrec Int
d Gr a b
g = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
                    String -> ShowS
showString String
"mkGraph "
                    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
labNodes Gr a b
g)
                    forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
                    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LEdge b]
labEdges Gr a b
g)

instance (Read a, Read b) => Read (Gr a b) where
  readsPrec :: Int -> ReadS (Gr a b)
readsPrec Int
p = forall a. Bool -> ReadS a -> ReadS a
readParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$ \ String
r -> do
    (String
"mkGraph", String
s) <- ReadS String
lex String
r
    ([LNode a]
ns,String
t) <- forall a. Read a => ReadS a
reads String
s
    ([LEdge b]
es,String
u) <- forall a. Read a => ReadS a
reads String
t
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall (gr :: * -> * -> *) a b.
Graph gr =>
[LNode a] -> [LEdge b] -> gr a b
mkGraph [LNode a]
ns [LEdge b]
es, String
u)

instance Graph Gr where
    empty :: forall a b. Gr a b
empty           = forall a b. GraphRep a b -> Gr a b
Gr forall a. IntMap a
IM.empty

    isEmpty :: forall a b. Gr a b -> Bool
isEmpty (Gr GraphRep a b
g)  = forall a. IntMap a -> Bool
IM.null GraphRep a b
g

    match :: forall a b. Int -> Gr a b -> Decomp Gr a b
match           = forall a b. Int -> Gr a b -> Decomp Gr a b
matchGr

    mkGraph :: forall a b. [LNode a] -> [LEdge b] -> Gr a b
mkGraph [LNode a]
vs [LEdge b]
es   = forall (gr :: * -> * -> *) b a.
DynGraph gr =>
[LEdge b] -> gr a b -> gr a b
insEdges [LEdge b]
es
                      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. GraphRep a b -> Gr a b
Gr
                      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [(Int, a)] -> IntMap a
IM.fromList
                      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (\a
l -> (forall a. IntMap a
IM.empty,a
l,forall a. IntMap a
IM.empty)))
                      forall a b. (a -> b) -> a -> b
$ [LNode a]
vs

    labNodes :: forall a b. Gr a b -> [LNode a]
labNodes (Gr GraphRep a b
g) = [ (Int
node, a
label)
                            | (Int
node, (IntMap [b]
_, a
label, IntMap [b]
_)) <- forall a. IntMap a -> [(Int, a)]
IM.toList GraphRep a b
g ]

    noNodes :: forall a b. Gr a b -> Int
noNodes   (Gr GraphRep a b
g) = forall a. IntMap a -> Int
IM.size GraphRep a b
g

    nodeRange :: forall a b. Gr a b -> (Int, Int)
nodeRange (Gr GraphRep a b
g) = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"nodeRange of empty graph")
                       forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (forall {b} {b} {b}. Maybe ((b, b), b) -> Maybe b
ix (forall a. IntMap a -> Maybe ((Int, a), IntMap a)
IM.minViewWithKey GraphRep a b
g))
                                    (forall {b} {b} {b}. Maybe ((b, b), b) -> Maybe b
ix (forall a. IntMap a -> Maybe ((Int, a), IntMap a)
IM.maxViewWithKey GraphRep a b
g))
      where
        ix :: Maybe ((b, b), b) -> Maybe b
ix = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)

    labEdges :: forall a b. Gr a b -> [LEdge b]
labEdges (Gr GraphRep a b
g) = do (Int
node, (IntMap [b]
_, a
_, IntMap [b]
s)) <- forall a. IntMap a -> [(Int, a)]
IM.toList GraphRep a b
g
                         (Int
next, [b]
labels)    <- forall a. IntMap a -> [(Int, a)]
IM.toList IntMap [b]
s
                         b
label             <- [b]
labels
                         forall (m :: * -> *) a. Monad m => a -> m a
return (Int
node, Int
next, b
label)

instance DynGraph Gr where
    (Adj b
p, Int
v, a
l, Adj b
s) & :: forall a b. Context a b -> Gr a b -> Gr a b
& (Gr GraphRep a b
g)
        = let !g1 :: GraphRep a b
g1 = forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
v (IntMap [b]
preds, a
l, IntMap [b]
succs) GraphRep a b
g
              !(Int
np, IntMap [b]
preds) = forall b. Adj b -> (Int, IntMap [b])
fromAdjCounting Adj b
p
              !(Int
ns, IntMap [b]
succs) = forall b. Adj b -> (Int, IntMap [b])
fromAdjCounting Adj b
s
              !g2 :: GraphRep a b
g2 = forall a b.
GraphRep a b -> Int -> Int -> IntMap [b] -> GraphRep a b
addSucc GraphRep a b
g1 Int
v Int
np IntMap [b]
preds
              !g3 :: GraphRep a b
g3 = forall a b.
GraphRep a b -> Int -> Int -> IntMap [b] -> GraphRep a b
addPred GraphRep a b
g2 Int
v Int
ns IntMap [b]
succs
          in forall a b. GraphRep a b -> Gr a b
Gr GraphRep a b
g3

#if MIN_VERSION_containers (0,4,2)
instance (NFData a, NFData b) => NFData (Gr a b) where
  rnf :: Gr a b -> ()
rnf (Gr GraphRep a b
g) = forall a. NFData a => a -> ()
rnf GraphRep a b
g
#endif

instance Functor (Gr a) where
  fmap :: forall a b. (a -> b) -> Gr a a -> Gr a b
fmap = forall a a b. (a -> b) -> Gr a a -> Gr a b
fastEMap

#if MIN_VERSION_base (4,8,0)
instance Bifunctor Gr where
  bimap :: forall a b c d. (a -> b) -> (c -> d) -> Gr a c -> Gr b d
bimap = forall a b c d. (a -> c) -> (b -> d) -> Gr a b -> Gr c d
fastNEMap

  first :: forall a b c. (a -> b) -> Gr a c -> Gr b c
first = forall a b c. (a -> c) -> Gr a b -> Gr c b
fastNMap

  second :: forall b c a. (b -> c) -> Gr a b -> Gr a c
second = forall a a b. (a -> b) -> Gr a a -> Gr a b
fastEMap
#endif

matchGr :: Node -> Gr a b -> Decomp Gr a b
matchGr :: forall a b. Int -> Gr a b -> Decomp Gr a b
matchGr Int
node (Gr GraphRep a b
g)
    = case forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
node GraphRep a b
g of
        Maybe (Context' a b)
Nothing
            -> (forall a. Maybe a
Nothing, forall a b. GraphRep a b -> Gr a b
Gr GraphRep a b
g)

        Just (IntMap [b]
p, a
label, IntMap [b]
s)
            -> let !g1 :: GraphRep a b
g1 = forall a. Int -> IntMap a -> IntMap a
IM.delete Int
node GraphRep a b
g
                   !p' :: IntMap [b]
p' = forall a. Int -> IntMap a -> IntMap a
IM.delete Int
node IntMap [b]
p
                   !s' :: IntMap [b]
s' = forall a. Int -> IntMap a -> IntMap a
IM.delete Int
node IntMap [b]
s
                   !g2 :: GraphRep a b
g2 = forall a b x. GraphRep a b -> Int -> IntMap x -> GraphRep a b
clearPred GraphRep a b
g1 Int
node IntMap [b]
s'
                   !g3 :: GraphRep a b
g3 = forall a b x. GraphRep a b -> Int -> IntMap x -> GraphRep a b
clearSucc GraphRep a b
g2 Int
node IntMap [b]
p'
               in (forall a. a -> Maybe a
Just (forall b. IntMap [b] -> Adj b
toAdj IntMap [b]
p', Int
node, a
label, forall b. IntMap [b] -> Adj b
toAdj IntMap [b]
s), forall a b. GraphRep a b -> Gr a b
Gr GraphRep a b
g3)

----------------------------------------------------------------------
-- OVERRIDING FUNCTIONS
----------------------------------------------------------------------

{-# RULES
      "insNode/Data.Graph.Inductive.PatriciaTree"  insNode = fastInsNode
  #-}
fastInsNode :: LNode a -> Gr a b -> Gr a b
fastInsNode :: forall a b. LNode a -> Gr a b -> Gr a b
fastInsNode (Int
v, a
l) (Gr GraphRep a b
g) = GraphRep a b
g' seq :: forall a b. a -> b -> b
`seq` forall a b. GraphRep a b -> Gr a b
Gr GraphRep a b
g'
  where
    g' :: GraphRep a b
g' = forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
v (forall a. IntMap a
IM.empty, a
l, forall a. IntMap a
IM.empty) GraphRep a b
g

{-# RULES
      "insEdge/Data.Graph.Inductive.PatriciaTree"  insEdge = fastInsEdge
  #-}
fastInsEdge :: LEdge b -> Gr a b -> Gr a b
fastInsEdge :: forall b a. LEdge b -> Gr a b -> Gr a b
fastInsEdge (Int
v, Int
w, b
l) (Gr GraphRep a b
g) = GraphRep a b
g2 seq :: forall a b. a -> b -> b
`seq` forall a b. GraphRep a b -> Gr a b
Gr GraphRep a b
g2
  where
    g1 :: GraphRep a b
g1 = forall a. (a -> a) -> Int -> IntMap a -> IntMap a
IM.adjust forall {a} {b}. (a, b, IntMap [b]) -> (a, b, IntMap [b])
addS' Int
v GraphRep a b
g
    g2 :: GraphRep a b
g2 = forall a. (a -> a) -> Int -> IntMap a -> IntMap a
IM.adjust forall {b} {c}. (IntMap [b], b, c) -> (IntMap [b], b, c)
addP' Int
w GraphRep a b
g1

    addS' :: (a, b, IntMap [b]) -> (a, b, IntMap [b])
addS' (a
ps, b
l', IntMap [b]
ss) = (a
ps, b
l', forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IM.insertWith forall a. [a] -> [a] -> [a]
addLists Int
w [b
l] IntMap [b]
ss)
    addP' :: (IntMap [b], b, c) -> (IntMap [b], b, c)
addP' (IntMap [b]
ps, b
l', c
ss) = (forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IM.insertWith forall a. [a] -> [a] -> [a]
addLists Int
v [b
l] IntMap [b]
ps, b
l', c
ss)

{-# RULES
      "gmap/Data.Graph.Inductive.PatriciaTree"  gmap = fastGMap
  #-}
fastGMap :: forall a b c d. (Context a b -> Context c d) -> Gr a b -> Gr c d
fastGMap :: forall a b c d. (Context a b -> Context c d) -> Gr a b -> Gr c d
fastGMap Context a b -> Context c d
f (Gr GraphRep a b
g) = forall a b. GraphRep a b -> Gr a b
Gr (forall a b. (Int -> a -> b) -> IntMap a -> IntMap b
IM.mapWithKey Int -> Context' a b -> Context' c d
f' GraphRep a b
g)
  where
    f' :: Node -> Context' a b -> Context' c d
    f' :: Int -> Context' a b -> Context' c d
f' = ((forall a b. Context a b -> Context' a b
fromContext forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context a b -> Context c d
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Int -> Context' a b -> Context a b
toContext

{-# RULES
      "nmap/Data.Graph.Inductive.PatriciaTree"  nmap = fastNMap
  #-}
fastNMap :: forall a b c. (a -> c) -> Gr a b -> Gr c b
fastNMap :: forall a b c. (a -> c) -> Gr a b -> Gr c b
fastNMap a -> c
f (Gr GraphRep a b
g) = forall a b. GraphRep a b -> Gr a b
Gr (forall a b. (a -> b) -> IntMap a -> IntMap b
IM.map Context' a b -> Context' c b
f' GraphRep a b
g)
  where
    f' :: Context' a b -> Context' c b
    f' :: Context' a b -> Context' c b
f' (IntMap [b]
ps, a
a, IntMap [b]
ss) = (IntMap [b]
ps, a -> c
f a
a, IntMap [b]
ss)

{-# RULES
      "emap/Data.Graph.Inductive.PatriciaTree"  emap = fastEMap
  #-}
fastEMap :: forall a b c. (b -> c) -> Gr a b -> Gr a c
fastEMap :: forall a a b. (a -> b) -> Gr a a -> Gr a b
fastEMap b -> c
f (Gr GraphRep a b
g) = forall a b. GraphRep a b -> Gr a b
Gr (forall a b. (a -> b) -> IntMap a -> IntMap b
IM.map Context' a b -> Context' a c
f' GraphRep a b
g)
  where
    f' :: Context' a b -> Context' a c
    f' :: Context' a b -> Context' a c
f' (IntMap [b]
ps, a
a, IntMap [b]
ss) = (forall a b. (a -> b) -> IntMap a -> IntMap b
IM.map (forall a b. (a -> b) -> [a] -> [b]
map b -> c
f) IntMap [b]
ps, a
a, forall a b. (a -> b) -> IntMap a -> IntMap b
IM.map (forall a b. (a -> b) -> [a] -> [b]
map b -> c
f) IntMap [b]
ss)

{-# RULES
      "nemap/Data.Graph.Inductive.PatriciaTree"  nemap = fastNEMap
  #-}
fastNEMap :: forall a b c d. (a -> c) -> (b -> d) -> Gr a b -> Gr c d
fastNEMap :: forall a b c d. (a -> c) -> (b -> d) -> Gr a b -> Gr c d
fastNEMap a -> c
fn b -> d
fe (Gr GraphRep a b
g) = forall a b. GraphRep a b -> Gr a b
Gr (forall a b. (a -> b) -> IntMap a -> IntMap b
IM.map Context' a b -> Context' c d
f GraphRep a b
g)
  where
    f :: Context' a b -> Context' c d
    f :: Context' a b -> Context' c d
f (IntMap [b]
ps, a
a, IntMap [b]
ss) = (forall a b. (a -> b) -> IntMap a -> IntMap b
IM.map (forall a b. (a -> b) -> [a] -> [b]
map b -> d
fe) IntMap [b]
ps, a -> c
fn a
a, forall a b. (a -> b) -> IntMap a -> IntMap b
IM.map (forall a b. (a -> b) -> [a] -> [b]
map b -> d
fe) IntMap [b]
ss)

----------------------------------------------------------------------
-- UTILITIES
----------------------------------------------------------------------

toAdj :: IntMap [b] -> Adj b
toAdj :: forall b. IntMap [b] -> Adj b
toAdj = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {b} {a}. (b, [a]) -> [(a, b)]
expand forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IntMap a -> [(Int, a)]
IM.toList
  where
    expand :: (b, [a]) -> [(a, b)]
expand (b
n,[a]
ls) = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) b
n) [a]
ls

fromAdj :: Adj b -> IntMap [b]
fromAdj :: forall b. Adj b -> IntMap [b]
fromAdj = forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a
IM.fromListWith forall a. [a] -> [a] -> [a]
addLists forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> (b, a)
swap)

data FromListCounting a = FromListCounting !Int !(IntMap a)
  deriving (FromListCounting a -> FromListCounting a -> Bool
forall a. Eq a => FromListCounting a -> FromListCounting a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FromListCounting a -> FromListCounting a -> Bool
$c/= :: forall a. Eq a => FromListCounting a -> FromListCounting a -> Bool
== :: FromListCounting a -> FromListCounting a -> Bool
$c== :: forall a. Eq a => FromListCounting a -> FromListCounting a -> Bool
Eq, Int -> FromListCounting a -> ShowS
forall a. Show a => Int -> FromListCounting a -> ShowS
forall a. Show a => [FromListCounting a] -> ShowS
forall a. Show a => FromListCounting a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FromListCounting a] -> ShowS
$cshowList :: forall a. Show a => [FromListCounting a] -> ShowS
show :: FromListCounting a -> String
$cshow :: forall a. Show a => FromListCounting a -> String
showsPrec :: Int -> FromListCounting a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> FromListCounting a -> ShowS
Show, ReadPrec [FromListCounting a]
ReadPrec (FromListCounting a)
ReadS [FromListCounting a]
forall a. Read a => ReadPrec [FromListCounting a]
forall a. Read a => ReadPrec (FromListCounting a)
forall a. Read a => Int -> ReadS (FromListCounting a)
forall a. Read a => ReadS [FromListCounting a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FromListCounting a]
$creadListPrec :: forall a. Read a => ReadPrec [FromListCounting a]
readPrec :: ReadPrec (FromListCounting a)
$creadPrec :: forall a. Read a => ReadPrec (FromListCounting a)
readList :: ReadS [FromListCounting a]
$creadList :: forall a. Read a => ReadS [FromListCounting a]
readsPrec :: Int -> ReadS (FromListCounting a)
$creadsPrec :: forall a. Read a => Int -> ReadS (FromListCounting a)
Read)

getFromListCounting :: FromListCounting a -> (Int, IntMap a)
getFromListCounting :: forall a. FromListCounting a -> (Int, IntMap a)
getFromListCounting (FromListCounting Int
i IntMap a
m) = (Int
i, IntMap a
m)
{-# INLINE getFromListCounting #-}

fromListWithKeyCounting :: (Int -> a -> a -> a) -> [(Int, a)] -> (Int, IntMap a)
fromListWithKeyCounting :: forall a. (Int -> a -> a -> a) -> [(Int, a)] -> (Int, IntMap a)
fromListWithKeyCounting Int -> a -> a -> a
f = forall a. FromListCounting a -> (Int, IntMap a)
getFromListCounting forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' FromListCounting a -> (Int, a) -> FromListCounting a
ins (forall a. Int -> IntMap a -> FromListCounting a
FromListCounting Int
0 forall a. IntMap a
IM.empty)
  where
    ins :: FromListCounting a -> (Int, a) -> FromListCounting a
ins (FromListCounting Int
i IntMap a
t) (Int
k,a
x) = forall a. Int -> IntMap a -> FromListCounting a
FromListCounting (Int
i forall a. Num a => a -> a -> a
+ Int
1) (forall a. (Int -> a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IM.insertWithKey Int -> a -> a -> a
f Int
k a
x IntMap a
t)
{-# INLINE fromListWithKeyCounting #-}

fromListWithCounting :: (a -> a -> a) -> [(Int, a)] -> (Int, IntMap a)
fromListWithCounting :: forall a. (a -> a -> a) -> [(Int, a)] -> (Int, IntMap a)
fromListWithCounting a -> a -> a
f = forall a. (Int -> a -> a -> a) -> [(Int, a)] -> (Int, IntMap a)
fromListWithKeyCounting (\Int
_ a
x a
y -> a -> a -> a
f a
x a
y)
{-# INLINE fromListWithCounting #-}

fromAdjCounting :: Adj b -> (Int, IntMap [b])
fromAdjCounting :: forall b. Adj b -> (Int, IntMap [b])
fromAdjCounting = forall a. (a -> a -> a) -> [(Int, a)] -> (Int, IntMap a)
fromListWithCounting forall a. [a] -> [a] -> [a]
addLists forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> (b, a)
swap)

-- We use differenceWith to modify a graph more than bulkThreshold times,
-- and repeated insertWith otherwise.
bulkThreshold :: Int
bulkThreshold :: Int
bulkThreshold = Int
5

toContext :: Node -> Context' a b -> Context a b
toContext :: forall a b. Int -> Context' a b -> Context a b
toContext Int
v (IntMap [b]
ps, a
a, IntMap [b]
ss) = (forall b. IntMap [b] -> Adj b
toAdj IntMap [b]
ps, Int
v, a
a, forall b. IntMap [b] -> Adj b
toAdj IntMap [b]
ss)

fromContext :: Context a b -> Context' a b
fromContext :: forall a b. Context a b -> Context' a b
fromContext (Adj b
ps, Int
_, a
a, Adj b
ss) = (forall b. Adj b -> IntMap [b]
fromAdj Adj b
ps, a
a, forall b. Adj b -> IntMap [b]
fromAdj Adj b
ss)

-- A version of @++@ where order isn't important, so @xs ++ [x]@
-- becomes @x:xs@.  Used when we have to have a function of type @[a]
-- -> [a] -> [a]@ but one of the lists is just going to be a single
-- element (and it isn't possible to tell which).
addLists :: [a] -> [a] -> [a]
addLists :: forall a. [a] -> [a] -> [a]
addLists [a
a] [a]
as  = a
a forall a. a -> [a] -> [a]
: [a]
as
addLists [a]
as  [a
a] = a
a forall a. a -> [a] -> [a]
: [a]
as
addLists [a]
xs  [a]
ys  = [a]
xs forall a. [a] -> [a] -> [a]
++ [a]
ys

addSucc :: forall a b . GraphRep a b -> Node -> Int -> IM.IntMap [b] -> GraphRep a b
addSucc :: forall a b.
GraphRep a b -> Int -> Int -> IntMap [b] -> GraphRep a b
addSucc GraphRep a b
g0 Int
v Int
numAdd IntMap [b]
xs
  | Int
numAdd forall a. Ord a => a -> a -> Bool
< Int
bulkThreshold = forall a b. (a -> Int -> b -> a) -> a -> IntMap b -> a
foldlWithKey' GraphRep a b -> Int -> [b] -> GraphRep a b
go GraphRep a b
g0 IntMap [b]
xs
  where
    go :: GraphRep a b -> Node -> [b] -> GraphRep a b
    go :: GraphRep a b -> Int -> [b] -> GraphRep a b
go GraphRep a b
g Int
p [b]
l = forall a. (a -> a) -> Int -> IntMap a -> IntMap a
IMS.adjust forall {a} {b}. (a, b, IntMap [b]) -> (a, b, IntMap [b])
f Int
p GraphRep a b
g
      where f :: (a, b, IntMap [b]) -> (a, b, IntMap [b])
f (a
ps, b
l', IntMap [b]
ss) = let !ss' :: IntMap [b]
ss' = forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IM.insertWith forall a. [a] -> [a] -> [a]
addLists Int
v [b]
l IntMap [b]
ss
                             in (a
ps, b
l', IntMap [b]
ss')
addSucc GraphRep a b
g Int
v Int
_ IntMap [b]
xs = forall a b. (a -> b -> Maybe a) -> IntMap a -> IntMap b -> IntMap a
IMS.differenceWith Context' a b -> [b] -> Maybe (Context' a b)
go GraphRep a b
g IntMap [b]
xs
  where
    go :: Context' a b -> [b] -> Maybe (Context' a b)
    go :: Context' a b -> [b] -> Maybe (Context' a b)
go (IntMap [b]
ps, a
l', IntMap [b]
ss) [b]
l = let !ss' :: IntMap [b]
ss' = forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IM.insertWith forall a. [a] -> [a] -> [a]
addLists Int
v [b]
l IntMap [b]
ss
                        in forall a. a -> Maybe a
Just (IntMap [b]
ps, a
l', IntMap [b]
ss')

foldlWithKey' :: (a -> IM.Key -> b -> a) -> a -> IntMap b -> a
foldlWithKey' :: forall a b. (a -> Int -> b -> a) -> a -> IntMap b -> a
foldlWithKey' =
#if MIN_VERSION_containers (0,4,2)
  forall a b. (a -> Int -> b -> a) -> a -> IntMap b -> a
IM.foldlWithKey'
#else
  IM.foldWithKey . adjustFunc
  where
    adjustFunc f k b a = f a k b
#endif

addPred :: forall a b . GraphRep a b -> Node -> Int -> IM.IntMap [b] -> GraphRep a b
addPred :: forall a b.
GraphRep a b -> Int -> Int -> IntMap [b] -> GraphRep a b
addPred GraphRep a b
g0 Int
v Int
numAdd IntMap [b]
xs
  | Int
numAdd forall a. Ord a => a -> a -> Bool
< Int
bulkThreshold = forall a b. (a -> Int -> b -> a) -> a -> IntMap b -> a
foldlWithKey' GraphRep a b -> Int -> [b] -> GraphRep a b
go GraphRep a b
g0 IntMap [b]
xs
  where
    go :: GraphRep a b -> Node -> [b] -> GraphRep a b
    go :: GraphRep a b -> Int -> [b] -> GraphRep a b
go GraphRep a b
g Int
p [b]
l = forall a. (a -> a) -> Int -> IntMap a -> IntMap a
IMS.adjust forall {b} {c}. (IntMap [b], b, c) -> (IntMap [b], b, c)
f Int
p GraphRep a b
g
      where f :: (IntMap [b], b, c) -> (IntMap [b], b, c)
f (IntMap [b]
ps, b
l', c
ss) = let !ps' :: IntMap [b]
ps' = forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IM.insertWith forall a. [a] -> [a] -> [a]
addLists Int
v [b]
l IntMap [b]
ps
                             in (IntMap [b]
ps', b
l', c
ss)
addPred GraphRep a b
g Int
v Int
_ IntMap [b]
xs = forall a b. (a -> b -> Maybe a) -> IntMap a -> IntMap b -> IntMap a
IMS.differenceWith Context' a b -> [b] -> Maybe (Context' a b)
go GraphRep a b
g IntMap [b]
xs
  where
    go :: Context' a b -> [b] -> Maybe (Context' a b)
    go :: Context' a b -> [b] -> Maybe (Context' a b)
go (IntMap [b]
ps, a
l', IntMap [b]
ss) [b]
l = let !ps' :: IntMap [b]
ps' = forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IM.insertWith forall a. [a] -> [a] -> [a]
addLists Int
v [b]
l IntMap [b]
ps
                        in forall a. a -> Maybe a
Just (IntMap [b]
ps', a
l', IntMap [b]
ss)

clearSucc :: forall a b x . GraphRep a b -> Node -> IM.IntMap x -> GraphRep a b
clearSucc :: forall a b x. GraphRep a b -> Int -> IntMap x -> GraphRep a b
clearSucc GraphRep a b
g Int
v = forall a b. (a -> b -> Maybe a) -> IntMap a -> IntMap b -> IntMap a
IMS.differenceWith Context' a b -> x -> Maybe (Context' a b)
go GraphRep a b
g
  where
    go :: Context' a b -> x -> Maybe (Context' a b)
    go :: Context' a b -> x -> Maybe (Context' a b)
go (IntMap [b]
ps, a
l, IntMap [b]
ss) x
_ = let !ss' :: IntMap [b]
ss' = forall a. Int -> IntMap a -> IntMap a
IM.delete Int
v IntMap [b]
ss
                       in forall a. a -> Maybe a
Just (IntMap [b]
ps, a
l, IntMap [b]
ss')

clearPred :: forall a b x . GraphRep a b -> Node -> IM.IntMap x -> GraphRep a b
clearPred :: forall a b x. GraphRep a b -> Int -> IntMap x -> GraphRep a b
clearPred GraphRep a b
g Int
v = forall a b. (a -> b -> Maybe a) -> IntMap a -> IntMap b -> IntMap a
IMS.differenceWith Context' a b -> x -> Maybe (Context' a b)
go GraphRep a b
g
  where
    go :: Context' a b -> x -> Maybe (Context' a b)
    go :: Context' a b -> x -> Maybe (Context' a b)
go (IntMap [b]
ps, a
l, IntMap [b]
ss) x
_ = let !ps' :: IntMap [b]
ps' = forall a. Int -> IntMap a -> IntMap a
IM.delete Int
v IntMap [b]
ps
                       in forall a. a -> Maybe a
Just (IntMap [b]
ps', a
l, IntMap [b]
ss)