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


{-# LINE 1 "src/IGraph/Internal/Community.chs" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module IGraph.Internal.Community where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Marshal.Utils as C2HSImp
import qualified Foreign.Ptr as C2HSImp



import Foreign
import Foreign.C.Types

import IGraph.Internal.Arpack
{-# LINE 7 "src/IGraph/Internal/Community.chs" #-}

import IGraph.Internal.Graph
{-# LINE 8 "src/IGraph/Internal/Community.chs" #-}

import IGraph.Internal.Data
{-# LINE 9 "src/IGraph/Internal/Community.chs" #-}

import IGraph.Internal.Constants
{-# LINE 10 "src/IGraph/Internal/Community.chs" #-}




igraphCommunitySpinglass :: (IGraph) -> (Vector) -> (Ptr CDouble) -> (Ptr CDouble) -> (Vector) -> (Ptr Vector) -> (Int) -> (Bool) -> (Double) -> (Double) -> (Double) -> (SpincommUpdate) -> (Double) -> (SpinglassImplementation) -> (Double) -> IO ((Int))
igraphCommunitySpinglass a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 =
  (withIGraph) a1 $ \a1' ->
  (withVector) a2 $ \a2' ->
  let {a3' = id a3} in
  let {a4' = id a4} in
  (withVector) a5 $ \a5' ->
  let {a6' = id a6} in
  let {a7' = fromIntegral a7} in
  let {a8' = C2HSImp.fromBool a8} in
  let {a9' = realToFrac a9} in
  let {a10' = realToFrac a10} in
  let {a11' = realToFrac a11} in
  let {a12' = (fromIntegral . fromEnum) a12} in
  let {a13' = realToFrac a13} in
  let {a14' = (fromIntegral . fromEnum) a14} in
  let {a15' = realToFrac a15} in
  igraphCommunitySpinglass'_ a1' a2' a3' a4' a5' a6' a7' a8' a9' a10' a11' a12' a13' a14' a15' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 30 "src/IGraph/Internal/Community.chs" #-}


igraphCommunityLeadingEigenvector :: (IGraph) -> (Vector) -> (Ptr Matrix) -> (Vector) -> (Int) -> (ArpackOpt) -> (Ptr CDouble) -> (Bool) -> (Ptr Vector) -> (Ptr VectorPtr) -> (Ptr Vector) -> (T) -> (Ptr ()) -> IO ((Int))
igraphCommunityLeadingEigenvector a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 =
  (withIGraph) a1 $ \a1' ->
  (withVector) a2 $ \a2' ->
  let {a3' = id a3} in
  (withVector) a4 $ \a4' ->
  let {a5' = fromIntegral a5} in
  (withArpackOpt) a6 $ \a6' ->
  let {a7' = id a7} in
  let {a8' = C2HSImp.fromBool a8} in
  let {a9' = id a9} in
  let {a10' = id a10} in
  let {a11' = id a11} in
  let {a12' = id a12} in
  let {a13' = id a13} in
  igraphCommunityLeadingEigenvector'_ a1' a2' a3' a4' a5' a6' a7' a8' a9' a10' a11' a12' a13' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 46 "src/IGraph/Internal/Community.chs" #-}


type T = FunPtr ( Ptr Vector
                -> CLong
                -> CDouble
                -> Ptr Vector
                -> FunPtr (Ptr CDouble -> Ptr CDouble -> CInt -> Ptr () -> IO CInt)
                -> Ptr ()
                -> Ptr ()
                -> IO CInt)

foreign import ccall safe "IGraph/Internal/Community.chs.h igraph_community_spinglass"
  igraphCommunitySpinglass'_ :: ((C2HSImp.Ptr (IGraph)) -> ((C2HSImp.Ptr (Vector)) -> ((C2HSImp.Ptr C2HSImp.CDouble) -> ((C2HSImp.Ptr C2HSImp.CDouble) -> ((C2HSImp.Ptr (Vector)) -> ((C2HSImp.Ptr (Vector)) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CInt -> (C2HSImp.CDouble -> (C2HSImp.CInt -> (C2HSImp.CDouble -> (IO C2HSImp.CInt))))))))))))))))

foreign import ccall safe "IGraph/Internal/Community.chs.h igraph_community_leading_eigenvector"
  igraphCommunityLeadingEigenvector'_ :: ((C2HSImp.Ptr (IGraph)) -> ((C2HSImp.Ptr (Vector)) -> ((C2HSImp.Ptr (Matrix)) -> ((C2HSImp.Ptr (Vector)) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (ArpackOpt)) -> ((C2HSImp.Ptr C2HSImp.CDouble) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (Vector)) -> ((C2HSImp.Ptr (VectorPtr)) -> ((C2HSImp.Ptr (Vector)) -> ((C2HSImp.FunPtr ((C2HSImp.Ptr (Vector)) -> (C2HSImp.CLong -> (C2HSImp.CDouble -> ((C2HSImp.Ptr (Vector)) -> ((C2HSImp.FunPtr ((C2HSImp.Ptr C2HSImp.CDouble) -> ((C2HSImp.Ptr C2HSImp.CDouble) -> (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))))) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))))))))) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))))))))))))))