Skip to content

haskell-gargantext
haskell-gargantext
Commit ebe7f7ef authored by Alexandre Delanoë's avatar Alexandre Delanoë
Browse files
Options

[FEAT] User can chose bridgeness method

parent 6981d86b
Hide whitespace changes
Inline Side-by-side
Showing with 91 additions and 82 deletions
src/Gargantext/API/Node/Update.hs
View file @ ebe7f7ef
......@@ -31,7 +31,7 @@ import Gargantext.Core.Methods.Similarities (GraphMetric(..))
import Gargantext.Core.Types.Main (ListType(..))
import Gargantext.Core.Viz.Graph (Strength)
import Gargantext.Core.Viz.Graph.API (recomputeGraph)
import Gargantext.Core.Viz.Graph.Tools (PartitionMethod(..))
import Gargantext.Core.Viz.Graph.Tools (PartitionMethod(..), BridgenessMethod(..))
import Gargantext.Core.Viz.Phylo (PhyloSubConfig(..), subConfig2config)
import Gargantext.Core.Viz.Phylo.API.Tools (flowPhyloAPI)
import Gargantext.Database.Action.Flow.Pairing (pairing)
......@@ -63,6 +63,7 @@ data UpdateNodeParams = UpdateNodeParamsList { methodList :: !Method }
| UpdateNodeParamsGraph { methodGraphMetric :: !GraphMetric
, methodGraphClustering :: !PartitionMethod
, methodGraphBridgeness :: !BridgenessMethod
, methodGraphEdgesStrength :: !Strength
, methodGraphNodeType1 :: !NgramsType
, methodGraphNodeType2 :: !NgramsType
......@@ -106,16 +107,16 @@ updateNode :: (HasSettings env, FlowCmdM env err m)
-> UpdateNodeParams
-> (JobLog -> m ())
-> m JobLog
updateNode uId nId (UpdateNodeParamsGraph metric method strength nt1 nt2) logStatus = do
updateNode uId nId (UpdateNodeParamsGraph metric partitionMethod bridgeMethod strength nt1 nt2) logStatus = do
logStatus JobLog { _scst_succeeded = Just 1
, _scst_failed = Just 0
, _scst_remaining = Just 1
, _scst_events = Just []
}
printDebug "Computing graph: " method
_ <- recomputeGraph uId nId method (Just metric) (Just strength) nt1 nt2 True
printDebug "Graph computed: " method
-- printDebug "Computing graph: " method
_ <- recomputeGraph uId nId partitionMethod bridgeMethod (Just metric) (Just strength) nt1 nt2 True
-- printDebug "Graph computed: " method
pure JobLog { _scst_succeeded = Just 2
, _scst_failed = Just 0
......@@ -275,7 +276,7 @@ instance ToSchema UpdateNodeParams
instance Arbitrary UpdateNodeParams where
arbitrary = do
l <- UpdateNodeParamsList <$> arbitrary
g <- UpdateNodeParamsGraph <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
g <- UpdateNodeParamsGraph <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
t <- UpdateNodeParamsTexts <$> arbitrary
b <- UpdateNodeParamsBoard <$> arbitrary
elements [l,g,t,b]
......
src/Gargantext/Core/NodeStory.hs
View file @ ebe7f7ef
......@@ -455,7 +455,7 @@ insertArchiveList c nodeId a = do
where
query :: PGS.Query
query = [sql| INSERT INTO node_stories(node_id, version, ngrams_type_id, ngrams_id, ngrams_repo_element)
SELECT ?, ?, ?, ngrams.id, ? FROM ngrams WHERE terms = ? |]
SELECT * WHERE EXISTS (SELECT ?, ?, ?, ngrams.id, ? FROM ngrams WHERE terms = ?) |]
deleteArchiveList :: PGS.Connection -> NodeId -> ArchiveList -> IO ()
deleteArchiveList c nodeId a = do
......
src/Gargantext/Core/Viz/Graph/API.hs
View file @ ebe7f7ef
......@@ -107,7 +107,8 @@ getGraph _uId nId = do
let defaultMetric = Order1
let defaultPartitionMethod = Spinglass
let defaultEdgesStrength = Strong
graph' <- computeGraph cId defaultPartitionMethod (withMetric defaultMetric) defaultEdgesStrength (NgramsTerms, NgramsTerms) repo
let defaultBridgenessMethod = BridgenessMethod_Basic
graph' <- computeGraph cId defaultPartitionMethod defaultBridgenessMethod (withMetric defaultMetric) defaultEdgesStrength (NgramsTerms, NgramsTerms) repo
mt <- defaultGraphMetadata cId "Title" repo defaultMetric defaultEdgesStrength
let
graph'' = set graph_metadata (Just mt) graph'
......@@ -125,13 +126,14 @@ recomputeGraph :: FlowCmdM env err m
=> UserId
-> NodeId
-> PartitionMethod
-> BridgenessMethod
-> Maybe GraphMetric
-> Maybe Strength
-> NgramsType
-> NgramsType
-> Bool
-> m Graph
recomputeGraph _uId nId method maybeSimilarity maybeStrength nt1 nt2 force = do
recomputeGraph _uId nId partitionMethod bridgeMethod maybeSimilarity maybeStrength nt1 nt2 force = do
nodeGraph <- getNodeWith nId (Proxy :: Proxy HyperdataGraph)
let
graph = nodeGraph ^. node_hyperdata . hyperdataGraph
......@@ -159,7 +161,7 @@ recomputeGraph _uId nId method maybeSimilarity maybeStrength nt1 nt2 force = do
let v = repo ^. unNodeStory . at listId . _Just . a_version
let computeG mt = do
!g <- computeGraph cId method similarity strength (nt1,nt2) repo
!g <- computeGraph cId partitionMethod bridgeMethod similarity strength (nt1,nt2) repo
let g' = set graph_metadata mt g
_nentries <- updateHyperdata nId (HyperdataGraph (Just g') camera)
pure g'
......@@ -180,12 +182,13 @@ recomputeGraph _uId nId method maybeSimilarity maybeStrength nt1 nt2 force = do
computeGraph :: FlowCmdM env err m
=> CorpusId
-> PartitionMethod
-> BridgenessMethod
-> Similarity
-> Strength
-> (NgramsType, NgramsType)
-> NodeListStory
-> m Graph
computeGraph corpusId method similarity strength (nt1,nt2) repo = do
computeGraph corpusId partitionMethod bridgeMethod similarity strength (nt1,nt2) repo = do
-- Getting the Node parameters
lId <- defaultList corpusId
lIds <- selectNodesWithUsername NodeList userMaster
......@@ -214,7 +217,7 @@ computeGraph corpusId method similarity strength (nt1,nt2) repo = do
-- TODO MultiPartite Here
graph <- liftBase
$ cooc2graphWith method (MultiPartite (Partite (HashMap.keysSet m1) nt1)
$ cooc2graphWith partitionMethod bridgeMethod (MultiPartite (Partite (HashMap.keysSet m1) nt1)
(Partite (HashMap.keysSet m2) nt2)
)
similarity 0 strength myCooc
......@@ -276,7 +279,7 @@ graphRecompute u n logStatus = do
, _scst_remaining = Just 1
, _scst_events = Just []
}
_g <- recomputeGraph u n Spinglass Nothing Nothing NgramsTerms NgramsTerms False
_g <- recomputeGraph u n Spinglass BridgenessMethod_Basic Nothing Nothing NgramsTerms NgramsTerms False
pure JobLog { _scst_succeeded = Just 1
, _scst_failed = Just 0
, _scst_remaining = Just 0
......@@ -331,7 +334,7 @@ recomputeVersions :: FlowCmdM env err m
=> UserId
-> NodeId
-> m Graph
recomputeVersions uId nId = recomputeGraph uId nId Spinglass Nothing Nothing NgramsTerms NgramsTerms False
recomputeVersions uId nId = recomputeGraph uId nId Spinglass BridgenessMethod_Basic Nothing Nothing NgramsTerms NgramsTerms False
------------------------------------------------------------
graphClone :: UserId
......
src/Gargantext/Core/Viz/Graph/Bridgeness.hs
View file @ ebe7f7ef
......@@ -7,10 +7,14 @@ Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
Let be a graph with partitions (from Louvain algo), Bridgeness uniformly
Let be a graph Bridgeness filters inter-communities links in two ways.
If the partitions are known, filtering is uniform to expose the communities clearly for the beginners.
But
uniformly
filters inter-communities links.
TODO rewrite Bridgeness with "equivalence structurale" metrics (Confluence)
TODO use Map LouvainNodeId (Map LouvainNodeId)
-}
......@@ -20,44 +24,46 @@ module Gargantext.Core.Viz.Graph.Bridgeness -- (bridgeness)
where
import Gargantext.Core.Methods.Similarities (Similarity(..))
import Data.IntMap (IntMap)
-- import Data.IntMap (IntMap)
import Data.Map (Map, fromListWith, lookup, toList, mapWithKey, elems)
import Data.Maybe (catMaybes)
import Data.Ord (Down(..))
import Debug.Trace (trace)
import Gargantext.Prelude
import Graph.Types (ClusterNode(..))
import qualified Data.IntMap as IntMap
-- import qualified Data.IntMap as IntMap
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 = Map (Int, Int) Double -> IO [ClusterNode]
----------------------------------------------------------------------
class ToComId a where
nodeId2comId :: a -> (NodeId,CommunityId)
nodeId2comId :: ClusterNode -> (NodeId, CommunityId)
nodeId2comId (ClusterNode i1 i2) = (i1, i2)
type NodeId = Int
type CommunityId = Int
----------------------------------------------------------------------
instance ToComId ClusterNode where
nodeId2comId (ClusterNode i1 i2) = (i1, i2)
----------------------------------------------------------------------
----------------------------------------------------------------------
type Bridgeness = Double
data Bridgeness = Bridgeness_Basic { bridgeness_partitions :: [ClusterNode]
, bridgeness_filter :: Double
}
| Bridgeness_Advanced { bridgeness_similarity :: Similarity
, bridgness_confluence :: Confluence
}
type Confluence = Map (NodeId, NodeId) Double
bridgeness3 :: Similarity
-> Confluence
-> Map (NodeId, NodeId) Double
-> Map (NodeId, NodeId) Double
bridgeness3 sim c m = Map.fromList
bridgeness :: Bridgeness
-> Map (NodeId, NodeId) Double
-> Map (NodeId, NodeId) Double
bridgeness (Bridgeness_Advanced sim c) m = Map.fromList
$ map (\(ks, (v1,_v2)) -> (ks,v1))
$ List.take (if sim == Conditional then 2*n else 4*n)
$ List.take (if sim == Conditional then 2*n else 3*n)
$ List.sortOn (Down . (snd . snd))
$ Map.toList
$ trace ("bridgeness3 m c" <> show (m,c)) $ Map.intersectionWithKey (\k v1 v2 -> trace ("intersectionWithKey " <> (show (k, v1, v2))) (v1, v2)) m c
......@@ -73,41 +79,11 @@ bridgeness3 sim c m = Map.fromList
where
(as, bs) = List.unzip $ Map.keys m
map2intMap :: Map (Int, Int) a -> IntMap (IntMap a)
map2intMap m = IntMap.fromListWith (<>)
$ map (\((k1,k2), v) -> if k1 < k2
then (k1, IntMap.singleton k2 v)
else (k2, IntMap.singleton k1 v)
)
$ Map.toList m
look :: (Int,Int) -> IntMap (IntMap a) -> Maybe a
look (k1,k2) m = if k1 < k2
then case (IntMap.lookup k1 m) of
Just m' -> IntMap.lookup k2 m'
_ -> Nothing
else look (k2,k1) m
bridgeness :: ToComId a
=> Confluence
-> [a]
-> Map (NodeId, NodeId) Double
-> Map (NodeId, NodeId) Double
bridgeness = bridgenessWith nodeId2comId
where
bridgenessWith :: (a -> (Int, Int))
-> Confluence
-> [a]
-> Map (Int, Int) Double
-> Map (Int, Int) Double
bridgenessWith f b ns = Map.fromList
. List.concat
. Map.elems
. filterComs b
. groupEdges (Map.fromList $ map f ns)
bridgeness (Bridgeness_Basic ns b) m = Map.fromList
$ List.concat
$ Map.elems
$ filterComs b
$ groupEdges (Map.fromList $ map nodeId2comId ns) m
groupEdges :: (Ord a, Ord b1)
=> Map b1 a
......@@ -142,13 +118,31 @@ filterComs _b m = Map.filter (\n -> length n > 0) $ mapWithKey filter' m
t = fromIntegral $ length $ List.concat $ elems m
--------------------------------------------------------------
-- Utils
{--
map2intMap :: Map (Int, Int) a -> IntMap (IntMap a)
map2intMap m = IntMap.fromListWith (<>)
$ map (\((k1,k2), v) -> if k1 < k2
then (k1, IntMap.singleton k2 v)
else (k2, IntMap.singleton k1 v)
)
$ Map.toList m
look :: (Int,Int) -> IntMap (IntMap a) -> Maybe a
look (k1,k2) m = if k1 < k2
then case (IntMap.lookup k1 m) of
Just m' -> IntMap.lookup k2 m'
_ -> Nothing
else look (k2,k1) m
{-
Compute the median of a list
From: https://hackage.haskell.org/package/dsp-0.2.5.1/docs/src/Numeric.Statistics.Median.html
Compute the center of the list in a more lazy manner
and thus halves memory requirement.
-}
median :: (Ord a, Fractional a) => [a] -> a
median [] = panic "medianFast: empty list has no median"
median zs =
......@@ -159,3 +153,4 @@ median zs =
panic "median: this error cannot occur in the way 'recurse' is called"
in recurse zs zs
-}
src/Gargantext/Core/Viz/Graph/Tools.hs
View file @ ebe7f7ef
......@@ -26,7 +26,7 @@ import Gargantext.Core.Methods.Similarities (Similarity(..), measure)
import Gargantext.Core.Methods.Similarities.Conditional (conditional)
import Gargantext.Core.Statistics
import Gargantext.Core.Viz.Graph
import Gargantext.Core.Viz.Graph.Bridgeness (bridgeness3, Partitions, ToComId(..))
import Gargantext.Core.Viz.Graph.Bridgeness (bridgeness, Bridgeness(..), Partitions, nodeId2comId)
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)
......@@ -57,6 +57,14 @@ instance ToSchema PartitionMethod
instance Arbitrary PartitionMethod where
arbitrary = elements [ minBound .. maxBound ]
data BridgenessMethod = BridgenessMethod_Basic | BridgenessMethod_Advanced
deriving (Generic, Eq, Ord, Enum, Bounded, Show)
instance FromJSON BridgenessMethod
instance ToJSON BridgenessMethod
instance ToSchema BridgenessMethod
instance Arbitrary BridgenessMethod where
arbitrary = elements [ minBound .. maxBound ]
-------------------------------------------------------------
defaultClustering :: Map (Int, Int) Double -> IO [ClusterNode]
......@@ -89,6 +97,7 @@ cooc2graph' distance threshold myCooc
-- coocurrences graph computation
cooc2graphWith :: PartitionMethod
-> BridgenessMethod
-> MultiPartite
-> Similarity
-> Threshold
......@@ -102,15 +111,15 @@ cooc2graphWith Infomap = cooc2graphWith' (infomap "-v -N2")
-- TODO: change these options, or make them configurable in UI?
cooc2graphWith' :: ToComId a
=> Partitions a
-> MultiPartite
-> Similarity
-> Threshold
-> Strength
-> HashMap (NgramsTerm, NgramsTerm) Int
-> IO Graph
cooc2graphWith' doPartitions multi similarity threshold strength myCooc = do
cooc2graphWith' :: Partitions
-> BridgenessMethod
-> MultiPartite
-> Similarity
-> Threshold
-> Strength
-> HashMap (NgramsTerm, NgramsTerm) Int
-> IO Graph
cooc2graphWith' doPartitions bridgenessMethod multi similarity threshold strength myCooc = do
let (distanceMap, diag, ti) = doSimilarityMap similarity threshold strength myCooc
distanceMap `seq` diag `seq` ti `seq` return ()
......@@ -130,7 +139,9 @@ cooc2graphWith' doPartitions multi similarity threshold strength myCooc = do
let
!confluence' = BAC.computeConfluences 3 (Map.keys distanceMap) True
!bridgeness' = bridgeness3 similarity confluence' distanceMap
!bridgeness' = if bridgenessMethod == BridgenessMethod_Basic
then bridgeness (Bridgeness_Basic partitions 1.0) distanceMap
else bridgeness (Bridgeness_Advanced similarity confluence') distanceMap
pure $ data2graph multi ti diag bridgeness' confluence' partitions
......@@ -195,13 +206,12 @@ nodeTypeWith (MultiPartite (Partite s1 t1) (Partite _s2 t2)) t =
else t2
data2graph :: ToComId a
=> MultiPartite
data2graph :: MultiPartite
-> Map NgramsTerm Int
-> Map (Int, Int) Occurrences
-> Map (Int, Int) Double
-> Map (Int, Int) Double
-> [a]
-> [ClusterNode]
-> Graph
data2graph multi labels' occurences bridge conf partitions =
Graph { _graph_nodes = nodes
......
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