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        (last,head,union,concat,null)
  21 import Data.Map         (Map,elems,adjust,unionWith,intersectionWith,intersection,size)
  22 import Data.Set         (Set)
  23 import Data.Tuple       (fst, snd)
  24
  25 import Gargantext.Prelude             hiding (head)
  26 import Gargantext.Viz.Phylo
  27 import Gargantext.Viz.Phylo.Tools
  28
  29 import qualified Data.List   as List
  30 import qualified Data.Map    as Map
  31 import qualified Data.Set    as Set
  32
  33
  34 -- | To process the weightedLogJaccard between two PhyloGroup fields
  35 weightedLogJaccard :: Double -> Map (Int, Int) Double -> Map (Int, Int) Double -> Double
  36 weightedLogJaccard s f1 f2
  37   | null wUnion      = 0
  38   | wUnion == wInter = 1
  39   | s == 0           = (fromIntegral $ length wInter)/(fromIntegral $ length wUnion)
  40   | s > 0            = (sumInvLog wInter)/(sumInvLog wUnion)
  41   | otherwise        = (sumLog wInter)/(sumLog wUnion)
  42   where
  43     --------------------------------------
  44     wInter :: [Double]
  45     wInter = elems $ intersectionWith (+) f1 f2
  46     --------------------------------------
  47     wUnion :: [Double]
  48     wUnion = elems $ unionWith (+) f1 f2
  49     --------------------------------------
  50     sumInvLog :: [Double] -> Double
  51     sumInvLog l = foldl (\mem x -> mem + (1 / log (s + x))) 0 l
  52     --------------------------------------
  53     sumLog :: [Double] -> Double
  54     sumLog l = foldl (\mem x -> mem + log (s + x)) 0 l
  55     --------------------------------------
  56
  57
  58 -- | To process the Hamming distance between two PhyloGroup fields
  59 hamming :: Map (Int, Int) Double -> Map (Int, Int) Double -> Double
  60 hamming f1 f2 = fromIntegral $ max ((size inter) - (size f1)) ((size inter) - (size f2))
  61   where
  62     --------------------------------------
  63     inter :: Map (Int, Int) Double
  64     inter = intersection f1 f2
  65     --------------------------------------