Commit d105a1c6 authored by Kai Zhang's avatar Kai Zhang

add lgl layout

parent 5bcc3ae5
......@@ -22,11 +22,12 @@ graphToDiagram gr = position (map drawNode (nodes gr)) <> mconcat (map drawEdge
, circle (_size nattr) # lwO 0 # fcA (_nodeColour nattr) )
where
nattr = nodeLab gr x
drawEdge (from, to) = arrowBetween'
drawEdge (from, to) = {-arrowBetween'
( with & arrowTail .~ noTail
& arrowHead .~ arrowH
& headLength .~ output (_edgeArrowLength eattr)
) start end
) start end-}
fromVertices [start, end]
# lwO (_edgeWeight eattr) # lcA (_edgeColour eattr)
where
eattr = edgeLab gr (from, to)
......@@ -34,6 +35,6 @@ graphToDiagram gr = position (map drawNode (nodes gr)) <> mconcat (map drawEdge
end = _positionX nattr2 ^& _positionY nattr2
nattr1 = nodeLab gr from
nattr2 = nodeLab gr to
arrowH | isDirected gr = dart
| otherwise = noHead
--arrowH | isDirected gr = dart
-- | otherwise = noHead
{-# INLINE graphToDiagram #-}
......@@ -25,3 +25,14 @@ import Foreign.C.Types
, id `Ptr VectorPtr'
, id `Ptr VectorPtr'
} -> `Int' #}
{# fun igraph_layout_lgl as ^ { `IGraphPtr'
, `MatrixPtr'
, `Int'
, `Double'
, `Double'
, `Double'
, `Double'
, `Double'
, `Int'
} -> `Int' #}
module IGraph.Layout
( getLayout
, LayoutOpt(..)
, LayoutMethod(..)
, defaultKamadaKawai
, defaultLGL
) where
import Foreign (nullPtr)
import Control.Applicative ((<$>))
import System.IO.Unsafe (unsafePerformIO)
import Data.Default.Class
import Control.Applicative ((<$>))
import Data.Default.Class
import Data.Maybe (isJust)
import Foreign (nullPtr)
import System.IO.Unsafe (unsafePerformIO)
import IGraph
import IGraph.Internal.Clique
import IGraph.Internal.Layout
import IGraph.Internal.Data
import IGraph
import IGraph.Internal.Clique
import IGraph.Internal.Data
import IGraph.Internal.Layout
data LayoutOpt = LayoutOpt
{ _seed :: Maybe [(Double, Double)]
, _nIter :: Int
, _method :: LayoutMethod
, _sigma :: (Int -> Double) -- ^ [KamadaKawai] the base standard deviation of position change proposals
, _startTemp :: Double -- ^ [KamadaKawai] the initial temperature for the annealing
, _coolFact :: Double -- ^ [KamadaKawai] the cooling factor for the simulated annealing
, _kkConst :: (Int -> Double) -- ^ [KamadaKawai] The Kamada-Kawai vertex attraction constant
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 -- ^ the Large Graph Layout algorithm
{ 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)
}
instance Default LayoutOpt where
def = LayoutOpt
{ _seed = Nothing
, _nIter = 10000
, _method = KamadaKawai
, _sigma = \x -> fromIntegral x / 4
, _startTemp = 10
, _coolFact = 0.99
, _kkConst = \x -> fromIntegral $ x^2
}
defaultKamadaKawai :: LayoutMethod
defaultKamadaKawai = KamadaKawai
{ kk_seed = Nothing
, kk_nIter = 1000
, kk_sigma = \x -> fromIntegral x / 4
, kk_startTemp = 10
, kk_coolFact = 0.99
, kk_const = \x -> fromIntegral $ x^2
}
data LayoutMethod = KamadaKawai
defaultLGL :: LayoutMethod
defaultLGL = LGL
{ lgl_nIter = 150
, 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 => LGraph d v e -> LayoutOpt -> IO [(Double, Double)]
getLayout gr opt = do
mptr <- mat
getLayout :: Graph d => LGraph d v e -> LayoutMethod -> IO [(Double, Double)]
getLayout gr method = do
case method of
KamadaKawai seed niter sigma initemp coolexp kkconst -> do
mptr <- case seed of
Nothing -> igraphMatrixNew 0 0
Just xs -> if length xs /= nNodes gr
then error "Seed error: incorrect size"
else listsToMatrixPtr $ (\(x,y) -> [x,y]) $ unzip xs
case _method opt of
KamadaKawai -> igraphLayoutKamadaKawai gptr mptr iters s initemp coolexp
kkconst useSeed nullPtr nullPtr nullPtr nullPtr
igraphLayoutKamadaKawai gptr mptr niter (sigma n) initemp coolexp
(kkconst n) (isJust seed) nullPtr nullPtr nullPtr nullPtr
[x, y] <- matrixPtrToColumnLists mptr
return $ zip x y
[x, y] <- matrixPtrToColumnLists mptr
return $ zip x y
LGL niter delta area coolexp repulserad cellsize -> do
mptr <- igraphMatrixNew 0 0
igraphLayoutLgl gptr mptr niter (delta n) (area n) coolexp
(repulserad n) (cellsize n) (-1)
[x, y] <- matrixPtrToColumnLists mptr
return $ zip x y
where
n = nNodes gr
gptr = _graph gr
iters = _nIter opt
s = _sigma opt n
initemp = _startTemp opt
coolexp = _coolFact opt
kkconst = _kkConst opt n
(useSeed, mat) = case _seed opt of
Just xs -> if length xs /= nNodes gr
then error "Seed error: incorrect size"
else (True, f xs)
_ -> (False, igraphMatrixNew 0 0)
f xs = let (x,y) = unzip xs
in listsToMatrixPtr [x,y]
flags: {}
flags:
haskell-igraph:
graphics: true
packages:
- '.'
- '.'
extra-deps: []
resolver: lts-5.5
extra-lib-dirs:
- "/home/kai/opt/lib"
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment