module Gargantext.Viz.Graph.Tools
where
-import Data.Graph.Clustering.Louvain.CplusPlus (LouvainNode(..))
+import Debug.Trace (trace)
+import Data.Graph.Clustering.Louvain.Utils (LouvainNode(..))
+-- import Data.Graph.Clustering.Louvain (hLouvain, {-iLouvainMap-})
import Data.Graph.Clustering.Louvain.CplusPlus (cLouvain)
import Data.Map (Map)
import qualified Data.Set as Set
import Gargantext.Core.Statistics
import Gargantext.Viz.Graph
import Gargantext.Viz.Graph.Bridgeness (bridgeness)
-import Gargantext.Viz.Graph.Distances.Matrice (measureConditional)
-import Gargantext.Viz.Graph.Index (createIndices, toIndex, map2mat, mat2map)
+import Gargantext.Viz.Graph.Distances (Distance(..), measure)
+import Gargantext.Viz.Graph.Index (createIndices, toIndex, map2mat, mat2map, Index)
import Gargantext.Viz.Graph.IGraph (mkGraphUfromEdges)
import Gargantext.Viz.Graph.Proxemy (confluence)
import GHC.Float (sin, cos)
type Threshold = Double
+
+cooc2graph' :: Ord t => Double
+ -> Map (t, t) Int
+ -> Map (Index, Index) Double
+cooc2graph' threshold myCooc = distanceMap
+ where
+ (ti, _) = createIndices myCooc
+ myCooc' = toIndex ti myCooc
+ matCooc = map2mat 0 (Map.size ti) $ Map.filter (> 1) myCooc'
+ distanceMat = measure Conditional matCooc
+ distanceMap = Map.filter (> threshold) $ mat2map distanceMat
+
+
cooc2graph :: Threshold
-> (Map (Text, Text) Int)
-> IO Graph
cooc2graph threshold myCooc = do
- let (ti, _) = createIndices myCooc
- myCooc' = toIndex ti myCooc
- matCooc = map2mat 0 (Map.size ti) $ Map.filter (> 1) myCooc'
- distanceMat = measureConditional matCooc
- distanceMap = Map.filter (> threshold) $ mat2map distanceMat
+ let
+ (ti, _) = createIndices myCooc
+ myCooc' = toIndex ti myCooc
+ matCooc = map2mat 0 (Map.size ti) $ Map.filter (> 1) myCooc'
+ distanceMat = measure Conditional matCooc
+ distanceMap = Map.filter (> threshold) $ mat2map distanceMat
+
+ nodesApprox :: Int
+ nodesApprox = n'
+ where
+ (as, bs) = List.unzip $ Map.keys distanceMap
+ n' = Set.size $ Set.fromList $ as <> bs
+ ClustersParams rivers level = clustersParams nodesApprox
+
+
+ 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"
- partitions <- case Map.size distanceMap > 0 of
- True -> cLouvain distanceMap
- False -> 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
- let bridgeness' = bridgeness 300 partitions distanceMap
- let confluence' = confluence (Map.keys bridgeness') 3 True False
+ pure $ data2graph (Map.toList ti) myCooc' bridgeness' confluence' partitions
- data2graph (Map.toList ti) myCooc' bridgeness' confluence' partitions
+data ClustersParams = ClustersParams { bridgness :: Double
+ , louvain :: Text
+ } deriving (Show)
+
+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"
+ -}
+
----------------------------------------------------------
-- | From data to Graph
data2graph :: [(Text, Int)]
-> Map (Int, Int) Double
-> Map (Int, Int) Double
-> [LouvainNode]
- -> IO Graph
-data2graph labels coocs bridge conf partitions = do
-
- let community_id_by_node_id = Map.fromList [ (n, c) | LouvainNode n c <- partitions ]
+ -> Graph
+data2graph labels coocs bridge conf partitions = Graph nodes edges Nothing
+ where
+
+ community_id_by_node_id = Map.fromList [ (n, c) | LouvainNode n c <- partitions ]
- nodes <- mapM (setCoord ForceAtlas labels bridge)
+ 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)
$ Map.toList bridge
]
- let edges = [ Edge { edge_source = cs (show s)
+ 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
| (i, ((s,t), d)) <- zip ([0..]::[Integer]) (Map.toList bridge), s /= t, d > 0
]
- pure $ Graph nodes edges Nothing
------------------------------------------------------------------------
-- | ACP
-setCoord :: Ord a => Layout -> [(a, Int)] -> Map (Int, Int) Double -> (Int, Node) -> IO Node
-setCoord l labels m (n,node) = getCoord l labels m n
- >>= \(x,y) -> pure $ node { node_x_coord = x
- , node_y_coord = y
- }
+setCoord :: Ord a => Layout -> [(a, Int)] -> Map (Int, Int) Double -> (Int, Node) -> Node
+setCoord l labels m (n,node) = node { node_x_coord = x
+ , node_y_coord = y
+ }
+ where
+ (x,y) = getCoord l labels m n
-getCoord :: Ord a => Layout
- -> [(a, Int)] -> Map (Int, Int) Double -> Int -> IO (Double, Double)
-getCoord KamadaKawai _ m n = layout m n
+getCoord :: Ord a
+ => Layout
+ -> [(a, Int)]
+ -> Map (Int, Int) Double
+ -> Int
+ -> (Double, Double)
+getCoord KamadaKawai _ _m _n = undefined -- layout m n
-getCoord ForceAtlas _ _ n = pure (sin d, cos d)
+getCoord ForceAtlas _ _ n = (sin d, cos d)
where
d = fromIntegral n
-getCoord ACP labels m n = pure $ to2d $ maybe (panic "Graph.Tools no coordinate") identity
+getCoord ACP labels m n = to2d $ maybe (panic "Graph.Tools no coordinate") identity
$ Map.lookup n
$ pcaReduceTo (Dimension 2)
$ mapArray labels m