Commit 3676c91f authored by Alexandre Delanoë's avatar Alexandre Delanoë

[WIP] bridgeness2 needs optim

parent 3b5169dd
...@@ -14,17 +14,21 @@ TODO rewrite Bridgeness with "equivalence structurale" metrics (Confluence) ...@@ -14,17 +14,21 @@ TODO rewrite Bridgeness with "equivalence structurale" metrics (Confluence)
TODO use Map LouvainNodeId (Map LouvainNodeId) TODO use Map LouvainNodeId (Map LouvainNodeId)
-} -}
{-# LANGUAGE BangPatterns #-}
module Gargantext.Core.Viz.Graph.Bridgeness -- (bridgeness) module Gargantext.Core.Viz.Graph.Bridgeness -- (bridgeness)
where where
import Data.List (concat, sortOn) import Data.List (concat, sortOn)
import Data.Map (Map, fromListWith, lookup, toList, mapWithKey, elems) import Data.Map (Map, fromListWith, lookup, toList, mapWithKey, elems)
import Data.Maybe (catMaybes) import Data.Maybe (catMaybes, fromMaybe)
import Data.Ord (Down(..)) import Data.Set (Set)
import Gargantext.Prelude import Gargantext.Prelude
import Graph.Types (ClusterNode(..)) import Graph.Types (ClusterNode(..))
import qualified Data.Map as DM import Data.Ord (Down(..))
import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Set as Set
---------------------------------------------------------------------- ----------------------------------------------------------------------
type Partitions a = Map (Int, Int) Double -> IO [a] type Partitions a = Map (Int, Int) Double -> IO [a]
...@@ -42,24 +46,62 @@ instance ToComId ClusterNode where ...@@ -42,24 +46,62 @@ instance ToComId ClusterNode where
---------------------------------------------------------------------- ----------------------------------------------------------------------
---------------------------------------------------------------------- ----------------------------------------------------------------------
type Bridgeness = Double type Bridgeness = Double
type Confluence = Map (NodeId, NodeId) Double
bridgeness3 :: Confluence
-> Map (NodeId, NodeId) Double
-> Map (NodeId, NodeId) Double
bridgeness3 _ m = m
bridgeness2 :: Confluence
-> Map (NodeId, NodeId) Double
-> Map (NodeId, NodeId) Double
bridgeness2 c m = Map.fromList
$ List.filter (\((k1,k2),_v) -> if k1 > k2
then fromMaybe False (Set.member k2 <$> Map.lookup k1 toKeep)
else fromMaybe False (Set.member k1 <$> Map.lookup k2 toKeep)
)
$ m'
where
toKeep :: Map NodeId (Set NodeId)
!toKeep = Map.fromListWith (<>)
$ map (\((k1,k2), _v) -> if k1 > k2
then (k1, Set.singleton k2)
else (k2, Set.singleton k1)
)
$ List.take n
$ List.sortOn (Down . snd)
$ Map.toList c
!m' = Map.toList m
n :: Int
!n = round $ (fromIntegral $ List.length m') / (2 :: Double)
{-
n :: Int
n = Set.size $ Set.fromList $ as <> bs
where
(as, bs) = List.unzip $ Map.keys m
-}
bridgeness :: ToComId a bridgeness :: ToComId a
=> Bridgeness => Confluence
-> [a] -> [a]
-> Map (NodeId, NodeId) Double -> Map (NodeId, NodeId) Double
-> Map (NodeId, NodeId) Double -> Map (NodeId, NodeId) Double
bridgeness = bridgenessWith nodeId2comId bridgeness = bridgenessWith nodeId2comId
where where
bridgenessWith :: (a -> (Int, Int)) bridgenessWith :: (a -> (Int, Int))
-> Bridgeness -> Confluence
-> [a] -> [a]
-> Map (Int, Int) Double -> Map (Int, Int) Double
-> Map (Int, Int) Double -> Map (Int, Int) Double
bridgenessWith f b ns = DM.fromList bridgenessWith f b ns = Map.fromList
. concat . concat
. DM.elems . Map.elems
. filterComs b . filterComs b
. groupEdges (DM.fromList $ map f ns) . groupEdges (Map.fromList $ map f ns)
groupEdges :: (Ord a, Ord b1) groupEdges :: (Ord a, Ord b1)
...@@ -81,7 +123,7 @@ filterComs :: (Ord n1, Eq n2) ...@@ -81,7 +123,7 @@ filterComs :: (Ord n1, Eq n2)
=> p => p
-> Map (n2, n2) [(a3, n1)] -> Map (n2, n2) [(a3, n1)]
-> Map (n2, n2) [(a3, n1)] -> Map (n2, n2) [(a3, n1)]
filterComs _b m = DM.filter (\n -> length n > 0) $ mapWithKey filter' m filterComs _b m = Map.filter (\n -> length n > 0) $ mapWithKey filter' m
where where
filter' (c1,c2) a filter' (c1,c2) a
| c1 == c2 = a | c1 == c2 = a
......
...@@ -26,7 +26,7 @@ import Gargantext.Core.Methods.Similarities (Similarity(..), measure) ...@@ -26,7 +26,7 @@ import Gargantext.Core.Methods.Similarities (Similarity(..), measure)
import Gargantext.Core.Methods.Similarities.Conditional (conditional) import Gargantext.Core.Methods.Similarities.Conditional (conditional)
import Gargantext.Core.Statistics import Gargantext.Core.Statistics
import Gargantext.Core.Viz.Graph import Gargantext.Core.Viz.Graph
import Gargantext.Core.Viz.Graph.Bridgeness (bridgeness, Partitions, ToComId(..)) import Gargantext.Core.Viz.Graph.Bridgeness (bridgeness2, Partitions, ToComId(..))
import Gargantext.Core.Viz.Graph.Index (createIndices, toIndex, map2mat, mat2map, Index, MatrixShape(..)) 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.IGraph (mkGraphUfromEdges, spinglass)
import Gargantext.Core.Viz.Graph.Tools.Infomap (infomap) import Gargantext.Core.Viz.Graph.Tools.Infomap (infomap)
...@@ -127,14 +127,10 @@ cooc2graphWith' doPartitions multi similarity threshold strength myCooc = do ...@@ -127,14 +127,10 @@ cooc2graphWith' doPartitions multi similarity threshold strength myCooc = do
, "Tutorial: link todo" , "Tutorial: link todo"
] ]
length partitions `seq` return () length partitions `seq` return ()
let let
nodesApprox :: Int
nodesApprox = n'
where
(as, bs) = List.unzip $ Map.keys distanceMap
n' = Set.size $ Set.fromList $ as <> bs
!confluence' = BAC.computeConfluences 3 (Map.keys bridgeness') True !confluence' = BAC.computeConfluences 3 (Map.keys bridgeness') True
!bridgeness' = bridgeness (fromIntegral nodesApprox) partitions distanceMap !bridgeness' = bridgeness2 confluence' distanceMap
pure $ data2graph multi ti diag bridgeness' confluence' partitions pure $ data2graph multi ti diag bridgeness' confluence' partitions
type Reverse = Bool type Reverse = Bool
...@@ -177,7 +173,7 @@ doSimilarityMap Conditional threshold strength myCooc = (distanceMap, toIndex ti ...@@ -177,7 +173,7 @@ doSimilarityMap Conditional threshold strength myCooc = (distanceMap, toIndex ti
where where
myCooc' = Map.fromList $ HashMap.toList myCooc myCooc' = Map.fromList $ HashMap.toList myCooc
(ti, _it) = createIndices myCooc' (ti, _it) = createIndices myCooc'
links = round (let n :: Double = fromIntegral (Map.size ti) in n * log n) links = round (let n :: Double = fromIntegral (Map.size ti) in n * (log n)^(2::Int))
distanceMap = toIndex ti distanceMap = toIndex ti
$ Map.fromList $ Map.fromList
$ List.take links $ List.take links
......
...@@ -99,6 +99,12 @@ instance FromJSONKey NgramsType where ...@@ -99,6 +99,12 @@ instance FromJSONKey NgramsType where
fromJSONKey = FromJSONKeyTextParser (parseJSON . String) fromJSONKey = FromJSONKeyTextParser (parseJSON . String)
instance ToJSON NgramsType instance ToJSON NgramsType
where
toJSON Authors = String "Authors"
toJSON Institutes = String "Institutes"
toJSON Sources = String "Sources"
toJSON NgramsTerms = String "Terms"
instance ToJSONKey NgramsType where instance ToJSONKey NgramsType where
toJSONKey = toJSONKeyText (pack . show) toJSONKey = toJSONKeyText (pack . show)
instance FromHttpApiData NgramsType where instance FromHttpApiData NgramsType where
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment