]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Core/Methods/Similarities/Conditional.hs
[FIX] Order 2 regression and split of clustering
[gargantext.git] / src / Gargantext / Core / Methods / Similarities / Conditional.hs
1 {-|
2 Module : Gargantext.Core.Methods.Similarities
3 Description :
4 Copyright : (c) CNRS, 2017-Present
5 License : AGPL + CECILL v3
6 Maintainer : team@gargantext.org
7 Stability : experimental
8 Portability : POSIX
9
10 Motivation and definition of the @Conditional@ distance.
11 -}
12
13 {-# LANGUAGE BangPatterns #-}
14 {-# LANGUAGE Strict #-}
15 module Gargantext.Core.Methods.Similarities.Conditional
16 where
17
18 import Control.DeepSeq (NFData)
19 import Control.Parallel.Strategies (parList, rdeepseq, using)
20 import Data.Hashable (Hashable)
21 import Data.List (unzip)
22 import Data.Maybe (catMaybes)
23 import Gargantext.Prelude
24 import Gargantext.Core.Viz.Graph.Utils (getMax)
25 import qualified Data.HashMap.Strict as Map
26 import qualified Data.Set as Set
27
28
29 type HashMap = Map.HashMap
30 ------------------------------------------------------------------------
31 -- First version as first implementation
32 -- - qualitatively verified
33 -- - parallized as main optimization
34 conditional :: (Ord a, Hashable a, NFData a)
35 => HashMap (a,a) Int
36 -> HashMap (a,a) Double
37 conditional m' = Map.fromList $ ((catMaybes results') `using` parList rdeepseq)
38 where
39 results' = [ let
40 ij = (/) <$> Map.lookup (i,j) m <*> Map.lookup (j,j) m
41 ji = (/) <$> Map.lookup (j,i) m <*> Map.lookup (i,i) m
42 in getMax (i,j) ij ji
43
44 | i <- keys
45 , j <- keys
46 , i < j
47 ]
48 -- Converting from Int to Double
49 m = Map.map fromIntegral m'
50
51 -- Get the matrix coordinates, removing duplicates
52 keys = Set.toList $ Set.fromList (x <> y)
53 (x,y) = unzip $ Map.keys m
54
55