module Gargantext.Core.Viz.Graph.Tools
where
+import Debug.Trace
+
import Data.Aeson
import Data.HashMap.Strict (HashMap)
import Data.Map (Map)
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.Methods.Graph.BAC.Proxemy (confluence)
import Gargantext.Core.Statistics
import Gargantext.Core.Viz.Graph
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 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
-data PartitionMethod = Spinglass | Confluence
+data PartitionMethod = Spinglass | Confluence | Infomap
deriving (Generic, Eq, Ord, Enum, Bounded, Show)
instance FromJSON PartitionMethod
instance ToJSON PartitionMethod
cooc2graphWith :: PartitionMethod
-> Distance
-> Threshold
+ -> Strength
-> 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
+ -> Strength
-> HashMap (NgramsTerm, NgramsTerm) Int
-> IO Graph
-cooc2graphWith' doPartitions distance threshold myCooc = do
- let
- (distanceMap, diag, ti) = doDistanceMap distance threshold myCooc
+cooc2graphWith' doPartitions distance threshold strength myCooc = do
+ let (distanceMap, diag, ti) = doDistanceMap distance threshold strength myCooc
+ distanceMap `seq` trace "distanceMap OK" diag `seq` trace "diag OK" ti `seq` printDebug "ti done" ()
--{- -- Debug
- saveAsFileDebug "/tmp/distanceMap" distanceMap
- saveAsFileDebug "/tmp/distanceMap.keys" (List.length $ Map.keys distanceMap)
+ -- saveAsFileDebug "/tmp/distanceMap" distanceMap
+ -- saveAsFileDebug "/tmp/distanceMap.keys" (List.length $ Map.keys distanceMap)
-- printDebug "similarities" similarities
--}
partitions <- if (Map.size distanceMap > 0)
then doPartitions distanceMap
- else panic "Text.Flow: DistanceMap is empty"
-
+ 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"
+ ]
+ partitions `seq` printDebug "partitions done" ()
let
nodesApprox :: Int
nodesApprox = n'
(as, bs) = List.unzip $ Map.keys distanceMap
n' = Set.size $ Set.fromList $ as <> bs
bridgeness' = bridgeness (fromIntegral nodesApprox) partitions distanceMap
- confluence' = confluence (Map.keys bridgeness') 3 True False
-
+ confluence' = Map.empty -- BAC.computeConfluences 3 (Map.keys bridgeness') True
+ -- confluence (Map.keys bridgeness') 3 True False
+ seq bridgeness' $ printDebug "bridgeness OK" ()
+ seq confluence' $ printDebug "confluence OK" ()
pure $ data2graph ti diag bridgeness' confluence' partitions
+type Reverse = Bool
doDistanceMap :: Distance
-> Threshold
+ -> Strength
-> HashMap (NgramsTerm, NgramsTerm) Int
-> ( Map (Int,Int) Double
, Map (Index, Index) Int
, Map NgramsTerm Index
)
-doDistanceMap Distributional threshold myCooc = (distanceMap, toIndex ti diag, ti)
+doDistanceMap Distributional threshold strength myCooc = (distanceMap, toIndex ti diag, ti)
where
-- TODO remove below
(diag, theMatrix) = Map.partitionWithKey (\(x,y) _ -> x == y)
(ti, _it) = createIndices theMatrix
tiSize = Map.size ti
- similarities = measure Distributional
- $ map2mat Square 0 tiSize
- $ toIndex ti theMatrix
+ similarities = (\m -> m `seq` trace "measure done" m)
+ $ (\m -> m `seq` trace "map2mat done" (measure Distributional m))
+ $ (\m -> m `seq` trace "toIndex done" (map2mat Square 0 tiSize m))
+ $ theMatrix `seq` trace "theMatrix done" (toIndex ti theMatrix)
links = round (let n :: Double = fromIntegral tiSize in n * (log n)^(2::Int))
- distanceMap = Map.fromList
+ distanceMap = Map.fromList . trace "fromList" identity
$ List.take links
- $ List.reverse
+ $ (if strength == Weak then List.reverse else identity)
$ List.sortOn snd
$ Map.toList
$ edgesFilter
- $ Map.filter (> threshold)
- $ mat2map similarities
+ $ (\m -> m `seq` trace "map2map done" (Map.filter (> threshold) m))
+ $ similarities `seq` mat2map (trace "similarities done" similarities)
-doDistanceMap Conditional threshold myCooc = (distanceMap, toIndex ti myCooc', ti)
+doDistanceMap Conditional threshold strength myCooc = (distanceMap, toIndex ti myCooc', ti)
where
myCooc' = Map.fromList $ HashMap.toList myCooc
(ti, _it) = createIndices myCooc'
distanceMap = toIndex ti
$ Map.fromList
$ List.take links
+ $ (if strength == Weak then List.reverse else identity)
$ List.sortOn snd
$ HashMap.toList
$ HashMap.filter (> threshold)
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 ->
+ $ List.concat
+ $ map (\idx ->
let selected = List.reverse
$ List.sortOn snd
- $ Map.toList
+ $ Map.toList
$ Map.filter (> 0)
$ Map.filterWithKey (\(from,_) _ -> idx == from) distanceMap
in List.take (round threshold) selected
-
-