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,keys)
  22 import Gargantext.Prelude
  23 -- import Debug.Trace (trace)
  24
  25 sumInvLog :: Double -> [Double] -> Double
  26 sumInvLog s l = foldl (\mem x -> mem + (1 / log (s + x))) 0 l
  27
  28 sumLog :: Double -> [Double] -> Double
  29 sumLog s l = foldl (\mem x -> mem + log (s + x)) 0 l
  30
  31
  32 -- | To process WeighedLogJaccard distance between to coocurency matrix
  33 weightedLogJaccard :: Double -> Map (Int, Int) Double -> Map (Int, Int) Double -> Double -> Double
  34 weightedLogJaccard sens cooc cooc' nbDocs
  35   | null union'      = 0
  36   | union' == inter' = 1
  37   | sens == 0        = (fromIntegral $ length $ keys inter') / (fromIntegral $ length $ keys union')
  38   | sens > 0         = (sumInvLog sens $ elems wInter) / (sumInvLog sens $ elems wUnion)
  39   | otherwise        = (sumLog sens $ elems wInter) / (sumLog sens $ elems wUnion)
  40   where
  41     --------------------------------------
  42     wInter :: Map (Int,Int) Double
  43     wInter = map (/nbDocs) inter'
  44     --------------------------------------
  45     wUnion :: Map (Int,Int) Double
  46     wUnion = map (/nbDocs) union'
  47     --------------------------------------
  48     inter' :: Map (Int, Int) Double
  49     inter' = intersectionWith (+) cooc cooc'
  50     --------------------------------------
  51     union' :: Map (Int, Int) Double
  52     union' = unionWith (+) cooc cooc'
  53     --------------------------------------
  54
  55
  56 -- | To process the Hamming distance between two PhyloGroup fields
  57 hamming :: Map (Int, Int) Double -> Map (Int, Int) Double -> Double
  58 hamming f1 f2 = fromIntegral $ max ((size inter) - (size f1)) ((size inter) - (size f2))
  59   where
  60     --------------------------------------
  61     inter :: Map (Int, Int) Double
  62     inter = intersection f1 f2
  63     --------------------------------------