{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
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)
class Graph g => Drawable g v e where
edgeFixator :: g v e -> EdgeFixator e
edgeFixator = const $ (,) []
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