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


{-# LINE 1 "src/IGraph/Layout.chs" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module IGraph.Layout
    ( getLayout
    , LayoutMethod(..)
    , defaultKamadaKawai
    , defaultLGL
    ) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Marshal.Utils as C2HSImp
import qualified Foreign.Ptr as C2HSImp



import           Data.Maybe             (isJust)
import           Foreign                (nullPtr)

import qualified Foreign.Ptr as C2HSImp
import Foreign

import           IGraph
import IGraph.Internal
{-# LINE 16 "src/IGraph/Layout.chs" #-}




data LayoutMethod =
    KamadaKawai { kk_seed      :: !(Maybe [(Double, Double)])
                , kk_nIter     :: !Int
                , kk_sigma     :: (Int -> Double) -- ^ The base standard deviation of
                -- position change proposals
                , kk_startTemp :: !Double  -- ^ The initial temperature for the annealing
                , kk_coolFact  :: !Double  -- ^ The cooling factor for the simulated annealing
                , kk_const     :: (Int -> Double)  -- ^ The Kamada-Kawai vertex attraction constant
                }
  | LGL { lgl_nIter      :: !Int
        , lgl_maxdelta   :: (Int -> Double)  -- ^ The maximum length of the move allowed
        -- for a vertex in a single iteration. A reasonable default is the number of vertices.
        , lgl_area       :: (Int -> Double)  -- ^ This parameter gives the area
        -- of the square on which the vertices will be placed. A reasonable
        -- default value is the number of vertices squared.
        , lgl_coolexp    :: !Double  -- ^ The cooling exponent. A reasonable default value is 1.5.
        , lgl_repulserad :: (Int -> Double) -- ^ Determines the radius at which
        -- vertex-vertex repulsion cancels out attraction of adjacent vertices.
        -- A reasonable default value is area times the number of vertices.
        , lgl_cellsize   :: (Int -> Double)
        }

defaultKamadaKawai :: LayoutMethod
defaultKamadaKawai = KamadaKawai
    { kk_seed = Nothing
    , kk_nIter = 10
    , kk_sigma = \x -> fromIntegral x / 4
    , kk_startTemp = 10
    , kk_coolFact = 0.99
    , kk_const = \x -> fromIntegral $ x^2
    }

defaultLGL :: LayoutMethod
defaultLGL = LGL
    { lgl_nIter = 100
    , lgl_maxdelta = \x -> fromIntegral x
    , lgl_area = area
    , lgl_coolexp = 1.5
    , lgl_repulserad = \x -> fromIntegral x * area x
    , lgl_cellsize = \x -> area x ** 0.25
    }
  where
    area x = fromIntegral $ x^2

getLayout :: Graph d v e -> LayoutMethod -> IO [(Double, Double)]
getLayout gr method = case method of
    KamadaKawai seed niter sigma initemp coolexp kkconst -> case seed of
        Nothing -> allocaMatrix $ \mat -> do
            igraphLayoutKamadaKawai gptr mat niter (sigma n) initemp coolexp
                (kkconst n) (isJust seed) nullPtr nullPtr nullPtr nullPtr
            [x, y] <- toColumnLists mat
            return $ zip x y
        Just xs -> if length xs /= nNodes gr
            then error "Seed error: incorrect size"
            else withRowLists ((\(x,y) -> [x,y]) (unzip xs)) $ \mat -> do
                igraphLayoutKamadaKawai gptr mat niter (sigma n) initemp coolexp
                    (kkconst n) (isJust seed) nullPtr nullPtr nullPtr nullPtr
                [x, y] <- toColumnLists mat
                return $ zip x y

    LGL niter delta area coolexp repulserad cellsize -> allocaMatrix $ \mat -> do
        igraphLayoutLgl gptr mat niter (delta n) (area n) coolexp
            (repulserad n) (cellsize n) (-1)
        [x, y] <- toColumnLists mat
        return $ zip x y
  where
    n = nNodes gr
    gptr = _graph gr

igraphLayoutKamadaKawai :: (IGraph) -> (Ptr Matrix) -> (Int) -> (Double) -> (Double) -> (Double) -> (Double) -> (Bool) -> (Ptr Vector) -> (Ptr Vector) -> (Ptr Vector) -> (Ptr Vector) -> IO ()
igraphLayoutKamadaKawai a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 =
  (withIGraph) a1 $ \a1' ->
  let {a2' = castPtr a2} in
  let {a3' = fromIntegral a3} in
  let {a4' = realToFrac a4} in
  let {a5' = realToFrac a5} in
  let {a6' = realToFrac a6} in
  let {a7' = realToFrac a7} in
  let {a8' = C2HSImp.fromBool a8} in
  let {a9' = castPtr a9} in
  let {a10' = castPtr a10} in
  let {a11' = castPtr a11} in
  let {a12' = castPtr a12} in
  igraphLayoutKamadaKawai'_ a1' a2' a3' a4' a5' a6' a7' a8' a9' a10' a11' a12' >>= \res ->
  return ()

{-# LINE 102 "src/IGraph/Layout.chs" #-}


igraphLayoutLgl :: (IGraph) -> (Ptr Matrix) -> (Int) -> (Double) -> (Double) -> (Double) -> (Double) -> (Double) -> (Int) -> IO ()
igraphLayoutLgl a1 a2 a3 a4 a5 a6 a7 a8 a9 =
  (withIGraph) a1 $ \a1' ->
  let {a2' = castPtr a2} in
  let {a3' = fromIntegral a3} in
  let {a4' = realToFrac a4} in
  let {a5' = realToFrac a5} in
  let {a6' = realToFrac a6} in
  let {a7' = realToFrac a7} in
  let {a8' = realToFrac a8} in
  let {a9' = fromIntegral a9} in
  igraphLayoutLgl'_ a1' a2' a3' a4' a5' a6' a7' a8' a9' >>= \res ->
  return ()

{-# LINE 114 "src/IGraph/Layout.chs" #-}


foreign import ccall safe "IGraph/Layout.chs.h igraph_layout_kamada_kawai"
  igraphLayoutKamadaKawai'_ :: ((C2HSImp.Ptr (IGraph)) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))))))))))))

foreign import ccall safe "IGraph/Layout.chs.h igraph_layout_lgl"
  igraphLayoutLgl'_ :: ((C2HSImp.Ptr (IGraph)) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))))))))