initialisation

.gitignore

+.stack-work/
+*~
\ No newline at end of file

ChangeLog.md

+# Changelog for gargantext-graph
+
+## Unreleased changes

README.md

+# gargantext-graph library
+
+- tools for graph management: FGL, Igraph
+- graph algorithms

Setup.hs

+import Distribution.Simple
+main = defaultMain

app/Main.hs

+module Main where
+
+import Protolude
+
+main :: IO ()
+main = undefined
+

gargantext-graph.cabal

+cabal-version: 1.12
+
+-- This file has been generated from package.yaml by hpack version 0.33.0.
+--
+-- see: https://github.com/sol/hpack
+--
+-- hash: 91be25176c3dca27abbaad970ceeed468702f7fcb80a37afb87b100689e657b3
+
+name:           gargantext-graph
+version:        0.1.0.0
+description:    Please see the README on GitHub at <https://github.com/githubuser/gargantext-graph#readme>
+homepage:       https://github.com/https://gitlab.iscpif.fr/gargantext/gargantext-graph#readme
+bug-reports:    https://github.com/https://gitlab.iscpif.fr/gargantext/gargantext-graph/issues
+author:         Alexandre Delanoë
+maintainer:     alexandre+dev@delanoe.org
+copyright:      2021 CNRS / Alexandre Delanoë
+license:        AGPL
+license-file:   LICENSE
+build-type:     Simple
+extra-source-files:
+    README.md
+    ChangeLog.md
+
+source-repository head
+  type: git
+  location: https://github.com/https://gitlab.iscpif.fr/gargantext/gargantext-graph
+
+library
+  exposed-modules:
+      Graph.BAC.Proxemy
+      Graph.FGL
+      Graph.IGraph
+  other-modules:
+      Paths_gargantext_graph
+  hs-source-dirs:
+      src
+  default-extensions: NoImplicitPrelude DataKinds FlexibleInstances OverloadedStrings
+  build-depends:
+      base >=4.7 && <5
+    , cereal
+    , containers
+    , fgl
+    , haskell-igraph
+    , protolude
+    , singletons
+  default-language: Haskell2010
+
+executable gargantext-graph-exe
+  main-is: Main.hs
+  other-modules:
+      Paths_gargantext_graph
+  hs-source-dirs:
+      app
+  default-extensions: NoImplicitPrelude DataKinds FlexibleInstances OverloadedStrings
+  ghc-options: -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+      base >=4.7 && <5
+    , cereal
+    , containers
+    , fgl
+    , gargantext-graph
+    , haskell-igraph
+    , protolude
+    , singletons
+  default-language: Haskell2010
+
+test-suite gargantext-graph-test
+  type: exitcode-stdio-1.0
+  main-is: Spec.hs
+  other-modules:
+      Paths_gargantext_graph
+  hs-source-dirs:
+      test
+  default-extensions: NoImplicitPrelude DataKinds FlexibleInstances OverloadedStrings
+  ghc-options: -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+      base >=4.7 && <5
+    , cereal
+    , containers
+    , fgl
+    , gargantext-graph
+    , haskell-igraph
+    , protolude
+    , singletons
+  default-language: Haskell2010

package.yaml

+name:                gargantext-graph
+version:             0.1.0.0
+github:              "https://gitlab.iscpif.fr/gargantext/gargantext-graph"
+license:             AGPL
+author:              "Alexandre Delanoë"
+maintainer:          "alexandre+dev@delanoe.org"
+copyright:           "2021 CNRS / Alexandre Delanoë"
+
+extra-source-files:
+- README.md
+- ChangeLog.md
+
+# Metadata used when publishing your package
+# synopsis:            Short description of your package
+# category:            Web
+
+# To avoid duplicated efforts in documentation and dealing with the
+# complications of embedding Haddock markup inside cabal files, it is
+# common to point users to the README.md file.
+description:         Please see the README on GitHub at <https://github.com/githubuser/gargantext-graph#readme>
+
+dependencies:
+- base >= 4.7 && < 5
+- protolude
+- fgl
+- haskell-igraph
+- cereal     # (IGraph)
+- singletons
+- containers
+
+  #- python-pickle
+
+default-extensions:
+- NoImplicitPrelude
+- DataKinds
+- FlexibleInstances
+- OverloadedStrings
+
+library:
+  source-dirs: src
+
+executables:
+  gargantext-graph-exe:
+    main:                Main.hs
+    source-dirs:         app
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    dependencies:
+    - gargantext-graph
+
+tests:
+  gargantext-graph-test:
+    main:                Spec.hs
+    source-dirs:         test
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    dependencies:
+    - gargantext-graph

src/Graph/FGL.hs

+{-| Module      : Gargantext.Core.Viz.Graph.FGL
+Description : FGL main functions used in Garg
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+Main FGL funs/types to ease portability with IGraph.
+
+-}
+
+{-# LANGUAGE ConstraintKinds   #-}
+
+module Graph.FGL where
+
+import Protolude
+import qualified Data.Graph.Inductive as FGL
+import Data.List as List
+------------------------------------------------------------------
+-- | Main Types
+
+type Graph_Undirected = FGL.Gr () ()
+type Graph_Directed   = FGL.Gr () ()
+
+type Graph = FGL.Graph
+type Node = FGL.Node -- Int
+type Edge = FGL.Edge -- (Int, Int)
+
+------------------------------------------------------------------
+-- | Main Functions
+mkGraph :: [Node] -> [Edge] -> Graph_Undirected
+mkGraph = FGL.mkUGraph
+
+neighbors :: Graph gr => gr a b -> Node -> [Node]
+neighbors = FGL.neighbors
+
+-- | TODO bug: if graph is undirected, we need to filter
+-- nub . (map (\(n1,n2) -> if n1 < n2 then (n1,n2) else (n2,n1))) . FGL.edges
+edges :: Graph gr => gr a b -> [Edge]
+edges = FGL.edges
+
+nodes :: Graph gr => gr a b -> [Node]
+nodes = FGL.nodes
+
+------------------------------------------------------------------------
+-- | Graph Tools
+
+filterNeighbors :: Graph_Undirected -> Node -> [Node]
+filterNeighbors g n = List.nub $ neighbors g n
+
+-- Q: why not D.G.I.deg ? (Int as result)
+degree :: Graph_Undirected -> Node -> Double
+degree g n = fromIntegral $ List.length (filterNeighbors g n)
+
+vcount :: Graph_Undirected -> Double
+vcount = fromIntegral . List.length . List.nub . nodes
+
+-- | TODO tests, optim and use IGraph library, fix IO ?
+ecount :: Graph_Undirected -> Double
+ecount = fromIntegral . List.length . List.nub . edges
+
+------------------------------------------------------------------
+-- | Main sugared functions
+mkGraphUfromEdges :: [(Int, Int)] -> Graph_Undirected
+mkGraphUfromEdges es = mkGraph ns es
+  where
+    ns = List.nub (a <> b)
+      where
+        (a, b) = List.unzip es
+

src/Graph/GEXF.sh

+{-|
+Module      : Gargantext.Core.Viz.Graph
+Description :
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+{-# LANGUAGE OverloadedLists   #-}   -- allows to write Map and HashMap as lists
+{-# LANGUAGE TypeOperators     #-}
+
+module Gargantext.Core.Viz.Graph.GEXF
+  where
+
+import Gargantext.Prelude
+import Gargantext.Core.Viz.Graph
+import qualified Data.HashMap.Lazy as HashMap
+import qualified Gargantext.Prelude as P
+import qualified Gargantext.Core.Viz.Graph as G
+import qualified Xmlbf as Xmlbf
+
+-- Converts to GEXF format
+-- See https://gephi.org/gexf/format/
+instance Xmlbf.ToXml Graph where
+  toXml (Graph { _graph_nodes = graphNodes
+                , _graph_edges = graphEdges }) = root graphNodes graphEdges
+    where
+      root :: [G.Node] -> [G.Edge] -> [Xmlbf.Node]
+      root gn ge =
+        Xmlbf.element "gexf" params $ meta <> (graph gn ge)
+        where
+          params = HashMap.fromList [ ("xmlns", "http://www.gexf.net/1.2draft")
+                                    , ("version", "1.2") ]
+      meta = Xmlbf.element "meta" params $ creator <> desc
+        where
+          params = HashMap.fromList [ ("lastmodifieddate", "2020-03-13") ]
+      creator = Xmlbf.element "creator" HashMap.empty $ Xmlbf.text "Gargantext.org"
+      desc = Xmlbf.element "description" HashMap.empty $ Xmlbf.text "Gargantext gexf file"
+      graph :: [G.Node] -> [G.Edge] -> [Xmlbf.Node]
+      graph gn ge = Xmlbf.element "graph" params $ (nodes gn) <> (edges ge)
+        where
+          params = HashMap.fromList [ ("mode", "static")
+                                    , ("defaultedgetype", "directed") ]
+      nodes :: [G.Node] -> [Xmlbf.Node]
+      nodes gn = Xmlbf.element "nodes" HashMap.empty $ P.concatMap node' gn
+
+      node' :: G.Node -> [Xmlbf.Node]
+      node' (G.Node { node_id = nId, node_label = l }) =
+        Xmlbf.element "node" params []
+        where
+          params = HashMap.fromList [ ("id", nId)
+                                    , ("label", l) ]
+      edges :: [G.Edge] -> [Xmlbf.Node]
+      edges gn = Xmlbf.element "edges" HashMap.empty $ P.concatMap edge gn
+      edge :: G.Edge -> [Xmlbf.Node]
+      edge (G.Edge { edge_id = eId, edge_source = es, edge_target = et }) =
+        Xmlbf.element "edge" params []
+        where
+          params = HashMap.fromList [ ("id", eId)
+                                    , ("source", es)
+                                    , ("target", et) ]

src/Graph/IGraph.hs

+{-| Module      : Gargantext.Core.Viz.Graph.IGraph
+Description : IGraph main functions used in Garg
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+Main IGraph funs/types to ease portability with FGL.
+
+Reference:
+* Gábor Csárdi, Tamás Nepusz: The igraph software package for complex network research. InterJournal Complex Systems, 1695, 2006.
+
+-}
+
+
+module Graph.IGraph where
+
+import Data.Serialize (Serialize)
+import Data.Singletons (SingI)
+import IGraph hiding (mkGraph, neighbors, edges, nodes, Node, Graph)
+import IGraph.Algorithms.Clique as IAC
+import Protolude
+import qualified Data.List as List
+import qualified IGraph as IG
+
+------------------------------------------------------------------
+-- | Main Types
+type Graph_Undirected = IG.Graph 'U () ()
+type Graph_Directed   = IG.Graph 'D () ()
+
+type Node = IG.Node
+type Graph = IG.Graph
+
+------------------------------------------------------------------
+-- | Main Functions
+
+mkGraph :: (SingI d, Ord v,
+             Serialize v, Serialize e) =>
+     [v] -> [LEdge e] -> IG.Graph d v e
+mkGraph = IG.mkGraph
+
+neighbors :: IG.Graph d v e -> IG.Node -> [Node]
+neighbors = IG.neighbors
+
+edges :: IG.Graph d v e -> [Edge]
+edges = IG.edges
+
+nodes :: IG.Graph d v e -> [Node]
+nodes = IG.nodes
+------------------------------------------------------------------
+
+-- | Tools
+maximalCliques :: IG.Graph d v e -> [[Int]]
+maximalCliques g = IAC.maximalCliques g (min',max')
+  where
+    min' = 0
+    max' = 0
+
+------------------------------------------------------------------
+-- | Main sugared functions
+mkGraphUfromEdges :: [(Int, Int)] -> Graph_Undirected
+mkGraphUfromEdges es = mkGraph (List.replicate n ()) $ zip es $ repeat ()
+  where
+    (a,b) = List.unzip es
+    n = List.length (List.nub $ a <> b)
+
+mkGraphDfromEdges :: [(Int, Int)] -> Graph_Directed
+mkGraphDfromEdges = undefined
+
+

src/Graph/Index.sh

+{-|
+Module      : Gargantext.Graph.Distances.Utils
+Description : Tools to compute distances from Cooccurrences
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+Basically @compute@ takes an accelerate function as first input, a Map
+of coccurrences as second input and outputs a Map automatically using
+indexes.
+
+TODO:
+--cooc2fgl :: Ord t, Integral n => Map (t, t) n -> Graph
+--fgl2json
+
+-}
+
+{-# LANGUAGE BangPatterns      #-}
+{-# LANGUAGE TypeOperators     #-}
+{-# LANGUAGE MonoLocalBinds    #-}
+
+module Gargantext.Core.Viz.Graph.Index
+  where
+
+import qualified Data.Array.Accelerate as A
+import qualified Data.Array.Accelerate.Interpreter as A
+import Data.Array.Accelerate (Matrix, Elt, Shape, (:.)(..), Z(..))
+
+import Data.Maybe (fromMaybe)
+
+import Data.Set (Set)
+import qualified Data.Set as S
+
+import Data.Map (Map)
+import qualified Data.Map.Strict    as M
+
+-- import Data.Vector (Vector)
+
+import Gargantext.Prelude
+
+type Index    = Int
+
+-------------------------------------------------------------------------------
+-------------------------------------------------------------------------------
+score :: (Ord t) => (A.Matrix Int -> A.Matrix Double)
+                -> Map (t, t) Int
+                -> Map (t, t) Double
+score f m = fromIndex fromI . mat2map . f $ cooc2mat toI m
+  where
+    (toI, fromI) = createIndices m
+
+-------------------------------------------------------------------------------
+-------------------------------------------------------------------------------
+cooc2mat :: Ord t => Map t Index -> Map (t, t) Int -> Matrix Int
+cooc2mat ti m = map2mat 0 n idx
+  where
+    n = M.size ti
+    idx = toIndex ti m -- it is important to make sure that toIndex is ran only once.
+
+map2mat :: Elt a => a -> Int -> Map (Index, Index) a -> Matrix a
+map2mat def n m = A.fromFunction shape (\(Z :. x :. y) -> fromMaybe def $ M.lookup (x, y) m)
+  where
+    shape = (Z :. n :. n)
+
+mat2map :: (Elt a, Shape (Z :. Index)) =>
+            A.Array (Z :. Index :. Index) a -> Map (Index, Index) a
+mat2map m = M.fromList . map f . A.toList . A.run . A.indexed $ A.use m
+  where
+    -- Z :. _ :. n = A.arrayShape m
+    f ((Z :. i :. j), x) = ((i, j), x)
+
+-------------------------------------------------------------------------------
+-------------------------------------------------------------------------------
+toIndex :: Ord t => Map t Index -> Map (t,t) a -> Map (Index,Index) a
+toIndex ni ns = indexConversion ni ns
+
+fromIndex :: Ord t => Map Index t -> Map (Index, Index) a -> Map (t,t) a
+fromIndex ni ns = indexConversion ni ns
+
+indexConversion :: (Ord b, Ord k) => Map k b -> Map (k,k) a -> Map (b, b) a
+indexConversion index ms = M.fromList $ map (\((k1,k2),c) -> ( ((M.!) index k1, (M.!) index k2), c)) (M.toList ms)
+---------------------------------------------------------------------------------
+
+-------------------------------------------------------------------------------
+--fromIndex' :: Ord t => Vector t -> Map (Index, Index) a -> Map (t,t) a
+--fromIndex' vi ns = undefined
+
+-- TODO: returing a Vector should be faster than a Map
+-- createIndices' :: Ord t => Map (t, t) b -> (Map t Index, Vector t)
+-- createIndices' = undefined
+
+createIndices :: Ord t => Map (t, t) b -> (Map t Index, Map Index t)
+createIndices = set2indices . map2set
+  where
+    map2set :: Ord t => Map (t, t) a -> Set t
+    map2set cs' = foldl' (\s ((t1,t2),_) -> insert [t1,t2] s ) S.empty (M.toList cs')
+      where
+        insert as s = foldl' (\s' t -> S.insert t s') s as
+
+    set2indices :: Ord t => Set t -> (Map t Index, Map Index t)
+    set2indices s = (M.fromList toIndex', M.fromList fromIndex')
+      where
+        fromIndex' = zip [0..] xs
+        toIndex'   = zip xs [0..]
+        xs         = S.toList s
+
+

src/Graph/Utils.sh

+{-|
+Module      : Gargantext.Core.Viz.Graph.Utils
+Description : 
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+These functions are used for Vector.Matrix only.
+
+-}
+
+{-# LANGUAGE BangPatterns      #-}
+{-# LANGUAGE Strict            #-}
+
+module Gargantext.Core.Viz.Graph.Utils
+  where
+
+import Data.Matrix hiding (identity)
+
+import Data.Vector (Vector)
+import qualified Data.Vector as V
+
+import qualified Data.List   as L
+import Gargantext.Prelude
+
+------------------------------------------------------------------------
+-- | Some utils to build the matrix from cooccurrence results
+
+-- | For tests only, to be removed
+-- m1 :: Matrix Double
+-- m1 = fromList 300 300 [1..]
+------------------------------------------------------------------------
+------------------------------------------------------------------------
+data Axis = Col | Row
+------------------------------------------------------------------------
+-- | Matrix functions
+type AxisId = Int
+
+-- Data.Vector.Additions
+dropAt :: Int -> Vector a -> Vector a
+dropAt n v = debut <> (V.tail fin)
+  where
+    debut = V.take n v
+    fin   = V.drop n v
+
+total :: Num a => Matrix a -> a
+total m = V.sum $ V.map (\c -> V.sum (getCol c m)) (V.enumFromTo 1 (nOf Col m))
+
+nOf :: Axis -> Matrix a -> Int
+nOf Row = nrows
+nOf Col = ncols
+
+axis :: Axis -> AxisId -> Matrix a -> Vector a
+axis Col = getCol
+axis Row = getRow
+
+
+toListsWithIndex :: Matrix a ->  [((Int, Int), a)]
+toListsWithIndex m = concat' $ zip [1..] $ map (\c -> zip [1..] c) $ toLists m
+  where
+    concat' :: [(Int, [(Int, a)])] -> [((Int, Int), a)]
+    concat' xs = L.concat $ map (\(x, ys) -> map (\(y, a) -> ((x,y), a)) ys ) xs
+
+
+
+
+
+

stack.yaml

+# This file was automatically generated by 'stack init'
+#
+# Some commonly used options have been documented as comments in this file.
+# For advanced use and comprehensive documentation of the format, please see:
+# https://docs.haskellstack.org/en/stable/yaml_configuration/
+
+# Resolver to choose a 'specific' stackage snapshot or a compiler version.
+# A snapshot resolver dictates the compiler version and the set of packages
+# to be used for project dependencies. For example:
+#
+# resolver: lts-3.5
+# resolver: nightly-2015-09-21
+# resolver: ghc-7.10.2
+#
+# The location of a snapshot can be provided as a file or url. Stack assumes
+# a snapshot provided as a file might change, whereas a url resource does not.
+#
+# resolver: ./custom-snapshot.yaml
+# resolver: https://example.com/snapshots/2018-01-01.yaml
+
+resolver: lts-16.26
+allow-newer: true
+# User packages to be built.
+# Various formats can be used as shown in the example below.
+#
+# packages:
+# - some-directory
+# - https://example.com/foo/bar/baz-0.0.2.tar.gz
+#   subdirs:
+#   - auto-update
+#   - wai
+packages:
+- .
+# Dependency packages to be pulled from upstream that are not in the resolver.
+# These entries can reference officially published versions as well as
+# forks / in-progress versions pinned to a git hash. For example:
+#
+extra-deps:
+- git: https://github.com/kaizhang/haskell-igraph.git
+  commit: 34553acc4ebdcae7065311dcefb426e0fd58c5a0
+  
+#- haskell-igraph-0.8.0@sha256:ebcd0dfcba0647c6d31d8558a8588a1c9195e3d575d0a9605b8b4276a379a324,16497
+#- python-pickle-0.2.3@sha256:d2ca35e7c7a6e07f5ec9189e143352265fde4bf3927e4a4d409e58037e7fb47c,1521
+#- containers-0.5.11.0@sha256:28ad7337057442f75bc689315ab4ec7bdf5e6b2c39668f306672cecd82c02798,16685
+#- Cabal-3.2.1.0@sha256:8743076ec022296f9771d962000c9ca3a0fe02e68c37b992c63e382a675f791d,27482
+#- binary-0.8.8.0@sha256:e9387a7ef2b34c6a23b09664c306e37cc01ae2cb4e4511a1c96ffb14008c24b0,6262
+#- text-1.2.4.0@sha256:8c24450feb8e3bbb7ea3e17af24ef57e85db077c4bf53e5bcc345b283d1b1d5b,10081
+#- ghc-prim-0.5.3@sha256:2284e90b0d56dfd389588b5c927e7f22c17f1d6c2291464cb0cc3f9651b0ba23,2319
+#- parsec-3.1.14.0@sha256:63a4555d6ea2aaccd8588fc809e5d137e72b668898ab3b171ce8458b792f0f36,4356
+#- template-haskell-2.15.0.0@sha256:6e803fbff5069effa18a921c76b3fed4535542e0721b464f38012b2f9eb66562,1894
+#
+  
+  # - acme-missiles-0.3
+# - git: https://github.com/commercialhaskell/stack.git
+#   commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+#
+# extra-deps: []
+
+# Override default flag values for local packages and extra-deps
+# flags: {}
+
+# Extra package databases containing global packages
+# extra-package-dbs: []
+
+# Control whether we use the GHC we find on the path
+# system-ghc: true
+#
+# Require a specific version of stack, using version ranges
+# require-stack-version: -any # Default
+# require-stack-version: ">=2.5"
+#
+# Override the architecture used by stack, especially useful on Windows
+# arch: i386
+# arch: x86_64
+#
+# Extra directories used by stack for building
+# extra-include-dirs: [/path/to/dir]
+# extra-lib-dirs: [/path/to/dir]
+#
+# Allow a newer minor version of GHC than the snapshot specifies
+# compiler-check: newer-minor

test/Spec.hs

+main :: IO ()
+main = putStrLn "Test suite not yet implemented"