Skip to content

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

[FIX] Order 1 and Order 2, node size ok.

parent 083c1f50
Hide whitespace changes
Inline Side-by-side
Showing with 98 additions and 103 deletions
src/Gargantext/Core/Methods/Graph/MaxClique.hs
View file @ 41908d30
......@@ -71,6 +71,7 @@ type Neighbor = Node
-- | getMaxCliques
-- TODO chose distance order
getMaxCliques :: Ord a => CliqueFilter -> Distance -> Threshold -> Map (a, a) Int -> [[a]]
getMaxCliques f d t m = map fromIndices $ getMaxCliques' t m'
where
......
src/Gargantext/Core/Viz/Graph/API.hs
View file @ 41908d30
......@@ -9,7 +9,6 @@ Portability : POSIX
-}
{-# LANGUAGE OverloadedLists #-} -- allows to write Map and HashMap as lists
{-# LANGUAGE TypeOperators #-}
......@@ -159,13 +158,6 @@ recomputeGraph _uId nId maybeDistance = do
pure $ trace "[G.V.G.API] Graph exists, recomputing" graph'''
-- TODO use Database Monad only here ?
--computeGraph :: HasNodeError err
-- => CorpusId
-- -> Distance
-- -> NgramsType
-- -> NodeListStory
-- -> Cmd err Graph
computeGraph :: FlowCmdM env err m
=> CorpusId
-> Distance
......@@ -180,7 +172,9 @@ computeGraph cId d nt repo = do
$ mapTermListRoot [lId] nt repo
myCooc <- HashMap.filter (>1) -- Removing the hapax (ngrams with 1 cooc)
<$> getCoocByNgrams (if d == Conditional then Diagonal True else Diagonal False)
-- <$> HashMap.filterWithKey (\(x,y) _ -> x /= y)
-- <$> getCoocByNgrams (if d == Conditional then Diagonal True else Diagonal False)
<$> getCoocByNgrams (Diagonal True)
<$> groupNodesByNgrams ngs
<$> getNodesByNgramsOnlyUser cId (lIds <> [lId]) nt (HashMap.keys ngs)
......@@ -220,7 +214,6 @@ defaultGraphMetadata cId t repo gm = do
}
-- (map (\n -> LegendField n "#FFFFFF" (pack $ show n)) [1..10])
------------------------------------------------------------
type GraphAsyncAPI = Summary "Recompute graph"
:> "recompute"
......@@ -339,8 +332,3 @@ getGraphGexf uId nId = do
HyperdataGraphAPI { _hyperdataAPIGraph = graph } <- getGraph uId nId
pure $ addHeader "attachment; filename=graph.gexf" graph
src/Gargantext/Core/Viz/Graph/Index.hs
View file @ 41908d30
......@@ -28,7 +28,7 @@ import qualified Data.Array.Accelerate as A
import qualified Data.Array.Accelerate.Interpreter as A
import Data.Array.Accelerate (Matrix, Elt, Shape, (:.)(..), Z(..))
import Data.Maybe (fromMaybe)
import Data.Maybe (fromMaybe, catMaybes)
import Data.Set (Set)
import qualified Data.Set as S
......@@ -69,7 +69,7 @@ map2mat sym def n m = A.fromFunction shape getData
case sym of
Triangle -> fromMaybe def (M.lookup (x,y) m)
Square -> fromMaybe (fromMaybe def $ M.lookup (y,x) m)
$ M.lookup (x, y) m
$ M.lookup (x,y) m
)
shape = (Z :. n :. n)
......@@ -93,8 +93,11 @@ fromIndex ni ns = indexConversion ni ns
indexConversion :: (Ord b, Ord k) => Map k b -> Map (k,k) a -> Map (b, b) a
indexConversion index ms = M.fromList
$ map (\((k1,k2),c) -> ( ((M.!) index k1, (M.!) index k2), c))
(M.toList ms)
$ catMaybes
$ map (\((k1,k2),c) -> ((,) <$> ((,) <$> M.lookup k1 index <*> M.lookup k2 index)
<*> Just c)
)
$ M.toList ms
---------------------------------------------------------------------------------
-------------------------------------------------------------------------------
......
src/Gargantext/Core/Viz/Graph/Tools.hs
View file @ 41908d30
......@@ -80,75 +80,6 @@ cooc2graphWith Louvain = undefined
cooc2graphWith Spinglass = cooc2graphWith' (spinglass 1)
-- cooc2graphWith Bac = cooc2graphWith' (\x -> pure $ BAC.defaultClustering x)
cooc2graph'' :: Ord t => Distance
-> Double
-> Map (t, t) Int
-> Map (Index, Index) Double
cooc2graph'' distance threshold myCooc = neighbourMap
where
(ti, _) = createIndices myCooc
myCooc' = toIndex ti myCooc
matCooc = map2mat Triangle 0 (Map.size ti) $ Map.filter (> 1) myCooc'
distanceMat = measure distance matCooc
neighbourMap = filterByNeighbours threshold
$ mat2map distanceMat
-- Quentin
filterByNeighbours :: Double -> Map (Index, Index) Double -> Map (Index, Index) Double
filterByNeighbours threshold distanceMap = filteredMap
where
indexes :: [Index]
indexes = List.nub $ List.concat $ map (\(idx,idx') -> [idx,idx'] ) $ Map.keys distanceMap
filteredMap :: Map (Index, Index) Double
filteredMap = Map.fromList
$ List.concat
$ map (\idx ->
let selected = List.reverse
$ List.sortOn snd
$ Map.toList
$ Map.filter (> 0)
$ Map.filterWithKey (\(from,_) _ -> idx == from) distanceMap
in List.take (round threshold) selected
) indexes
doDistanceMap :: Distance
-> Threshold
-> HashMap (NgramsTerm, NgramsTerm) Int
-> ( Map (Int,Int) Double
, Map (Index, Index) Int
, Map NgramsTerm Index
)
doDistanceMap distance threshold myCooc = (distanceMap, myCooc', ti)
where
-- TODO remove below
theMatrix = Map.fromList
$ HashMap.toList myCooc
(ti, _) = createIndices theMatrix
tiSize = Map.size ti
myCooc' = toIndex ti theMatrix
matCooc = case distance of -- Shape of the Matrix
Conditional -> map2mat Triangle 0 tiSize
Distributional -> map2mat Square 0 tiSize
$ case distance of -- Removing the Diagonal ?
Conditional -> Map.filterWithKey (\(a,b) _ -> a /= b)
Distributional -> identity
$ Map.filter (>1) myCooc'
similarities = measure distance matCooc
links = round (let n :: Double = fromIntegral tiSize in n * log n)
distanceMap = Map.fromList
$ List.take links
$ List.sortOn snd
$ Map.toList
$ case distance of
Conditional -> Map.filter (> threshold)
Distributional -> Map.filter (> 0)
$ mat2map similarities
cooc2graphWith' :: ToComId a
=> Partitions a
......@@ -158,7 +89,7 @@ cooc2graphWith' :: ToComId a
-> IO Graph
cooc2graphWith' doPartitions distance threshold myCooc = do
let
(distanceMap, myCooc', ti) = doDistanceMap distance threshold myCooc
(distanceMap, diag, ti) = doDistanceMap distance threshold myCooc
nodesApprox :: Int
nodesApprox = n'
......@@ -184,7 +115,48 @@ cooc2graphWith' doPartitions distance threshold myCooc = do
confluence' = confluence (Map.keys bridgeness') 3 True False
pure $ data2graph (Map.toList $ Map.mapKeys unNgramsTerm ti)
myCooc' bridgeness' confluence' partitions
diag bridgeness' confluence' partitions
doDistanceMap :: Distance
-> Threshold
-> HashMap (NgramsTerm, NgramsTerm) Int
-> ( Map (Int,Int) Double
, Map (Index, Index) Int
, Map NgramsTerm Index
)
doDistanceMap distance threshold myCooc = (distanceMap, toIndex ti diag, ti)
where
-- TODO remove below
(diag, theMatrix) = Map.partitionWithKey (\(x,y) _ -> x == y)
$ Map.fromList
$ HashMap.toList myCooc
(ti, _it) = createIndices theMatrix
tiSize = Map.size ti
matCooc = case distance of -- Shape of the Matrix
Conditional -> map2mat Triangle 0 tiSize
Distributional -> map2mat Square 0 tiSize
{-$ case distance of -- Removing the Diagonal ?
Conditional -> Map.filterWithKey (\(a,b) _ -> a /= b)
Distributional -> Map.filterWithKey (\(a,b) _ -> a /= b)
-}
$ toIndex ti theMatrix
similarities = measure distance matCooc
links = round (let n :: Double = fromIntegral tiSize in n * log n)
distanceMap = Map.fromList
$ List.take links
$ List.sortOn snd
$ Map.toList
$ Map.filter (> threshold)
$ mat2map similarities
------------------------------------------------------------------------
------------------------------------------------------------------------
......@@ -204,22 +176,26 @@ clustersParams x = ClustersParams (fromIntegral x) "0.00000001" -- y
----------------------------------------------------------
-- | From data to Graph
type Occurrences = Map (Int, Int) Int
data2graph :: ToComId a
=> [(Text, Int)]
-> Map (Int, Int) Int
-> Occurrences
-> Map (Int, Int) Double
-> Map (Int, Int) Double
-> [a]
-> Graph
data2graph labels coocs bridge conf partitions = Graph { _graph_nodes = nodes
data2graph labels occurences bridge conf partitions = Graph { _graph_nodes = nodes
, _graph_edges = edges
, _graph_metadata = Nothing }
where
community_id_by_node_id = Map.fromList $ map nodeId2comId partitions
community_id_by_node_id = Map.fromList
$ map nodeId2comId partitions
nodes = map (setCoord ForceAtlas labels bridge)
[ (n, Node { node_size = maybe 0 identity (Map.lookup (n,n) coocs)
[ (n, Node { node_size = maybe 0 identity (Map.lookup (n,n) occurences)
, node_type = Terms -- or Unknown
, node_id = cs (show n)
, node_label = l
......@@ -313,14 +289,41 @@ layout m n gen = maybe (panic "") identity $ Map.lookup n $ coord
--p = Layout.defaultLGL
p = Layout.kamadaKawai
g = mkGraphUfromEdges $ map fst $ List.filter (\e -> snd e > 0) $ Map.toList m
-----------------------------------------------------------------------------
-----------------------------------------------------------------------------
-----------------------------------------------------------------------------
-- Debug
{-
-- measure logDistributional
dataDebug = map2mat Square (0::Int) 19 dataBug'
-- MISC Tools
cooc2graph'' :: Ord t => Distance
-> Double
-> Map (t, t) Int
-> Map (Index, Index) Double
cooc2graph'' distance threshold myCooc = neighbourMap
where
(ti, _) = createIndices myCooc
myCooc' = toIndex ti myCooc
matCooc = map2mat Triangle 0 (Map.size ti) $ Map.filter (> 1) myCooc'
distanceMat = measure distance matCooc
neighbourMap = filterByNeighbours threshold
$ mat2map distanceMat
-- Quentin
filterByNeighbours :: Double -> Map (Index, Index) Double -> Map (Index, Index) Double
filterByNeighbours threshold distanceMap = filteredMap
where
indexes :: [Index]
indexes = List.nub $ List.concat $ map (\(idx,idx') -> [idx,idx'] ) $ Map.keys distanceMap
filteredMap :: Map (Index, Index) Double
filteredMap = Map.fromList
$ List.concat
$ map (\idx ->
let selected = List.reverse
$ List.sortOn snd
$ Map.toList
$ Map.filter (> 0)
$ Map.filterWithKey (\(from,_) _ -> idx == from) distanceMap
in List.take (round threshold) selected
) indexes
dataBug' :: Map (Int, Int) Int
dataBug' = Map.fromList [((0,0),28),((0,1),8),((0,2),6),((0,3),2),((0,5),4),((0,6),4),((0,7),2),((0,9),7),((0,10),4),((0,13),4),((0,14),2),((0,15),5),((0,16),8),((0,17),3),((1,1),28),((1,2),6),((1,3),7),((1,4),5),((1,5),7),((1,6),5),((1,7),2),((1,9),6),((1,10),7),((1,11),5),((1,13),6),((1,15),6),((1,16),14),((1,18),4),((2,2),39),((2,3),5),((2,4),4),((2,5),3),((2,6),4),((2,7),4),((2,8),3),((2,9),17),((2,10),4),((2,11),8),((2,12),2),((2,13),15),((2,14),4),((2,15),5),((2,16),21),((2,18),4),((3,3),48),((3,4),10),((3,5),7),((3,6),3),((3,7),7),((3,8),6),((3,9),12),((3,10),9),((3,11),8),((3,12),5),((3,13),15),((3,14),5),((3,15),9),((3,16),17),((3,18),4),((4,4),33),((4,5),2),((4,6),5),((4,7),7),((4,8),4),((4,9),6),((4,10),12),((4,11),8),((4,12),3),((4,13),16),((4,14),4),((4,15),4),((4,16),5),((4,17),2),((4,18),12),((5,5),27),((5,6),2),((5,8),3),((5,9),12),((5,10),6),((5,11),9),((5,13),4),((5,14),2),((5,15),7),((5,16),11),((5,18),4),((6,6),34),((6,7),4),((6,8),3),((6,9),12),((6,10),8),((6,11),2),((6,12),5),((6,13),6),((6,14),6),((6,15),5),((6,16),22),((6,17),8),((6,18),4),((7,7),27),((7,8),2),((7,9),6),((7,10),2),((7,11),4),((7,13),13),((7,15),2),((7,16),8),((7,17),6),((7,18),4),((8,8),30),((8,9),9),((8,10),6),((8,11),9),((8,12),6),((8,13),3),((8,14),3),((8,15),4),((8,16),15),((8,17),3),((8,18),5),((9,9),69),((9,10),9),((9,11),22),((9,12),15),((9,13),18),((9,14),10),((9,15),14),((9,16),48),((9,17),6),((9,18),9),((10,10),39),((10,11),15),((10,12),5),((10,13),11),((10,14),2),((10,15),4),((10,16),19),((10,17),3),((10,18),11),((11,11),48),((11,12),9),((11,13),20),((11,14),2),((11,15),13),((11,16),29),((11,18),13),((12,12),30),((12,13),4),((12,15),5),((12,16),16),((12,17),6),((12,18),2),((13,13),65),((13,14),10),((13,15),14),((13,16),23),((13,17),6),((13,18),10),((14,14),25),((14,16),9),((14,17),3),((14,18),3),((15,15),38),((15,16),17),((15,18),4),((16,16),99),((16,17),11),((16,18),14),((17,17),29),((18,18),23)]
-}
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