-{-|
-Module : Gargantext.Viz.Graph.Proxemy
+{-| Module : Gargantext.Viz.Graph.Proxemy
Description : Proxemy
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
-}
{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedStrings #-}
module Gargantext.Viz.Graph.Proxemy
where
-import Data.Tuple.Extra (second)
+--import Debug.SimpleReflect
import Gargantext.Prelude
-import IGraph
import Data.Map (Map)
import qualified Data.Map as Map
import qualified Data.List as List
+--import Gargantext.Viz.Graph.IGraph
+import Gargantext.Viz.Graph.FGL
-type Graph_Undirected = Graph 'U () ()
type Length = Int
-type Reflexive = Bool
+type FalseReflexive = Bool
type NeighborsFilter = Graph_Undirected -> Node -> [Node]
+type We = Bool
+
+confluence :: [(Node,Node)] -> Length -> FalseReflexive -> We -> Map (Node,Node) Double
+confluence ns l fr we = similarity_conf (mkGraphUfromEdges ns) l fr we
+
+similarity_conf :: Graph_Undirected -> Length -> FalseReflexive -> We -> Map (Node,Node) Double
+similarity_conf g l fr we = Map.fromList [ ((x,y), similarity_conf_x_y g (x,y) l fr we)
+ | x <- nodes g, y <- nodes g, x < y]
+
+similarity_conf_x_y :: Graph_Undirected -> (Node,Node) -> Length -> FalseReflexive -> We -> Double
+similarity_conf_x_y g (x,y) l r we = similarity
+ where
+ similarity :: Double
+ similarity | denominator == 0 = 0
+ | otherwise = prox_x_y / denominator
+ where
+ denominator = prox_x_y + lim_SC
+
+ prox_x_y :: Double
+ prox_x_y = maybe 0 identity $ Map.lookup y xline
+
+ xline :: Map Node Double
+ xline = prox_markov g [x] l r filterNeighbors'
+ where
+ filterNeighbors' | we == True = filterNeighbors
+ | otherwise = rm_edge_neighbors (x,y)
+
+ pair_is_edge :: Bool
+ pair_is_edge | we == True = False
+ | otherwise = List.elem y (filterNeighbors g x)
+
+ lim_SC :: Double
+ lim_SC
+ | denominator == 0 = 0
+ | otherwise = if pair_is_edge
+ then (degree g y + 1-1) / denominator
+ else (degree g y + 1 ) / denominator
+ where
+ denominator = if pair_is_edge
+ then (2 * (ecount g) + (vcount g) - 2)
+ else (2 * (ecount g) + (vcount g) )
+
+
+rm_edge_neighbors :: (Node, Node) -> Graph_Undirected -> Node -> [Node]
+rm_edge_neighbors (x,y) g n | (n == x && List.elem y all_neighbors) = List.filter (/= y) all_neighbors
+ | (n == y && List.elem x all_neighbors) = List.filter (/= x) all_neighbors
+ | otherwise = all_neighbors
+ where
+ all_neighbors = filterNeighbors g n
+
-- | TODO do as a Map instead of [Node] ?
-prox_markov :: Graph_Undirected -> [Node] -> Length -> Reflexive -> NeighborsFilter -> [Map Node Double]
-prox_markov g ns l r nf = map (\_ -> spreading g ms r nf) [0..l]
+prox_markov :: Graph_Undirected -> [Node] -> Length -> FalseReflexive -> NeighborsFilter -> Map Node Double
+prox_markov g ns l r nf = foldl' (\m _ -> spreading g m r nf) ms path
where
+ path
+ | l == 0 = []
+ | l > 0 = [0..l-1]
+ | otherwise = panic "Gargantext.Viz.Graph.Proxemy.prox_markov: Length < 0"
-- TODO if ns empty
- ms = Map.fromList $ map (\n -> (n, 1 / (fromIntegral $ List.length ns))) ns
+ ms = case List.length ns > 0 of
+ True -> Map.fromList $ map (\n -> (n, 1 / (fromIntegral $ List.length ns))) ns
+ _ -> Map.empty
-spreading :: Graph_Undirected -> Map Node Double -> Reflexive -> NeighborsFilter -> Map Node Double
-spreading g ms r nf = Map.fromListWith (+) $ map pvalue (Map.toList ms)
+spreading :: Graph_Undirected
+ -> Map Node Double
+ -> FalseReflexive
+ -> NeighborsFilter
+ -> Map Node Double
+spreading g ms r nf = Map.fromListWith (+) $ List.concat $ map pvalue (Map.keys ms)
where
-- TODO if list empty ...
- pvalue (n,v) = (n, v / (fromIntegral $ List.length neighborhood))
+ -- pvalue' n = [pvalue n] <> map pvalue (neighborhood n)
+ pvalue n = [(n, pvalue' n)] <> map (\n''->(n'', pvalue' n)) (nf g n)
where
- neighborhood = (nf g n) <> (if r then [n] else [])
+ pvalue' n' = (value n') / (fromIntegral $ List.length neighborhood)
+ value n' = maybe 0 identity $ Map.lookup n' ms
+ neighborhood = (nf g n) <> (if r then [n] else [])
------------------------------------------------------------------------
--- | Graph Tools
+-- | Behavior tests
-mkGraphUfromEdges :: [(Int, Int)] -> Graph 'U () ()
-mkGraphUfromEdges es = mkGraph (List.replicate n ()) $ zip es $ repeat ()
+graphTest :: Graph_Undirected
+graphTest= mkGraphUfromEdges graphTest_data
+
+graphTest_data :: [(Int,Int)]
+graphTest_data = [(0,1),(0,2),(0,4),(0,5),(1,3),(1,8),(2,3),(2,4),(2,5),(2,6),(2,16),(3,4),(3,5),(3,6),(3,18),(4,6),(5,8),(7,8),(7,9),(7,10),(7,13),(8,9),(8,10),(8,11),(8,12),(8,13),(9,12),(9,13),(10,11),(10,17),(11,12),(13,20),(14,16),(14,17),(14,18),(14,20),(15,16),(15,17),(15,18),(15,20),(16,18),(16,20),(17,18),(17,20),(18,19),(18,20),(19,20)]
+
+graphTest_data' :: [(Int,Int)]
+graphTest_data' = [(0,1),(0,2),(0,4),(0,5),(1,0),(1,3),(1,8),(2,0),(2,3),(2,4),(2,5),(2,6),(2,16),(3,1),(3,2),(3,4),(3,5),(3,6),(3,18),(4,0),(4,2),(4,3),(4,6),(5,0),(5,2),(5,3),(5,8),(6,2),(6,3),(6,4),(7,8),(7,9),(7,10),(7,13),(8,1),(8,5),(8,7),(8,9),(8,10),(8,11),(8,12),(8,13),(9,7),(9,8),(9,12),(9,13),(10,7),(10,8),(10,11),(10,17),(11,8),(11,10),(11,12),(12,8),(12,9),(12,11),(13,7),(13,8),(13,9),(13,20),(14,16),(14,17),(14,18),(14,20),(15,16),(15,17),(15,18),(15,20),(16,2),(16,14),(16,15),(16,18),(16,20),(17,10),(17,14),(17,15),(17,18),(17,20),(18,3),(18,14),(18,15),(18,16),(18,17),(18,19),(18,20),(19,18),(19,20),(20,13),(20,14),(20,15),(20,16),(20,17),(20,18),(20,19)]
+
+-- | Tests
+-- >>> runTest_Confluence_Proxemy
+-- (True,True)
+runTest_Confluence_Proxemy :: (Bool, Bool)
+runTest_Confluence_Proxemy = (runTest_conf_is_ok, runTest_prox_is_ok)
where
- (a,b) = List.unzip es
- n = List.length (List.nub $ a <> b)
+ runTest_conf_is_ok :: Bool
+ runTest_conf_is_ok = List.null $ List.filter (\t -> snd t == False)
+ [ (((x,y)), abs ((look (y,x) test) - (look (y,x) temoin)) < 0.0001)
+ | y <- nodes graphTest
+ , x <- nodes graphTest
+ ]
-mkGraphDfromEdges :: [(Int, Int)] -> Graph 'D () ()
-mkGraphDfromEdges = undefined
+ where
+ test = toMap [(n, [ (y, similarity_conf_x_y graphTest (n,y) 3 True False) | y <- nodes graphTest])
+ | n <- nodes graphTest
+ ]
+ temoin = test_confluence_temoin
-------------------------------------------------------------------------
--- | Behavior tests
+ runTest_prox_is_ok :: Bool
+ runTest_prox_is_ok = List.null (List.filter (not . List.null) $ map runTest_prox' [0..3])
-graphTest :: Graph 'U () ()
-graphTest= mkGraphUfromEdges [(0,1),(0,2),(0,4),(0,5),(1,0),(1,3),(1,8),(2,0),(2,3),(2,4),(2,5),(2,6),(2,16),(3,1),(3,2),(3,4),(3,5),(3,6),(3,18),(4,0),(4,2),(4,3),(4,6),(5,0),(5,2),(5,3),(5,8),(6,2),(6,3),(6,4),(7,8),(7,9),(7,10),(7,13),(8,1),(8,5),(8,7),(8,9),(8,10),(8,11),(8,12),(8,13),(9,7),(9,8),(9,12),(9,13),(10,7),(10,8),(10,11),(10,17),(11,8),(11,10),(11,12),(12,8),(12,9),(12,11),(13,7),(13,8),(13,9),(13,20),(14,16),(14,17),(14,18),(14,20),(15,16),(15,17),(15,18),(15,20),(16,2),(16,14),(16,15),(16,18),(16,20),(17,10),(17,14),(17,15),(17,18),(17,20),(18,3),(18,14),(18,15),(18,16),(18,17),(18,19),(18,20),(19,18),(19,20),(20,13),(20,14),(20,15),(20,16),(20,17),(20,18),(20,19)]
+ runTest_prox' :: Node -> [((Node, (Node, Node)), Bool)]
+ runTest_prox' l = List.filter (\t -> snd t == False)
+ [ ((l,(x,y)), abs ((look (y,x) test) - (look (y,x) temoin)) < 0.0001)
+ | y <- nodes graphTest
+ , x <- nodes graphTest
+ ]
+ where
+ test = toMap $ test_proxs_y l
+ temoin = toMap $ test_prox l
+
+ test_proxs_y :: Length -> [(Node, [(Node, Double)])]
+ test_proxs_y l' = map (\n -> test_proxs_x l' n) (nodes graphTest)
+
+ test_proxs_x :: Length -> Node -> (Node, [(Node, Double)])
+ test_proxs_x l' a = (a, map (\x -> (x, maybe 0 identity $ Map.lookup x (m a))) (nodes graphTest))
+ where
+ m x' = prox_markov graphTest [x'] l' True filterNeighbors
-test_proxs :: Map Int (Map Int Double)
-test_proxs = Map.fromList $ map (second Map.fromList) $ test_prox0 <> test_prox1 <> test_prox2 <> test_prox3 <> test_prox4
+ toMap = Map.map Map.fromList . Map.fromList
+
+ look :: (Node,Node) -> Map Node (Map Node Double) -> Double
+ look (x,y) m = look' x $ look' y m
+ where
+ look' x' m' = maybe (panic "nokey") identity $ Map.lookup x' m'
--prox : longueur balade = 0
-test_prox0 :: [(Int, [(Int, Double)])]
-test_prox0 = [ (0,[(0,1.0000),(1,0.0000),(2,0.0000),(3,0.0000),(4,0.0000),(5,0.0000),(6,0.0000),(7,0.0000),(8,0.0000),(9,0.0000),(10,0.0000),(11,0.0000),(12,0.0000),(13,0.0000),(14,0.0000),(15,0.0000),(16,0.0000),(17,0.0000),(18,0.0000),(19,0.0000),(20,0.0000)])
+test_prox :: Node -> [(Node, [(Node, Double)])]
+test_prox 0 = [ (0,[(0,1.0000),(1,0.0000),(2,0.0000),(3,0.0000),(4,0.0000),(5,0.0000),(6,0.0000),(7,0.0000),(8,0.0000),(9,0.0000),(10,0.0000),(11,0.0000),(12,0.0000),(13,0.0000),(14,0.0000),(15,0.0000),(16,0.0000),(17,0.0000),(18,0.0000),(19,0.0000),(20,0.0000)])
, (1,[(0,0.0000),(1,1.0000),(2,0.0000),(3,0.0000),(4,0.0000),(5,0.0000),(6,0.0000),(7,0.0000),(8,0.0000),(9,0.0000),(10,0.0000),(11,0.0000),(12,0.0000),(13,0.0000),(14,0.0000),(15,0.0000),(16,0.0000),(17,0.0000),(18,0.0000),(19,0.0000),(20,0.0000)])
, (2,[(0,0.0000),(1,0.0000),(2,1.0000),(3,0.0000),(4,0.0000),(5,0.0000),(6,0.0000),(7,0.0000),(8,0.0000),(9,0.0000),(10,0.0000),(11,0.0000),(12,0.0000),(13,0.0000),(14,0.0000),(15,0.0000),(16,0.0000),(17,0.0000),(18,0.0000),(19,0.0000),(20,0.0000)])
, (3,[(0,0.0000),(1,0.0000),(2,0.0000),(3,1.0000),(4,0.0000),(5,0.0000),(6,0.0000),(7,0.0000),(8,0.0000),(9,0.0000),(10,0.0000),(11,0.0000),(12,0.0000),(13,0.0000),(14,0.0000),(15,0.0000),(16,0.0000),(17,0.0000),(18,0.0000),(19,0.0000),(20,0.0000)])
--{-
--, longueur balade , 1]),
-test_prox1 :: [(Int, [(Int, Double)])]
-test_prox1 = [(0,[(0,0.2000),(1,0.2000),(2,0.2000),(3,0.0000),(4,0.2000),(5,0.2000),(6,0.0000),(7,0.0000),(8,0.0000),(9,0.0000),(10,0.0000),(11,0.0000),(12,0.0000),(13,0.0000),(14,0.0000),(15,0.0000),(16,0.0000),(17,0.0000),(18,0.0000),(19,0.0000),(20,0.0000)])
+test_prox 1 = [(0,[(0,0.2000),(1,0.2000),(2,0.2000),(3,0.0000),(4,0.2000),(5,0.2000),(6,0.0000),(7,0.0000),(8,0.0000),(9,0.0000),(10,0.0000),(11,0.0000),(12,0.0000),(13,0.0000),(14,0.0000),(15,0.0000),(16,0.0000),(17,0.0000),(18,0.0000),(19,0.0000),(20,0.0000)])
, (1,[(0,0.2500),(1,0.2500),(2,0.0000),(3,0.2500),(4,0.0000),(5,0.0000),(6,0.0000),(7,0.0000),(8,0.2500),(9,0.0000),(10,0.0000),(11,0.0000),(12,0.0000),(13,0.0000),(14,0.0000),(15,0.0000),(16,0.0000),(17,0.0000),(18,0.0000),(19,0.0000),(20,0.0000)])
, (2,[(0,0.1429),(1,0.0000),(2,0.1429),(3,0.1429),(4,0.1429),(5,0.1429),(6,0.1429),(7,0.0000),(8,0.0000),(9,0.0000),(10,0.0000),(11,0.0000),(12,0.0000),(13,0.0000),(14,0.0000),(15,0.0000),(16,0.1429),(17,0.0000),(18,0.0000),(19,0.0000),(20,0.0000)])
, (3,[(0,0.0000),(1,0.1429),(2,0.1429),(3,0.1429),(4,0.1429),(5,0.1429),(6,0.1429),(7,0.0000),(8,0.0000),(9,0.0000),(10,0.0000),(11,0.0000),(12,0.0000),(13,0.0000),(14,0.0000),(15,0.0000),(16,0.0000),(17,0.0000),(18,0.1429),(19,0.0000),(20,0.0000)])
-- | longueur balade 2
-test_prox2 :: [(Int, [(Int, Double)])]
-test_prox2 = [ (0,[(0,0.1986),(1,0.0900),(2,0.1486),(3,0.1586),(4,0.1086),(5,0.1086),(6,0.0686),(7,0.0000),(8,0.0900),(9,0.0000),(10,0.0000),(11,0.0000),(12,0.0000),(13,0.0000),(14,0.0000),(15,0.0000),(16,0.0286),(17,0.0000),(18,0.0000),(19,0.0000),(20,0.0000)])
+test_prox 2 = [ (0,[(0,0.1986),(1,0.0900),(2,0.1486),(3,0.1586),(4,0.1086),(5,0.1086),(6,0.0686),(7,0.0000),(8,0.0900),(9,0.0000),(10,0.0000),(11,0.0000),(12,0.0000),(13,0.0000),(14,0.0000),(15,0.0000),(16,0.0286),(17,0.0000),(18,0.0000),(19,0.0000),(20,0.0000)])
, (1,[(0,0.1125),(1,0.1760),(2,0.0857),(3,0.0982),(4,0.0857),(5,0.1135),(6,0.0357),(7,0.0278),(8,0.0903),(9,0.0278),(10,0.0278),(11,0.0278),(12,0.0278),(13,0.0278),(14,0.0000),(15,0.0000),(16,0.0000),(17,0.0000),(18,0.0357),(19,0.0000),(20,0.0000)])
, (2,[(0,0.1061),(1,0.0490),(2,0.1861),(3,0.1337),(4,0.1337),(5,0.0980),(6,0.1051),(7,0.0000),(8,0.0286),(9,0.0000),(10,0.0000),(11,0.0000),(12,0.0000),(13,0.0000),(14,0.0238),(15,0.0238),(16,0.0442),(17,0.0000),(18,0.0442),(19,0.0000),(20,0.0238)])
, (3,[(0,0.1133),(1,0.0561),(2,0.1337),(3,0.1872),(4,0.1051),(5,0.0694),(6,0.1051),(7,0.0000),(8,0.0643),(9,0.0000),(10,0.0000),(11,0.0000),(12,0.0000),(13,0.0000),(14,0.0179),(15,0.0179),(16,0.0383),(17,0.0179),(18,0.0383),(19,0.0179),(20,0.0179)])
]
-- | longueur balade 3
-test_prox3 :: [(Int, [(Int, Double)])]
-test_prox3 = [ (0,[(0,0.1269),(1,0.0949),(2,0.1489),(3,0.1269),(4,0.1224),(5,0.1153),(6,0.0827),(7,0.0100),(8,0.0542),(9,0.0100),(10,0.0100),(11,0.0100),(12,0.0100),(13,0.0100),(14,0.0048),(15,0.0048),(16,0.0260),(17,0.0000),(18,0.0274),(19,0.0000),(20,0.0048)])
+test_prox 3 = [ (0,[(0,0.1269),(1,0.0949),(2,0.1489),(3,0.1269),(4,0.1224),(5,0.1153),(6,0.0827),(7,0.0100),(8,0.0542),(9,0.0100),(10,0.0100),(11,0.0100),(12,0.0100),(13,0.0100),(14,0.0048),(15,0.0048),(16,0.0260),(17,0.0000),(18,0.0274),(19,0.0000),(20,0.0048)])
, (1,[(0,0.1186),(1,0.0906),(2,0.0975),(3,0.1235),(4,0.0748),(5,0.0815),(6,0.0523),(7,0.0323),(8,0.1128),(9,0.0336),(10,0.0281),(11,0.0295),(12,0.0295),(13,0.0267),(14,0.0045),(15,0.0045),(16,0.0167),(17,0.0100),(18,0.0185),(19,0.0045),(20,0.0100)])
, (2,[(0,0.1064),(1,0.0557),(2,0.1469),(3,0.1360),(4,0.1199),(5,0.0897),(6,0.0987),(7,0.0032),(8,0.0350),(9,0.0032),(10,0.0032),(11,0.0032),(12,0.0032),(13,0.0062),(14,0.0206),(15,0.0206),(16,0.0520),(17,0.0180),(18,0.0445),(19,0.0085),(20,0.0254)])
, (3,[(0,0.0907),(1,0.0706),(2,0.1360),(3,0.1258),(4,0.1158),(5,0.0895),(6,0.0931),(7,0.0071),(8,0.0351),(9,0.0071),(10,0.0101),(11,0.0071),(12,0.0071),(13,0.0094),(14,0.0199),(15,0.0199),(16,0.0396),(17,0.0171),(18,0.0562),(19,0.0130),(20,0.0295)])
, (19,[(0,0.0000),(1,0.0060),(2,0.0198),(3,0.0303),(4,0.0060),(5,0.0060),(6,0.0060),(7,0.0083),(8,0.0083),(9,0.0083),(10,0.0139),(11,0.0000),(12,0.0000),(13,0.0326),(14,0.0931),(15,0.0931),(16,0.0958),(17,0.0958),(18,0.1805),(19,0.1134),(20,0.1829)])
, (20,[(0,0.0030),(1,0.0050),(2,0.0222),(3,0.0258),(4,0.0052),(5,0.0080),(6,0.0052),(7,0.0251),(8,0.0251),(9,0.0209),(10,0.0290),(11,0.0069),(12,0.0078),(13,0.0446),(14,0.0979),(15,0.0979),(16,0.1034),(17,0.1046),(18,0.1440),(19,0.0686),(20,0.1499)])
]
+test_prox _ = undefined
+
--- | confluence longueur balade 4
-test_prox4 :: [(Int, [(Int, Double)])]
-test_prox4 = [(0,[(0,0.7448),(1,0.4844),(2,0.6471),(3,0.6759),(4,0.6297),(5,0.6219),(6,0.7040),(7,0.1870),(8,0.4092),(9,0.1870),(10,0.1870),(11,0.2233),(12,0.2233),(13,0.1870),(14,0.0987),(15,0.0987),(16,0.3325),(17,0.0000),(18,0.2827),(19,0.0000),(20,0.0641)])
+-- | confluence longueur balade 3
+test_confluence_temoin :: Map Node (Map Node Double)
+test_confluence_temoin = Map.map Map.fromList $ Map.fromList [(0,[(0,0.7448),(1,0.4844),(2,0.6471),(3,0.6759),(4,0.6297),(5,0.6219),(6,0.7040),(7,0.1870),(8,0.4092),(9,0.1870),(10,0.1870),(11,0.2233),(12,0.2233),(13,0.1870),(14,0.0987),(15,0.0987),(16,0.3325),(17,0.0000),(18,0.2827),(19,0.0000),(20,0.0641)])
, (1,[(0,0.4844),(1,0.7225),(2,0.6158),(3,0.4509),(4,0.6326),(5,0.6521),(6,0.6008),(7,0.4259),(8,0.2441),(9,0.4362),(10,0.3925),(11,0.4587),(12,0.4587),(13,0.3804),(14,0.0931),(15,0.0931),(16,0.2426),(17,0.1611),(18,0.2100),(19,0.1461),(20,0.1259)])
, (2,[(0,0.6471),(1,0.6158),(2,0.7070),(3,0.6569),(4,0.7060),(5,0.5915),(6,0.6918),(7,0.0680),(8,0.3091),(9,0.0680),(10,0.0680),(11,0.0836),(12,0.0836),(13,0.1239),(14,0.3219),(15,0.3219),(16,0.0630),(17,0.2568),(18,0.3901),(19,0.2458),(20,0.2674)])
, (3,[(0,0.6759),(1,0.4509),(2,0.6569),(3,0.6740),(4,0.6865),(5,0.5777),(6,0.6659),(7,0.1411),(8,0.3093),(9,0.1411),(10,0.1888),(11,0.1704),(12,0.1704),(13,0.1774),(14,0.3144),(15,0.3144),(16,0.4317),(17,0.2472),(18,0.0602),(19,0.3320),(20,0.2975)])