Components.hs

{- |
   Module      : Data.Graph.Unordered.Algorithms.Components
   Description : Connected components
   Copyright   : (c) Ivan Lazar Miljenovic
   License     : MIT
   Maintainer  : Ivan.Miljenovic@gmail.com



 -}
module Data.Graph.Unordered.Algorithms.Components where

import           Data.Graph.Unordered

import           Control.Arrow (first)
import qualified Data.DList as DL
import qualified Data.HashMap.Strict as HM
import qualified Data.HashSet as HS
import           Data.List (unfoldr,mapAccumL)
import           Data.Maybe (catMaybes)
import           Data.Tuple (swap)

-- -----------------------------------------------------------------------------

-- | Calculate connected components of a graph; edge directionality
-- doesn't matter.
components :: (ValidGraph et n) => Graph et n nl el -> [Graph et n nl el]
components = unfoldr getComponent

getComponent :: (ValidGraph et n) => Graph et n nl el
                -> Maybe (Graph et n nl el, Graph et n nl el)
getComponent g = uncurry getComponentFrom <$> matchAny g

getComponentFrom :: (ValidGraph et n) => Context (AdjType et) n nl el
                    -> Graph et n nl el -> (Graph et n nl el, Graph et n nl el)
getComponentFrom c = first (buildGr . (c:) . DL.toList)
                     . step (HS.singleton (cNode c)) (HS.fromList (adjN c))
  where
    step vis toVis g
      | HS.null toVis = (mempty,g)
      | otherwise     = first (DL.fromList cs`DL.append`) (step vis' toVis' g')
      where
        (g',mcs) = mapAccumL getC g (HS.toList toVis)

        cs = catMaybes mcs

        -- smaller set should be first for good performance
        vis' = toVis `HS.union` vis

        toVis' = (`HS.difference`vis')
                 . HS.fromList
                 . concatMap adjN
                 $ cs

    getC g n = maybe (g,Nothing) (swap . first Just) (match n g)
    adjN = map (getNode . fst) . HM.elems . cAdj