{-|
Module      : Gargantext.Viz.Phylo.Tools
Description : Phylomemy Tools to build/manage it
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX


-}

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE OverloadedStrings #-}

module Gargantext.Viz.Phylo.LinkMaker
  where

import Control.Lens                 hiding (both, Level)
import Data.List                    ((++), sortOn, null, tail, splitAt, elem, concat, sort, delete)
import Data.Tuple.Extra
import Data.Map                     (Map,(!))
import Gargantext.Prelude
import Gargantext.Viz.Phylo
import Gargantext.Viz.Phylo.Tools
import Gargantext.Viz.Phylo.Metrics.Proximity
import qualified Data.List  as List
import qualified Data.Maybe as Maybe
import qualified Data.Map as Map

import qualified Data.Vector.Storable as VS
import Debug.Trace (trace)
import Numeric.Statistics (percentile)


------------------------------------------------------------------------
-- | Make links from Level to Level


-- | To choose a LevelLink strategy based an a given Level
shouldLink :: (Level,Level) -> PhyloGroup -> PhyloGroup -> Bool
shouldLink (lvl,_lvl) g g'
  | lvl <= 1  = doesContainsOrd (getGroupNgrams g) (getGroupNgrams g')
  | lvl >  1  = elem (getGroupId g) (getGroupLevelChildsId g')
  | otherwise = panic ("[ERR][Viz.Phylo.LinkMaker.shouldLink] Level not defined")


-- | To set the LevelLinks between a given PhyloGroup and a list of childs/parents PhyloGroups
linkGroupToGroups :: (Level,Level) -> PhyloGroup -> [PhyloGroup] -> PhyloGroup
linkGroupToGroups (lvl,lvl') current targets
  | lvl < lvl' = setLevelParents current
  | lvl > lvl' = setLevelChilds current
  | otherwise = current
  where
    --------------------------------------
    setLevelChilds :: PhyloGroup -> PhyloGroup
    setLevelChilds =  over (phylo_groupLevelChilds) addPointers
    --------------------------------------
    setLevelParents :: PhyloGroup -> PhyloGroup
    setLevelParents =  over (phylo_groupLevelParents) addPointers
    --------------------------------------
    addPointers :: [Pointer] -> [Pointer]
    addPointers lp = lp ++ Maybe.mapMaybe (\target ->
                                            if shouldLink (lvl,lvl') current target
                                            then Just ((getGroupId target),1)
                                            else Nothing) targets
    --------------------------------------


-- | To set the LevelLinks between two lists of PhyloGroups
linkGroupsByLevel :: (Level,Level) -> Phylo -> [PhyloGroup] -> [PhyloGroup]
linkGroupsByLevel (lvl,lvl') p groups  = map (\group ->
                                              if getGroupLevel group == lvl
                                              then linkGroupToGroups (lvl,lvl') group (getGroupsWithFilters lvl' (getGroupPeriod group) p)
                                              else group) groups


-- | To set the LevelLink of all the PhyloGroups of a Phylo
setLevelLinks :: (Level,Level) -> Phylo -> Phylo
setLevelLinks (lvl,lvl') p = alterPhyloGroups (linkGroupsByLevel (lvl,lvl') p) p


------------------------------------------------------------------------
-- | Make links from Period to Period


-- | To apply the corresponding proximity function based on a given Proximity
applyProximity :: Proximity -> PhyloGroup -> PhyloGroup -> (PhyloGroupId, Double)
applyProximity prox g1 g2 = case prox of
  WeightedLogJaccard (WLJParams _ s) -> ((getGroupId g2),weightedLogJaccard s (getGroupCooc g1) (unifySharedKeys (getGroupCooc g2) (getGroupCooc g1)))
  Hamming (HammingParams _)          -> ((getGroupId g2),hamming (getGroupCooc g1) (unifySharedKeys (getGroupCooc g2) (getGroupCooc g1)))
  _                                  -> panic ("[ERR][Viz.Phylo.Example.applyProximity] Proximity function not defined")


-- | To get the next or previous PhyloPeriod based on a given PhyloPeriodId
getNextPeriods :: Filiation -> PhyloPeriodId -> [PhyloPeriodId] -> [PhyloPeriodId]
getNextPeriods to' id l = case to' of
    Descendant -> (tail . snd) next
    Ascendant  -> (reverse . fst) next
    _          -> panic ("[ERR][Viz.Phylo.Example.getNextPeriods] Filiation type not defined")
    where
      --------------------------------------
      next :: ([PhyloPeriodId], [PhyloPeriodId])
      next = splitAt idx l
      --------------------------------------
      idx :: Int
      idx = case (List.elemIndex id l) of
        Nothing -> panic ("[ERR][Viz.Phylo.Example.getNextPeriods] PhyloPeriodId not defined")
        Just i  -> i
      --------------------------------------


-- | To find the best candidates regarding a given proximity
findBestCandidates' :: Filiation -> Int -> Int -> Proximity -> [PhyloPeriodId] -> [PhyloGroup] -> PhyloGroup -> ([Pointer],[Double])
findBestCandidates' fil depth limit prox prds gs g 
  | depth > limit || null next = ([],[])
  | (not . null) bestScores    = (take 2 bestScores, map snd scores)
  | otherwise                  = findBestCandidates' fil (depth + 1) limit prox prds gs g
  where
    --------------------------------------
    next :: [PhyloPeriodId]
    next = take depth prds
    --------------------------------------
    candidates :: [PhyloGroup]
    candidates = filter (\g' -> elem (getGroupPeriod g') next) gs 
    --------------------------------------
    scores :: [(PhyloGroupId, Double)]
    scores = map (\g' -> applyProximity prox g g') candidates
    --------------------------------------       
    bestScores :: [(PhyloGroupId, Double)]
    bestScores = reverse
               $ sortOn snd
               $ filter (\(_id,score) -> case prox of
                  WeightedLogJaccard (WLJParams thr _) -> score >= thr
                  Hamming (HammingParams thr)          -> score <= thr
                  Filiation                            -> panic "[ERR][Viz.Phylo.LinkMaker.findBestCandidates] Filiation"
                  ) scores
    --------------------------------------               


-- | To add some Pointer to a PhyloGroup
addPointers' :: Filiation -> [Pointer] -> PhyloGroup -> PhyloGroup
addPointers' fil pts g = g & case fil of 
   Descendant -> phylo_groupPeriodChilds  %~ (++ pts)
   Ascendant  -> phylo_groupPeriodParents %~ (++ pts)
   _          -> panic ("[ERR][Viz.Phylo.LinkMaker.addPointers] Wrong type of filiation")



-- | To update a list of pkyloGroups with some Pointers
updateGroups :: Filiation -> Level -> Map PhyloGroupId [Pointer] -> Phylo -> Phylo 
updateGroups fil lvl m p = alterPhyloGroups (\gs -> map (\g -> if (getGroupLevel g) == lvl
                                                               then addPointers' fil (m ! (getGroupId g)) g
                                                                else g ) gs) p



-- | To apply the intertemporal matching to Phylo at a given level
interTempoMatching :: Filiation -> Level -> Proximity -> Phylo -> Phylo
interTempoMatching fil lvl prox p = traceMatching fil lvl scores
                                  $ updateGroups fil lvl pointers p
  where
    --------------------------------------
    pointers :: Map PhyloGroupId [Pointer]
    pointers = Map.fromList $ map (\(id,x) -> (id,fst x)) candidates
    --------------------------------------
    scores :: [Double]
    scores = sort $ concat $ map (snd . snd) candidates 
    -------------------------------------- 
    candidates :: [(PhyloGroupId,([Pointer],[Double]))]
    candidates = map (\g -> ( getGroupId g, findBestCandidates' fil 1 5 prox (getNextPeriods fil (getGroupPeriod g) prds) (delete g gs) g)) gs
    --------------------------------------
    gs :: [PhyloGroup]
    gs = getGroupsWithLevel lvl p
    --------------------------------------
    prds :: [PhyloPeriodId]
    prds = getPhyloPeriods p
    --------------------------------------


----------------
-- | Tracer | --
----------------


traceMatching :: Filiation -> Level -> [Double] -> Phylo -> Phylo
traceMatching fil lvl lst p = trace ( "----\n" <> show (fil) <> " unfiltered temporal Matching in Phylo" <> show (lvl) <> " :\n"
                                      <> "count : " <> show (length lst) <> " potential pointers\n"
                                      <> "similarity : " <> show (percentile 25 (VS.fromList lst)) <> " (25%) "
                                                         <> show (percentile 50 (VS.fromList lst)) <> " (50%) "
                                                         <> show (percentile 75 (VS.fromList lst)) <> " (75%) "
                                                         <> show (percentile 90 (VS.fromList lst)) <> " (90%)\n") p