-- | Graph algorithms operating on 'GraphQuery v'.
--
-- All traversal algorithms accept a 'TraversalWeight v' at the call site,
-- enabling the same 'GraphQuery' to be used with directed, undirected, or
-- custom-weighted traversal without any conversion.
--
-- == Categorical Interpretation
--
-- Algorithms are natural transformations over the 'GraphQuery' coalgebra.
-- They unfold the coalgebra according to a traversal policy ('TraversalWeight')
-- and accumulate results.
--
-- == Complexity Note
--
-- 'betweennessCentrality' uses the Brandes algorithm: O(n·(n+r)·log n).
-- It calls 'queryIncidentRels' in the inner loop. For large graphs, wrap
-- the 'GraphQuery' with 'memoizeIncidentRels' before calling this function.
-- TODO: bulk adjacency — see open question §1 in the feature proposal.
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
module Pattern.Graph.Algorithms
  ( -- * Traversal
    bfs
  , dfs
    -- * Paths
  , shortestPath
  , hasPath
  , allPaths
    -- * Boolean queries
  , isNeighbor
  , isConnected
    -- * Structural
  , connectedComponents
  , topologicalSort
  , hasCycle
    -- * Spanning
  , minimumSpanningTree
    -- * Centrality
  , degreeCentrality
  , betweennessCentrality
    -- * Context query helpers
  , queryAnnotationsOf
  , queryWalksContaining
  , queryCoMembers
  ) where

import Data.List (foldl', sortBy)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (mapMaybe, fromMaybe)
import Data.Ord (comparing)
import qualified Data.Set as Set
import qualified Data.Sequence as Seq

import Pattern.Core (Pattern(..))
import Pattern.Graph.GraphClassifier (GraphValue(..), GraphClass(..), GraphClassifier(..))
import Pattern.Graph.GraphQuery (GraphQuery(..), TraversalWeight, TraversalDirection(..))

-- ============================================================================
-- Internal helper: reachable neighbors given a traversal weight
-- ============================================================================

-- | Given a 'GraphQuery', a 'TraversalWeight', and a node, return all
-- neighbor nodes reachable via relationships with finite traversal cost.
--
-- Inlined by GHC at call sites to eliminate the function-call overhead in
-- the inner loop of every traversal algorithm.
{-# INLINE reachableNeighbors #-}
reachableNeighbors :: GraphValue v => GraphQuery v -> TraversalWeight v -> Pattern v -> [Pattern v]
reachableNeighbors :: forall v.
GraphValue v =>
GraphQuery v -> TraversalWeight v -> Pattern v -> [Pattern v]
reachableNeighbors GraphQuery v
gq TraversalWeight v
weight Pattern v
node =
  (Pattern v -> Maybe (Pattern v)) -> [Pattern v] -> [Pattern v]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Pattern v -> Maybe (Pattern v)
neighborOf (GraphQuery v -> Pattern v -> [Pattern v]
forall v. GraphQuery v -> Pattern v -> [Pattern v]
queryIncidentRels GraphQuery v
gq Pattern v
node)
  where
    neighborOf :: Pattern v -> Maybe (Pattern v)
neighborOf Pattern v
rel =
      let fwdCost :: Double
fwdCost = TraversalWeight v
weight Pattern v
rel TraversalDirection
Forward
          bwdCost :: Double
bwdCost = TraversalWeight v
weight Pattern v
rel TraversalDirection
Backward
          src :: Maybe (Pattern v)
src = GraphQuery v -> Pattern v -> Maybe (Pattern v)
forall v. GraphQuery v -> Pattern v -> Maybe (Pattern v)
querySource GraphQuery v
gq Pattern v
rel
          tgt :: Maybe (Pattern v)
tgt = GraphQuery v -> Pattern v -> Maybe (Pattern v)
forall v. GraphQuery v -> Pattern v -> Maybe (Pattern v)
queryTarget GraphQuery v
gq Pattern v
rel
          nodeId :: Id v
nodeId = v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
node)
      in case (Maybe (Pattern v)
src, Maybe (Pattern v)
tgt) of
           (Just Pattern v
s, Just Pattern v
t)
             | v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
s) Id v -> Id v -> Bool
forall a. Eq a => a -> a -> Bool
== Id v
nodeId Bool -> Bool -> Bool
&& Double -> Bool
forall {a}. RealFloat a => a -> Bool
isFinite Double
fwdCost -> Pattern v -> Maybe (Pattern v)
forall a. a -> Maybe a
Just Pattern v
t
             | v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
t) Id v -> Id v -> Bool
forall a. Eq a => a -> a -> Bool
== Id v
nodeId Bool -> Bool -> Bool
&& Double -> Bool
forall {a}. RealFloat a => a -> Bool
isFinite Double
bwdCost -> Pattern v -> Maybe (Pattern v)
forall a. a -> Maybe a
Just Pattern v
s
           (Maybe (Pattern v), Maybe (Pattern v))
_ -> Maybe (Pattern v)
forall a. Maybe a
Nothing
    isFinite :: a -> Bool
isFinite a
x = Bool -> Bool
not (a -> Bool
forall {a}. RealFloat a => a -> Bool
isInfinite a
x) Bool -> Bool -> Bool
&& Bool -> Bool
not (a -> Bool
forall {a}. RealFloat a => a -> Bool
isNaN a
x)

-- ============================================================================
-- Traversal
-- ============================================================================

-- | Breadth-first search from a starting node.
--
-- Returns all nodes reachable from @start@ in BFS order, including @start@.
-- Traversal direction and cost are governed by @weight@.
bfs :: (GraphValue v, Ord (Id v)) => GraphQuery v -> TraversalWeight v -> Pattern v -> [Pattern v]
bfs :: forall v.
(GraphValue v, Ord (Id v)) =>
GraphQuery v -> TraversalWeight v -> Pattern v -> [Pattern v]
bfs GraphQuery v
gq TraversalWeight v
weight Pattern v
start = Seq (Pattern v) -> Set (Id v) -> [Pattern v] -> [Pattern v]
go (Pattern v -> Seq (Pattern v)
forall a. a -> Seq a
Seq.singleton Pattern v
start) (Id v -> Set (Id v)
forall a. a -> Set a
Set.singleton (v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
start))) []
  where
    go :: Seq (Pattern v) -> Set (Id v) -> [Pattern v] -> [Pattern v]
go Seq (Pattern v)
queue Set (Id v)
visited [Pattern v]
acc =
      case Seq (Pattern v) -> ViewL (Pattern v)
forall a. Seq a -> ViewL a
Seq.viewl Seq (Pattern v)
queue of
        ViewL (Pattern v)
Seq.EmptyL -> [Pattern v] -> [Pattern v]
forall a. [a] -> [a]
reverse [Pattern v]
acc
        Pattern v
n Seq.:< Seq (Pattern v)
rest ->
          let nbrs :: [Pattern v]
nbrs = (Pattern v -> Bool) -> [Pattern v] -> [Pattern v]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Pattern v
nb -> Bool -> Bool
not (Id v -> Set (Id v) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
nb)) Set (Id v)
visited))
                            (GraphQuery v -> TraversalWeight v -> Pattern v -> [Pattern v]
forall v.
GraphValue v =>
GraphQuery v -> TraversalWeight v -> Pattern v -> [Pattern v]
reachableNeighbors GraphQuery v
gq TraversalWeight v
weight Pattern v
n)
              newVisited :: Set (Id v)
newVisited = (Set (Id v) -> Pattern v -> Set (Id v))
-> Set (Id v) -> [Pattern v] -> Set (Id v)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Set (Id v)
s Pattern v
nb -> Id v -> Set (Id v) -> Set (Id v)
forall a. Ord a => a -> Set a -> Set a
Set.insert (v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
nb)) Set (Id v)
s) Set (Id v)
visited [Pattern v]
nbrs
              newQueue :: Seq (Pattern v)
newQueue   = (Seq (Pattern v) -> Pattern v -> Seq (Pattern v))
-> Seq (Pattern v) -> [Pattern v] -> Seq (Pattern v)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Seq (Pattern v) -> Pattern v -> Seq (Pattern v)
forall a. Seq a -> a -> Seq a
(Seq.|>) Seq (Pattern v)
rest [Pattern v]
nbrs
          in Seq (Pattern v) -> Set (Id v) -> [Pattern v] -> [Pattern v]
go Seq (Pattern v)
newQueue Set (Id v)
newVisited (Pattern v
n Pattern v -> [Pattern v] -> [Pattern v]
forall a. a -> [a] -> [a]
: [Pattern v]
acc)

-- | Depth-first search from a starting node.
--
-- Returns all nodes reachable from @start@ in DFS order, including @start@.
-- Traversal direction and cost are governed by @weight@.
dfs :: (GraphValue v, Ord (Id v)) => GraphQuery v -> TraversalWeight v -> Pattern v -> [Pattern v]
dfs :: forall v.
(GraphValue v, Ord (Id v)) =>
GraphQuery v -> TraversalWeight v -> Pattern v -> [Pattern v]
dfs GraphQuery v
gq TraversalWeight v
weight Pattern v
start = [Pattern v] -> Set (Id v) -> [Pattern v] -> [Pattern v]
go [Pattern v
start] Set (Id v)
forall a. Set a
Set.empty []
  where
    go :: [Pattern v] -> Set (Id v) -> [Pattern v] -> [Pattern v]
go [] Set (Id v)
_ [Pattern v]
acc = [Pattern v] -> [Pattern v]
forall a. [a] -> [a]
reverse [Pattern v]
acc
    go (Pattern v
n:[Pattern v]
stack) Set (Id v)
visited [Pattern v]
acc
      | Id v -> Set (Id v) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
n)) Set (Id v)
visited = [Pattern v] -> Set (Id v) -> [Pattern v] -> [Pattern v]
go [Pattern v]
stack Set (Id v)
visited [Pattern v]
acc
      | Bool
otherwise =
          let newVisited :: Set (Id v)
newVisited = Id v -> Set (Id v) -> Set (Id v)
forall a. Ord a => a -> Set a -> Set a
Set.insert (v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
n)) Set (Id v)
visited
              nbrs :: [Pattern v]
nbrs = (Pattern v -> Bool) -> [Pattern v] -> [Pattern v]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Pattern v
nb -> Bool -> Bool
not (Id v -> Set (Id v) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
nb)) Set (Id v)
newVisited))
                            (GraphQuery v -> TraversalWeight v -> Pattern v -> [Pattern v]
forall v.
GraphValue v =>
GraphQuery v -> TraversalWeight v -> Pattern v -> [Pattern v]
reachableNeighbors GraphQuery v
gq TraversalWeight v
weight Pattern v
n)
          in [Pattern v] -> Set (Id v) -> [Pattern v] -> [Pattern v]
go ([Pattern v]
nbrs [Pattern v] -> [Pattern v] -> [Pattern v]
forall a. [a] -> [a] -> [a]
++ [Pattern v]
stack) Set (Id v)
newVisited (Pattern v
n Pattern v -> [Pattern v] -> [Pattern v]
forall a. a -> [a] -> [a]
: [Pattern v]
acc)

-- ============================================================================
-- Paths
-- ============================================================================

-- | Shortest path between two nodes using Dijkstra's algorithm.
--
-- Returns 'Just' a list of nodes (including endpoints) if a path exists,
-- 'Nothing' otherwise. Edge costs are determined by @weight@.
shortestPath :: (GraphValue v, Ord (Id v)) => GraphQuery v -> TraversalWeight v -> Pattern v -> Pattern v -> Maybe [Pattern v]
shortestPath :: forall v.
(GraphValue v, Ord (Id v)) =>
GraphQuery v
-> TraversalWeight v -> Pattern v -> Pattern v -> Maybe [Pattern v]
shortestPath GraphQuery v
gq TraversalWeight v
weight Pattern v
start Pattern v
end
  | v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
start) Id v -> Id v -> Bool
forall a. Eq a => a -> a -> Bool
== v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
end) = [Pattern v] -> Maybe [Pattern v]
forall a. a -> Maybe a
Just [Pattern v
start]
  | Bool
otherwise = Map (Double, Id v) [Pattern v]
-> Map (Id v) Double -> Set (Id v) -> Maybe [Pattern v]
dijkstra
      -- Priority queue keyed by (cost, nodeId) so deleteFindMin gives lowest-cost entry
      ((Double, Id v) -> [Pattern v] -> Map (Double, Id v) [Pattern v]
forall k a. k -> a -> Map k a
Map.singleton (Double
0.0, v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
start)) [Pattern v
start])
      -- Best known cost per node
      (Id v -> Double -> Map (Id v) Double
forall k a. k -> a -> Map k a
Map.singleton (v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
start)) Double
0.0)
      Set (Id v)
forall a. Set a
Set.empty
  where
    endId :: Id v
endId = v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
end)

    dijkstra :: Map (Double, Id v) [Pattern v]
-> Map (Id v) Double -> Set (Id v) -> Maybe [Pattern v]
dijkstra Map (Double, Id v) [Pattern v]
pq Map (Id v) Double
bestCost Set (Id v)
settled
      | Map (Double, Id v) [Pattern v] -> Bool
forall k a. Map k a -> Bool
Map.null Map (Double, Id v) [Pattern v]
pq = Maybe [Pattern v]
forall a. Maybe a
Nothing
      | Bool
otherwise =
          let (((Double
cost, Id v
nId), [Pattern v]
path), Map (Double, Id v) [Pattern v]
rest) = Map (Double, Id v) [Pattern v]
-> (((Double, Id v), [Pattern v]), Map (Double, Id v) [Pattern v])
forall k a. Map k a -> ((k, a), Map k a)
Map.deleteFindMin Map (Double, Id v) [Pattern v]
pq
          in case [Pattern v]
path of
            [] -> Map (Double, Id v) [Pattern v]
-> Map (Id v) Double -> Set (Id v) -> Maybe [Pattern v]
dijkstra Map (Double, Id v) [Pattern v]
rest Map (Id v) Double
bestCost Set (Id v)
settled
            (Pattern v
n:[Pattern v]
_)
              | Id v -> Set (Id v) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Id v
nId Set (Id v)
settled -> Map (Double, Id v) [Pattern v]
-> Map (Id v) Double -> Set (Id v) -> Maybe [Pattern v]
dijkstra Map (Double, Id v) [Pattern v]
rest Map (Id v) Double
bestCost Set (Id v)
settled
              | Id v
nId Id v -> Id v -> Bool
forall a. Eq a => a -> a -> Bool
== Id v
endId -> [Pattern v] -> Maybe [Pattern v]
forall a. a -> Maybe a
Just ([Pattern v] -> [Pattern v]
forall a. [a] -> [a]
reverse [Pattern v]
path)
              | Bool
otherwise ->
                  let newSettled :: Set (Id v)
newSettled = Id v -> Set (Id v) -> Set (Id v)
forall a. Ord a => a -> Set a -> Set a
Set.insert Id v
nId Set (Id v)
settled
                      rels :: [Pattern v]
rels = GraphQuery v -> Pattern v -> [Pattern v]
forall v. GraphQuery v -> Pattern v -> [Pattern v]
queryIncidentRels GraphQuery v
gq Pattern v
n
                      updates :: [(Id v, Double, [Pattern v])]
updates = (Pattern v -> Maybe (Id v, Double, [Pattern v]))
-> [Pattern v] -> [(Id v, Double, [Pattern v])]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Double
-> [Pattern v]
-> Pattern v
-> Set (Id v)
-> Pattern v
-> Maybe (Id v, Double, [Pattern v])
edgeUpdate Double
cost [Pattern v]
path Pattern v
n Set (Id v)
newSettled) [Pattern v]
rels
                      (Map (Double, Id v) [Pattern v]
pq', Map (Id v) Double
bestCost') = ((Map (Double, Id v) [Pattern v], Map (Id v) Double)
 -> (Id v, Double, [Pattern v])
 -> (Map (Double, Id v) [Pattern v], Map (Id v) Double))
-> (Map (Double, Id v) [Pattern v], Map (Id v) Double)
-> [(Id v, Double, [Pattern v])]
-> (Map (Double, Id v) [Pattern v], Map (Id v) Double)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Map (Double, Id v) [Pattern v], Map (Id v) Double)
-> (Id v, Double, [Pattern v])
-> (Map (Double, Id v) [Pattern v], Map (Id v) Double)
forall {b} {a} {a}.
(Ord b, Ord a) =>
(Map (a, b) a, Map b a) -> (b, a, a) -> (Map (a, b) a, Map b a)
insertIfBetter (Map (Double, Id v) [Pattern v]
rest, Map (Id v) Double
bestCost) [(Id v, Double, [Pattern v])]
updates
                  in Map (Double, Id v) [Pattern v]
-> Map (Id v) Double -> Set (Id v) -> Maybe [Pattern v]
dijkstra Map (Double, Id v) [Pattern v]
pq' Map (Id v) Double
bestCost' Set (Id v)
newSettled

    edgeUpdate :: Double
-> [Pattern v]
-> Pattern v
-> Set (Id v)
-> Pattern v
-> Maybe (Id v, Double, [Pattern v])
edgeUpdate Double
cost [Pattern v]
path Pattern v
node Set (Id v)
settled Pattern v
rel =
      let fwdCost :: Double
fwdCost = TraversalWeight v
weight Pattern v
rel TraversalDirection
Forward
          bwdCost :: Double
bwdCost = TraversalWeight v
weight Pattern v
rel TraversalDirection
Backward
          src :: Maybe (Pattern v)
src = GraphQuery v -> Pattern v -> Maybe (Pattern v)
forall v. GraphQuery v -> Pattern v -> Maybe (Pattern v)
querySource GraphQuery v
gq Pattern v
rel
          tgt :: Maybe (Pattern v)
tgt = GraphQuery v -> Pattern v -> Maybe (Pattern v)
forall v. GraphQuery v -> Pattern v -> Maybe (Pattern v)
queryTarget GraphQuery v
gq Pattern v
rel
          nodeId :: Id v
nodeId = v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
node)
      in case (Maybe (Pattern v)
src, Maybe (Pattern v)
tgt) of
           (Just Pattern v
s, Just Pattern v
t)
             | v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
s) Id v -> Id v -> Bool
forall a. Eq a => a -> a -> Bool
== Id v
nodeId Bool -> Bool -> Bool
&& Double -> Bool
forall {a}. RealFloat a => a -> Bool
isFinite Double
fwdCost Bool -> Bool -> Bool
&& Bool -> Bool
not (Id v -> Set (Id v) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
t)) Set (Id v)
settled) ->
                 (Id v, Double, [Pattern v]) -> Maybe (Id v, Double, [Pattern v])
forall a. a -> Maybe a
Just (v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
t), Double
cost Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
fwdCost, Pattern v
t Pattern v -> [Pattern v] -> [Pattern v]
forall a. a -> [a] -> [a]
: [Pattern v]
path)
             | v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
t) Id v -> Id v -> Bool
forall a. Eq a => a -> a -> Bool
== Id v
nodeId Bool -> Bool -> Bool
&& Double -> Bool
forall {a}. RealFloat a => a -> Bool
isFinite Double
bwdCost Bool -> Bool -> Bool
&& Bool -> Bool
not (Id v -> Set (Id v) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
s)) Set (Id v)
settled) ->
                 (Id v, Double, [Pattern v]) -> Maybe (Id v, Double, [Pattern v])
forall a. a -> Maybe a
Just (v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
s), Double
cost Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
bwdCost, Pattern v
s Pattern v -> [Pattern v] -> [Pattern v]
forall a. a -> [a] -> [a]
: [Pattern v]
path)
           (Maybe (Pattern v), Maybe (Pattern v))
_ -> Maybe (Id v, Double, [Pattern v])
forall a. Maybe a
Nothing

    insertIfBetter :: (Map (a, b) a, Map b a) -> (b, a, a) -> (Map (a, b) a, Map b a)
insertIfBetter (Map (a, b) a
pq, Map b a
bestCost) (b
nId, a
newCost, a
newPath) =
      case b -> Map b a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup b
nId Map b a
bestCost of
        Just a
oldCost | a
oldCost a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
newCost -> (Map (a, b) a
pq, Map b a
bestCost)
        Maybe a
_ -> ( (a, b) -> a -> Map (a, b) a -> Map (a, b) a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (a
newCost, b
nId) a
newPath Map (a, b) a
pq
             , b -> a -> Map b a -> Map b a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert b
nId a
newCost Map b a
bestCost
             )

    isFinite :: a -> Bool
isFinite a
x = Bool -> Bool
not (a -> Bool
forall {a}. RealFloat a => a -> Bool
isInfinite a
x) Bool -> Bool -> Bool
&& Bool -> Bool
not (a -> Bool
forall {a}. RealFloat a => a -> Bool
isNaN a
x)

-- | Return 'True' if a path exists between @src@ and @tgt@.
hasPath :: (GraphValue v, Ord (Id v)) => GraphQuery v -> TraversalWeight v -> Pattern v -> Pattern v -> Bool
hasPath :: forall v.
(GraphValue v, Ord (Id v)) =>
GraphQuery v -> TraversalWeight v -> Pattern v -> Pattern v -> Bool
hasPath GraphQuery v
gq TraversalWeight v
weight Pattern v
src Pattern v
tgt = case GraphQuery v
-> TraversalWeight v -> Pattern v -> Pattern v -> Maybe [Pattern v]
forall v.
(GraphValue v, Ord (Id v)) =>
GraphQuery v
-> TraversalWeight v -> Pattern v -> Pattern v -> Maybe [Pattern v]
shortestPath GraphQuery v
gq TraversalWeight v
weight Pattern v
src Pattern v
tgt of
  Just [Pattern v]
_  -> Bool
True
  Maybe [Pattern v]
Nothing -> Bool
False

-- | All simple paths between two nodes (DFS-based, no repeated nodes).
--
-- Returns @[]@ if no path exists or the graph is empty.
-- Warning: exponential in the worst case for dense graphs.
allPaths :: (GraphValue v, Ord (Id v)) => GraphQuery v -> TraversalWeight v -> Pattern v -> Pattern v -> [[Pattern v]]
allPaths :: forall v.
(GraphValue v, Ord (Id v)) =>
GraphQuery v
-> TraversalWeight v -> Pattern v -> Pattern v -> [[Pattern v]]
allPaths GraphQuery v
gq TraversalWeight v
weight Pattern v
start Pattern v
end = [Pattern v] -> Set (Id v) -> [[Pattern v]]
go [Pattern v
start] (Id v -> Set (Id v)
forall a. a -> Set a
Set.singleton (v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
start)))
  where
    endId :: Id v
endId = v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
end)
    go :: [Pattern v] -> Set (Id v) -> [[Pattern v]]
go [Pattern v]
path Set (Id v)
visited = case [Pattern v]
path of
      [] -> []
      (Pattern v
n:[Pattern v]
_)
        | v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
n) Id v -> Id v -> Bool
forall a. Eq a => a -> a -> Bool
== Id v
endId -> [[Pattern v] -> [Pattern v]
forall a. [a] -> [a]
reverse [Pattern v]
path]
        | Bool
otherwise ->
            let nbrs :: [Pattern v]
nbrs = (Pattern v -> Bool) -> [Pattern v] -> [Pattern v]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Pattern v
nb -> Bool -> Bool
not (Id v -> Set (Id v) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
nb)) Set (Id v)
visited))
                              (GraphQuery v -> TraversalWeight v -> Pattern v -> [Pattern v]
forall v.
GraphValue v =>
GraphQuery v -> TraversalWeight v -> Pattern v -> [Pattern v]
reachableNeighbors GraphQuery v
gq TraversalWeight v
weight Pattern v
n)
            in (Pattern v -> [[Pattern v]]) -> [Pattern v] -> [[Pattern v]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Pattern v
nb -> [Pattern v] -> Set (Id v) -> [[Pattern v]]
go (Pattern v
nb Pattern v -> [Pattern v] -> [Pattern v]
forall a. a -> [a] -> [a]
: [Pattern v]
path) (Id v -> Set (Id v) -> Set (Id v)
forall a. Ord a => a -> Set a -> Set a
Set.insert (v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
nb)) Set (Id v)
visited)) [Pattern v]
nbrs

-- ============================================================================
-- Boolean queries
-- ============================================================================

-- | Return 'True' if @a@ and @b@ are directly connected by a relationship
-- with finite traversal cost.
isNeighbor :: (GraphValue v, Eq (Id v)) => GraphQuery v -> TraversalWeight v -> Pattern v -> Pattern v -> Bool
isNeighbor :: forall v.
(GraphValue v, Eq (Id v)) =>
GraphQuery v -> TraversalWeight v -> Pattern v -> Pattern v -> Bool
isNeighbor GraphQuery v
gq TraversalWeight v
weight Pattern v
a Pattern v
b =
  let bId :: Id v
bId = v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
b)
  in (Pattern v -> Bool) -> [Pattern v] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Pattern v
nb -> v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
nb) Id v -> Id v -> Bool
forall a. Eq a => a -> a -> Bool
== Id v
bId) (GraphQuery v -> TraversalWeight v -> Pattern v -> [Pattern v]
forall v.
GraphValue v =>
GraphQuery v -> TraversalWeight v -> Pattern v -> [Pattern v]
reachableNeighbors GraphQuery v
gq TraversalWeight v
weight Pattern v
a)

-- | Return 'True' if the graph is connected under the given traversal weight.
--
-- An empty graph is considered connected (vacuously true).
isConnected :: (GraphValue v, Ord (Id v)) => GraphQuery v -> TraversalWeight v -> Bool
isConnected :: forall v.
(GraphValue v, Ord (Id v)) =>
GraphQuery v -> TraversalWeight v -> Bool
isConnected GraphQuery v
gq TraversalWeight v
weight =
  case GraphQuery v -> [Pattern v]
forall v. GraphQuery v -> [Pattern v]
queryNodes GraphQuery v
gq of
    []    -> Bool
True
    (Pattern v
n:[Pattern v]
_) -> [Pattern v] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (GraphQuery v -> TraversalWeight v -> Pattern v -> [Pattern v]
forall v.
(GraphValue v, Ord (Id v)) =>
GraphQuery v -> TraversalWeight v -> Pattern v -> [Pattern v]
bfs GraphQuery v
gq TraversalWeight v
weight Pattern v
n) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Pattern v] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (GraphQuery v -> [Pattern v]
forall v. GraphQuery v -> [Pattern v]
queryNodes GraphQuery v
gq)

-- ============================================================================
-- Structural
-- ============================================================================

-- | Find all connected components under the given traversal weight.
--
-- Returns a list of node lists, each representing one component.
connectedComponents :: (GraphValue v, Ord (Id v)) => GraphQuery v -> TraversalWeight v -> [[Pattern v]]
connectedComponents :: forall v.
(GraphValue v, Ord (Id v)) =>
GraphQuery v -> TraversalWeight v -> [[Pattern v]]
connectedComponents GraphQuery v
gq TraversalWeight v
weight = [Pattern v] -> Set (Id v) -> [[Pattern v]] -> [[Pattern v]]
go (GraphQuery v -> [Pattern v]
forall v. GraphQuery v -> [Pattern v]
queryNodes GraphQuery v
gq) Set (Id v)
forall a. Set a
Set.empty []
  where
    go :: [Pattern v] -> Set (Id v) -> [[Pattern v]] -> [[Pattern v]]
go [] Set (Id v)
_ [[Pattern v]]
acc = [[Pattern v]] -> [[Pattern v]]
forall a. [a] -> [a]
reverse [[Pattern v]]
acc
    go (Pattern v
n:[Pattern v]
ns) Set (Id v)
visited [[Pattern v]]
acc
      | Id v -> Set (Id v) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
n)) Set (Id v)
visited = [Pattern v] -> Set (Id v) -> [[Pattern v]] -> [[Pattern v]]
go [Pattern v]
ns Set (Id v)
visited [[Pattern v]]
acc
      | Bool
otherwise =
          let component :: [Pattern v]
component = GraphQuery v -> TraversalWeight v -> Pattern v -> [Pattern v]
forall v.
(GraphValue v, Ord (Id v)) =>
GraphQuery v -> TraversalWeight v -> Pattern v -> [Pattern v]
bfs GraphQuery v
gq TraversalWeight v
weight Pattern v
n
              newVisited :: Set (Id v)
newVisited = (Set (Id v) -> Pattern v -> Set (Id v))
-> Set (Id v) -> [Pattern v] -> Set (Id v)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Set (Id v)
s Pattern v
m -> Id v -> Set (Id v) -> Set (Id v)
forall a. Ord a => a -> Set a -> Set a
Set.insert (v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
m)) Set (Id v)
s) Set (Id v)
visited [Pattern v]
component
          in [Pattern v] -> Set (Id v) -> [[Pattern v]] -> [[Pattern v]]
go [Pattern v]
ns Set (Id v)
newVisited ([Pattern v]
component [Pattern v] -> [[Pattern v]] -> [[Pattern v]]
forall a. a -> [a] -> [a]
: [[Pattern v]]
acc)

-- | Topological sort using DFS (Kahn-style post-order).
--
-- Returns 'Nothing' if the graph contains a cycle.
-- Operates on the directed structure implied by relationship endpoint order
-- (source → target), ignoring 'TraversalWeight'.
topologicalSort :: (GraphValue v, Ord (Id v)) => GraphQuery v -> Maybe [Pattern v]
topologicalSort :: forall v.
(GraphValue v, Ord (Id v)) =>
GraphQuery v -> Maybe [Pattern v]
topologicalSort GraphQuery v
gq = [Pattern v]
-> Set (Id v) -> Set (Id v) -> [Pattern v] -> Maybe [Pattern v]
go (GraphQuery v -> [Pattern v]
forall v. GraphQuery v -> [Pattern v]
queryNodes GraphQuery v
gq) Set (Id v)
forall a. Set a
Set.empty Set (Id v)
forall a. Set a
Set.empty []
  where
    go :: [Pattern v]
-> Set (Id v) -> Set (Id v) -> [Pattern v] -> Maybe [Pattern v]
go [] Set (Id v)
_ Set (Id v)
_ [Pattern v]
acc = [Pattern v] -> Maybe [Pattern v]
forall a. a -> Maybe a
Just [Pattern v]
acc
    go (Pattern v
n:[Pattern v]
ns) Set (Id v)
visited Set (Id v)
inStack [Pattern v]
acc
      | Id v -> Set (Id v) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
n)) Set (Id v)
visited = [Pattern v]
-> Set (Id v) -> Set (Id v) -> [Pattern v] -> Maybe [Pattern v]
go [Pattern v]
ns Set (Id v)
visited Set (Id v)
inStack [Pattern v]
acc
      | Bool
otherwise = case Pattern v
-> Set (Id v)
-> Set (Id v)
-> [Pattern v]
-> Maybe (Set (Id v), [Pattern v])
visit Pattern v
n Set (Id v)
visited Set (Id v)
inStack [Pattern v]
acc of
          Maybe (Set (Id v), [Pattern v])
Nothing -> Maybe [Pattern v]
forall a. Maybe a
Nothing
          Just (Set (Id v)
visited', [Pattern v]
acc') -> [Pattern v]
-> Set (Id v) -> Set (Id v) -> [Pattern v] -> Maybe [Pattern v]
go [Pattern v]
ns Set (Id v)
visited' Set (Id v)
inStack [Pattern v]
acc'

    visit :: Pattern v
-> Set (Id v)
-> Set (Id v)
-> [Pattern v]
-> Maybe (Set (Id v), [Pattern v])
visit Pattern v
n Set (Id v)
visited Set (Id v)
inStack [Pattern v]
acc
      | Id v -> Set (Id v) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Id v
nId Set (Id v)
inStack = Maybe (Set (Id v), [Pattern v])
forall a. Maybe a
Nothing
      | Id v -> Set (Id v) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Id v
nId Set (Id v)
visited = (Set (Id v), [Pattern v]) -> Maybe (Set (Id v), [Pattern v])
forall a. a -> Maybe a
Just (Set (Id v)
visited, [Pattern v]
acc)
      | Bool
otherwise =
          let newInStack :: Set (Id v)
newInStack = Id v -> Set (Id v) -> Set (Id v)
forall a. Ord a => a -> Set a -> Set a
Set.insert Id v
nId Set (Id v)
inStack
              -- Only follow edges where n is the source (outgoing edges)
              outgoing :: [Pattern v]
outgoing = (Pattern v -> Bool) -> [Pattern v] -> [Pattern v]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Pattern v
r -> case GraphQuery v -> Pattern v -> Maybe (Pattern v)
forall v. GraphQuery v -> Pattern v -> Maybe (Pattern v)
querySource GraphQuery v
gq Pattern v
r of
                                         Just Pattern v
s -> v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
s) Id v -> Id v -> Bool
forall a. Eq a => a -> a -> Bool
== Id v
nId
                                         Maybe (Pattern v)
Nothing -> Bool
False)
                                (GraphQuery v -> Pattern v -> [Pattern v]
forall v. GraphQuery v -> Pattern v -> [Pattern v]
queryIncidentRels GraphQuery v
gq Pattern v
n)
              nbrs :: [Pattern v]
nbrs = (Pattern v -> Maybe (Pattern v)) -> [Pattern v] -> [Pattern v]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (GraphQuery v -> Pattern v -> Maybe (Pattern v)
forall v. GraphQuery v -> Pattern v -> Maybe (Pattern v)
queryTarget GraphQuery v
gq) [Pattern v]
outgoing
          in case (Maybe (Set (Id v), [Pattern v])
 -> Pattern v -> Maybe (Set (Id v), [Pattern v]))
-> Maybe (Set (Id v), [Pattern v])
-> [Pattern v]
-> Maybe (Set (Id v), [Pattern v])
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Set (Id v)
-> Maybe (Set (Id v), [Pattern v])
-> Pattern v
-> Maybe (Set (Id v), [Pattern v])
visitStep Set (Id v)
newInStack) ((Set (Id v), [Pattern v]) -> Maybe (Set (Id v), [Pattern v])
forall a. a -> Maybe a
Just (Set (Id v)
visited, [Pattern v]
acc)) [Pattern v]
nbrs of
               Maybe (Set (Id v), [Pattern v])
Nothing -> Maybe (Set (Id v), [Pattern v])
forall a. Maybe a
Nothing
               Just (Set (Id v)
visited', [Pattern v]
acc') ->
                 (Set (Id v), [Pattern v]) -> Maybe (Set (Id v), [Pattern v])
forall a. a -> Maybe a
Just (Id v -> Set (Id v) -> Set (Id v)
forall a. Ord a => a -> Set a -> Set a
Set.insert Id v
nId Set (Id v)
visited', Pattern v
n Pattern v -> [Pattern v] -> [Pattern v]
forall a. a -> [a] -> [a]
: [Pattern v]
acc')
      where nId :: Id v
nId = v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
n)

    visitStep :: Set (Id v)
-> Maybe (Set (Id v), [Pattern v])
-> Pattern v
-> Maybe (Set (Id v), [Pattern v])
visitStep Set (Id v)
_ Maybe (Set (Id v), [Pattern v])
Nothing Pattern v
_ = Maybe (Set (Id v), [Pattern v])
forall a. Maybe a
Nothing
    visitStep Set (Id v)
inStack (Just (Set (Id v)
visited, [Pattern v]
acc)) Pattern v
nb = Pattern v
-> Set (Id v)
-> Set (Id v)
-> [Pattern v]
-> Maybe (Set (Id v), [Pattern v])
visit Pattern v
nb Set (Id v)
visited Set (Id v)
inStack [Pattern v]
acc

-- | Return 'True' if the graph contains a directed cycle.
hasCycle :: (GraphValue v, Ord (Id v)) => GraphQuery v -> Bool
hasCycle :: forall v. (GraphValue v, Ord (Id v)) => GraphQuery v -> Bool
hasCycle GraphQuery v
gq = case GraphQuery v -> Maybe [Pattern v]
forall v.
(GraphValue v, Ord (Id v)) =>
GraphQuery v -> Maybe [Pattern v]
topologicalSort GraphQuery v
gq of
  Maybe [Pattern v]
Nothing -> Bool
True
  Just [Pattern v]
_  -> Bool
False

-- ============================================================================
-- Spanning
-- ============================================================================

-- | Minimum spanning tree using Kruskal's algorithm.
--
-- Returns the list of nodes in the MST (not edges). For a forest (disconnected
-- graph), returns nodes reachable in the minimum spanning forest.
-- Edge weight is the average of forward and backward traversal costs.
minimumSpanningTree :: (GraphValue v, Ord (Id v)) => GraphQuery v -> TraversalWeight v -> [Pattern v]
minimumSpanningTree :: forall v.
(GraphValue v, Ord (Id v)) =>
GraphQuery v -> TraversalWeight v -> [Pattern v]
minimumSpanningTree GraphQuery v
gq TraversalWeight v
weight =
  let rels :: [Pattern v]
rels = GraphQuery v -> [Pattern v]
forall v. GraphQuery v -> [Pattern v]
queryRelationships GraphQuery v
gq
      edgesWithCost :: [(Double, Pattern v, Pattern v)]
edgesWithCost = (Pattern v -> Maybe (Double, Pattern v, Pattern v))
-> [Pattern v] -> [(Double, Pattern v, Pattern v)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Pattern v -> Maybe (Double, Pattern v, Pattern v)
edgeCost [Pattern v]
rels
      sortedEdges :: [(Double, Pattern v, Pattern v)]
sortedEdges = ((Double, Pattern v, Pattern v)
 -> (Double, Pattern v, Pattern v) -> Ordering)
-> [(Double, Pattern v, Pattern v)]
-> [(Double, Pattern v, Pattern v)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Double, Pattern v, Pattern v) -> Double)
-> (Double, Pattern v, Pattern v)
-> (Double, Pattern v, Pattern v)
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (\(Double
c, Pattern v
_, Pattern v
_) -> Double
c)) [(Double, Pattern v, Pattern v)]
edgesWithCost
      nodeIds :: [Id v]
nodeIds = (Pattern v -> Id v) -> [Pattern v] -> [Id v]
forall a b. (a -> b) -> [a] -> [b]
map (v -> Id v
forall v. GraphValue v => v -> Id v
identify (v -> Id v) -> (Pattern v -> v) -> Pattern v -> Id v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern v -> v
forall v. Pattern v -> v
value) (GraphQuery v -> [Pattern v]
forall v. GraphQuery v -> [Pattern v]
queryNodes GraphQuery v
gq)
      initialUF :: Map (Id v) (Id v)
initialUF = [(Id v, Id v)] -> Map (Id v) (Id v)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Id v
i, Id v
i) | Id v
i <- [Id v]
nodeIds]
      (Map (Id v) (Id v)
_, Set (Id v)
mstNodes) = ((Map (Id v) (Id v), Set (Id v))
 -> (Double, Pattern v, Pattern v)
 -> (Map (Id v) (Id v), Set (Id v)))
-> (Map (Id v) (Id v), Set (Id v))
-> [(Double, Pattern v, Pattern v)]
-> (Map (Id v) (Id v), Set (Id v))
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Map (Id v) (Id v), Set (Id v))
-> (Double, Pattern v, Pattern v)
-> (Map (Id v) (Id v), Set (Id v))
forall {v} {v} {a}.
(Id v ~ Id v, GraphValue v, GraphValue v) =>
(Map (Id v) (Id v), Set (Id v))
-> (a, Pattern v, Pattern v) -> (Map (Id v) (Id v), Set (Id v))
addEdge (Map (Id v) (Id v)
initialUF, Set (Id v)
forall a. Set a
Set.empty) [(Double, Pattern v, Pattern v)]
sortedEdges
  in (Pattern v -> Bool) -> [Pattern v] -> [Pattern v]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Pattern v
n -> Id v -> Set (Id v) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
n)) Set (Id v)
mstNodes) (GraphQuery v -> [Pattern v]
forall v. GraphQuery v -> [Pattern v]
queryNodes GraphQuery v
gq)
  where
    edgeCost :: Pattern v -> Maybe (Double, Pattern v, Pattern v)
edgeCost Pattern v
rel = case (GraphQuery v -> Pattern v -> Maybe (Pattern v)
forall v. GraphQuery v -> Pattern v -> Maybe (Pattern v)
querySource GraphQuery v
gq Pattern v
rel, GraphQuery v -> Pattern v -> Maybe (Pattern v)
forall v. GraphQuery v -> Pattern v -> Maybe (Pattern v)
queryTarget GraphQuery v
gq Pattern v
rel) of
      (Just Pattern v
s, Just Pattern v
t) ->
        let fwd :: Double
fwd = TraversalWeight v
weight Pattern v
rel TraversalDirection
Forward
            bwd :: Double
bwd = TraversalWeight v
weight Pattern v
rel TraversalDirection
Backward
            cost :: Double
cost = Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
fwd Double
bwd
        in if Double -> Bool
forall {a}. RealFloat a => a -> Bool
isInfinite Double
cost then Maybe (Double, Pattern v, Pattern v)
forall a. Maybe a
Nothing else (Double, Pattern v, Pattern v)
-> Maybe (Double, Pattern v, Pattern v)
forall a. a -> Maybe a
Just (Double
cost, Pattern v
s, Pattern v
t)
      (Maybe (Pattern v), Maybe (Pattern v))
_ -> Maybe (Double, Pattern v, Pattern v)
forall a. Maybe a
Nothing

    addEdge :: (Map (Id v) (Id v), Set (Id v))
-> (a, Pattern v, Pattern v) -> (Map (Id v) (Id v), Set (Id v))
addEdge (Map (Id v) (Id v)
uf, Set (Id v)
nodes) (a
_, Pattern v
s, Pattern v
t) =
      let sRoot :: Id v
sRoot = Map (Id v) (Id v) -> Id v -> Id v
forall {t}. Ord t => Map t t -> t -> t
find Map (Id v) (Id v)
uf (v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
s))
          tRoot :: Id v
tRoot = Map (Id v) (Id v) -> Id v -> Id v
forall {t}. Ord t => Map t t -> t -> t
find Map (Id v) (Id v)
uf (v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
t))
      in if Id v
sRoot Id v -> Id v -> Bool
forall a. Eq a => a -> a -> Bool
== Id v
tRoot
         then (Map (Id v) (Id v)
uf, Set (Id v)
nodes)
         else ( Id v -> Id v -> Map (Id v) (Id v) -> Map (Id v) (Id v)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Id v
sRoot Id v
tRoot Map (Id v) (Id v)
uf
              , Id v -> Set (Id v) -> Set (Id v)
forall a. Ord a => a -> Set a -> Set a
Set.insert (v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
s)) (Id v -> Set (Id v) -> Set (Id v)
forall a. Ord a => a -> Set a -> Set a
Set.insert (v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
t)) Set (Id v)
nodes)
              )

    find :: Map t t -> t -> t
find Map t t
uf t
i = case t -> Map t t -> Maybe t
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup t
i Map t t
uf of
      Maybe t
Nothing -> t
i
      Just t
p  -> if t
p t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
i then t
i else Map t t -> t -> t
find Map t t
uf t
p

-- ============================================================================
-- Centrality
-- ============================================================================

-- | Degree centrality: normalized count of incident relationships per node.
--
-- Returns a map from node identity to normalized degree in [0, 1].
-- Normalization factor is (n - 1) where n is the number of nodes.
degreeCentrality :: (GraphValue v, Ord (Id v)) => GraphQuery v -> Map (Id v) Double
degreeCentrality :: forall v.
(GraphValue v, Ord (Id v)) =>
GraphQuery v -> Map (Id v) Double
degreeCentrality GraphQuery v
gq =
  let ns :: [Pattern v]
ns = GraphQuery v -> [Pattern v]
forall v. GraphQuery v -> [Pattern v]
queryNodes GraphQuery v
gq
      n :: Int
n  = [Pattern v] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pattern v]
ns
      norm :: Double
norm = if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 then Double
1.0 else Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  in [(Id v, Double)] -> Map (Id v) Double
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
       [ (v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
node), Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GraphQuery v -> Pattern v -> Int
forall v. GraphQuery v -> Pattern v -> Int
queryDegree GraphQuery v
gq Pattern v
node) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
norm)
       | Pattern v
node <- [Pattern v]
ns
       ]

-- | Betweenness centrality using the Brandes algorithm.
--
-- Returns a map from node identity to betweenness score (unnormalized).
-- Complexity: O(n·(n+r)·log n). For large graphs, wrap the 'GraphQuery'
-- with 'memoizeIncidentRels' before calling this function.
--
-- TODO: bulk adjacency — see open question §1 in the feature proposal.
-- This implementation calls 'queryIncidentRels' in the inner loop, which
-- is O(r) per call. A bulk adjacency representation would reduce this to O(1).
betweennessCentrality :: (GraphValue v, Ord (Id v)) => GraphQuery v -> TraversalWeight v -> Map (Id v) Double
betweennessCentrality :: forall v.
(GraphValue v, Ord (Id v)) =>
GraphQuery v -> TraversalWeight v -> Map (Id v) Double
betweennessCentrality GraphQuery v
gq TraversalWeight v
weight =
  let ns :: [Pattern v]
ns = GraphQuery v -> [Pattern v]
forall v. GraphQuery v -> [Pattern v]
queryNodes GraphQuery v
gq
      initial :: Map (Id v) Double
initial = [(Id v, Double)] -> Map (Id v) Double
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
n), Double
0.0) | Pattern v
n <- [Pattern v]
ns]
  in (Map (Id v) Double -> Pattern v -> Map (Id v) Double)
-> Map (Id v) Double -> [Pattern v] -> Map (Id v) Double
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ([Pattern v] -> Map (Id v) Double -> Pattern v -> Map (Id v) Double
accumulate [Pattern v]
ns) Map (Id v) Double
initial [Pattern v]
ns
  where
    accumulate :: [Pattern v] -> Map (Id v) Double -> Pattern v -> Map (Id v) Double
accumulate [Pattern v]
ns Map (Id v) Double
betweenness Pattern v
s =
      let (Map (Id v) Double
sigma, Map (Id v) [Id v]
pred, Map (Id v) Double
dist) = Pattern v
-> [Pattern v]
-> (Map (Id v) Double, Map (Id v) [Id v], Map (Id v) Double)
bfsPhase Pattern v
s [Pattern v]
ns
          delta :: Map (Id v) Double
delta = [(Id v, Double)] -> Map (Id v) Double
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
n), Double
0.0) | Pattern v
n <- [Pattern v]
ns]
          stack :: [Pattern v]
stack = (Pattern v -> Pattern v -> Ordering) -> [Pattern v] -> [Pattern v]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Pattern v -> Double) -> Pattern v -> Pattern v -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (\Pattern v
n -> Double -> Double
forall a. Num a => a -> a
negate (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0.0 (Id v -> Map (Id v) Double -> Maybe Double
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
n)) Map (Id v) Double
dist)))) [Pattern v]
ns
          delta' :: Map (Id v) Double
delta' = (Map (Id v) Double -> Pattern v -> Map (Id v) Double)
-> Map (Id v) Double -> [Pattern v] -> Map (Id v) Double
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Map (Id v) Double
-> Map (Id v) [Id v]
-> Map (Id v) Double
-> Pattern v
-> Map (Id v) Double
forall {v} {a}.
(GraphValue v, Fractional a) =>
Map (Id v) a
-> Map (Id v) [Id v] -> Map (Id v) a -> Pattern v -> Map (Id v) a
backProp Map (Id v) Double
sigma Map (Id v) [Id v]
pred) Map (Id v) Double
delta [Pattern v]
stack
      in (Id v -> Double -> Double)
-> Map (Id v) Double -> Map (Id v) Double
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\Id v
k Double
v -> Double
v Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0.0 (Id v -> Map (Id v) Double -> Maybe Double
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Id v
k Map (Id v) Double
delta')) Map (Id v) Double
betweenness

    bfsPhase :: Pattern v
-> [Pattern v]
-> (Map (Id v) Double, Map (Id v) [Id v], Map (Id v) Double)
bfsPhase Pattern v
s [Pattern v]
ns =
      let sId :: Id v
sId = v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
s)
          sigma0 :: Map (Id v) Double
sigma0 = [(Id v, Double)] -> Map (Id v) Double
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
n), Double
0.0) | Pattern v
n <- [Pattern v]
ns]
          sigma1 :: Map (Id v) Double
sigma1 = Id v -> Double -> Map (Id v) Double -> Map (Id v) Double
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Id v
sId Double
1.0 Map (Id v) Double
sigma0
          dist0 :: Map (Id v) Double
dist0  = [(Id v, Double)] -> Map (Id v) Double
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
n), -Double
1.0) | Pattern v
n <- [Pattern v]
ns]
          dist1 :: Map (Id v) Double
dist1  = Id v -> Double -> Map (Id v) Double -> Map (Id v) Double
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Id v
sId Double
0.0 Map (Id v) Double
dist0
          emptyPreds :: [Id v]
emptyPreds = [] [Id v] -> [Id v] -> [Id v]
forall a. a -> a -> a
`asTypeOf` [v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
s)]
          pred0 :: Map (Id v) [Id v]
pred0  = [(Id v, [Id v])] -> Map (Id v) [Id v]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
n), [Id v]
emptyPreds) | Pattern v
n <- [Pattern v]
ns]
      in Seq (Pattern v)
-> Map (Id v) Double
-> Map (Id v) [Id v]
-> Map (Id v) Double
-> (Map (Id v) Double, Map (Id v) [Id v], Map (Id v) Double)
bfsLoop (Pattern v -> Seq (Pattern v)
forall a. a -> Seq a
Seq.singleton Pattern v
s) Map (Id v) Double
sigma1 Map (Id v) [Id v]
pred0 Map (Id v) Double
dist1

    bfsLoop :: Seq (Pattern v)
-> Map (Id v) Double
-> Map (Id v) [Id v]
-> Map (Id v) Double
-> (Map (Id v) Double, Map (Id v) [Id v], Map (Id v) Double)
bfsLoop Seq (Pattern v)
queue Map (Id v) Double
sigma Map (Id v) [Id v]
pred Map (Id v) Double
dist =
      case Seq (Pattern v) -> ViewL (Pattern v)
forall a. Seq a -> ViewL a
Seq.viewl Seq (Pattern v)
queue of
        ViewL (Pattern v)
Seq.EmptyL -> (Map (Id v) Double
sigma, Map (Id v) [Id v]
pred, Map (Id v) Double
dist)
        Pattern v
v Seq.:< Seq (Pattern v)
rest ->
          let vId :: Id v
vId   = v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
v)
              vDist :: Double
vDist = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0.0 (Id v -> Map (Id v) Double -> Maybe Double
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Id v
vId Map (Id v) Double
dist)
              vSig :: Double
vSig  = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0.0 (Id v -> Map (Id v) Double -> Maybe Double
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Id v
vId Map (Id v) Double
sigma)
              rels :: [Pattern v]
rels  = GraphQuery v -> Pattern v -> [Pattern v]
forall v. GraphQuery v -> Pattern v -> [Pattern v]
queryIncidentRels GraphQuery v
gq Pattern v
v
              (Map (Id v) Double
sigma', Map (Id v) [Id v]
pred', Map (Id v) Double
dist', Seq (Pattern v)
newQueue) =
                ((Map (Id v) Double, Map (Id v) [Id v], Map (Id v) Double,
  Seq (Pattern v))
 -> Pattern v
 -> (Map (Id v) Double, Map (Id v) [Id v], Map (Id v) Double,
     Seq (Pattern v)))
-> (Map (Id v) Double, Map (Id v) [Id v], Map (Id v) Double,
    Seq (Pattern v))
-> [Pattern v]
-> (Map (Id v) Double, Map (Id v) [Id v], Map (Id v) Double,
    Seq (Pattern v))
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Id v
-> Double
-> Double
-> (Map (Id v) Double, Map (Id v) [Id v], Map (Id v) Double,
    Seq (Pattern v))
-> Pattern v
-> (Map (Id v) Double, Map (Id v) [Id v], Map (Id v) Double,
    Seq (Pattern v))
processNeighbor Id v
vId Double
vDist Double
vSig) (Map (Id v) Double
sigma, Map (Id v) [Id v]
pred, Map (Id v) Double
dist, Seq (Pattern v)
rest) [Pattern v]
rels
          in Seq (Pattern v)
-> Map (Id v) Double
-> Map (Id v) [Id v]
-> Map (Id v) Double
-> (Map (Id v) Double, Map (Id v) [Id v], Map (Id v) Double)
bfsLoop Seq (Pattern v)
newQueue Map (Id v) Double
sigma' Map (Id v) [Id v]
pred' Map (Id v) Double
dist'

    processNeighbor :: Id v
-> Double
-> Double
-> (Map (Id v) Double, Map (Id v) [Id v], Map (Id v) Double,
    Seq (Pattern v))
-> Pattern v
-> (Map (Id v) Double, Map (Id v) [Id v], Map (Id v) Double,
    Seq (Pattern v))
processNeighbor Id v
vId Double
vDist Double
vSig (Map (Id v) Double
sigma, Map (Id v) [Id v]
pred, Map (Id v) Double
dist, Seq (Pattern v)
queue) Pattern v
rel =
      let fwdCost :: Double
fwdCost = TraversalWeight v
weight Pattern v
rel TraversalDirection
Forward
          bwdCost :: Double
bwdCost = TraversalWeight v
weight Pattern v
rel TraversalDirection
Backward
          src :: Maybe (Pattern v)
src = GraphQuery v -> Pattern v -> Maybe (Pattern v)
forall v. GraphQuery v -> Pattern v -> Maybe (Pattern v)
querySource GraphQuery v
gq Pattern v
rel
          tgt :: Maybe (Pattern v)
tgt = GraphQuery v -> Pattern v -> Maybe (Pattern v)
forall v. GraphQuery v -> Pattern v -> Maybe (Pattern v)
queryTarget GraphQuery v
gq Pattern v
rel
      in case (Maybe (Pattern v)
src, Maybe (Pattern v)
tgt) of
           (Just Pattern v
s, Just Pattern v
t)
             | v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
s) Id v -> Id v -> Bool
forall a. Eq a => a -> a -> Bool
== Id v
vId Bool -> Bool -> Bool
&& Double -> Bool
forall {a}. RealFloat a => a -> Bool
isFinite Double
fwdCost ->
                 Id v
-> Double
-> Double
-> Id v
-> Pattern v
-> (Map (Id v) Double, Map (Id v) [Id v], Map (Id v) Double,
    Seq (Pattern v))
-> (Map (Id v) Double, Map (Id v) [Id v], Map (Id v) Double,
    Seq (Pattern v))
forall {a} {a} {k} {p} {a}.
(Fractional a, Fractional a, Ord k, Ord a) =>
k
-> a
-> p
-> k
-> a
-> (Map k a, Map k [k], Map k a, Seq a)
-> (Map k a, Map k [k], Map k a, Seq a)
updateNeighbor Id v
vId Double
vDist Double
vSig (v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
t)) Pattern v
t (Map (Id v) Double
sigma, Map (Id v) [Id v]
pred, Map (Id v) Double
dist, Seq (Pattern v)
queue)
             | v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
t) Id v -> Id v -> Bool
forall a. Eq a => a -> a -> Bool
== Id v
vId Bool -> Bool -> Bool
&& Double -> Bool
forall {a}. RealFloat a => a -> Bool
isFinite Double
bwdCost ->
                 Id v
-> Double
-> Double
-> Id v
-> Pattern v
-> (Map (Id v) Double, Map (Id v) [Id v], Map (Id v) Double,
    Seq (Pattern v))
-> (Map (Id v) Double, Map (Id v) [Id v], Map (Id v) Double,
    Seq (Pattern v))
forall {a} {a} {k} {p} {a}.
(Fractional a, Fractional a, Ord k, Ord a) =>
k
-> a
-> p
-> k
-> a
-> (Map k a, Map k [k], Map k a, Seq a)
-> (Map k a, Map k [k], Map k a, Seq a)
updateNeighbor Id v
vId Double
vDist Double
vSig (v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
s)) Pattern v
s (Map (Id v) Double
sigma, Map (Id v) [Id v]
pred, Map (Id v) Double
dist, Seq (Pattern v)
queue)
           (Maybe (Pattern v), Maybe (Pattern v))
_ -> (Map (Id v) Double
sigma, Map (Id v) [Id v]
pred, Map (Id v) Double
dist, Seq (Pattern v)
queue)

    updateNeighbor :: k
-> a
-> p
-> k
-> a
-> (Map k a, Map k [k], Map k a, Seq a)
-> (Map k a, Map k [k], Map k a, Seq a)
updateNeighbor k
vId a
vDist p
vSig k
wId a
w (Map k a
sigma, Map k [k]
pred, Map k a
dist, Seq a
queue) =
      let wDist :: a
wDist = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe (-a
1.0) (k -> Map k a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
wId Map k a
dist)
          wSig :: a
wSig  = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
0.0   (k -> Map k a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
wId Map k a
sigma)
          vSig' :: a
vSig' = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
0.0   (k -> Map k a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
vId Map k a
sigma)
      in if a
wDist a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0
         then ( k -> a -> Map k a -> Map k a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
wId (a
wSig a -> a -> a
forall a. Num a => a -> a -> a
+ a
vSig') Map k a
sigma
              , ([k] -> [k]) -> k -> Map k [k] -> Map k [k]
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (k
vId k -> [k] -> [k]
forall a. a -> [a] -> [a]
:) k
wId Map k [k]
pred
              , k -> a -> Map k a -> Map k a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
wId (a
vDist a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) Map k a
dist
              , Seq a
queue Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
Seq.|> a
w
              )
         else if a
wDist a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
vDist a -> a -> a
forall a. Num a => a -> a -> a
+ a
1
              then ( k -> a -> Map k a -> Map k a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
wId (a
wSig a -> a -> a
forall a. Num a => a -> a -> a
+ a
vSig') Map k a
sigma
                   , ([k] -> [k]) -> k -> Map k [k] -> Map k [k]
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (k
vId k -> [k] -> [k]
forall a. a -> [a] -> [a]
:) k
wId Map k [k]
pred
                   , Map k a
dist
                   , Seq a
queue
                   )
              else (Map k a
sigma, Map k [k]
pred, Map k a
dist, Seq a
queue)

    backProp :: Map (Id v) a
-> Map (Id v) [Id v] -> Map (Id v) a -> Pattern v -> Map (Id v) a
backProp Map (Id v) a
sigma Map (Id v) [Id v]
pred Map (Id v) a
delta Pattern v
w =
      let wId :: Id v
wId = v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
w)
          preds :: [Id v]
preds = [Id v] -> Maybe [Id v] -> [Id v]
forall a. a -> Maybe a -> a
fromMaybe [] (Id v -> Map (Id v) [Id v] -> Maybe [Id v]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Id v
wId Map (Id v) [Id v]
pred)
          wSig :: a
wSig  = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
1.0 (Id v -> Map (Id v) a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Id v
wId Map (Id v) a
sigma)
          wDelta :: a
wDelta = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
0.0 (Id v -> Map (Id v) a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Id v
wId Map (Id v) a
delta)
          delta' :: Map (Id v) a
delta' = (Map (Id v) a -> Id v -> Map (Id v) a)
-> Map (Id v) a -> [Id v] -> Map (Id v) a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Map (Id v) a
d Id v
vId ->
            let vSig :: a
vSig  = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
1.0 (Id v -> Map (Id v) a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Id v
vId Map (Id v) a
sigma)
                vDelta :: a
vDelta = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
0.0 (Id v -> Map (Id v) a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Id v
vId Map (Id v) a
d)
                contribution :: a
contribution = (a
vSig a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
wSig) a -> a -> a
forall a. Num a => a -> a -> a
* (a
1.0 a -> a -> a
forall a. Num a => a -> a -> a
+ a
wDelta)
            in Id v -> a -> Map (Id v) a -> Map (Id v) a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Id v
vId (a
vDelta a -> a -> a
forall a. Num a => a -> a -> a
+ a
contribution) Map (Id v) a
d
            ) Map (Id v) a
delta [Id v]
preds
      in Map (Id v) a
delta'

    isFinite :: a -> Bool
isFinite a
x = Bool -> Bool
not (a -> Bool
forall {a}. RealFloat a => a -> Bool
isInfinite a
x) Bool -> Bool -> Bool
&& Bool -> Bool
not (a -> Bool
forall {a}. RealFloat a => a -> Bool
isNaN a
x)

-- ============================================================================
-- Context query helpers
-- ============================================================================

-- | Return all annotations that directly contain the given element.
--
-- Filters the result of 'queryContainers' to elements classified as 'GAnnotation'.
queryAnnotationsOf :: GraphClassifier extra v -> GraphQuery v -> Pattern v -> [Pattern v]
queryAnnotationsOf :: forall extra v.
GraphClassifier extra v -> GraphQuery v -> Pattern v -> [Pattern v]
queryAnnotationsOf GraphClassifier extra v
classifier GraphQuery v
gq Pattern v
p =
  (Pattern v -> Bool) -> [Pattern v] -> [Pattern v]
forall a. (a -> Bool) -> [a] -> [a]
filter (GraphClass extra -> Bool
forall {extra}. GraphClass extra -> Bool
isAnnotation (GraphClass extra -> Bool)
-> (Pattern v -> GraphClass extra) -> Pattern v -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GraphClassifier extra v -> Pattern v -> GraphClass extra
forall extra v.
GraphClassifier extra v -> Pattern v -> GraphClass extra
classify GraphClassifier extra v
classifier) (GraphQuery v -> Pattern v -> [Pattern v]
forall v. GraphQuery v -> Pattern v -> [Pattern v]
queryContainers GraphQuery v
gq Pattern v
p)
  where
    isAnnotation :: GraphClass extra -> Bool
isAnnotation GraphClass extra
GAnnotation = Bool
True
    isAnnotation GraphClass extra
_           = Bool
False

-- | Return all walks that directly contain the given element.
--
-- Filters the result of 'queryContainers' to elements classified as 'GWalk'.
queryWalksContaining :: GraphClassifier extra v -> GraphQuery v -> Pattern v -> [Pattern v]
queryWalksContaining :: forall extra v.
GraphClassifier extra v -> GraphQuery v -> Pattern v -> [Pattern v]
queryWalksContaining GraphClassifier extra v
classifier GraphQuery v
gq Pattern v
p =
  (Pattern v -> Bool) -> [Pattern v] -> [Pattern v]
forall a. (a -> Bool) -> [a] -> [a]
filter (GraphClass extra -> Bool
forall {extra}. GraphClass extra -> Bool
isWalk (GraphClass extra -> Bool)
-> (Pattern v -> GraphClass extra) -> Pattern v -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GraphClassifier extra v -> Pattern v -> GraphClass extra
forall extra v.
GraphClassifier extra v -> Pattern v -> GraphClass extra
classify GraphClassifier extra v
classifier) (GraphQuery v -> Pattern v -> [Pattern v]
forall v. GraphQuery v -> Pattern v -> [Pattern v]
queryContainers GraphQuery v
gq Pattern v
p)
  where
    isWalk :: GraphClass extra -> Bool
isWalk GraphClass extra
GWalk = Bool
True
    isWalk GraphClass extra
_     = Bool
False

-- | Return all co-members of @element@ within @container@.
--
-- Co-members are the other elements that are contained by @container@ (i.e. all
-- elements that share this container with @element@), excluding @element@ itself.
-- E.g. for two nodes that share a common walk, calling 'queryCoMembers' with
-- one node and the walk as container returns the other node(s) in that walk.
queryCoMembers :: (GraphValue v, Eq (Id v)) => GraphQuery v -> Pattern v -> Pattern v -> [Pattern v]
queryCoMembers :: forall v.
(GraphValue v, Eq (Id v)) =>
GraphQuery v -> Pattern v -> Pattern v -> [Pattern v]
queryCoMembers GraphQuery v
gq Pattern v
element Pattern v
container =
  let containerId :: Id v
containerId = v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
container)
      elementId :: Id v
elementId   = v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
element)
      inContainer :: Pattern v -> Bool
inContainer Pattern v
e = (Pattern v -> Bool) -> [Pattern v] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Pattern v
c -> v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
c) Id v -> Id v -> Bool
forall a. Eq a => a -> a -> Bool
== Id v
containerId) (GraphQuery v -> Pattern v -> [Pattern v]
forall v. GraphQuery v -> Pattern v -> [Pattern v]
queryContainers GraphQuery v
gq Pattern v
e)
      candidates :: [Pattern v]
candidates     = GraphQuery v -> [Pattern v]
forall v. GraphQuery v -> [Pattern v]
queryNodes GraphQuery v
gq [Pattern v] -> [Pattern v] -> [Pattern v]
forall a. [a] -> [a] -> [a]
++ GraphQuery v -> [Pattern v]
forall v. GraphQuery v -> [Pattern v]
queryRelationships GraphQuery v
gq
      allInContainer :: [Pattern v]
allInContainer = (Pattern v -> Bool) -> [Pattern v] -> [Pattern v]
forall a. (a -> Bool) -> [a] -> [a]
filter Pattern v -> Bool
inContainer [Pattern v]
candidates
  in (Pattern v -> Bool) -> [Pattern v] -> [Pattern v]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Pattern v
e -> v -> Id v
forall v. GraphValue v => v -> Id v
identify (Pattern v -> v
forall v. Pattern v -> v
value Pattern v
e) Id v -> Id v -> Bool
forall a. Eq a => a -> a -> Bool
/= Id v
elementId) [Pattern v]
allInContainer