packages feed

haskell-igraph-0.7.0: src/IGraph/Algorithms/Structure.chs

{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE DataKinds #-}
module IGraph.Algorithms.Structure
    ( -- * Shortest Path Related Functions
      getShortestPath
    , inducedSubgraph
    , isConnected
    , isStronglyConnected
    , decompose
    , isDag
    , topSort
    , topSortUnsafe
    ) where

import           Control.Monad
import           Data.Serialize            (Serialize)
import Data.List (foldl')
import           System.IO.Unsafe          (unsafePerformIO)
import Data.Maybe
import Data.Singletons (SingI)

import Foreign
import Foreign.C.Types

import           IGraph
import IGraph.Internal.C2HS
{#import IGraph.Internal #}
{#import IGraph.Internal.Constants #}

#include "haskell_igraph.h"

{#fun igraph_shortest_paths as ^
    { `IGraph'
    , castPtr `Ptr Matrix'
    , castPtr %`Ptr VertexSelector'
    , castPtr %`Ptr VertexSelector'
    , `Neimode'
    } -> `CInt' void- #}

-- Calculates and returns a single unweighted shortest path from a given vertex
-- to another one. If there are more than one shortest paths between the two
-- vertices, then an arbitrary one is returned.
getShortestPath :: Graph d v e
                -> Node     -- ^ The id of the source vertex.
                -> Node     -- ^ The id of the target vertex.
                -> [Node]
getShortestPath gr s t = unsafePerformIO $ allocaVector $ \path -> do
    igraphGetShortestPath (_graph gr) path nullPtr s t IgraphOut
    map truncate <$> toList path
{#fun igraph_get_shortest_path as ^
    { `IGraph'
    , castPtr `Ptr Vector'
    , castPtr `Ptr Vector'
    , `Int'
    , `Int'
    , `Neimode'
    } -> `CInt' void- #}

inducedSubgraph :: (Ord v, Serialize v)
                => Graph d v e
                -> [Int]
                -> Graph d v e
inducedSubgraph gr nds = unsafePerformIO $ withVerticesList nds $ \vs ->
    igraphInducedSubgraph (_graph gr) vs IgraphSubgraphCreateFromScratch >>=
        (\g -> return $ Graph g $ mkLabelToId g)
{#fun igraph_induced_subgraph as ^
    { `IGraph'
    , allocaIGraph- `IGraph' addIGraphFinalizer*
    , castPtr %`Ptr VertexSelector'
    , `SubgraphImplementation'
    } -> `CInt' void- #}

-- | Decides whether the graph is weakly connected.
isConnected :: Graph d v e -> Bool
isConnected gr = igraphIsConnected (_graph gr) IgraphWeak

isStronglyConnected :: Graph 'D v e -> Bool
isStronglyConnected gr = igraphIsConnected (_graph gr) IgraphStrong

{#fun pure igraph_is_connected as ^
    { `IGraph'
    , alloca- `Bool' peekBool*
    , `Connectedness'
    } -> `CInt' void- #}

-- | Decompose a graph into connected components.
decompose :: (Ord v, Serialize v)
          => Graph d v e -> [Graph d v e]
decompose gr = unsafePerformIO $ allocaVectorPtr $ \ptr -> do
    igraphDecompose (_graph gr) ptr IgraphWeak (-1) 1
    n <- igraphVectorPtrSize ptr
    forM [0..n-1] $ \i -> do
        p <- igraphVectorPtrE ptr i
        addIGraphFinalizer (castPtr p) >>= (\g -> return $ Graph g $ mkLabelToId g)
{-# INLINE decompose #-}
{#fun igraph_decompose as ^
    { `IGraph'
    , castPtr `Ptr VectorPtr'
    , `Connectedness'
    , `Int'
    , `Int'
    } -> `CInt' void- #}


-- | Checks whether a graph is a directed acyclic graph (DAG) or not.
isDag :: Graph d v e -> Bool
isDag = igraphIsDag . _graph
{#fun pure igraph_is_dag as ^
    { `IGraph'
    , alloca- `Bool' peekBool*
    } -> `CInt' void- #}

-- | Calculate a possible topological sorting of the graph.
topSort :: Graph d v e -> [Node]
topSort gr | isDag gr = topSortUnsafe gr
           | otherwise = error "the graph is not acyclic"

-- | Calculate a possible topological sorting of the graph. If the graph is not
-- acyclic (it has at least one cycle), a partial topological sort is returned.
topSortUnsafe :: Graph d v e -> [Node]
topSortUnsafe gr = unsafePerformIO $ allocaVectorN n $ \res -> do
    igraphTopologicalSorting (_graph gr) res IgraphOut
    map truncate <$> toList res
  where
    n = nNodes gr
{#fun igraph_topological_sorting as ^
    { `IGraph'
    , castPtr `Ptr Vector'
    , `Neimode'
    } -> `CInt' void- #}