[FEAT] Proxemy implemented and tested.

src/Gargantext/Viz/Graph/Proxemy.hs

@@ -20,7 +20,6 @@ Références:
 module Gargantext.Viz.Graph.Proxemy
   where
 
-import Data.Tuple.Extra (second)
 import Gargantext.Prelude
 import IGraph
 import Data.Map (Map)
@@ -29,24 +28,33 @@ import qualified Data.List as List
 
 type Graph_Undirected = Graph 'U () ()
 type Length = Int
-type Reflexive = Bool
+type FalseReflexive = Bool
 type NeighborsFilter = Graph_Undirected -> Node -> [Node]
 
 -- | 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 [])
 
 
 ------------------------------------------------------------------------
@@ -68,12 +76,38 @@ 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)]
 
 
-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
+--{-
+--runTest_prox :: [Bool
+
+runTest_prox_is_ok = List.null (List.filter (not . List.null) $ map runTest_prox' [0..3])
+
+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
+    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
+    test   = Map.map Map.fromList $ Map.fromList   $ test_proxs_y l
+    temoin = Map.map Map.fromList $ Map.fromList   $ 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 (\g n -> List.nub $ neighbors g n)
+
 
 --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)])
@@ -98,8 +132,7 @@ test_prox0 = [ (0,[(0,1.0000),(1,0.0000),(2,0.0000),(3,0.0000),(4,0.0000),(5,0.0
 
 --{-
 --, 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)])
@@ -124,8 +157,7 @@ test_prox1 = [(0,[(0,0.2000),(1,0.2000),(2,0.2000),(3,0.0000),(4,0.2000),(5,0.20
 
 
 -- | 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)])
@@ -149,8 +181,7 @@ test_prox2 = [ (0,[(0,0.1986),(1,0.0900),(2,0.1486),(3,0.1586),(4,0.1086),(5,0.1
    ]
 
 -- | 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)])
@@ -172,10 +203,12 @@ test_prox3 = [ (0,[(0,0.1269),(1,0.0949),(2,0.1489),(3,0.1269),(4,0.1224),(5,0.1
    , (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 :: [(Node, [(Node, Double)])]
+test_confluence_temoin =  [(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)])