add lgl layout

src/IGraph/Exporter/Graphics.hs

@@ -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 #-}

src/IGraph/Internal/Layout.chs

@@ -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' #}

src/IGraph/Layout.hs

 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           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.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
 
+        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]

stack.yaml

-flags: {}
+flags:
+    haskell-igraph:
+        graphics: true
 packages:
-- '.'
+    - '.'
 extra-deps: []
 resolver: lts-5.5
-
-extra-lib-dirs:
-    - "/home/kai/opt/lib"