-}
+{-# LANGUAGE ScopedTypeVariables #-}
module Gargantext.Core.Viz.Graph.Tools
where
--- import Data.Graph.Clustering.Louvain (hLouvain, {-iLouvainMap-})
-import Data.Graph.Clustering.Louvain.CplusPlus (cLouvain)
-import Data.Graph.Clustering.Louvain.Utils (LouvainNode(..))
-import Data.Map (Map)
+import Data.Aeson
import Data.HashMap.Strict (HashMap)
-import Data.Text (Text)
-import Debug.Trace (trace)
+import Data.Map (Map)
+import Data.Maybe (fromMaybe)
+import Data.Swagger hiding (items)
import GHC.Float (sin, cos)
+import GHC.Generics (Generic)
import Gargantext.API.Ngrams.Types (NgramsTerm(..))
import Gargantext.Core.Methods.Distances (Distance(..), measure)
+import Gargantext.Core.Methods.Distances.Conditional (conditional)
import Gargantext.Core.Methods.Graph.BAC.Proxemy (confluence)
import Gargantext.Core.Statistics
import Gargantext.Core.Viz.Graph
-import Gargantext.Core.Viz.Graph.Bridgeness (bridgeness)
-import Gargantext.Core.Viz.Graph.IGraph (mkGraphUfromEdges)
-import Gargantext.Core.Viz.Graph.Index (createIndices, toIndex, map2mat, mat2map, Index)
+import Gargantext.Core.Viz.Graph.Bridgeness (bridgeness, Partitions, ToComId(..))
+import Gargantext.Core.Viz.Graph.Index (createIndices, toIndex, map2mat, mat2map, Index, MatrixShape(..))
+import Gargantext.Core.Viz.Graph.Tools.IGraph (mkGraphUfromEdges, spinglass)
+import Gargantext.Core.Viz.Graph.Tools.Infomap (infomap)
+import Gargantext.Core.Viz.Graph.Utils (edgesFilter)
import Gargantext.Prelude
+import Graph.Types (ClusterNode)
import IGraph.Random -- (Gen(..))
+import Test.QuickCheck (elements)
+import Test.QuickCheck.Arbitrary
+import qualified Data.HashMap.Strict as HashMap
import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Set as Set
+import qualified Data.Text as Text
import qualified Data.Vector.Storable as Vec
+import qualified Graph.BAC.ProxemyOptim as BAC
import qualified IGraph as Igraph
import qualified IGraph.Algorithms.Layout as Layout
-import qualified Data.HashMap.Strict as HashMap
+
+data PartitionMethod = Spinglass | Confluence | Infomap
+ deriving (Generic, Eq, Ord, Enum, Bounded, Show)
+instance FromJSON PartitionMethod
+instance ToJSON PartitionMethod
+instance ToSchema PartitionMethod
+instance Arbitrary PartitionMethod where
+ arbitrary = elements [ minBound .. maxBound ]
+
+
+-------------------------------------------------------------
+defaultClustering :: Map (Int, Int) Double -> IO [ClusterNode]
+-- defaultClustering x = pure $ BAC.defaultClustering x
+defaultClustering x = spinglass 1 x
+
+-------------------------------------------------------------
type Threshold = Double
-> Double
-> Map (t, t) Int
-> Map (Index, Index) Double
-cooc2graph' distance threshold myCooc = distanceMap
- where
- (ti, _) = createIndices myCooc
- myCooc' = toIndex ti myCooc
- matCooc = map2mat 0 (Map.size ti) $ Map.filter (> 1) myCooc'
- distanceMat = measure distance matCooc
- distanceMap = Map.filter (> threshold) $ mat2map distanceMat
+cooc2graph' distance threshold myCooc
+ = Map.filter (> threshold)
+ $ mat2map
+ $ measure distance
+ $ case distance of
+ Conditional -> map2mat Triangle 0 tiSize
+ Distributional -> map2mat Square 0 tiSize
+ $ Map.filter (> 1) myCooc'
+
+ where
+ (ti, _) = createIndices myCooc
+ tiSize = Map.size ti
+ myCooc' = toIndex ti myCooc
+
+
+
+-- coocurrences graph computation
+cooc2graphWith :: PartitionMethod
+ -> Distance
+ -> Threshold
+ -> HashMap (NgramsTerm, NgramsTerm) Int
+ -> IO Graph
+cooc2graphWith Spinglass = cooc2graphWith' (spinglass 1)
+cooc2graphWith Confluence= cooc2graphWith' (\x -> pure $ BAC.defaultClustering x)
+cooc2graphWith Infomap = cooc2graphWith' (infomap "--silent --two-level -N2")
+ -- TODO: change these options, or make them configurable in UI?
+
+
+cooc2graphWith' :: ToComId a
+ => Partitions a
+ -> Distance
+ -> Threshold
+ -> HashMap (NgramsTerm, NgramsTerm) Int
+ -> IO Graph
+cooc2graphWith' doPartitions distance threshold myCooc = do
+ let
+ (distanceMap, diag, ti) = doDistanceMap distance threshold myCooc
+--{- -- Debug
+ -- saveAsFileDebug "/tmp/distanceMap" distanceMap
+ -- saveAsFileDebug "/tmp/distanceMap.keys" (List.length $ Map.keys distanceMap)
+ -- printDebug "similarities" similarities
+--}
-cooc2graph :: Distance
- -> Threshold
- -> HashMap (NgramsTerm, NgramsTerm) Int
- -> IO Graph
-cooc2graph distance threshold myCooc = do
- printDebug "cooc2graph" distance
- let
- -- TODO remove below
- theMatrix = Map.fromList $ HashMap.toList myCooc
- (ti, _) = createIndices theMatrix
- myCooc' = toIndex ti theMatrix
- matCooc = map2mat 0 (Map.size ti)
- $ Map.filterWithKey (\(a,b) _ -> a /= b)
- $ Map.filter (> 1) myCooc'
- distanceMat = measure distance matCooc
- distanceMap = Map.filter (> threshold) $ mat2map distanceMat
+ partitions <- if (Map.size distanceMap > 0)
+ then doPartitions distanceMap
+ else panic $ Text.unlines [ "[Gargantext.C.V.Graph.Tools] Similarity Matrix is empty"
+ , "Maybe you should add more Map Terms in your list"
+ , "Tutorial: link todo"
+ ]
+ let
nodesApprox :: Int
nodesApprox = n'
where
(as, bs) = List.unzip $ Map.keys distanceMap
n' = Set.size $ Set.fromList $ as <> bs
- ClustersParams rivers level = clustersParams nodesApprox
+ bridgeness' = bridgeness (fromIntegral nodesApprox) partitions distanceMap
+ confluence' = confluence (Map.keys bridgeness') 3 True False
+ pure $ data2graph ti diag bridgeness' confluence' partitions
- partitions <- if (Map.size distanceMap > 0)
- -- then iLouvainMap 100 10 distanceMap
- -- then hLouvain distanceMap
- then cLouvain level distanceMap
- else panic "Text.Flow: DistanceMap is empty"
- let
- -- bridgeness' = distanceMap
- bridgeness' = trace ("Rivers: " <> show rivers)
- $ bridgeness rivers partitions distanceMap
- confluence' = confluence (Map.keys bridgeness') 3 True False
+doDistanceMap :: Distance
+ -> Threshold
+ -> HashMap (NgramsTerm, NgramsTerm) Int
+ -> ( Map (Int,Int) Double
+ , Map (Index, Index) Int
+ , Map NgramsTerm Index
+ )
+doDistanceMap Distributional threshold myCooc = (distanceMap, toIndex ti diag, ti)
+ where
+ -- TODO remove below
+ (diag, theMatrix) = Map.partitionWithKey (\(x,y) _ -> x == y)
+ $ Map.fromList
+ $ HashMap.toList myCooc
+
+ (ti, _it) = createIndices theMatrix
+ tiSize = Map.size ti
- pure $ data2graph (Map.toList $ Map.mapKeys unNgramsTerm ti) myCooc' bridgeness' confluence' partitions
+ similarities = measure Distributional
+ $ map2mat Square 0 tiSize
+ $ toIndex ti theMatrix
+ links = round (let n :: Double = fromIntegral tiSize in n * (log n)^(2::Int))
+ distanceMap = Map.fromList
+ $ List.take links
+ $ List.reverse
+ $ List.sortOn snd
+ $ Map.toList
+ $ edgesFilter
+ $ Map.filter (> threshold)
+ $ mat2map similarities
+
+doDistanceMap Conditional threshold myCooc = (distanceMap, toIndex ti myCooc', ti)
+ where
+ myCooc' = Map.fromList $ HashMap.toList myCooc
+ (ti, _it) = createIndices myCooc'
-data ClustersParams = ClustersParams { bridgness :: Double
- , louvain :: Text
- } deriving (Show)
+ links = round (let n :: Double = fromIntegral (Map.size ti) in n * log n)
-clustersParams :: Int -> ClustersParams
-clustersParams x = ClustersParams (fromIntegral x) "0.00000001" -- y
- {- where
- y | x < 100 = "0.000001"
- | x < 350 = "0.000001"
- | x < 500 = "0.000001"
- | x < 1000 = "0.000001"
- | otherwise = "1"
- -}
+ distanceMap = toIndex ti
+ $ Map.fromList
+ $ List.take links
+ $ List.sortOn snd
+ $ HashMap.toList
+ $ HashMap.filter (> threshold)
+ $ conditional myCooc
----------------------------------------------------------
-- | From data to Graph
-data2graph :: [(Text, Int)]
- -> Map (Int, Int) Int
+
+type Occurrences = Int
+
+data2graph :: ToComId a
+ => Map NgramsTerm Int
+ -> Map (Int, Int) Occurrences
-> Map (Int, Int) Double
-> Map (Int, Int) Double
- -> [LouvainNode]
+ -> [a]
-> Graph
-data2graph labels coocs bridge conf partitions = Graph nodes edges Nothing
+data2graph labels' occurences bridge conf partitions = Graph { _graph_nodes = nodes
+ , _graph_edges = edges
+ , _graph_metadata = Nothing
+ }
where
- community_id_by_node_id = Map.fromList [ (n, c) | LouvainNode n c <- partitions ]
-
nodes = map (setCoord ForceAtlas labels bridge)
- [ (n, Node { node_size = maybe 0 identity (Map.lookup (n,n) coocs)
- , node_type = Terms -- or Unknown
- , node_id = cs (show n)
- , node_label = l
- , node_x_coord = 0
- , node_y_coord = 0
- , node_attributes =
- Attributes { clust_default = maybe 0 identity
- (Map.lookup n community_id_by_node_id) } }
+ [ (n, Node { node_size = maybe 0 identity (Map.lookup (n,n) occurences)
+ , node_type = Terms -- or Unknown
+ , node_id = cs (show n)
+ , node_label = unNgramsTerm l
+ , node_x_coord = 0
+ , node_y_coord = 0
+ , node_attributes = Attributes { clust_default = fromMaybe 0
+ (Map.lookup n community_id_by_node_id)
+ }
+ , node_children = []
+ }
)
| (l, n) <- labels
- , Set.member n $ Set.fromList
- $ List.concat
- $ map (\((s,t),d) -> if d > 0 && s /=t then [s,t] else [])
- $ Map.toList bridge
+ , Set.member n nodesWithScores
]
edges = [ Edge { edge_source = cs (show s)
- , edge_target = cs (show t)
- , edge_weight = d
- , edge_confluence = maybe 0 identity $ Map.lookup (s,t) conf
- -- , edge_confluence = maybe (panic "E: data2graph edges") identity $ Map.lookup (s,t) conf
- , edge_id = cs (show i) }
- | (i, ((s,t), d)) <- zip ([0..]::[Integer]) (Map.toList bridge), s /= t, d > 0
- ]
+ , edge_target = cs (show t)
+ , edge_weight = weight
+ , edge_confluence = maybe 0 identity $ Map.lookup (s,t) conf
+ , edge_id = cs (show i)
+ }
+ | (i, ((s,t), weight)) <- zip ([0..]::[Integer] ) $ Map.toList bridge
+ , s /= t
+ , weight > 0
+ ]
+
+ community_id_by_node_id = Map.fromList
+ $ map nodeId2comId partitions
+
+ labels = Map.toList labels'
+
+ nodesWithScores = Set.fromList
+ $ List.concat
+ $ map (\((s,t),d) -> if d > 0 && s/=t then [s,t] else [])
+ $ Map.toList bridge
------------------------------------------------------------------------
ns = map snd items
toVec :: Int -> [Int] -> Map (Int,Int) Double -> (Int, Vec.Vector Double)
- toVec n' ns' m' = (n', Vec.fromList $ map (\n'' -> maybe 0 identity $ Map.lookup (n',n'') m') ns')
+ toVec n' ns' m'' = (n', Vec.fromList $ map (\n'' -> maybe 0 identity $ Map.lookup (n',n'') m'') ns')
------------------------------------------------------------------------
-- | KamadaKawai Layout
p = Layout.kamadaKawai
g = mkGraphUfromEdges $ map fst $ List.filter (\e -> snd e > 0) $ Map.toList m
+-----------------------------------------------------------------------------
+-- MISC Tools
+cooc2graph'' :: Ord t => Distance
+ -> Double
+ -> Map (t, t) Int
+ -> Map (Index, Index) Double
+cooc2graph'' distance threshold myCooc = neighbourMap
+ where
+ (ti, _) = createIndices myCooc
+ myCooc' = toIndex ti myCooc
+ matCooc = map2mat Triangle 0 (Map.size ti) $ Map.filter (> 1) myCooc'
+ distanceMat = measure distance matCooc
+ neighbourMap = filterByNeighbours threshold
+ $ mat2map distanceMat
+
+-- Quentin
+filterByNeighbours :: Double -> Map (Index, Index) Double -> Map (Index, Index) Double
+filterByNeighbours threshold distanceMap = filteredMap
+ where
+ indexes :: [Index]
+ indexes = List.nub $ List.concat $ map (\(idx,idx') -> [idx,idx'] ) $ Map.keys distanceMap
+ filteredMap :: Map (Index, Index) Double
+ filteredMap = Map.fromList
+ $ List.concat
+ $ map (\idx ->
+ let selected = List.reverse
+ $ List.sortOn snd
+ $ Map.toList
+ $ Map.filter (> 0)
+ $ Map.filterWithKey (\(from,_) _ -> idx == from) distanceMap
+ in List.take (round threshold) selected
+ ) indexes
+
+
+
+
+