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 @@
#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
-- see: https://github.com/sol/hpack
name: gargantext
version: 0.0.6.6
version: 0.0.6.6
synopsis: Search, map, share
description: Please see README.md
category: Data
......
......@@ -26,6 +26,7 @@ Source : https://en.wikipedia.org/wiki/Type%E2%80%93token_distinction#Occurrence
module Gargantext.Core.Text.Metrics.Count
where
import Debug.Trace (trace)
import Data.Text (Text)
import Control.Arrow (Arrow(..), (***))
import qualified Data.List as List
......@@ -143,8 +144,10 @@ occurrences = occurrencesOn _terms_stem
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
occurrencesWith :: (Foldable list, Ord k, Num a) => (b -> k) -> list b -> Map k a
occurrencesWith f xs = foldl' (\x y -> insertWith (+) (f y) 1 x) empty xs
occurrencesWith :: (Foldable list, Ord k, Num a, Show k, Show a, Show (list b)) => (b -> k) -> list b -> Map k a
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
......
......@@ -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.Tools.IGraph (mkGraphUfromEdges, spinglass)
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 Graph.Types (ClusterNode)
import IGraph.Random -- (Gen(..))
......@@ -172,9 +172,7 @@ doDistanceMap Conditional threshold strength myCooc = (distanceMap, toIndex ti m
where
myCooc' = Map.fromList $ HashMap.toList myCooc
(ti, _it) = createIndices myCooc'
links = round (let n :: Double = fromIntegral (Map.size ti) in n * log n)
distanceMap = toIndex ti
$ Map.fromList
$ List.take links
......@@ -216,16 +214,18 @@ data2graph labels' occurences bridge conf partitions = Graph { _graph_nodes = no
}
)
| (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)
, edge_target = cs (show t)
, edge_weight = weight
, edge_confluence = maybe 0 identity $ Map.lookup (s,t) conf
, 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
, weight > 0
]
......@@ -235,11 +235,6 @@ data2graph labels' occurences bridge conf partitions = Graph { _graph_nodes = no
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
in List.take (round threshold) selected
) indexes
......@@ -17,16 +17,19 @@ These functions are used for Vector.Matrix only.
module Gargantext.Core.Viz.Graph.Utils
where
import Data.List (unzip)
import Data.Map (Map)
import Data.Matrix hiding (identity)
import Data.Maybe (catMaybes)
import Data.Set (Set)
import Data.Vector (Vector)
import qualified Data.List as L
import qualified Data.Map as Map
import Gargantext.Core.Text.Metrics.Count (occurrencesWith)
import Gargantext.Prelude
import Data.List (unzip)
import qualified Data.Vector as V
import Data.Maybe (catMaybes)
import qualified Data.Set as Set
import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Vector as Vector
------------------------------------------------------------------------
-- | Some utils to build the matrix from cooccurrence results
......@@ -42,13 +45,13 @@ type AxisId = Int
-- Data.Vector.Additions
dropAt :: Int -> Vector a -> Vector a
dropAt n v = debut <> (V.tail fin)
dropAt n v = debut <> (Vector.tail fin)
where
debut = V.take n v
fin = V.drop n v
debut = Vector.take n v
fin = Vector.drop n v
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 Row = nrows
......@@ -60,10 +63,10 @@ axis Row = getRow
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
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
......@@ -82,7 +85,19 @@ edgesFilter m = Map.fromList $ catMaybes results
keys = Set.toList $ Set.fromList (x <> y)
(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
......
......@@ -57,7 +57,7 @@ getTficf cId mId nt = do
) mapTextDoubleLocal
-}
getTficf_withSample :: HasDBid NodeType
getTficf_withSample :: HasDBid NodeType
=> UserCorpusId
-> MasterCorpusId
-> NgramsType
......@@ -68,7 +68,8 @@ getTficf_withSample cId mId nt = do
<$> getContextsByNgramsUser cId nt
countLocal <- selectCountDocs cId
let countGlobal = countLocal * 10
let countGlobal = countLocal
-- * 10
mapTextDoubleGlobal <- HM.map fromIntegral
<$> getOccByNgramsOnlyFast_withSample mId countGlobal nt
......
......@@ -38,7 +38,7 @@ updateHyperdataQuery i h = seq h' $ trace "updateHyperdataQuery: encoded JSON" $
, uUpdateWith = updateEasy (\ (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
}
where h' = (sqlJSONB $ cs $ encode $ h)
......@@ -65,5 +65,3 @@ updateNodesWithType_ nt h = do
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