-- GENERATED by C->Haskell Compiler, version 0.28.3 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/IGraph/Algorithms/Centrality.chs" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module IGraph.Algorithms.Centrality
    ( closeness
    , betweenness
    , eigenvectorCentrality
    , pagerank
    ) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Marshal.Utils as C2HSImp
import qualified Foreign.Ptr as C2HSImp



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
{-# LINE 20 "src/IGraph/Algorithms/Centrality.chs" #-}

import IGraph.Internal.Constants
{-# LINE 21 "src/IGraph/Algorithms/Centrality.chs" #-}




-- | The normalized closeness centrality of a node is the average length of the
-- shortest path between the node and all other nodes in the graph.
closeness :: [Int]  -- ^ vertices
          -> Graph d v e
          -> Maybe [Double]  -- ^ optional edge weights
          -> Bool   -- ^ whether to normalize the results
          -> [Double]
closeness nds gr ws normal = unsafePerformIO $ allocaVector $ \result ->
    withVerticesList nds $ \vs -> withListMaybe ws $ \ws' -> do
        igraphCloseness (_graph gr) result vs IgraphOut ws' normal
        toList result
igraphCloseness :: (IGraph) -> (Ptr Vector) -> (Ptr VertexSelector) -> (Neimode) -> (Ptr Vector) -> (Bool) -> IO ()
igraphCloseness a1 a2 a3 a4 a5 a6 =
  (withIGraph) a1 $ \a1' ->
  let {a2' = castPtr a2} in
  let {a3' = castPtr a3} in
  let {a4' = (fromIntegral . fromEnum) a4} in
  let {a5' = castPtr a5} in
  let {a6' = C2HSImp.fromBool a6} in
  igraphCloseness'_ a1' a2' a3' a4' a5' a6' >>= \res ->
  return ()

{-# LINE 42 "src/IGraph/Algorithms/Centrality.chs" #-}



-- | Betweenness centrality
betweenness :: [Int]
            -> Graph d v e
            -> Maybe [Double]
            -> [Double]
betweenness nds gr ws = unsafePerformIO $ allocaVector $ \result ->
    withVerticesList nds $ \vs -> withListMaybe ws $ \ws' -> do
        igraphBetweenness (_graph gr) result vs True ws' False
        toList result
igraphBetweenness :: (IGraph) -> (Ptr Vector) -> (Ptr VertexSelector) -> (Bool) -> (Ptr Vector) -> (Bool) -> IO ()
igraphBetweenness a1 a2 a3 a4 a5 a6 =
  (withIGraph) a1 $ \a1' ->
  let {a2' = castPtr a2} in
  let {a3' = castPtr a3} in
  let {a4' = C2HSImp.fromBool a4} in
  let {a5' = castPtr a5} in
  let {a6' = C2HSImp.fromBool a6} in
  igraphBetweenness'_ a1' a2' a3' a4' a5' a6' >>= \res ->
  return ()

{-# LINE 60 "src/IGraph/Algorithms/Centrality.chs" #-}


-- | Eigenvector centrality
eigenvectorCentrality :: Graph d v e
                      -> Maybe [Double]
                      -> [Double]
eigenvectorCentrality gr ws = unsafePerformIO $ allocaArpackOpt $ \arparck ->
    allocaVector $ \result -> withListMaybe ws $ \ws' -> do
        igraphEigenvectorCentrality (_graph gr) result nullPtr True True ws' arparck
        toList result
igraphEigenvectorCentrality :: (IGraph) -> (Ptr Vector) -> (Ptr CDouble) -> (Bool) -> (Bool) -> (Ptr Vector) -> (Ptr ArpackOpt) -> IO ()
igraphEigenvectorCentrality a1 a2 a3 a4 a5 a6 a7 =
  (withIGraph) a1 $ \a1' ->
  let {a2' = castPtr a2} in
  let {a3' = id a3} in
  let {a4' = C2HSImp.fromBool a4} in
  let {a5' = C2HSImp.fromBool a5} in
  let {a6' = castPtr a6} in
  let {a7' = castPtr a7} in
  igraphEigenvectorCentrality'_ a1' a2' a3' a4' a5' a6' a7' >>= \res ->
  return ()

{-# LINE 77 "src/IGraph/Algorithms/Centrality.chs" #-}


-- | Google's PageRank algorithm, with option to
pagerank :: SingI d
         => Graph d v e
         -> Maybe [Double]  -- ^ Node weights or reset probability. If provided,
                            -- the personalized PageRank will be used
         -> Maybe [Double]  -- ^ Edge weights
         -> Double  -- ^ damping factor, usually around 0.85
         -> [Double]
pagerank gr reset ws d
    | n == 0 = []
    | isJust ws && length (fromJust ws) /= m = error "incorrect length of edge weight vector"
    | isJust reset && length (fromJust reset) /= n = error
        "incorrect length of node weight vector"
    | fmap (foldl' (+) 0) reset == Just 0 = error "sum of node weight vector must be non-zero"
    | otherwise = unsafePerformIO $ alloca $ \p -> allocaVector $ \result ->
        withVerticesAll $ \vs -> withListMaybe ws $ \ws' -> do
            case reset of
                Nothing -> igraphPagerank (_graph gr) IgraphPagerankAlgoPrpack
                    result p vs (isDirected gr) d ws' nullPtr
                Just reset' -> withList reset' $ \reset'' -> igraphPersonalizedPagerank
                    (_graph gr) IgraphPagerankAlgoPrpack result p vs
                    (isDirected gr) d reset'' ws' nullPtr
            toList result
  where
    n = nNodes gr
    m = nEdges gr

igraphPagerank :: (IGraph) -> (PagerankAlgo) -> (Ptr Vector) -> (Ptr CDouble) -> (Ptr VertexSelector) -> (Bool) -> (Double) -> (Ptr Vector) -> (Ptr ()) -> IO ()
igraphPagerank a1 a2 a3 a4 a5 a6 a7 a8 a9 =
  (withIGraph) a1 $ \a1' ->
  let {a2' = (fromIntegral . fromEnum) a2} in
  let {a3' = castPtr a3} in
  let {a4' = id a4} in
  let {a5' = castPtr a5} in
  let {a6' = C2HSImp.fromBool a6} in
  let {a7' = realToFrac a7} in
  let {a8' = castPtr a8} in
  let {a9' = id a9} in
  igraphPagerank'_ a1' a2' a3' a4' a5' a6' a7' a8' a9' >>= \res ->
  return ()

{-# LINE 116 "src/IGraph/Algorithms/Centrality.chs" #-}


igraphPersonalizedPagerank :: (IGraph) -> (PagerankAlgo) -> (Ptr Vector) -> (Ptr CDouble) -> (Ptr VertexSelector) -> (Bool) -> (Double) -> (Ptr Vector) -> (Ptr Vector) -> (Ptr ()) -> IO ()
igraphPersonalizedPagerank a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 =
  (withIGraph) a1 $ \a1' ->
  let {a2' = (fromIntegral . fromEnum) a2} in
  let {a3' = castPtr a3} in
  let {a4' = id a4} in
  let {a5' = castPtr a5} in
  let {a6' = C2HSImp.fromBool a6} in
  let {a7' = realToFrac a7} in
  let {a8' = castPtr a8} in
  let {a9' = castPtr a9} in
  let {a10' = id a10} in
  igraphPersonalizedPagerank'_ a1' a2' a3' a4' a5' a6' a7' a8' a9' a10' >>= \res ->
  return ()

{-# LINE 129 "src/IGraph/Algorithms/Centrality.chs" #-}


foreign import ccall safe "IGraph/Algorithms/Centrality.chs.h __c2hs_wrapped__igraph_closeness"
  igraphCloseness'_ :: ((C2HSImp.Ptr (IGraph)) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))))))

foreign import ccall safe "IGraph/Algorithms/Centrality.chs.h __c2hs_wrapped__igraph_betweenness"
  igraphBetweenness'_ :: ((C2HSImp.Ptr (IGraph)) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))))))

foreign import ccall safe "IGraph/Algorithms/Centrality.chs.h igraph_eigenvector_centrality"
  igraphEigenvectorCentrality'_ :: ((C2HSImp.Ptr (IGraph)) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CDouble) -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))))))))

foreign import ccall safe "IGraph/Algorithms/Centrality.chs.h __c2hs_wrapped__igraph_pagerank"
  igraphPagerank'_ :: ((C2HSImp.Ptr (IGraph)) -> (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CDouble) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (C2HSImp.CDouble -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))))))))))

foreign import ccall safe "IGraph/Algorithms/Centrality.chs.h __c2hs_wrapped__igraph_personalized_pagerank"
  igraphPersonalizedPagerank'_ :: ((C2HSImp.Ptr (IGraph)) -> (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CDouble) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (C2HSImp.CDouble -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))))))))))