Version 0.1.5.0. math-grads is now open-source. (#13)

README.md

@@ -1,2 +1,107 @@
 # Math.Grads
-Graph Algorithms and Data Structures
+
+Math.Grads is library that provides graph-like data structures
+and various useful algorithms for analysis of these data structures.
+
+Its main feature is that all of provided type classes, data structures and 
+functions are written in most abstract way possible to meet different demands
+in functionality.
+
+## Data Structures
+
+### Graph
+
+Graph is a type class that upon being instantiated gives data structure
+properties of graph-like object.
+
+### GenericGraph
+
+GenericGraph is a data structure that describes undirected graphs and is
+parametrized by type of graph's vertices and type of graph's edges. 
+So it's really up to the developer what will be stored in Generic Graph's vertices
+and edges.
+
+GenericGraph is honest instance of Graph, therefore it can be used in all functions
+that require their parameters to be Graphs.
+
+## Algorithms
+
+### Ullman's subgraph isomorphism algorithm
+
+Math.Grads contains implementation of Ullman's subgraph isomorphism 
+[algorithm](https://www.cs.bgu.ac.il/~dinitz/Course/SS-12/Ullman_Algorithm.pdf).
+There are several functions that one can find helpful in order to check two graphs
+for isomorphism or subgraph isomorphism: 
+
+* `isIso` checks whether two graphs are isomorphic;
+* `isIsoSub` checks whether second graph has subgraph isomorphic to the first one;
+* `getIso` finds matching of vertices of first graph to vertices of subgraph in second graph that
+is isomorphic to the first graph;
+* `getMultiIso` finds all such matchings.
+
+In order for these functions to work graphs that are being passed to them have to also
+be instances of `GComparable` type class.
+
+Definition of this class is as follows:
+
+```haskell
+class (Graph g1, Graph g2) => GComparable g1 v1 e1 g2 v2 e2 where
+  vComparator :: g1 v1 e1 -> g2 v2 e2 -> VComparator v1 v2
+  eComparator :: g1 v1 e1 -> g2 v2 e2 -> EComparator e1 e2
+
+-- | Function that checks whether two vertices are identical.
+type VComparator v1 v2 = VertexIndex -> VertexIndex -> Bool
+
+-- | Function that checks whether two edges are identical.
+type EComparator e1 e2 = GraphEdge e1 -> GraphEdge e2 -> Bool
+```
+
+So, basically, if two `Graph`s are `GComparable` with each other there exist
+two functions that are responsible for establishing equality between vertices and edges
+of such Graphs.
+
+Here Math.Grads gets its chance to shine, because developer isn't constrained to 
+what we (as developers of Math.Grads) thought would be an appropriate way for comparing 
+vertices and edges of your data structure. We give the developers opportunity to define 
+such relations for their data structures themselves. 
+
+Maybe you want to know surroundings of two vertices in order to compare them, maybe 
+you don't — the choice is yours!
+
+### Algorithm for calculation of planar graph's coordinates
+
+Math.Grads provides algorithm for calculation of coordinates of planar graphs.
+Its main idea is that most such graphs used in practice can be represented 
+as union of systems of conjugated cycles and paths that connect these systems.
+
+So, if you know, that your planar graph looks just like this 
+(for example, small molecules from chemistry perfectly fit 
+into the definition of graphs that can be drawn correctly by the algorithm), 
+you may find `getCoordsForGraph` function quite useful.
+
+Algorithm first draws systems of conjugated cycles, then draws paths between them,
+unites systems with path and using random generator samples different conformations
+of resulting graph until conformation without self-intersections (that's why graph needs
+to be planar) is found.
+
+Once again, in order for you graph to be drawn you need to make it an instance of
+special type class:
+
+```haskell
+class Graph g => Drawable g v e where
+  edgeFixator :: g v e -> EdgeFixator e
+  edgeFixator = const $ (,) []
+
+type EdgeFixator e = CoordMap -> (EdgeList e, CoordMap)
+```
+
+`edgeFixator` is function that given `Graph` returns other function that somehow transforms 
+coordinates of graph before sampling and states, which edges of graph shouldn't change their coordinates
+during sampling ('fixates' them, if you will). As you can see, `edgeFixator` has default implementation,
+so if you don't want such functionality, just instantiate your graph as `Drawable` without
+getting into such details.
+
+### Miscellaneous functions on graphs
+
+Math.Grads also provides all other kinds of graph algorithms that you might find useful:
+your depth-first searches, breadth-first searches, functions to find cycles in graphs and so on.

math-grads.cabal

@@ -1,20 +1,26 @@
 name:                math-grads
-version:             0.1.4.4
+version:             0.1.5.0
 synopsis:            Library containing graph data structures and graph algorithms
-description:         Library containing graph data structures and graph algorithms
+description:         Library containing graph data structures and graph algorithms.
+                     .
+                     Graph data structures:
+                     .
+                       * Graph type class;
+                     .
+                       * GenericGraph data structure.
                      .
                      Graph algorithms:
                      .
-                       * drawing
+                       * Ullmann's subgraph isomorphism algorithm;
                      .
-                       * isomorphism
+                       * drawing of planar graphs.
 homepage:            https://github.com/biocad/math-grads#readme
 license:             BSD3
 license-file:        LICENSE
 author:              Alexandr Sadovnikov
 maintainer:          artemkondyukov, AlexKaneRUS, vks4git
 copyright:           2017 Alexandr Sadovnikov
-category:            Web
+category:            Math, Graph
 build-type:          Simple
 extra-source-files:  README.md
 cabal-version:       >=1.10
@@ -36,13 +42,15 @@ library
                      , Math.Grads.Drawing.Internal.Paths
                      , Math.Grads.Drawing.Internal.Sampling
                      , Math.Grads.Drawing.Internal.Utils
+
+                     , Math.Grads.Angem
+                     , Math.Grads.Angem.Internal.VectorOperations
+                     , Math.Grads.Angem.Internal.MatrixOperations
   build-depends:       base >= 4.7 && < 5
                      , aeson
                      , array
                      , containers
-                     , either
                      , linear
-                     , math-angem
                      , matrix
                      , mtl
                      , random

src/Math/Grads/Algo/Cycles.hs

@@ -1,3 +1,5 @@
+-- | Module that provides functions for analysis of graph's cycles.
+--
 module Math.Grads.Algo.Cycles
   ( findCycles
   , findLocalCycles
@@ -8,33 +10,37 @@ module Math.Grads.Algo.Cycles
 import           Control.Monad.State         (State, runState)
 import           Control.Monad.State.Class   (get, modify)
 import           Data.List                   (partition, sort, union, (\\))
+import           Data.Map.Strict             (Map)
+import qualified Data.Map.Strict             as M (keys, (!))
 import           Data.Set                    (Set)
 import qualified Data.Set                    as S (empty, fromList, insert,
                                                    member)
-import           Math.Grads.Algo.Interaction (getEnds, getIndices, getOtherEnd,
-                                              getVertexIncident, haveSharedEdge)
+import           Math.Grads.Algo.Interaction (edgeListToMap, getEnds,
+                                              getIndices, getOtherEnd,
+                                              getVertexIncident, haveSharedEdge,
+                                              matchEdges)
 import           Math.Grads.Algo.Paths       (dfsAllPaths)
-import           Math.Grads.Algo.Traversals  (dfsSt)
 import           Math.Grads.GenericGraph     (GenericGraph, safeIdx)
 import           Math.Grads.Graph            (EdgeList, GraphEdge, vCount)
 
--- | Takes adjacency list and finds non-redundant set of simple cycles
--- | Cycles sharing in common one edge are considered to be one cycle
--- | BondList must obey rule (b, e, _) b < e
-findCycles :: Ord e => [GraphEdge e] -> [[GraphEdge e]]
+-- | Takes 'EdgeList' and finds non-redundant set of conjugated simple cycles.
+-- Cycles sharing in common one edge are considered to be one cycle.
+-- BondList must obey rule (b, e, _) b < e.
+--
+findCycles :: Ord e => EdgeList e -> [EdgeList e]
 findCycles bonds = sort <$> conjRings redundantCycles
   where
     redundantCycles = findCyclesR bonds
 
-    findCyclesR :: Ord e => [GraphEdge e] -> [[GraphEdge e]]
+    findCyclesR :: Ord e => EdgeList e -> [EdgeList e]
     findCyclesR bs = let (result, taken) = stateCycles bs in
       if sort taken == sort bs then result
       else result ++ findCyclesR (bs \\ taken)
 
-    stateCycles :: Ord e => [GraphEdge e] -> ([[GraphEdge e]], [GraphEdge e])
+    stateCycles :: Ord e => EdgeList e -> ([EdgeList e], EdgeList e)
     stateCycles bs = runState (cyclesHelper bs [] (minimum (getIndices bs))) []
 
-conjRings :: Ord e => [[GraphEdge e]] -> [[GraphEdge e]]
+conjRings :: Ord e => [EdgeList e] -> [EdgeList e]
 conjRings (b : bs) =
   let
     (shd, rest) = partition (haveSharedEdge b) bs
@@ -44,8 +50,8 @@ conjRings (b : bs) =
       _  -> conjRings $ foldr union b shd : rest
 conjRings b = b
 
-takeCycle :: [GraphEdge e] -> GraphEdge e -> [GraphEdge e]
-takeCycle [] _ = error "Take cycle on empty list."
+takeCycle :: EdgeList e -> GraphEdge e -> EdgeList e
+takeCycle [] _                                        = []
 takeCycle bl@((aPop, bPop, _) : _) bn@(aNow, bNow, _) = bn : takeWhile cond bl ++ take 1 (dropWhile cond bl)
   where
     theB | bPop == aNow = bNow
@@ -55,7 +61,7 @@ takeCycle bl@((aPop, bPop, _) : _) bn@(aNow, bNow, _) = bn : takeWhile cond bl +
     cond :: GraphEdge e -> Bool
     cond (a', b', _) = theB /= a' && theB /= b'
 
-cyclesHelper :: Eq e => [GraphEdge e] -> [GraphEdge e] -> Int -> State [GraphEdge e] [[GraphEdge e]]
+cyclesHelper :: Eq e => EdgeList e -> EdgeList e -> Int -> State (EdgeList e) [EdgeList e]
 cyclesHelper bs trc n = do
   curSt <- get
   let adjBonds = filter (`notElem` curSt) $ getVertexIncident bs n
@@ -69,10 +75,13 @@ cyclesHelper bs trc n = do
 
   return $ (takeCycle trc <$> curBondClosures) ++ concat restBondClosures
 
-isEdgeInCycle :: Ord e => [GraphEdge e] -> Int -> Bool
+-- | Checks that edge with given index in 'EdgeList' is contained in any cycle.
+--
+isEdgeInCycle :: Ord e => EdgeList e -> Int -> Bool
 isEdgeInCycle bs n = any ((bs !! n) `elem`) $ findCycles bs
 
--- Finds all cycles of minimal length contained in system of cycles
+-- | Finds all cycles of minimal length contained in system of conjugated cycles.
+--
 findLocalCycles :: Eq e => EdgeList e -> [EdgeList e]
 findLocalCycles bonds = if null cycles then []
                         else helperFilter (tail res) [head res]
@@ -84,9 +93,30 @@ findLocalCycles bonds = if null cycles then []
 findLocalCycles' :: Eq e => EdgeList e -> [EdgeList e]
 findLocalCycles' bonds = concatMap (\(a, b, _) -> dfsAllPaths bonds a b) cycleBonds
   where
-    stBonds = dfsSt bonds
+    stBonds    = dfsSt bonds
     cycleBonds = bonds \\ stBonds
 
+    dfsSt :: EdgeList e -> EdgeList e
+    dfsSt bs = matchEdges bs bondsInd
+      where
+        graph    = edgeListToMap bs
+        bondsInd = dfsSt' graph (M.keys graph) [] []
+
+    dfsSt' :: Map Int [Int] -> [Int] -> [Int] -> [(Int, Int)] -> [(Int, Int)]
+    dfsSt' _ [] _ bs = bs
+    dfsSt' graph (current : toVisit) visited bs | current `elem` visited = dfsSt' graph toVisit visited bs
+                                                | otherwise = dfsSt' graph toVisitModified (current:visited) visitedBonds
+      where
+        visitedBonds = bs ++ if not (null visited) then [found | snd found /= -1] else []
+        found = findRib graph visited current
+
+        toVisitModified = (graph M.! current) ++ toVisit
+
+    findRib :: Map Int [Int] -> [Int] -> Int -> (Int, Int)
+    findRib graph visited current = (current, if not (null found) then head found else -1)
+      where
+        found = filter (`elem` visited) (graph M.! current)
+
 filterBigCycles :: Eq e => EdgeList e -> [EdgeList e] -> Bool
 filterBigCycles currentCycle cycles = not (foldl (\x y -> x || currentCycle /= y && length currentCycle > length y && length (filter (`elem` currentCycle) y) > 1) False cycles)
 
@@ -96,8 +126,8 @@ helperFilter (x:xs) ready = if exists x ready then helperFilter xs ready else he
   where
     exists a1 = any (\x' -> length a1 == length x' && all (\(a, b, t) -> (a, b, t) `elem` x' || (b, a, t) `elem` x') a1)
 
--- Checks whether or not given atom belongs to any cycle. This information is used in SMILES construction.
--- If an atom belongs to a cycle and has double or triple bond, depth-first search will branch to it.
+-- | Checks whether or not given vertex belongs to any cycle.
+--
 isCyclic :: GenericGraph v e -> Int -> Int -> (Bool, Set Int) -> Int -> (Bool, Set Int)
 isCyclic graph target previous (result, visited) current | result = (result, visited)
                                                          | (previous /= (-1)) && (current == target) = (True, visited)
@@ -113,7 +143,8 @@ isCyclic graph target previous (result, visited) current | result = (result, vis
     foldFunc :: (Bool, Set Int) -> Int -> (Bool, Set Int)
     foldFunc = isCyclic graph target current
 
--- Returns the set of all atoms which belong to any cycle.
+-- | Returns the set of all vertices which belong to any cycle.
+--
 getCyclic :: GenericGraph v e -> Set Int
 getCyclic graph = S.fromList . map fst . filter snd $ zip indices cyclic
   where