[MERGE]

gargantext.cabal

@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           gargantext
-version: 0.0.6.9.7
+version:        0.0.6.9.7
 synopsis:       Search, map, share
 description:    Please see README.md
 category:       Data

src/Gargantext/Core/Viz/Phylo.hs

@@ -71,7 +71,7 @@ data SeaElevation =
 
 instance ToSchema SeaElevation
 
-data Similarity =
+data PhyloSimilarity =
       WeightedLogJaccard
       { _wlj_sensibility     :: Double
       , _wlj_minSharedNgrams :: Int }
@@ -84,7 +84,7 @@ data Similarity =
 
     deriving (Show,Generic,Eq)
 
-instance ToSchema Similarity where
+instance ToSchema PhyloSimilarity where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
 
 
@@ -179,7 +179,7 @@ data PhyloConfig =
             , listParser     :: ListParser
             , phyloName      :: Text
             , phyloScale     :: Int
-            , similarity     :: Similarity
+            , similarity     :: PhyloSimilarity
             , seaElevation   :: SeaElevation
             , defaultMode    :: Bool
             , findAncestors  :: Bool
@@ -253,8 +253,8 @@ instance ToJSON CorpusParser
 instance FromJSON ListParser
 instance ToJSON ListParser
 
-instance FromJSON Similarity
-instance ToJSON Similarity
+instance FromJSON PhyloSimilarity
+instance ToJSON PhyloSimilarity
 
 instance FromJSON SeaElevation
 instance ToJSON SeaElevation
@@ -601,7 +601,7 @@ instance ToSchema PhyloExport where
 
 makeLenses ''PhyloConfig
 makeLenses ''PhyloSubConfig
-makeLenses ''Similarity
+makeLenses ''PhyloSimilarity
 makeLenses ''SeaElevation
 makeLenses ''Quality
 makeLenses ''Cluster

src/Gargantext/Core/Viz/Phylo/PhyloExport.hs

@@ -596,7 +596,7 @@ getGroupThr step g =
         breaks = (g ^. phylo_groupMeta) ! "breaks"
      in (last' "export" (take (round $ (last' "export" breaks) + 1) seaLvl)) - step
 
-toAncestor :: Double -> Map Int Double -> Similarity -> Double -> [PhyloGroup] -> PhyloGroup -> PhyloGroup
+toAncestor :: Double -> Map Int Double -> PhyloSimilarity -> Double -> [PhyloGroup] -> PhyloGroup -> PhyloGroup
 toAncestor nbDocs diago similarity step candidates ego =
   let curr = ego ^. phylo_groupAncestors
    in ego & phylo_groupAncestors .~ (curr ++ (map (\(g,w) -> (getGroupId g,w))
@@ -605,7 +605,7 @@ toAncestor nbDocs diago similarity step candidates ego =
          $ filter (\g -> g ^. phylo_groupBranchId /= ego ^. phylo_groupBranchId ) candidates))
 
 
-headsToAncestors :: Double -> Map Int Double -> Similarity -> Double -> [PhyloGroup] -> [PhyloGroup] -> [PhyloGroup]
+headsToAncestors :: Double -> Map Int Double -> PhyloSimilarity -> Double -> [PhyloGroup] -> [PhyloGroup] -> [PhyloGroup]
 headsToAncestors nbDocs diago similarity step heads acc =
   if (null heads)
     then acc

src/Gargantext/Core/Viz/Phylo/PhyloTools.hs

@@ -406,14 +406,14 @@ getPeriodPointers fil g =
         ToChildsMemory  -> undefined
         ToParentsMemory -> undefined
 
-filterSimilarity :: Similarity -> Double -> Double -> Bool
+filterSimilarity :: PhyloSimilarity -> Double -> Double -> Bool
 filterSimilarity similarity thr local =
     case similarity of
         WeightedLogJaccard _ _ -> local >= thr
         WeightedLogSim     _ _ -> local >= thr
         Hamming            _ _ -> undefined
 
-getSimilarityName :: Similarity -> String
+getSimilarityName :: PhyloSimilarity -> String
 getSimilarityName similarity =
     case similarity of
         WeightedLogJaccard _ _ -> "WLJaccard"
@@ -474,7 +474,7 @@ getScales phylo = nub
 getSeaElevation :: Phylo -> SeaElevation
 getSeaElevation phylo = seaElevation (getConfig phylo)
 
-getSimilarity :: Phylo -> Similarity
+getSimilarity :: Phylo -> PhyloSimilarity
 getSimilarity phylo = similarity (getConfig phylo)
 
 
@@ -687,13 +687,13 @@ traceSynchronyStart phylo =
 -- | Similarity | --
 -------------------
 
-getSensibility :: Similarity -> Double
+getSensibility :: PhyloSimilarity -> Double
 getSensibility proxi = case proxi of
     WeightedLogJaccard s _ -> s
     WeightedLogSim     s _ -> s
     Hamming            _ _ -> undefined
 
-getMinSharedNgrams :: Similarity -> Int
+getMinSharedNgrams :: PhyloSimilarity -> Int
 getMinSharedNgrams proxi = case proxi of
     WeightedLogJaccard _ m -> m
     WeightedLogSim     _ m -> m

src/Gargantext/Core/Viz/Phylo/SynchronicClustering.hs

@@ -124,13 +124,13 @@ toDiamonds groups = foldl' (\acc groups' ->
                   $ foldl' (\acc g -> acc ++ (map (\(id,_) -> (id,[g]) ) $ g ^. phylo_groupPeriodParents)  ) [] groups
 
 
-groupsToEdges :: Similarity -> Synchrony -> Double -> Map Int Double -> [PhyloGroup] -> [((PhyloGroup,PhyloGroup),Double)]
+groupsToEdges :: PhyloSimilarity -> Synchrony -> Double -> Map Int Double -> [PhyloGroup] -> [((PhyloGroup,PhyloGroup),Double)]
 groupsToEdges prox sync nbDocs diago groups =
     case sync of
         ByProximityThreshold  thr sens _ strat ->
             filter (\(_,w) -> w >= thr)
           $ toEdges sens
-          $ toPairs strat groups         
+          $ toPairs strat groups
         ByProximityDistribution sens strat -> 
             let diamonds = sortOn snd 
                          $ toEdges sens $ concat
@@ -146,14 +146,14 @@ groupsToEdges prox sync nbDocs diago groups =
                 WeightedLogSim _ _     -> map (\(g,g') -> 
                                                      ((g,g'), weightedLogJaccard' (1 / sens) nbDocs diago
                                                                   (g ^. phylo_groupNgrams) (g' ^. phylo_groupNgrams))) edges
-                
-                _ -> undefined  
+
+                _ -> undefined
 
 toParentId :: PhyloGroup -> PhyloGroupId
 toParentId child = ((child ^. phylo_groupPeriod, child ^. phylo_groupScale + 1), child ^. phylo_groupIndex) 
 
 
-reduceGroups :: Similarity -> Synchrony -> Map Date Double -> Map Date Cooc -> [PhyloGroup] -> [PhyloGroup]
+reduceGroups :: PhyloSimilarity -> Synchrony -> Map Date Double -> Map Date Cooc -> [PhyloGroup] -> [PhyloGroup]
 reduceGroups prox sync docs diagos branch =
     --  1) reduce a branch as a set of periods & groups
     let periods = fromListWith (++)

src/Gargantext/Core/Viz/Phylo/TemporalMatching.hs

@@ -119,7 +119,7 @@ weightedLogSim' sens nbDocs diago ego_ngrams target_ngrams
 {- 
 -- perform a seamilarity measure between a given group and a pair of targeted groups
 -}
-toSimilarity :: Double -> Map Int Double -> Similarity -> [Int] -> [Int] -> [Int] -> Double
+toSimilarity :: Double -> Map Int Double -> PhyloSimilarity -> [Int] -> [Int] -> [Int] -> Double
 toSimilarity nbDocs diago similarity egoNgrams targetNgrams targetNgrams' =
   case similarity of
     WeightedLogJaccard sens _ ->
@@ -147,7 +147,7 @@ findLastPeriod fil periods = case fil of
     ToChildsMemory  -> undefined
     ToParentsMemory -> undefined
 
-removeOldPointers :: [Pointer] -> Filiation -> Double -> Similarity -> Period
+removeOldPointers :: [Pointer] -> Filiation -> Double -> PhyloSimilarity -> Period
                   -> [((PhyloGroupId,[Int]),(PhyloGroupId,[Int]))]
                   -> [((PhyloGroupId,[Int]),(PhyloGroupId,[Int]))]
 removeOldPointers oldPointers fil thr prox prd pairs
@@ -166,10 +166,10 @@ removeOldPointers oldPointers fil thr prox prd pairs
                                || (((fst . fst . fst) id') > (fst lastMatchedPrd))) pairs
   | otherwise = []
 
-filterPointers :: Similarity -> Double -> [Pointer] -> [Pointer]
+filterPointers :: PhyloSimilarity -> Double -> [Pointer] -> [Pointer]
 filterPointers proxi thr pts = filter (\(_,w) -> filterSimilarity proxi thr w) pts
 
-filterPointers' :: Similarity -> Double -> [(Pointer,[Int])] -> [(Pointer,[Int])]
+filterPointers' :: PhyloSimilarity -> Double -> [(Pointer,[Int])] -> [(Pointer,[Int])]
 filterPointers' proxi thr pts = filter (\((_,w),_) -> filterSimilarity proxi thr w) pts
 
 
@@ -231,7 +231,7 @@ groupsToBranches groups =
 {- 
 -- find the best pair/singleton of parents/childs for a given group
 -}
-makePairs :: (PhyloGroupId,[Int]) -> [(PhyloGroupId,[Int])] -> [Period] -> [Pointer] -> Filiation -> Double -> Similarity
+makePairs :: (PhyloGroupId,[Int]) -> [(PhyloGroupId,[Int])] -> [Period] -> [Pointer] -> Filiation -> Double -> PhyloSimilarity
            -> Map Date Double -> Map Date Cooc -> [((PhyloGroupId,[Int]),(PhyloGroupId,[Int]))]
 makePairs (egoId, egoNgrams) candidates periods oldPointers fil thr prox docs diagos =
     if (null periods)
@@ -258,7 +258,7 @@ makePairs (egoId, egoNgrams) candidates periods oldPointers fil thr prox docs di
 {- 
 -- find the best temporal links between a given group and its parents/childs
 -}
-phyloGroupMatching :: [[(PhyloGroupId,[Int])]] -> Filiation -> Similarity -> Map Date Double -> Map Date Cooc
+phyloGroupMatching :: [[(PhyloGroupId,[Int])]] -> Filiation -> PhyloSimilarity -> Map Date Double -> Map Date Cooc
                    -> Double -> [Pointer] -> (PhyloGroupId,[Int]) -> [Pointer]
 phyloGroupMatching candidates filiation proxi docs diagos thr oldPointers (id,ngrams) =
         if (null $ filterPointers proxi thr oldPointers)
@@ -329,7 +329,7 @@ getCandidates minNgrams ego targets =
 {- 
 -- set up and start performing the upstream/downstream inter‐temporal matching period by period
 -}
-reconstructTemporalLinks :: Int -> [Period] -> Similarity -> Double -> Map Date Double -> Map Date Cooc -> [PhyloGroup] -> [PhyloGroup]
+reconstructTemporalLinks :: Int -> [Period] -> PhyloSimilarity -> Double -> Map Date Double -> Map Date Cooc -> [PhyloGroup] -> [PhyloGroup]
 reconstructTemporalLinks frame periods similarity thr docs coocs groups =
   let groups' = groupByField _phylo_groupPeriod groups
    in foldl' (\acc prd ->
@@ -396,7 +396,7 @@ filterByNgrams inf ngrams groups =
 {- 
 -- perform the upstream/downstream inter‐temporal matching process group by group
 -}
-reconstructTemporalLinks' :: Int -> [Period] -> Similarity -> Double -> Map Date Double -> Map Date Cooc -> Map Int [PhyloGroupId] -> [PhyloGroup] -> [PhyloGroup]
+reconstructTemporalLinks' :: Int -> [Period] -> PhyloSimilarity -> Double -> Map Date Double -> Map Date Cooc -> Map Int [PhyloGroupId] -> [PhyloGroup] -> [PhyloGroup]
 reconstructTemporalLinks' frame periods similarity thr docs coocs roots groups = 
   let egos = map (\ego ->
                 let -- 1) find the parents/childs matching periods
@@ -432,7 +432,7 @@ reconstructTemporalLinks' frame periods similarity thr docs coocs roots groups =
 {- 
 -- reconstruct a phylomemetic network from a list of groups and from a given threshold
 -}
-toPhylomemeticNetwork :: Int -> [Period] -> Similarity -> Double -> Map Date Double -> Map Date Cooc -> Map Int [PhyloGroupId] -> [PhyloGroup] -> [Branch]
+toPhylomemeticNetwork :: Int -> [Period] -> PhyloSimilarity -> Double -> Map Date Double -> Map Date Cooc -> Map Int [PhyloGroupId] -> [PhyloGroup] -> [Branch]
 toPhylomemeticNetwork timescale periods similarity thr docs coocs roots groups = 
   groupsToBranches $ fromList $ map (\g -> (getGroupId g, g))
                    -- $ reconstructTemporalLinks timescale periods similarity thr docs coocs groups
@@ -592,7 +592,7 @@ thrToMeta thr branches =
 -- done = all the already separated branches
 -- rest = all the branches we still have to separate
 -}
-separateBranches :: Double -> Similarity -> Double -> Map Int Double -> Int -> Double -> Double
+separateBranches :: Double -> PhyloSimilarity -> Double -> Map Int Double -> Int -> Double -> Double
               -> Int -> Map Date Double -> Map Date Cooc -> Map Int [PhyloGroupId] -> [Period] 
               -> [(Branch,ShouldTry)] -> (Branch,ShouldTry) -> [(Branch,ShouldTry)] 
               -> [(Branch,ShouldTry)]
@@ -647,7 +647,7 @@ separateBranches fdt similarity lambda frequency minBranch thr rise timescale do
 {- 
 -- perform the sea-level rise algorithm, browse the similarity ladder and check that we can try out the next step
 -}
-seaLevelRise :: Double -> Similarity -> Double -> Int -> Map Int Double 
+seaLevelRise :: Double -> PhyloSimilarity -> Double -> Int -> Map Int Double 
              -> [Double] -> Double
              -> Int -> [Period] 
              -> Map Date Double -> Map Date Cooc 
@@ -717,4 +717,4 @@ temporalMatching ladder phylo = updatePhyloGroups 1
                          (getDocsByDate phylo)
                          (getCoocByDate phylo)
                          ((phylo ^. phylo_foundations) ^. foundations_rootsInGroups)
-                         (traceTemporalMatching $ getGroupsFromScale 1 phylo)
\ No newline at end of file
+                         (traceTemporalMatching $ getGroupsFromScale 1 phylo)