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     --------------------------------------