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 ------------------------------------------------------------------------
  84
  85 data Layout = KamadaKawai | ACP | ForceAtlas
  86
  87 setCoord'' :: Layout -> (Int, Node) -> Node
  88 setCoord'' ForceAtlas = setCoord' (\i-> (sin $ fromIntegral i, cos $ fromIntegral i))
  89 setCoord'' ACP = undefined
  90 setCoord'' KamadaKawai = undefined
  91
  92
  93 setCoord' :: (Int -> (Double, Double)) -> (Int, Node) -> Node
  94 setCoord' f (i,n) = n { node_x_coord = x, node_y_coord = y }
  95   where
  96     (x,y) = f i
  97
  98
  99 -- | ACP
 100 setCoord :: Ord a => Layout -> [(a, Int)] -> Map (Int, Int) Double -> (Int, Node) -> Node
 101 setCoord l labels m (n,node) = node { node_x_coord = x, node_y_coord = y }
 102   where
 103     (x,y) = getCoord l labels m n
 104
 105
 106 getCoord :: Ord a => Layout
 107                   -> [(a, Int)] -> Map (Int, Int) Double -> Int -> (Double, Double)
 108 getCoord KamadaKawai _ _ _ = undefined
 109 getCoord ForceAtlas _ _ n = (sin d, cos d)
 110   where
 111     d = fromIntegral n
 112 getCoord ACP labels m n = to2d $ maybe (panic "Graph.Tools no coordinate") identity
 113              $ Map.lookup n
 114              $ pcaReduceTo (Dimension 2)
 115              $ mapArray labels m
 116   where
 117     to2d :: Vec.Vector Double -> (Double, Double)
 118     to2d v  = (x',y')
 119       where
 120         ds = take 2 $ Vec.toList v
 121         x'  = head' "to2d" ds
 122         y'  = last' "to2d" ds
 123
 124     mapArray :: Ord a => [(a, Int)] -> Map (Int, Int) Double -> Map Int (Vec.Vector Double)
 125     mapArray items m' = Map.fromList [ toVec n' ns m' | n' <- ns ]
 126       where
 127         ns = map snd items
 128
 129     toVec :: Int -> [Int] -> Map (Int,Int) Double -> (Int, Vec.Vector Double)
 130     toVec n' ns' m' = (n', Vec.fromList $ map (\n'' -> maybe 0 identity $ Map.lookup (n',n'') m') ns')
 131 ------------------------------------------------------------------------
 132
 133 -- | KamadaKawai Layout
 134 layout :: Map (Int, Int) Double -> IO (Map Int (Double, Double))
 135 layout = undefined
 136
 137