src/Gargantext/Viz/Graph/Tools.hs

   1 {-|
   2 Module      : Gargantext.Viz.Graph.Tools
   3 Description : Tools to build Graph
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 -}
  11
  12 {-# LANGUAGE NoImplicitPrelude           #-}
  13 {-# LANGUAGE OverloadedStrings           #-}
  14
  15 module Gargantext.Viz.Graph.Tools
  16   where
  17
  18 import Debug.Trace (trace)
  19 import Data.Graph.Clustering.Louvain.CplusPlus (LouvainNode(..))
  20 import Data.Graph.Clustering.Louvain.CplusPlus (cLouvain)
  21 import Data.Map (Map)
  22 import Data.Text (Text)
  23 import Gargantext.Prelude
  24 import Gargantext.Core.Statistics
  25 import Gargantext.Viz.Graph
  26 --import Gargantext.Viz.Graph.Bridgeness (bridgeness)
  27 import Gargantext.Viz.Graph.Distances.Matrice (measureConditional)
  28 import Gargantext.Viz.Graph.Index (createIndices, toIndex, map2mat, mat2map)
  29 import GHC.Float (sin, cos)
  30 import qualified Data.Vector.Storable as Vec
  31 import qualified Data.Map  as Map
  32
  33 cooc2graph :: (Map (Text, Text) Int) -> IO Graph
  34 cooc2graph myCooc = do
  35   let (ti, _) = createIndices myCooc
  36       myCooc4 = toIndex ti myCooc
  37       matCooc = map2mat (0) (Map.size ti) myCooc4
  38       distanceMat = measureConditional matCooc
  39       distanceMap = Map.map (\_ -> 1) $ Map.filter (>0) $ mat2map distanceMat
  40
  41   partitions <- case Map.size distanceMap > 0 of
  42     True  -> cLouvain distanceMap
  43     False -> panic "Text.Flow: DistanceMap is empty"
  44
  45   let distanceMap' = distanceMap -- bridgeness 300 partitions distanceMap
  46
  47   pure $ data2graph (Map.toList ti) myCooc4 distanceMap' partitions
  48
  49
  50 ----------------------------------------------------------
  51 -- | From data to Graph
  52 -- FIXME: distance should not be a map since we just "toList" it (same as cLouvain)
  53 data2graph :: [(Text, Int)] -> Map (Int, Int) Int
  54                             -> Map (Int, Int) Double
  55                             -> [LouvainNode]
  56               -> Graph
  57 data2graph labels coocs distance partitions = Graph nodes edges Nothing
  58   where
  59     community_id_by_node_id = Map.fromList [ (n, c) | LouvainNode n c <- partitions ]
  60
  61     nodes = map (setCoord ForceAtlas labels distance)
  62           [ (n, Node { node_size = maybe 0 identity (Map.lookup (n,n) coocs)
  63                    , node_type = Terms -- or Unknown
  64                    , node_id    = cs (show n)
  65                    , node_label = l
  66                    , node_x_coord = 0
  67                    , node_y_coord = 0
  68                    , node_attributes =
  69                      Attributes { clust_default = maybe 0 identity
  70                                 (Map.lookup n community_id_by_node_id) } }
  71                )
  72             | (l, n) <- labels
  73             ]
  74
  75     edges = trace (show distance) [ Edge { edge_source = cs (show s)
  76                    , edge_target = cs (show t)
  77                    , edge_weight = w
  78                    , edge_id     = cs (show i) }
  79             | (i, ((s,t), w)) <- zip ([0..]::[Integer]) (Map.toList distance) ]
  80
  81 ------------------------------------------------------------------------
  82
  83 data Layout = KamadaKawai | ACP | ForceAtlas
  84
  85
  86 setCoord' :: (Int -> (Double, Double)) -> (Int, Node) -> Node
  87 setCoord' f (i,n) = n { node_x_coord = x, node_y_coord = y }
  88   where
  89     (x,y) = f i
  90
  91
  92 -- | ACP
  93 setCoord :: Ord a => Layout -> [(a, Int)] -> Map (Int, Int) Double -> (Int, Node) -> Node
  94 setCoord l labels m (n,node) = node { node_x_coord = x, node_y_coord = y }
  95   where
  96     (x,y) = getCoord l labels m n
  97
  98
  99 getCoord :: Ord a => Layout
 100                   -> [(a, Int)] -> Map (Int, Int) Double -> Int -> (Double, Double)
 101 getCoord KamadaKawai _ _ _ = undefined
 102 getCoord ForceAtlas _ _ n = (sin d, cos d)
 103   where
 104     d = fromIntegral n
 105 getCoord ACP labels m n = to2d $ maybe (panic "Graph.Tools no coordinate") identity
 106              $ Map.lookup n
 107              $ pcaReduceTo (Dimension 2)
 108              $ mapArray labels m
 109   where
 110     to2d :: Vec.Vector Double -> (Double, Double)
 111     to2d v  = (x',y')
 112       where
 113         ds = take 2 $ Vec.toList v
 114         x'  = head' "to2d" ds
 115         y'  = last' "to2d" ds
 116
 117     mapArray :: Ord a => [(a, Int)] -> Map (Int, Int) Double -> Map Int (Vec.Vector Double)
 118     mapArray items m' = Map.fromList [ toVec n' ns m' | n' <- ns ]
 119       where
 120         ns = map snd items
 121
 122     toVec :: Int -> [Int] -> Map (Int,Int) Double -> (Int, Vec.Vector Double)
 123     toVec n' ns' m' = (n', Vec.fromList $ map (\n'' -> maybe 0 identity $ Map.lookup (n',n'') m') ns')
 124 ------------------------------------------------------------------------
 125
 126 -- | KamadaKawai Layout
 127 layout :: Map (Int, Int) Double -> IO (Map Int (Double, Double))
 128 layout = undefined
 129
 130