Merge branch 'dev-phylo' of https://gitlab.iscpif.fr/gargantext/haskell-gargantext into dev-phylo

src/Gargantext/Viz/Phylo/Aggregates/Cluster.hs

@@ -49,9 +49,10 @@ graphToClusters clust (nodes,edges) = case clust of
 
 
 -- | To transform a list of PhyloGroups into a Graph of Proximity
-groupsToGraph :: Proximity -> [PhyloGroup] -> Map (Int, Int) Double -> ([GroupNode],[GroupEdge])
-groupsToGraph prox gs cooc = case prox of 
-      WeightedLogJaccard (WLJParams _ sens) -> (gs, map (\(x,y) -> ((x,y), weightedLogJaccard sens (getSubCooc (getGroupNgrams x) cooc) (getSubCooc (getGroupNgrams y) cooc)))
+groupsToGraph :: Proximity -> [PhyloGroup] -> Map (Int, Int) Double -> Phylo -> ([GroupNode],[GroupEdge])
+groupsToGraph prox gs cooc p = case prox of 
+      WeightedLogJaccard (WLJParams _ sens) -> (gs, map (\(x,y) -> ((x,y), traceSim x y (getSubCooc (getGroupNgrams x) cooc) (getSubCooc (getGroupNgrams y) cooc) p  
+                                                                         $ weightedLogJaccard sens (getSubCooc (getGroupNgrams x) cooc) (getSubCooc (getGroupNgrams y) cooc)))
                                                                          $ getCandidates gs)
       Hamming (HammingParams _)             -> (gs, map (\(x,y) -> ((x,y), hamming (getSubCooc (getGroupNgrams x) cooc) (getSubCooc (getGroupNgrams y) cooc)))
                                                                          $ getCandidates gs)
@@ -81,7 +82,7 @@ phyloToClusters lvl clus p = Map.fromList
     --------------------------------------
     graphs  :: [([GroupNode],[GroupEdge])]
     graphs  = traceGraph lvl (getThreshold prox) 
-            $ map (\prd -> groupsToGraph prox (getGroupsWithFilters lvl prd p) (getCooc [prd] p)) periods 
+            $ map (\prd -> groupsToGraph prox (getGroupsWithFilters lvl prd p) (getCooc [prd] p) p) periods 
     --------------------------------------
     prox :: Proximity
     prox = getProximity clus
@@ -99,6 +100,7 @@ phyloToClusters lvl clus p = Map.fromList
 traceGraph :: Level -> Double -> [([GroupNode],[GroupEdge])] -> [([GroupNode],[GroupEdge])]
 traceGraph lvl thr g = trace ( "----\nUnfiltered clustering in Phylo" <> show (lvl) <> " :\n"
                                       <> "count : " <> show (length lst) <> " potential edges (" <> show (length $ filter (>= thr) lst) <> " >= " <> show (thr) <> ")\n"
+                                      <> show (lst) <> "\n"
                                       <> "similarity : " <> show (percentile 25 (VS.fromList lst)) <> " (25%) "
                                                          <> show (percentile 50 (VS.fromList lst)) <> " (50%) "
                                                          <> show (percentile 75 (VS.fromList lst)) <> " (75%) "
@@ -117,3 +119,8 @@ traceGraphFiltered lvl g = trace ( "----\nClustering in Phylo" <> show (lvl) <>
   where 
     lst = sort $ map snd $ concat $ map snd g 
 
+
+traceSim :: PhyloGroup -> PhyloGroup -> Map (Int, Int) Double -> Map (Int, Int) Double -> Phylo -> Double -> Double
+traceSim g g' c c' p sim = trace (show (getGroupText g p) <> " [vs] " <>  show (getGroupText g' p) <> " = " <> show (sim) <> "\n"
+                                 -- <> show (c) <> " [vs] " <> show (c') <>  " = " <> show (sim)
+                                 ) sim

src/Gargantext/Viz/Phylo/Aggregates/Cooc.hs

@@ -52,7 +52,7 @@ toCooc :: [([Int],Double)] -> Map (Int, Int) Double
 toCooc l = map (/docs)
          $ foldl (\mem x -> adjust (+1) x mem) cooc
          $ concat
-         $ map (\x -> listToDirectedCombi $ fst x) l
+         $ map (\x -> listToFullCombi $ fst x) l
   where
     --------------------------------------
     idx :: [Int]
@@ -62,7 +62,7 @@ toCooc l = map (/docs)
     docs = sum $ map snd l
     --------------------------------------
     cooc :: Map (Int, Int) (Double)
-    cooc = Map.fromList $ map (\x -> (x,0)) $ listToDirectedCombi idx
+    cooc = Map.fromList $ map (\x -> (x,0)) $ listToFullCombi idx
     --------------------------------------    
 
 

src/Gargantext/Viz/Phylo/Example.hs

@@ -77,7 +77,7 @@ queryViewEx = "level=3"
 
 
 phyloQueryView :: PhyloQueryView
-phyloQueryView = PhyloQueryView 4 Merge False 1 [BranchAge] [] [BranchPeakFreq,GroupLabelCooc] (Just (ByBranchAge,Asc)) Json Flat True
+phyloQueryView = PhyloQueryView 1 Merge False 1 [BranchAge] [] [BranchPeakFreq,GroupLabelCooc] (Just (ByBranchAge,Asc)) Json Flat True
 
 
 --------------------------------------------------
@@ -104,7 +104,7 @@ queryEx = "title=Cesar et Cleôpatre"
 
 phyloQueryBuild :: PhyloQueryBuild
 phyloQueryBuild = PhyloQueryBuild "Cesar et Cleôpatre" "An example of Phylomemy (french without accent)"
-             5 3 defaultFis [] [] (WeightedLogJaccard $ WLJParams 0.1 10) 4 (RelatedComponents $ RCParams $ WeightedLogJaccard $ WLJParams 0.1 10)
+             5 3 defaultFis [] [] (WeightedLogJaccard $ WLJParams 0.1 10) 2 (RelatedComponents $ RCParams $ WeightedLogJaccard $ WLJParams 0.13 0)
 
 
 

src/Gargantext/Viz/Phylo/Metrics/Proximity.hs

@@ -20,15 +20,15 @@ module Gargantext.Viz.Phylo.Metrics.Proximity
 import Data.List        (null)
 import Data.Map         (Map,elems,unionWith,intersectionWith,intersection,size)
 import Gargantext.Prelude
--- import Debug.Trace (trace)
+import Debug.Trace (trace)
 
 -- | To process the weightedLogJaccard between two PhyloGroup fields
 weightedLogJaccard :: Double -> Map (Int, Int) Double -> Map (Int, Int) Double -> Double
 weightedLogJaccard s f1 f2
   | null wUnion      = 0
   | wUnion == wInter = 1 
-  | s == 0           = (fromIntegral $ length wInter)/(fromIntegral $ length wUnion)
-  | s > 0            = (sumInvLog wInter)/(sumInvLog wUnion)
+  | s == 0           = trace ("==0") $ (fromIntegral $ length wInter)/(fromIntegral $ length wUnion)
+  | s > 0            = trace (">0") $ (sumInvLog wInter)/(sumInvLog wUnion)
   | otherwise        = (sumLog wInter)/(sumLog wUnion)
   where 
     --------------------------------------

src/Gargantext/Viz/Phylo/Tools.hs

@@ -100,6 +100,11 @@ keepFilled f thr l = if (null $ f thr l) && (not $ null l)
                      else f thr l
 
 
+-- | To get all combinations of a list
+listToFullCombi :: Eq a => [a] -> [(a,a)]
+listToFullCombi l = [(x,y) | x <- l, y <- l]
+
+
 -- | To get all combinations of a list
 listToDirectedCombi :: Eq a => [a] -> [(a,a)]
 listToDirectedCombi l = [(x,y) | x <- l, y <- l, x /= y]