Commit 612e9aad authored by Grégoire Locqueville's avatar Grégoire Locqueville

Apply low-hanging changes suggested during code review

parent b88373d3
......@@ -31,7 +31,7 @@ import Data.Text (pack, unpack, toLower)
import Data.Tuple.Extra (both)
import GHC.Generics
import Gargantext.Core (Lang(..), allLangs)
import Gargantext.Core.Text.Metrics.Count (occurrencesSimple)
import Gargantext.Core.Text.Metrics.Count (countOccurrences)
import Gargantext.Core.Text.Samples.DE qualified as DE
import Gargantext.Core.Text.Samples.EN qualified as EN
import Gargantext.Core.Text.Samples.ES qualified as ES
......@@ -197,7 +197,7 @@ wordToBook ns n txt = EventBook ef en
where
chks = allChunks ns n txt
en = DM.fromList $ map (\(n',ns') -> (n', length ns')) $ zip ns chks
ef = foldl' DM.union DM.empty $ map occurrencesSimple chks
ef = foldl' DM.union DM.empty $ map countOccurrences chks
op :: (Freq -> Freq -> Freq) -> EventBook -> EventBook -> EventBook
op f (EventBook ef1 en1)
......
......@@ -138,12 +138,12 @@ occurrences = occurrencesOn _terms_stem
-- Note: Compared to `occurences`, this is the more elementary function, maybe
-- it would make more sense to rename this one into `occurences` and the other
-- into something more descriptive
occurrencesSimple :: (Foldable f, Ord a, Num n)
countOccurrences :: (Foldable f, Ord a, Num n)
=> f a -- ^ The collection whose items will be counted
-> Map a n -- ^ A map whose keys are items of the input
-- collection, and whose values are the number of
-- times those items appear in the input collection
occurrencesSimple collection =
countOccurrences collection =
foldl' (\occurenceMap item -> insertWith (+) item 1 occurenceMap)
empty
collection
......
......@@ -21,7 +21,7 @@ import Gargantext.API.Ngrams.NgramsTree ( toTree, NgramsTree )
import Gargantext.API.Ngrams.Tools ( filterListWithRoot, getListNgrams, getRepo, mapTermListRoot )
import Gargantext.API.Ngrams.Types ( NgramsTerm(NgramsTerm) )
import Gargantext.Core.NodeStory.Types ( NodeStoryEnv )
import Gargantext.Core.Text.Metrics.Count (occurrencesSimple)
import Gargantext.Core.Text.Metrics.Count (countOccurrences)
import Gargantext.Core.Text.Ngrams (NgramsType)
import Gargantext.Core.Types.Main ( ListType )
import Gargantext.Database.Admin.Types.Node ( NodeType(NodeList), CorpusId, contextId2NodeId )
......@@ -43,7 +43,7 @@ histoData cId = do
$ V.fromList
$ sortOn fst -- TODO Vector.sortOn
$ toList
$ occurrencesSimple dates
$ countOccurrences dates
pure (Histo ls css)
......
......@@ -97,8 +97,10 @@ cooc2graphWith bridgenessMethod multi similarity threshold strength myCooc = do
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`
-- | Given a list of sets, each identifying the nodes in a cluster, returns
-- a list of 'ClusterNode' where each node has been uniquely labeled
-- by its community ID. This allows flattening the input sets without conflicts
-- on nodes with the same ID (as they would belong to a different community).
partitionsToClusterNodes :: [Set Int] -> [ClusterNode]
partitionsToClusterNodes setlist = setlist
& fmap toList -- Convert sets to lists
......
......@@ -20,7 +20,6 @@ module Gargantext.Core.Viz.Graph.Tools.IGraph
import Data.Serialize (Serialize)
import IGraph hiding (mkGraph, neighbors, edges, nodes, Node, Graph)
import Protolude
import Gargantext.Prelude (saveAsFileDebug)
import qualified Data.List as List
import qualified Data.Map.Strict as Map
import qualified IGraph as IG
......@@ -62,7 +61,6 @@ spinglassAux seed graph = do
-- The clusters we get are composed of vertex IDs corresponding to the internal
-- representation of IGraph graphs, so we need to retrieve the vertex labels:
let clusterLabels = (fmap . fmap) (IG.nodeLab graph) rawClusters
saveAsFileDebug "/tmp/res" clusterLabels -- log the result
pure clusterLabels -- return the result
......@@ -80,7 +78,8 @@ edgeList2UGraph edgeList =
-- Warning: there is no guarantee, as far as I know, that the underlying
-- representation of the nodes corresponds to the original `Int`.
mkGraphUfromEdges :: [(Int, Int)] -> IG.Graph 'U () ()
mkGraphUfromEdges es = IG.mkGraph (List.replicate n ()) $ zip es $ repeat ()
mkGraphUfromEdges es = IG.mkGraph (List.replicate n ()) $ fmap makeLEdge es
where
(a,b) = List.unzip es
n = List.length (List.nub $ a <> b)
makeLEdge e = (e, ())
n = Set.size nodes
nodes = Set.fromList $ map fst es
......@@ -23,7 +23,7 @@ import Data.Matrix hiding (identity)
import Data.Set qualified as Set
import Data.Vector (Vector)
import Data.Vector qualified as Vector
import Gargantext.Core.Text.Metrics.Count (occurrencesSimple)
import Gargantext.Core.Text.Metrics.Count (countOccurrences)
import Gargantext.Prelude
------------------------------------------------------------------------
......@@ -88,7 +88,7 @@ nodesFilter f m = (m', toKeep)
toKeep = Set.fromList
$ Map.keys
$ Map.filter f
$ occurrencesSimple
$ countOccurrences
$ tupleConcat
$ List.unzip
$ Map.keys m
......
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