]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Viz/Phylo/Metrics/Proximity.hs
tune the threshold and sensibility of the WeightedLogJaccard
[gargantext.git] / src / Gargantext / Viz / Phylo / Metrics / Proximity.hs
1 {-|
2 Module : Gargantext.Viz.Phylo.Tools
3 Description : Phylomemy Tools to build/manage it
4 Copyright : (c) CNRS, 2017-Present
5 License : AGPL + CECILL v3
6 Maintainer : team@gargantext.org
7 Stability : experimental
8 Portability : POSIX
9
10
11 -}
12
13 {-# LANGUAGE NoImplicitPrelude #-}
14 {-# LANGUAGE FlexibleContexts #-}
15 {-# LANGUAGE OverloadedStrings #-}
16
17 module Gargantext.Viz.Phylo.Metrics.Proximity
18 where
19
20 import Data.List (null)
21 import Data.Map (Map,elems,unionWith,intersectionWith,intersection,size)
22 import Gargantext.Prelude
23 -- import Debug.Trace (trace)
24
25 -- | To process the weightedLogJaccard between two PhyloGroup fields
26 weightedLogJaccard :: Double -> Map (Int, Int) Double -> Map (Int, Int) Double -> Double
27 weightedLogJaccard s f1 f2
28 | null wUnion = 0
29 | wUnion == wInter = 1
30 | s == 0 = (fromIntegral $ length wInter)/(fromIntegral $ length wUnion)
31 | s > 0 = (sumInvLog wInter)/(sumInvLog wUnion)
32 | otherwise = (sumLog wInter)/(sumLog wUnion)
33 where
34 --------------------------------------
35 wInter :: [Double]
36 wInter = elems $ intersectionWith (+) f1 f2
37 --------------------------------------
38 wUnion :: [Double]
39 wUnion = elems $ unionWith (+) f1 f2
40 --------------------------------------
41 sumInvLog :: [Double] -> Double
42 sumInvLog l = foldl (\mem x -> mem + (1 / log (s + x))) 0 l
43 --------------------------------------
44 sumLog :: [Double] -> Double
45 sumLog l = foldl (\mem x -> mem + log (s + x)) 0 l
46 --------------------------------------
47
48
49 -- | To process the Hamming distance between two PhyloGroup fields
50 hamming :: Map (Int, Int) Double -> Map (Int, Int) Double -> Double
51 hamming f1 f2 = fromIntegral $ max ((size inter) - (size f1)) ((size inter) - (size f2))
52 where
53 --------------------------------------
54 inter :: Map (Int, Int) Double
55 inter = intersection f1 f2
56 --------------------------------------