Skip to content

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

Merge remote-tracking branch 'origin/445-cherrypicked' into dev

parents 44df14d2 137f53bd
Hide whitespace changes
Inline Side-by-side
Showing with 59 additions and 148 deletions
src/Gargantext/API/Node/Update.hs
View file @ 3116328b
......@@ -63,12 +63,12 @@ updateNode :: (HasNodeStory env err m
-> JobHandle m
-> m ()
updateNode nId (UpdateNodeParamsGraph
(UpdateNodeConfigGraph metric partitionMethod bridgeMethod strength nt1 nt2)) jobHandle = do
(UpdateNodeConfigGraph metric bridgeMethod strength nt1 nt2)) jobHandle = do
markStarted 2 jobHandle
markProgress 1 jobHandle
-- printDebug "Computing graph: " method
_ <- recomputeGraph nId partitionMethod bridgeMethod (Just metric) (Just strength) nt1 nt2 True
_ <- recomputeGraph nId bridgeMethod (Just metric) (Just strength) nt1 nt2 True
-- printDebug "Graph computed: " method
markComplete jobHandle
......
src/Gargantext/API/Node/Update/Types.hs
View file @ 3116328b
......@@ -5,8 +5,7 @@ import Data.Aeson
import Data.Swagger ( ToSchema )
import Gargantext.Core.Methods.Similarities (GraphMetric(..))
import Gargantext.Core.Text.Ngrams (NgramsType)
import Gargantext.Core.Viz.Graph.Tools (PartitionMethod(..), BridgenessMethod(..))
import Gargantext.Core.Viz.Graph.Types (Strength)
import Gargantext.Core.Viz.Graph.Types (BridgenessMethod, Strength)
import Gargantext.Core.Viz.Phylo (PhyloSubConfigAPI(..))
import Gargantext.Database.Admin.Types.Node ( NodeId, NodeType )
import Gargantext.Prelude
......@@ -46,7 +45,6 @@ data Charts = Sources | Authors | Institutes | Ngrams | All
------------------------------------------------------------------------
data UpdateNodeConfigGraph = UpdateNodeConfigGraph { methodGraphMetric :: !GraphMetric
, methodGraphClustering :: !PartitionMethod
, methodGraphBridgeness :: !BridgenessMethod
, methodGraphEdgesStrength :: !Strength
, methodGraphNodeType1 :: !NgramsType
......
src/Gargantext/Core/Viz/Graph/API.hs
View file @ 3116328b
......@@ -71,10 +71,9 @@ getGraph nId = do
case graph of
Nothing -> do
let defaultMetric = Order1
let defaultPartitionMethod = Spinglass
let defaultEdgesStrength = Strong
let defaultBridgenessMethod = BridgenessMethod_Basic
graph' <- computeGraph cId defaultPartitionMethod defaultBridgenessMethod (withMetric defaultMetric) defaultEdgesStrength (NgramsTerms, NgramsTerms) repo
let defaultBridgenessMethod = BridgenessBasic
graph' <- computeGraph cId defaultBridgenessMethod (withMetric defaultMetric) defaultEdgesStrength (NgramsTerms, NgramsTerms) repo
mt <- defaultGraphMetadata cId listId "Title" repo defaultMetric defaultEdgesStrength
let mt' = set gm_legend (generateLegend graph') mt
let
......@@ -91,7 +90,6 @@ getGraph nId = do
--recomputeGraph :: UserId -> NodeId -> Maybe GraphMetric -> GargNoServer Graph
recomputeGraph :: HasNodeStory env err m
=> NodeId
-> PartitionMethod
-> BridgenessMethod
-> Maybe GraphMetric
-> Maybe Strength
......@@ -99,7 +97,7 @@ recomputeGraph :: HasNodeStory env err m
-> NgramsType
-> Bool
-> m Graph
recomputeGraph nId partitionMethod bridgeMethod maybeSimilarity maybeStrength nt1 nt2 force' = do
recomputeGraph nId bridgeMethod maybeSimilarity maybeStrength nt1 nt2 force' = do
nodeGraph <- getNodeWith nId (Proxy :: Proxy HyperdataGraph)
let
graph = nodeGraph ^. node_hyperdata . hyperdataGraph
......@@ -127,7 +125,7 @@ recomputeGraph nId partitionMethod bridgeMethod maybeSimilarity maybeStrength nt
let v = repo ^. unNodeStory . at listId . _Just . a_version
let computeG mt = do
!g <- computeGraph cId partitionMethod bridgeMethod similarity strength (nt1,nt2) repo
!g <- computeGraph cId bridgeMethod similarity strength (nt1,nt2) repo
let mt' = set gm_legend (generateLegend g) mt
let g' = set graph_metadata (Just mt') g
_nentries <- updateHyperdata nId (HyperdataGraph (Just g') camera)
......@@ -154,14 +152,13 @@ recomputeGraph nId partitionMethod bridgeMethod maybeSimilarity maybeStrength nt
-- TODO remove repo
computeGraph :: HasNodeError err
=> CorpusId
-> PartitionMethod
-> BridgenessMethod
-> Similarity
-> Strength
-> (NgramsType, NgramsType)
-> NodeListStory
-> DBCmd err Graph
computeGraph corpusId partitionMethod bridgeMethod similarity strength (nt1,nt2) repo = do
computeGraph corpusId bridgeMethod similarity strength (nt1,nt2) repo = do
-- Getting the Node parameters
lId <- defaultList corpusId
lIds <- selectNodesWithUsername NodeList userMaster
......@@ -190,7 +187,7 @@ computeGraph corpusId partitionMethod bridgeMethod similarity strength (nt1,nt2)
-- TODO MultiPartite Here
liftBase
$ cooc2graphWith partitionMethod bridgeMethod (MultiPartite (Partite (HashMap.keysSet m1) nt1)
$ cooc2graphWith bridgeMethod (MultiPartite (Partite (HashMap.keysSet m1) nt1)
(Partite (HashMap.keysSet m2) nt2)
)
similarity 0 strength myCooc
......@@ -239,7 +236,7 @@ graphRecompute :: (HasNodeStory env err m, MonadJobStatus m)
-> m ()
graphRecompute n jobHandle = do
markStarted 1 jobHandle
_g <- recomputeGraph n Spinglass BridgenessMethod_Basic Nothing Nothing NgramsTerms NgramsTerms False
_g <- recomputeGraph n BridgenessBasic Nothing Nothing NgramsTerms NgramsTerms False
markComplete jobHandle
graphVersions :: (HasNodeStory env err m)
......@@ -274,7 +271,7 @@ graphVersions u nId = do
recomputeVersions :: HasNodeStory env err m
=> NodeId
-> m Graph
recomputeVersions nId = recomputeGraph nId Spinglass BridgenessMethod_Basic Nothing Nothing NgramsTerms NgramsTerms False
recomputeVersions nId = recomputeGraph nId BridgenessBasic Nothing Nothing NgramsTerms NgramsTerms False
------------------------------------------------------------
graphClone :: (HasNodeError err)
......
src/Gargantext/Core/Viz/Graph/Bridgeness.hs
View file @ 3116328b
......@@ -20,8 +20,6 @@ TODO use Map LouvainNodeId (Map LouvainNodeId)
{-# OPTIONS_GHC -fno-warn-deprecations #-}
{-# LANGUAGE BangPatterns #-}
module Gargantext.Core.Viz.Graph.Bridgeness -- (bridgeness)
where
......@@ -31,8 +29,8 @@ import Data.Map.Strict (fromListWith, lookup, toList, mapWithKey, elems)
import Data.Map.Strict qualified as Map
import Data.Set qualified as Set
import Data.Tuple.Extra qualified as Tuple
import Gargantext.Core.Methods.Similarities (Similarity(..))
import Gargantext.Prelude hiding (toList)
import Gargantext.Core.Viz.Graph.Types (BridgenessMethod(..))
import Gargantext.Prelude hiding (toList, filter)
import Graph.Types (ClusterNode(..))
----------------------------------------------------------------------
......@@ -66,51 +64,21 @@ clusterNodes2sets = Dico.elems
. Dico.fromListWith (<>)
. (map ((Tuple.second Set.singleton) . swap . nodeId2comId))
----------------------------------------------------------------------
data Bridgeness = Bridgeness_Basic { bridgeness_partitions :: [ClusterNode]
, bridgeness_filter :: Double
}
| Bridgeness_Advanced { bridgeness_similarity :: Similarity
, bridgness_confluence :: Confluence
}
| Bridgeness_Recursive { br_partitions :: [[Set NodeId]]
, br_filter :: Double
, br_similarity :: Similarity
}
type Confluence = Map (NodeId, NodeId) Double
-- Filter Links between the Clusters
-- Links: Map (NodeId, NodeId) Double
-- List of Clusters: [Set NodeId]
bridgeness :: Bridgeness
-> Map (NodeId, NodeId) Double
-> Map (NodeId, NodeId) Double
bridgeness (Bridgeness_Recursive sn f sim) m =
Map.unions $ [linksBetween] <> map (\s -> bridgeness (Bridgeness_Basic (setNodes2clusterNodes s) (if sim == Conditional then pi*f else f)) m') sn
where
(linksBetween, m') = Map.partitionWithKey (\(n1,n2) _v -> Map.lookup n1 mapNodeIdClusterId
/= Map.lookup n2 mapNodeIdClusterId
) $ bridgeness (Bridgeness_Basic clusters f) m
clusters = setNodes2clusterNodes (map Set.unions sn)
mapNodeIdClusterId = clusterNodes2map clusters
bridgeness (Bridgeness_Advanced sim c) m = Map.fromList
$ List.filter (\x -> if sim == Conditional then snd x > 0.2 else snd x > 0.02)
$ map (\(ks, (v1,_v2)) -> (ks,v1))
$ Map.toList
$ Map.intersectionWithKey
(\k v1 v2 -> trace ("intersectionWithKey " <> (show (k, v1, v2)) :: Text) (v1, v2)) m c
bridgeness (Bridgeness_Basic ns b) m = Map.fromList
$ List.concat
$ Map.elems
$ filterComs (round b)
$ groupEdges (Map.fromList $ map nodeId2comId ns) m
-- | Filter the edges of a graph based on the computed clustering
bridgeness :: [ClusterNode] -- ^ Clustering
-> BridgenessMethod -- ^ basic/advanced flag
-> Double -- ^ Bridgeness threshold
-> Map (NodeId, NodeId) Double -- ^ Input graph
-> Map (NodeId, NodeId) Double -- ^ Output graph
bridgeness partitions method filterThreshold graph =
Map.fromList $
List.concat $
Map.elems $
(case method of
BridgenessBasic -> filterComs (round filterThreshold)
BridgenessAdvanced -> filterComsAdvanced
) $
groupEdges (Map.fromList $ map nodeId2comId partitions) graph
groupEdges :: (Ord comId, Ord nodeId)
=> Map nodeId comId
......@@ -130,7 +98,7 @@ filterComs :: (Ord n1, Eq n2)
=> Int
-> Map (n2, n2) [(a3, n1)]
-> Map (n2, n2) [(a3, n1)]
filterComs b m = Map.filter (\n -> length n > 0) $ mapWithKey filter' m
filterComs b m = Map.filter (not . null) $ mapWithKey filter' m
where
filter' (c1,c2) a
| c1 == c2 = a
......@@ -143,40 +111,14 @@ filterComs b m = Map.filter (\n -> length n > 0) $ mapWithKey filter' m
t :: Double
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 =
let recurse (x0:_) (_:[]) = x0
recurse (x0:x1:_) (_:_:[]) = (x0+x1)/2
recurse (_:xs) (_:_:ys) = recurse xs ys
recurse _ _ =
panic "median: this error cannot occur in the way 'recurse' is called"
in recurse zs zs
-}
-- Weak links are often due to noise in the data and decrease the readability of the graph.
-- This function prunes the links between the clusters when their weight is under a given 'threshold'.
filterComsAdvanced :: (Ord a1, Fractional a1, Eq a2)
=> Map (a2, a2) [(a3, a1)]
-> Map (a2, a2) [(a3, a1)]
filterComsAdvanced m = Map.filter (not . null) $ mapWithKey filter' m
where
threshold = 0.03 -- TODO make this threshold configurable
filter' (c1,c2) xs
| c1 == c2 = xs
| otherwise = List.filter (\(_nn,v) -> v >= threshold) xs
src/Gargantext/Core/Viz/Graph/Tools.hs
View file @ 3116328b
......@@ -23,18 +23,16 @@ import Data.HashSet qualified as HashSet
import Data.List qualified as List
import Data.Map.Strict qualified as Map
import Data.Set qualified as Set
import Data.Swagger ( ToSchema )
import Data.Text qualified as Text
import Data.Vector.Storable qualified as Vec
import Gargantext.API.Ngrams.Types (NgramsTerm(..))
import Gargantext.Core.Methods.Similarities (Similarity(..), measure)
import Gargantext.Core.Statistics ( pcaReduceTo, Dimension(Dimension) )
import Gargantext.Core.Text.Ngrams (NgramsType(..))
import Gargantext.Core.Viz.Graph.Bridgeness (bridgeness, Bridgeness(..), Partitions, nodeId2comId, setNodes2clusterNodes)
import Gargantext.Core.Viz.Graph.Bridgeness (bridgeness, nodeId2comId, setNodes2clusterNodes)
import Gargantext.Core.Viz.Graph.Index (createIndices, toIndex, map2mat, mat2map, Index, MatrixShape(..))
import Gargantext.Core.Viz.Graph.Tools.IGraph (mkGraphUfromEdges, spinglass, spinglass')
import Gargantext.Core.Viz.Graph.Tools.Infomap (infomap)
import Gargantext.Core.Viz.Graph.Types (Attributes(..), Edge(..), Graph(..), MultiPartite(..), Node(..), Partite(..), Strength(..), LegendField(..))
import Gargantext.Core.Viz.Graph.Types (Attributes(..), BridgenessMethod, Edge(..), Graph(..), MultiPartite(..), Node(..), Partite(..), Strength(..), LegendField(..))
import Gargantext.Core.Viz.Graph.Utils (edgesFilter, nodesFilter)
import Gargantext.Prelude
import Graph.BAC.ProxemyOptim qualified as BAC
......@@ -42,24 +40,6 @@ import Graph.Types (ClusterNode(..))
import IGraph qualified as Igraph
import IGraph.Algorithms.Layout qualified as Layout
import IGraph.Random ( Gen ) -- (Gen(..))
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary ( Arbitrary(arbitrary) )
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 ]
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 ]
-------------------------------------------------------------
......@@ -90,33 +70,18 @@ cooc2graph' distance threshold myCooc
-- coocurrences graph computation
cooc2graphWith :: PartitionMethod
-> BridgenessMethod
cooc2graphWith :: BridgenessMethod
-> MultiPartite
-> Similarity
-> 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 "-v -N2")
--cooc2graphWith Infomap = cooc2graphWith' (infomap "--silent --two-level -N2")
-- TODO: change these options, or make them configurable in UI?
cooc2graphWith' :: Partitions
-> BridgenessMethod
-> MultiPartite
-> Similarity
-> Threshold
-> Strength
-> HashMap (NgramsTerm, NgramsTerm) Int
-> IO Graph
cooc2graphWith' _doPartitions _bridgenessMethod multi similarity threshold strength myCooc = do
cooc2graphWith bridgenessMethod multi similarity threshold strength myCooc = do
let (distanceMap, diag, ti) = doSimilarityMap similarity threshold strength myCooc
distanceMap `seq` diag `seq` ti `seq` pure ()
partitions <- if (Map.size distanceMap > 0)
partitions <- if Map.size distanceMap > 0
then spinglass' 1 distanceMap
else panic $ Text.unwords [ "I can not compute the graph you request"
, "because either the quantity of documents"
......@@ -130,13 +95,13 @@ cooc2graphWith' _doPartitions _bridgenessMethod multi similarity threshold stren
let
!confluence' = BAC.computeConfluences 3 (Map.keys distanceMap) True
!bridgeness' = bridgeness
(Bridgeness_Basic (partitionsToClusterNodes partitions) 1.0)
distanceMap
!bridgeness' = bridgeness (partitionsToClusterNodes partitions)
bridgenessMethod
1.0
distanceMap
pure $ data2graph multi ti diag bridgeness' confluence' (setNodes2clusterNodes partitions)
-- | A converter from the partition type returned by `spinglass'`
-- to the partition type required by `bridgeness`
partitionsToClusterNodes :: [Set Int] -> [ClusterNode]
......@@ -154,7 +119,6 @@ partitionsToClusterNodes setlist =
-- Turn pairs into `ClusterNode`s
fmap (\(clusterId, nodeId) -> ClusterNode nodeId clusterId)
type Reverse = Bool
doSimilarityMap :: Similarity
......
src/Gargantext/Core/Viz/Graph/Types.hs
View file @ 3116328b
......@@ -40,6 +40,16 @@ instance ToJSON TypeNode
instance FromJSON TypeNode
instance ToSchema TypeNode
data BridgenessMethod = BridgenessBasic | BridgenessAdvanced
deriving (Generic, Eq, Ord, Enum, Bounded, Show)
instance FromJSON BridgenessMethod
instance ToJSON BridgenessMethod
instance ToSchema BridgenessMethod
instance Arbitrary BridgenessMethod where
arbitrary = elements [ minBound .. maxBound ]
data Attributes = Attributes { clust_default :: Int }
deriving (Show, Generic)
$(deriveJSON (unPrefix "") ''Attributes)
......
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