{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} -- | Module providing functions for obtaining coordinates of 'GenericGraph's on -- a 2D plane. -- module Math.Grads.Drawing.Coords ( Coord , CoordList , CoordMap , Drawable (..) , EdgeFixator , bondLength , getCoordsForGraph ) where import Control.Monad (join) import Data.Map.Strict (keys, singleton) import Math.Grads.Algo.Cycles (findCycles) import Math.Grads.Algo.Interaction (getIndices) import Math.Grads.Drawing.Internal.Coords (Coord, CoordList, CoordMap, bondLength, coordListForDrawing) import Math.Grads.Drawing.Internal.Cycles (getCoordsOfGlobalCycle) import Math.Grads.Drawing.Internal.CyclesPathsAlignment (alignCyclesAndPaths) import Math.Grads.Drawing.Internal.Paths (findPaths, getCoordsOfPath) import Math.Grads.Drawing.Internal.Sampling (EdgeFixator, bestSample) import Math.Grads.GenericGraph (GenericGraph) import Math.Grads.Graph (EdgeList, Graph, toList) import System.Random (StdGen) -- | Type class that defines whether graph can be drawn or not. -- class Graph g => Drawable g v e where -- | Change coordinates and fixate edges that shouldn't take part in sampling. -- edgeFixator :: g v e -> EdgeFixator e edgeFixator = const $ (,) [] -- | Given 'StdGen' returns 'CoordMap', which keys correspond to indices of -- vertices of given 'GenericGraph'. Works only for simple planar graphs. If graph -- is neither simple nor planar, returns Nothing. This function is best used for -- graphs that can be represented as systems of conjugated cycles and paths between -- them. If graph contains too complex conjugated cycles, function will return Nothing. -- getCoordsForGraph :: (Ord v, Ord e, Eq e, Drawable GenericGraph v e) => StdGen -> GenericGraph v e -> Maybe CoordMap getCoordsForGraph stdGen graph = if length vertices == 1 then Just (singleton 0 (0, 0)) else res where (vertices, edges) = toList graph (globalCycles, paths) = splitIntoCyclesAndPaths edges globalCyclesWithCoords = sequence (fmap (getCoordsOfGlobalCycle pathsWithCoords) globalCycles) pathsWithCoords = fmap getCoordsOfPath paths finalCoords = join (fmap (alignCyclesAndPaths pathsWithCoords) globalCyclesWithCoords) resCoords = join (fmap (bestSample stdGen (edgeFixator graph) (concat paths)) finalCoords) resMap = fmap coordListForDrawing resCoords res = if fmap (length . keys) resMap == pure (length vertices) then resMap else Nothing splitIntoCyclesAndPaths :: (Ord e, Eq e) => EdgeList e -> ([EdgeList e], [EdgeList e]) splitIntoCyclesAndPaths edges = (globalCycles, paths) where globalCycles = findCycles edges forPaths = filter (`notElem` concat globalCycles) edges paths = findPaths forPaths $ concatMap getIndices globalCycles