Commit 8d05149f authored by Alexandre Delanoë's avatar Alexandre Delanoë

[FIX] Nodes with one edge only are removed now

parent 73c6bc8c
...@@ -2,4 +2,11 @@ ...@@ -2,4 +2,11 @@
#stack install --nix --profile --test --fast --no-install-ghc --skip-ghc-check #stack install --nix --profile --test --fast --no-install-ghc --skip-ghc-check
env LANG=C.UTF-8 stack install --haddock --nix --test --no-install-ghc --skip-ghc-check --no-haddock-deps if [[ $1 == "dev" ]] ;
then
echo "DEV install"
env LANG=C.UTF-8 stack install --nix --no-install-ghc --skip-ghc-check --no-haddock-deps
else
echo "PROD install (with documentation)"
env LANG=C.UTF-8 stack install --haddock --nix --test --no-install-ghc --skip-ghc-check --no-haddock-deps
fi
...@@ -5,7 +5,7 @@ cabal-version: 1.12 ...@@ -5,7 +5,7 @@ cabal-version: 1.12
-- see: https://github.com/sol/hpack -- see: https://github.com/sol/hpack
name: gargantext name: gargantext
version: 0.0.6.6 version: 0.0.6.6
synopsis: Search, map, share synopsis: Search, map, share
description: Please see README.md description: Please see README.md
category: Data category: Data
......
...@@ -26,6 +26,7 @@ Source : https://en.wikipedia.org/wiki/Type%E2%80%93token_distinction#Occurrence ...@@ -26,6 +26,7 @@ Source : https://en.wikipedia.org/wiki/Type%E2%80%93token_distinction#Occurrence
module Gargantext.Core.Text.Metrics.Count module Gargantext.Core.Text.Metrics.Count
where where
import Debug.Trace (trace)
import Data.Text (Text) import Data.Text (Text)
import Control.Arrow (Arrow(..), (***)) import Control.Arrow (Arrow(..), (***))
import qualified Data.List as List import qualified Data.List as List
...@@ -143,8 +144,10 @@ occurrences = occurrencesOn _terms_stem ...@@ -143,8 +144,10 @@ occurrences = occurrencesOn _terms_stem
occurrencesOn :: (Ord a, Ord b) => (a -> b) -> [a] -> Map b (Map a Int) occurrencesOn :: (Ord a, Ord b) => (a -> b) -> [a] -> Map b (Map a Int)
occurrencesOn f = foldl' (\m a -> insertWith (unionWith (+)) (f a) (singleton a 1) m) empty occurrencesOn f = foldl' (\m a -> insertWith (unionWith (+)) (f a) (singleton a 1) m) empty
occurrencesWith :: (Foldable list, Ord k, Num a) => (b -> k) -> list b -> Map k a occurrencesWith :: (Foldable list, Ord k, Num a, Show k, Show a, Show (list b)) => (b -> k) -> list b -> Map k a
occurrencesWith f xs = foldl' (\x y -> insertWith (+) (f y) 1 x) empty xs occurrencesWith f xs = trace (show (xs,m)) m
where
m = foldl' (\x y -> insertWith (+) (f y) 1 x) empty xs
-- TODO add groups and filter stops -- TODO add groups and filter stops
......
...@@ -30,7 +30,7 @@ import Gargantext.Core.Viz.Graph.Bridgeness (bridgeness, Partitions, ToComId(..) ...@@ -30,7 +30,7 @@ import Gargantext.Core.Viz.Graph.Bridgeness (bridgeness, 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)
import Gargantext.Core.Viz.Graph.Utils (edgesFilter) import Gargantext.Core.Viz.Graph.Utils (edgesFilter, nodesFilter)
import Gargantext.Prelude import Gargantext.Prelude
import Graph.Types (ClusterNode) import Graph.Types (ClusterNode)
import IGraph.Random -- (Gen(..)) import IGraph.Random -- (Gen(..))
...@@ -172,9 +172,7 @@ doDistanceMap Conditional threshold strength myCooc = (distanceMap, toIndex ti m ...@@ -172,9 +172,7 @@ doDistanceMap Conditional threshold strength myCooc = (distanceMap, toIndex ti m
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)
distanceMap = toIndex ti distanceMap = toIndex ti
$ Map.fromList $ Map.fromList
$ List.take links $ List.take links
...@@ -216,16 +214,18 @@ data2graph labels' occurences bridge conf partitions = Graph { _graph_nodes = no ...@@ -216,16 +214,18 @@ data2graph labels' occurences bridge conf partitions = Graph { _graph_nodes = no
} }
) )
| (l, n) <- labels | (l, n) <- labels
, Set.member n nodesWithScores , Set.member n toKeep
] ]
(bridge', toKeep) = nodesFilter (\v -> v > 1) bridge
edges = [ Edge { edge_source = cs (show s) edges = [ Edge { edge_source = cs (show s)
, edge_target = cs (show t) , edge_target = cs (show t)
, edge_weight = weight , edge_weight = weight
, edge_confluence = maybe 0 identity $ Map.lookup (s,t) conf , edge_confluence = maybe 0 identity $ Map.lookup (s,t) conf
, edge_id = cs (show i) , edge_id = cs (show i)
} }
| (i, ((s,t), weight)) <- zip ([0..]::[Integer] ) $ Map.toList bridge | (i, ((s,t), weight)) <- zip ([0..]::[Integer] ) $ Map.toList bridge'
, s /= t , s /= t
, weight > 0 , weight > 0
] ]
...@@ -235,11 +235,6 @@ data2graph labels' occurences bridge conf partitions = Graph { _graph_nodes = no ...@@ -235,11 +235,6 @@ data2graph labels' occurences bridge conf partitions = Graph { _graph_nodes = no
labels = Map.toList labels' labels = Map.toList labels'
nodesWithScores = Set.fromList
$ List.concat
$ map (\((s,t),d) -> if d > 0 && s/=t then [s,t] else [])
$ Map.toList bridge
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -338,5 +333,3 @@ filterByNeighbours threshold distanceMap = filteredMap ...@@ -338,5 +333,3 @@ filterByNeighbours threshold distanceMap = filteredMap
in List.take (round threshold) selected in List.take (round threshold) selected
) indexes ) indexes
...@@ -17,16 +17,19 @@ These functions are used for Vector.Matrix only. ...@@ -17,16 +17,19 @@ These functions are used for Vector.Matrix only.
module Gargantext.Core.Viz.Graph.Utils module Gargantext.Core.Viz.Graph.Utils
where where
import Data.List (unzip)
import Data.Map (Map) import Data.Map (Map)
import Data.Matrix hiding (identity) import Data.Matrix hiding (identity)
import Data.Maybe (catMaybes)
import Data.Set (Set)
import Data.Vector (Vector) import Data.Vector (Vector)
import qualified Data.List as L import Gargantext.Core.Text.Metrics.Count (occurrencesWith)
import qualified Data.Map as Map
import Gargantext.Prelude import Gargantext.Prelude
import Data.List (unzip) import qualified Data.List as List
import qualified Data.Vector as V import qualified Data.Map as Map
import Data.Maybe (catMaybes) import qualified Data.Set as Set
import qualified Data.Set as Set import qualified Data.Vector as Vector
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- | Some utils to build the matrix from cooccurrence results -- | Some utils to build the matrix from cooccurrence results
...@@ -42,13 +45,13 @@ type AxisId = Int ...@@ -42,13 +45,13 @@ type AxisId = Int
-- Data.Vector.Additions -- Data.Vector.Additions
dropAt :: Int -> Vector a -> Vector a dropAt :: Int -> Vector a -> Vector a
dropAt n v = debut <> (V.tail fin) dropAt n v = debut <> (Vector.tail fin)
where where
debut = V.take n v debut = Vector.take n v
fin = V.drop n v fin = Vector.drop n v
total :: Num a => Matrix a -> a total :: Num a => Matrix a -> a
total m = V.sum $ V.map (\c -> V.sum (getCol c m)) (V.enumFromTo 1 (nOf Col m)) total m = Vector.sum $ Vector.map (\c -> Vector.sum (getCol c m)) (Vector.enumFromTo 1 (nOf Col m))
nOf :: Axis -> Matrix a -> Int nOf :: Axis -> Matrix a -> Int
nOf Row = nrows nOf Row = nrows
...@@ -60,10 +63,10 @@ axis Row = getRow ...@@ -60,10 +63,10 @@ axis Row = getRow
toListsWithIndex :: Matrix a -> [((Int, Int), a)] toListsWithIndex :: Matrix a -> [((Int, Int), a)]
toListsWithIndex m = concat' $ zip [1..] $ map (\c -> zip [1..] c) $ toLists m toListsWithIndex m = concat' $ zip [1..] $ List.map (\c -> zip [1..] c) $ toLists m
where where
concat' :: [(Int, [(Int, a)])] -> [((Int, Int), a)] concat' :: [(Int, [(Int, a)])] -> [((Int, Int), a)]
concat' xs = L.concat $ map (\(x, ys) -> map (\(y, a) -> ((x,y), a)) ys ) xs concat' xs = List.concat $ List.map (\(x, ys) -> List.map (\(y, a) -> ((x,y), a)) ys ) xs
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- Utils to manage Graphs -- Utils to manage Graphs
...@@ -82,7 +85,19 @@ edgesFilter m = Map.fromList $ catMaybes results ...@@ -82,7 +85,19 @@ edgesFilter m = Map.fromList $ catMaybes results
keys = Set.toList $ Set.fromList (x <> y) keys = Set.toList $ Set.fromList (x <> y)
(x,y) = unzip $ Map.keys m (x,y) = unzip $ Map.keys m
nodesFilter :: (Show a, Show b, Ord a, Ord b, Num b) => (b -> Bool) -> Map (a,a) b -> (Map (a,a) b, Set a)
nodesFilter f m = (m', toKeep)
where
m' = Map.filterWithKey (\(a,b) _ -> Set.member a toKeep && Set.member b toKeep) m
toKeep = Set.fromList
$ Map.keys
$ Map.filter f
$ occurrencesWith identity
$ tupleConcat
$ List.unzip
$ Map.keys m
tupleConcat :: ([a],[a]) -> [a]
tupleConcat (a,b) = a <> b
getMax :: Ord b getMax :: Ord b
......
...@@ -57,7 +57,7 @@ getTficf cId mId nt = do ...@@ -57,7 +57,7 @@ getTficf cId mId nt = do
) mapTextDoubleLocal ) mapTextDoubleLocal
-} -}
getTficf_withSample :: HasDBid NodeType getTficf_withSample :: HasDBid NodeType
=> UserCorpusId => UserCorpusId
-> MasterCorpusId -> MasterCorpusId
-> NgramsType -> NgramsType
...@@ -68,7 +68,8 @@ getTficf_withSample cId mId nt = do ...@@ -68,7 +68,8 @@ getTficf_withSample cId mId nt = do
<$> getContextsByNgramsUser cId nt <$> getContextsByNgramsUser cId nt
countLocal <- selectCountDocs cId countLocal <- selectCountDocs cId
let countGlobal = countLocal * 10 let countGlobal = countLocal
-- * 10
mapTextDoubleGlobal <- HM.map fromIntegral mapTextDoubleGlobal <- HM.map fromIntegral
<$> getOccByNgramsOnlyFast_withSample mId countGlobal nt <$> getOccByNgramsOnlyFast_withSample mId countGlobal nt
......
...@@ -38,7 +38,7 @@ updateHyperdataQuery i h = seq h' $ trace "updateHyperdataQuery: encoded JSON" $ ...@@ -38,7 +38,7 @@ updateHyperdataQuery i h = seq h' $ trace "updateHyperdataQuery: encoded JSON" $
, uUpdateWith = updateEasy (\ (Node _ni _nh _nt _nu _np _nn _nd _h) , uUpdateWith = updateEasy (\ (Node _ni _nh _nt _nu _np _nn _nd _h)
-> trace "updating mate" $ Node _ni _nh _nt _nu _np _nn _nd h' -> trace "updating mate" $ Node _ni _nh _nt _nu _np _nn _nd h'
) )
, uWhere = (\row -> trace "uWhere" $ _node_id row .== pgNodeId i ) , uWhere = (\row -> {-trace "uWhere" $-} _node_id row .== pgNodeId i )
, uReturning = rCount , uReturning = rCount
} }
where h' = (sqlJSONB $ cs $ encode $ h) where h' = (sqlJSONB $ cs $ encode $ h)
...@@ -65,5 +65,3 @@ updateNodesWithType_ nt h = do ...@@ -65,5 +65,3 @@ updateNodesWithType_ nt h = do
mapM (\n -> updateHyperdata n h) ns mapM (\n -> updateHyperdata n h) ns
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