{- | Module : Persistence.HasseDiagram Copyright : (c) Eben Cowley, 2018 License : BSD 3 Clause Maintainer : eben.cowley42@gmail.com Stability : experimental This module implements algorithms for admissible Hasse diagrams. A Hasse diagram is admissible if it is stratified and oriented. A diagram is stratified if all the vertices can be arranged in rows such that all the sources of each vertex are in the next highest row and all the targets are in the next lowest row. A diagram is oriented if every vertex has a linear ordering on its targets. A node in the diagram is represented as a tuple: the indices of the level 0 nodes in the diagram that are reachable from this node, the indices of targets in the next lowest level, and the indices of the sources in the next highest level. The entire diagram is simply an array where each entry is an array representing a particular level; index 0 represents level 0, etc. Any directed graph can be encoded as an admissible Hasse diagram with 2 levels. The edges are level 1 and the vertices are level 0. The ordering on the targets of a node representing an edge is simply the terminal vertex first and the initial vertex second. This may be counterintuitive, but its helpful to interpret an arrow between two vertices as the "<" operator. This induces a linear ordering on the vertices of any acyclic complete subgraph - which is what the nodes in the Hasse diagram of the directed clique complex represent. Any oriented simplicial complex can also be encoded as an admissible Hasse diagram. A node is a simplex, the targets are the faces of the simplex, and the sources are simplices of which the given simplex is a face. The main feature of this module is an algorithm which takes the Hasse diagram of a directed graph and generates the Hasse diagram of the directed flag complex - the simplicial complex whose simplices are acyclic complete subgraphs of the given graph. Here acyclic refers to a directed graph without any sequence of arrows whose heads and tails match up an which has the same start and end vertex. The idea is that, if your directed graph represents any kind of information flow, "sub-modules" in the network that simply take input, process it using its nodes, and then output it without spinning the information around at all. These "sub-modules" are the directed cliques/flags which I've been referring to as acyclic complete subgraphs up to this point. Constructing a simplicial complex out of them will allow you to both simplify the 1-dimensional topology of the network and possibly detect higher-dimensional topological features. -} module HasseDiagram ( Node , HasseDiagram , hsd2String , encodeDirectedGraph , directedFlagComplex , toSimplicialComplex ) where import Util import SimplicialComplex import Data.List as L import Data.Vector as V {- | Type representing a node in a Hasse diagram. Hasse diagrams are being used to represent simplicial complexes so each node represents a simplex Contents of the tuple in order: Vector of references to vertices of the underlying directed graph, vector of references to the simplices faes in the next lowest level of the Hasse diagram, vector of references to "parent" simplices (simplices who have this simplex as a face) in the next highest level of the Hasse diagram. -} type Node = (Vector Int, Vector Int, Vector Int) -- | Type representing an admissible Hasse diagram. Each entry in the vector represents a level in the Hasse diagram. type HasseDiagram = Vector (Vector Node) -- | Simple printing function for Hasse diagrams. hsd2String :: HasseDiagram -> String hsd2String = (L.intercalate "\n\n") . V.toList . (V.map (L.intercalate "\n" . V.toList . V.map show)) -- | Given the number of vertices in a directed graph, and pairs representing the direction of each edge (initial, terminal), construct a Hasse diagram representing the graph. encodeDirectedGraph :: Int -> [(Int, Int)] -> HasseDiagram encodeDirectedGraph numVerts cxns = let verts = V.map (\n -> (n `cons` V.empty, V.empty, V.empty)) $ 0 `range` (numVerts - 1) encodeEdges _ vertices edges [] = V.empty `snoc` vertices `snoc` edges encodeEdges n vertices edges ((i, j):xs) = let v1 = vertices ! i; v2 = vertices ! j; edge = V.empty `snoc` j `snoc` i in encodeEdges (n + 1) (replaceElem i (one v1, two v1, (thr v1) `snoc` n) $ replaceElem j (one v2, two v2, (thr v2) `snoc` n) vertices) (edges `snoc` (edge, edge, V.empty)) xs in encodeEdges 0 verts V.empty cxns -- | Given a Hasse diagram representing a directed graph, construct the diagram representing the directed clique/flag complex of the graph. directedFlagComplex :: HasseDiagram -> HasseDiagram directedFlagComplex directedGraph = let edges = V.last directedGraph fstSinks = V.map (\e -> V.map (\(e0, _) -> (two e0) ! 0) $ findBothElems (\e1 e2 -> (two e1) ! 0 == (two e2) ! 0) (V.filter (\e0 -> (two e0) ! 1 == (two e) ! 1) edges) (V.filter (\e0 -> (two e0) ! 1 == (two e) ! 0) edges)) edges --take last level of nodes and their sinks. return modified last level, new level, and new sinks makeLevel :: Bool -> HasseDiagram -> Vector Node -> Vector (Vector Int) -> (Vector Node, Vector Node, Vector (Vector Int)) makeLevel fstIter result oldNodes oldSinks = let maxindex = V.length oldNodes --given a node and a specific sink, construct a new node with new sinks that has the given index. Fst output is the modified input nodes, snd output is the new node, thrd output is the sinks of the new node makeNode :: Int -> Int -> Int -> Vector Node -> Vector Int -> (Vector Node, Node, Vector Int) makeNode newIndex oldIndex sinkIndex nodes sinks = let sink = sinks ! sinkIndex oldNode = nodes ! oldIndex verts = sink `cons` (one oldNode) --the vertices of the new simplex are the vertices of the old simplex plus the sink numFaces = V.length $ two oldNode --find all the faces of the new node by looking at the faces of the old node testTargets :: Int -> Node -> Vector Node -> Node -> Vector Int -> (Vector Node, Node, Vector Int) testTargets i onode onodes newNode newSinks = let faceVerts = if fstIter then one $ (V.last $ V.init $ result) ! ((two onode) ! i) else one $ (V.last $ result) ! ((two onode) ! i) in if i == numFaces then (onodes, newNode, newSinks) else case V.find (\(_, (v, _, _)) -> V.head v == sink && V.tail v == faceVerts) $ mapWithIndex (\j n -> (j, n)) onodes of Just (j, n) -> testTargets (i + 1) onode (replaceElem j (one n, two n, (thr n) `smartSnoc` newIndex) onodes) (one newNode, (two newNode) `snoc` j, thr newNode) (newSinks |^| (oldSinks ! j)) Nothing -> error "Face not found, HasseDiagram.directedFlagComplex.makeDiagram.makeNode.testTargets" in testTargets 0 oldNode nodes (verts, oldIndex `cons` V.empty, V.empty) sinks loopSinks :: Int -> Int -> Vector Node -> (Vector Node, Vector Node, Vector (Vector Int), Int) loopSinks nodeIndex lastIndex nodes = let node = oldNodes ! nodeIndex sinks = oldSinks ! nodeIndex numSinks = V.length sinks loop i (modifiedNodes, newNodes, newSinks) = if i == numSinks then (modifiedNodes, newNodes, newSinks, i + lastIndex) else let (modNodes, newNode, ns) = makeNode (i + lastIndex) nodeIndex i modifiedNodes sinks in loop (i + 1) (modNodes, newNodes `snoc` newNode, newSinks `snoc` ns) in loop 0 (nodes, V.empty, V.empty) loopNodes :: Int -> Int -> Vector Node -> Vector Node -> Vector (Vector Int) -> (Vector Node, Vector Node, Vector (Vector Int)) loopNodes i lastIndex nodes newNodes newSinks = if i == maxindex then (nodes, newNodes, newSinks) else let (modifiedNodes, nnodes, nsinks, index) = loopSinks i lastIndex nodes in loopNodes (i + 1) lastIndex modifiedNodes (newNodes V.++ nnodes) (newSinks V.++ nsinks) in loopNodes 0 0 oldNodes V.empty V.empty loopLevels :: Int -> HasseDiagram -> Vector Node -> Vector (Vector Int) -> HasseDiagram loopLevels iter diagram nextNodes sinks = let (modifiedNodes, newNodes, newSinks) = makeLevel (iter < 2) diagram nextNodes sinks newDiagram = diagram `snoc` modifiedNodes in if V.null newNodes then newDiagram else loopLevels (iter + 1) newDiagram newNodes newSinks in loopLevels 0 directedGraph edges fstSinks -- | Convert a Hasse diagram to a simplicial complex. toSimplicialComplex :: HasseDiagram -> SimplicialComplex toSimplicialComplex diagram = let sc = V.map (V.map not3) $ V.tail diagram in (V.length $ V.head diagram, (V.map (\(v, _) -> (v, V.empty)) $ sc ! 0) `cons` V.tail sc)