TopologicalMinor.hs

module HGraph.Directed.TopologicalMinor
       ( isMinorOf
       , isMinorOfI
       , isMinorEmbedding
       , topologicalMinor
       , topologicalMinorI
       )
where

import HGraph.Directed
import HGraph.Directed.Connectivity
import HGraph.Directed.Subgraph
import HGraph.Utils
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Maybe

-- | Whether there is some subgraph of `d` which is isomorphic to some subdivision of `h`
isMinorOf h d = isJust $ topologicalMinor h d

isMinorOfI h di = isJust $ topologicalMinor h di

isMinorEmbedding h d phi = isJust $ linkage d [(phi M.! v, phi M.! u) | (v,u) <- arcs h]
  
topologicalMinor h d = fmap convertResult $ topologicalMinorI h di
  where
    (di, itova) = linearizeVertices d
    iToV = M.fromList itova
    convertResult phi = M.map (iToV M.!) phi

topologicalMinorI h di = mhead $
  [ phi
  | phi <- embeddings
  , isJust $ linkageI di [(phi M.! v, phi M.! u) | (v,u) <- arcs h]
  ]
  where
    embeddings = embeddings' (vertices h) S.empty M.empty
    embeddings' [] _ phi = return phi
    embeddings' (v:vs) blocked phi = do
      u <- filter (\u -> (not $ u `S.member` blocked) && indegree di u >= indegree h v && outdegree di u >= outdegree h v ) $ vertices di
      embeddings' vs (S.insert u blocked) (M.insert v u phi)