Skip to content

haskell-gargantext
haskell-gargantext
Commit 5863fee7 authored by Alexandre Delanoë's avatar Alexandre Delanoë
Browse files
Options

[MAP] 2D ACP initialization/backend.

parent ab437142
Show whitespace changes
Inline Side-by-side
Showing with 40 additions and 9 deletions
src/Gargantext/Viz/Graph.hs
View file @ 5863fee7
...@@ -49,6 +49,8 @@ data Node = Node { node_size :: Int ...@@ -49,6 +49,8 @@ data Node = Node { node_size :: Int
, node_type :: TypeNode -- TODO NgramsType | Person , node_type :: TypeNode -- TODO NgramsType | Person
, node_id :: Text -- TODO NgramId , node_id :: Text -- TODO NgramId
, node_label :: Text , node_label :: Text
, node_x_coord :: Double
, node_y_coord :: Double
, node_attributes :: Attributes , node_attributes :: Attributes
} }
deriving (Show, Generic) deriving (Show, Generic)
...@@ -117,7 +119,7 @@ instance Arbitrary Graph where ...@@ -117,7 +119,7 @@ instance Arbitrary Graph where
arbitrary = elements $ [defaultGraph] arbitrary = elements $ [defaultGraph]
defaultGraph :: Graph defaultGraph :: Graph
defaultGraph = Graph {_graph_nodes = [Node {node_size = 4, node_type = Terms, node_id = pack "0", node_label = pack "animal", node_attributes = Attributes {clust_default = 0}},Node {node_size = 3, node_type = Terms, node_id = pack "1", node_label = pack "bird", node_attributes = Attributes {clust_default = 0}},Node {node_size = 2, node_type = Terms, node_id = pack "2", node_label = pack "boy", node_attributes = Attributes {clust_default = 1}},Node {node_size = 2, node_type = Terms, node_id = pack "3", node_label = pack "dog", node_attributes = Attributes {clust_default = 0}},Node {node_size = 2, node_type = Terms, node_id = pack "4", node_label = pack "girl", node_attributes = Attributes {clust_default = 1}},Node {node_size = 4, node_type = Terms, node_id = pack "5", node_label = pack "human body", node_attributes = Attributes {clust_default = 1}},Node {node_size = 3, node_type = Terms, node_id = pack "6", node_label = pack "object", node_attributes = Attributes {clust_default = 2}},Node {node_size = 2, node_type = Terms, node_id = pack "7", node_label = pack "pen", node_attributes = Attributes {clust_default = 2}},Node {node_size = 2, node_type = Terms, node_id = pack "8", node_label = pack "table", node_attributes = Attributes {clust_default = 2}}], _graph_edges = [Edge {edge_source = pack "0", edge_target = pack "0", edge_weight = 1.0, edge_id = pack "0"},Edge {edge_source = pack "1", edge_target = pack "0", edge_weight = 1.0, edge_id = pack "1"},Edge {edge_source = pack "1", edge_target = pack "1", edge_weight = 1.0, edge_id = pack "2"},Edge {edge_source = pack "2", edge_target = pack "2", edge_weight = 1.0, edge_id = pack "3"},Edge {edge_source = pack "2", edge_target = pack "5", edge_weight = 1.0, edge_id = pack "4"},Edge {edge_source = pack "3", edge_target = pack "0", edge_weight = 1.0, edge_id = pack "5"},Edge {edge_source = pack "3", edge_target = pack "1", edge_weight = 1.0, edge_id = pack "6"},Edge {edge_source = pack "3", edge_target = pack "3", edge_weight = 1.0, edge_id = pack "7"},Edge {edge_source = pack "4", edge_target = pack "4", edge_weight = 1.0, edge_id = pack "8"},Edge {edge_source = pack "4", edge_target = pack "5", edge_weight = 1.0, edge_id = pack "9"},Edge {edge_source = pack "5", edge_target = pack "5", edge_weight = 1.0, edge_id = pack "10"},Edge {edge_source = pack "6", edge_target = pack "6", edge_weight = 1.0, edge_id = pack "11"},Edge {edge_source = pack "7", edge_target = pack "6", edge_weight = 1.0, edge_id = pack "12"},Edge {edge_source = pack "7", edge_target = pack "7", edge_weight = 1.0, edge_id = pack "13"},Edge {edge_source = pack "8", edge_target = pack "6", edge_weight = 1.0, edge_id = pack "14"},Edge {edge_source = pack "8", edge_target = pack "7", edge_weight = 1.0, edge_id = pack "15"},Edge {edge_source = pack "8", edge_target = pack "8", edge_weight = 1.0, edge_id = pack "16"}], _graph_metadata = Nothing} defaultGraph = Graph {_graph_nodes = [Node {node_x_coord=0, node_y_coord=0, node_size = 4, node_type = Terms, node_id = pack "0", node_label = pack "animal", node_attributes = Attributes {clust_default = 0}},Node {node_x_coord=0, node_y_coord=0, node_size = 3, node_type = Terms, node_id = pack "1", node_label = pack "bird", node_attributes = Attributes {clust_default = 0}},Node {node_x_coord=0, node_y_coord=0, node_size = 2, node_type = Terms, node_id = pack "2", node_label = pack "boy", node_attributes = Attributes {clust_default = 1}},Node {node_x_coord=0, node_y_coord=0, node_size = 2, node_type = Terms, node_id = pack "3", node_label = pack "dog", node_attributes = Attributes {clust_default = 0}},Node {node_x_coord=0, node_y_coord=0, node_size = 2, node_type = Terms, node_id = pack "4", node_label = pack "girl", node_attributes = Attributes {clust_default = 1}},Node {node_x_coord=0, node_y_coord=0, node_size = 4, node_type = Terms, node_id = pack "5", node_label = pack "human body", node_attributes = Attributes {clust_default = 1}},Node {node_x_coord=0, node_y_coord=0, node_size = 3, node_type = Terms, node_id = pack "6", node_label = pack "object", node_attributes = Attributes {clust_default = 2}},Node {node_x_coord=0, node_y_coord=0, node_size = 2, node_type = Terms, node_id = pack "7", node_label = pack "pen", node_attributes = Attributes {clust_default = 2}},Node {node_x_coord=0, node_y_coord=0, node_size = 2, node_type = Terms, node_id = pack "8", node_label = pack "table", node_attributes = Attributes {clust_default = 2}}], _graph_edges = [Edge {edge_source = pack "0", edge_target = pack "0", edge_weight = 1.0, edge_id = pack "0"},Edge {edge_source = pack "1", edge_target = pack "0", edge_weight = 1.0, edge_id = pack "1"},Edge {edge_source = pack "1", edge_target = pack "1", edge_weight = 1.0, edge_id = pack "2"},Edge {edge_source = pack "2", edge_target = pack "2", edge_weight = 1.0, edge_id = pack "3"},Edge {edge_source = pack "2", edge_target = pack "5", edge_weight = 1.0, edge_id = pack "4"},Edge {edge_source = pack "3", edge_target = pack "0", edge_weight = 1.0, edge_id = pack "5"},Edge {edge_source = pack "3", edge_target = pack "1", edge_weight = 1.0, edge_id = pack "6"},Edge {edge_source = pack "3", edge_target = pack "3", edge_weight = 1.0, edge_id = pack "7"},Edge {edge_source = pack "4", edge_target = pack "4", edge_weight = 1.0, edge_id = pack "8"},Edge {edge_source = pack "4", edge_target = pack "5", edge_weight = 1.0, edge_id = pack "9"},Edge {edge_source = pack "5", edge_target = pack "5", edge_weight = 1.0, edge_id = pack "10"},Edge {edge_source = pack "6", edge_target = pack "6", edge_weight = 1.0, edge_id = pack "11"},Edge {edge_source = pack "7", edge_target = pack "6", edge_weight = 1.0, edge_id = pack "12"},Edge {edge_source = pack "7", edge_target = pack "7", edge_weight = 1.0, edge_id = pack "13"},Edge {edge_source = pack "8", edge_target = pack "6", edge_weight = 1.0, edge_id = pack "14"},Edge {edge_source = pack "8", edge_target = pack "7", edge_weight = 1.0, edge_id = pack "15"},Edge {edge_source = pack "8", edge_target = pack "8", edge_weight = 1.0, edge_id = pack "16"}], _graph_metadata = Nothing}
----------------------------------------------------------- -----------------------------------------------------------
...@@ -156,7 +158,7 @@ graphV3ToGraph (GraphV3 links nodes) = Graph (map nodeV32node nodes) (zipWith li ...@@ -156,7 +158,7 @@ graphV3ToGraph (GraphV3 links nodes) = Graph (map nodeV32node nodes) (zipWith li
where where
nodeV32node :: NodeV3 -> Node nodeV32node :: NodeV3 -> Node
nodeV32node (NodeV3 no_id' (AttributesV3 cl') no_s' no_lb') nodeV32node (NodeV3 no_id' (AttributesV3 cl') no_s' no_lb')
= Node no_s' Terms (cs $ show no_id') no_lb' (Attributes cl') = Node no_s' Terms (cs $ show no_id') no_lb' 0 0 (Attributes cl')
linkV32edge :: Int -> EdgeV3 -> Edge linkV32edge :: Int -> EdgeV3 -> Edge
linkV32edge n (EdgeV3 eo_s' eo_t' eo_w') = Edge (cs $ show eo_s') (cs $ show eo_t') ((T.read $ T.unpack eo_w') :: Double) (cs $ show n) linkV32edge n (EdgeV3 eo_s' eo_t' eo_w') = Edge (cs $ show eo_s') (cs $ show eo_t') ((T.read $ T.unpack eo_w') :: Double) (cs $ show n)
......
src/Gargantext/Viz/Graph/API.hs
View file @ 5863fee7
...@@ -22,8 +22,7 @@ Portability : POSIX ...@@ -22,8 +22,7 @@ Portability : POSIX
module Gargantext.Viz.Graph.API module Gargantext.Viz.Graph.API
where where
import Data.List (sortOn) import Control.Lens (set)
import Control.Lens (set, over)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Gargantext.API.Ngrams.Tools import Gargantext.API.Ngrams.Tools
import Gargantext.API.Types import Gargantext.API.Types
...@@ -77,8 +76,7 @@ getGraph nId = do ...@@ -77,8 +76,7 @@ getGraph nId = do
<$> getNodesByNgramsOnlyUser cId (lIds <> [lId]) NgramsTerms (Map.keys ngs) <$> getNodesByNgramsOnlyUser cId (lIds <> [lId]) NgramsTerms (Map.keys ngs)
graph <- liftIO $ cooc2graph myCooc graph <- liftIO $ cooc2graph myCooc
pure $ set graph_metadata (Just metadata) pure $ set graph_metadata (Just metadata) graph
$ over graph_nodes (sortOn node_id) graph
postGraph :: NodeId -> GargServer (Post '[JSON] [NodeId]) postGraph :: NodeId -> GargServer (Post '[JSON] [NodeId])
......
src/Gargantext/Viz/Graph/Tools.hs
View file @ 5863fee7
...@@ -21,11 +21,13 @@ import Data.Graph.Clustering.Louvain.CplusPlus (cLouvain) ...@@ -21,11 +21,13 @@ import Data.Graph.Clustering.Louvain.CplusPlus (cLouvain)
import Data.Map (Map) import Data.Map (Map)
import Data.Text (Text) import Data.Text (Text)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Core.Statistics
import Gargantext.Viz.Graph (Graph(..)) import Gargantext.Viz.Graph (Graph(..))
import Gargantext.Viz.Graph -- (Graph(..)) import Gargantext.Viz.Graph -- (Graph(..))
import Gargantext.Viz.Graph.Bridgeness (bridgeness) import Gargantext.Viz.Graph.Bridgeness (bridgeness)
import Gargantext.Viz.Graph.Distances.Matrice (measureConditional) import Gargantext.Viz.Graph.Distances.Matrice (measureConditional)
import Gargantext.Viz.Graph.Index (createIndices, toIndex, map2mat, mat2map) import Gargantext.Viz.Graph.Index (createIndices, toIndex, map2mat, mat2map)
import qualified Data.Vector.Storable as Vec
import qualified Data.Map as Map import qualified Data.Map as Map
cooc2graph :: (Map (Text, Text) Int) -> IO Graph cooc2graph :: (Map (Text, Text) Int) -> IO Graph
...@@ -55,18 +57,47 @@ data2graph :: [(Text, Int)] -> Map (Int, Int) Int ...@@ -55,18 +57,47 @@ data2graph :: [(Text, Int)] -> Map (Int, Int) Int
data2graph labels coocs distance partitions = Graph nodes edges Nothing data2graph labels coocs distance partitions = Graph nodes edges Nothing
where where
community_id_by_node_id = Map.fromList [ (n, c) | LouvainNode n c <- partitions ] community_id_by_node_id = Map.fromList [ (n, c) | LouvainNode n c <- partitions ]
nodes = [ Node { node_size = maybe 0 identity (Map.lookup (n,n) coocs)
nodes = map (setCoord mapCoord)
[ (n, Node { node_size = maybe 0 identity (Map.lookup (n,n) coocs)
, node_type = Terms -- or Unknown , node_type = Terms -- or Unknown
, node_id = cs (show n) , node_id = cs (show n)
, node_label = l , node_label = l
, node_x_coord = 0
, node_y_coord = 0
, node_attributes = , node_attributes =
Attributes { clust_default = maybe 0 identity Attributes { clust_default = maybe 0 identity
(Map.lookup n community_id_by_node_id) } } (Map.lookup n community_id_by_node_id) } }
| (l, n) <- labels ] )
| (l, n) <- labels
]
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 = w , edge_weight = w
, edge_id = cs (show i) } , edge_id = cs (show i) }
| (i, ((s,t), w)) <- zip ([0..]::[Integer]) (Map.toList distance) ] | (i, ((s,t), w)) <- zip ([0..]::[Integer]) (Map.toList distance) ]
mapCoord = pcaReduceTo (Dimension 2) $ mapArray labels distance
setCoord :: Map Int (Vec.Vector Double) -> (Int, Node) -> Node
setCoord m (n,node) = node { node_x_coord = x, node_y_coord = y }
where
(x,y) = to2d $ maybe (panic "Graph.Tools no coordinate") identity $ Map.lookup n m
to2d :: Vec.Vector Double -> (Double, Double)
to2d v = (x,y)
where
ds = take 2 $ Vec.toList v
x = head' "to2d" ds
y = last' "to2d" ds
mapArray :: Ord a => [(a, Int)] -> Map (Int, Int) Double -> Map Int (Vec.Vector Double)
mapArray items m = Map.fromList [ toVec n ns m | n <- ns ]
where
ns = map snd items
toVec :: Int -> [Int] -> Map (Int,Int) Double -> (Int, Vec.Vector Double)
toVec n' ns' m' = (n', Vec.fromList $ map (\n'' -> maybe 0 identity $ Map.lookup (n',n'') m') 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