{-|
Module      : Gargantext.Graph.Distances.Utils
Description : Tools to compute distances from Cooccurrences
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX

Basically @compute@ takes an accelerate function as first input, a Map
of coccurrences as second input and outputs a Map automatically using
indexes.

TODO:
--cooc2fgl :: Ord t, Integral n => Map (t, t) n -> Graph
--fgl2json

-}

{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE TypeOperators     #-}
{-# LANGUAGE MonoLocalBinds    #-}

module Gargantext.Core.Viz.Graph.Index
  where

import qualified Data.Array.Accelerate as A
import qualified Data.Array.Accelerate.Interpreter as A
import Data.Array.Accelerate (Matrix, Elt, Shape, (:.)(..), Z(..))

import Data.Maybe (fromMaybe, catMaybes)

import Data.Set (Set)
import qualified Data.Set as S

import Data.Map (Map)
import qualified Data.Map.Strict    as M

-- import Data.Vector (Vector)

import Gargantext.Prelude

type Index    = Int

-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
score :: (Ord t) => MatrixShape
                 -> (A.Matrix Int -> A.Matrix Double)
                 -> Map (t, t) Int
                 -> Map (t, t) Double
score :: MatrixShape
-> (Matrix Int -> Matrix Double)
-> Map (t, t) Int
-> Map (t, t) Double
score MatrixShape
s Matrix Int -> Matrix Double
f Map (t, t) Int
m = Map Int t -> Map (Int, Int) Double -> Map (t, t) Double
forall t a. Ord t => Map Int t -> Map (Int, Int) a -> Map (t, t) a
fromIndex Map Int t
fromI (Map (Int, Int) Double -> Map (t, t) Double)
-> (Matrix Int -> Map (Int, Int) Double)
-> Matrix Int
-> Map (t, t) Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matrix Double -> Map (Int, Int) Double
forall a.
(Elt a, Shape (Z :. Int)) =>
Array ((Z :. Int) :. Int) a -> Map (Int, Int) a
mat2map (Matrix Double -> Map (Int, Int) Double)
-> (Matrix Int -> Matrix Double)
-> Matrix Int
-> Map (Int, Int) Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matrix Int -> Matrix Double
f (Matrix Int -> Map (t, t) Double)
-> Matrix Int -> Map (t, t) Double
forall a b. (a -> b) -> a -> b
$ MatrixShape -> Map t Int -> Map (t, t) Int -> Matrix Int
forall t.
Ord t =>
MatrixShape -> Map t Int -> Map (t, t) Int -> Matrix Int
cooc2mat MatrixShape
s Map t Int
toI Map (t, t) Int
m
  where
    (Map t Int
toI, Map Int t
fromI) = Map (t, t) Int -> (Map t Int, Map Int t)
forall t b. Ord t => Map (t, t) b -> (Map t Int, Map Int t)
createIndices Map (t, t) Int
m

-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
cooc2mat :: Ord t => MatrixShape -> Map t Index -> Map (t, t) Int -> Matrix Int
cooc2mat :: MatrixShape -> Map t Int -> Map (t, t) Int -> Matrix Int
cooc2mat MatrixShape
sym Map t Int
ti Map (t, t) Int
m = MatrixShape -> Int -> Int -> Map (Int, Int) Int -> Matrix Int
forall a.
Elt a =>
MatrixShape -> a -> Int -> Map (Int, Int) a -> Matrix a
map2mat MatrixShape
sym Int
0 Int
n Map (Int, Int) Int
idx
  where
    n :: Int
n = Map t Int -> Int
forall k a. Map k a -> Int
M.size Map t Int
ti
    idx :: Map (Int, Int) Int
idx = Map t Int -> Map (t, t) Int -> Map (Int, Int) Int
forall t a. Ord t => Map t Int -> Map (t, t) a -> Map (Int, Int) a
toIndex Map t Int
ti Map (t, t) Int
m -- it is important to make sure that toIndex is ran only once.

data MatrixShape = Triangle | Square

map2mat :: Elt a => MatrixShape -> a -> Int -> Map (Index, Index) a -> Matrix a
map2mat :: MatrixShape -> a -> Int -> Map (Int, Int) a -> Matrix a
map2mat MatrixShape
sym a
def Int
n Map (Int, Int) a
m = ((Z :. Int) :. Int) -> (((Z :. Int) :. Int) -> a) -> Matrix a
forall sh e. (Shape sh, Elt e) => sh -> (sh -> e) -> Array sh e
A.fromFunction (Z :. Int) :. Int
shape ((Z :. Int) :. Int) -> a
getData
  where
    getData :: ((Z :. Int) :. Int) -> a
getData = (\(Z
Z :. Int
x :. Int
y) ->
      case MatrixShape
sym of
        MatrixShape
Triangle -> a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
def ((Int, Int) -> Map (Int, Int) a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Int
x,Int
y) Map (Int, Int) a
m)
        MatrixShape
Square   -> a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe (a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
def (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Map (Int, Int) a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Int
y,Int
x) Map (Int, Int) a
m)
                                             (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Map (Int, Int) a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Int
x,Int
y) Map (Int, Int) a
m
                                             )
    shape :: (Z :. Int) :. Int
shape   = (Z
Z Z -> Int -> Z :. Int
forall tail head. tail -> head -> tail :. head
:. Int
n (Z :. Int) -> Int -> (Z :. Int) :. Int
forall tail head. tail -> head -> tail :. head
:. Int
n)

mat2map :: (Elt a, Shape (Z :. Index)) =>
            A.Array (Z :. Index :. Index) a -> Map (Index, Index) a
mat2map :: Array ((Z :. Int) :. Int) a -> Map (Int, Int) a
mat2map Array ((Z :. Int) :. Int) a
m = [((Int, Int), a)] -> Map (Int, Int) a
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([((Int, Int), a)] -> Map (Int, Int) a)
-> (Acc (Array ((Z :. Int) :. Int) a) -> [((Int, Int), a)])
-> Acc (Array ((Z :. Int) :. Int) a)
-> Map (Int, Int) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Z :. Int) :. Int, a) -> ((Int, Int), a))
-> [((Z :. Int) :. Int, a)] -> [((Int, Int), a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ((Z :. Int) :. Int, a) -> ((Int, Int), a)
forall a b b. ((Z :. a) :. b, b) -> ((a, b), b)
f ([((Z :. Int) :. Int, a)] -> [((Int, Int), a)])
-> (Acc (Array ((Z :. Int) :. Int) a) -> [((Z :. Int) :. Int, a)])
-> Acc (Array ((Z :. Int) :. Int) a)
-> [((Int, Int), a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array ((Z :. Int) :. Int) ((Z :. Int) :. Int, a)
-> [((Z :. Int) :. Int, a)]
forall sh e. Array sh e -> [e]
A.toList (Array ((Z :. Int) :. Int) ((Z :. Int) :. Int, a)
 -> [((Z :. Int) :. Int, a)])
-> (Acc (Array ((Z :. Int) :. Int) a)
    -> Array ((Z :. Int) :. Int) ((Z :. Int) :. Int, a))
-> Acc (Array ((Z :. Int) :. Int) a)
-> [((Z :. Int) :. Int, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Acc (Array ((Z :. Int) :. Int) ((Z :. Int) :. Int, a))
-> Array ((Z :. Int) :. Int) ((Z :. Int) :. Int, a)
forall a. Arrays a => Acc a -> a
A.run (Acc (Array ((Z :. Int) :. Int) ((Z :. Int) :. Int, a))
 -> Array ((Z :. Int) :. Int) ((Z :. Int) :. Int, a))
-> (Acc (Array ((Z :. Int) :. Int) a)
    -> Acc (Array ((Z :. Int) :. Int) ((Z :. Int) :. Int, a)))
-> Acc (Array ((Z :. Int) :. Int) a)
-> Array ((Z :. Int) :. Int) ((Z :. Int) :. Int, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Acc (Array ((Z :. Int) :. Int) a)
-> Acc (Array ((Z :. Int) :. Int) ((Z :. Int) :. Int, a))
forall sh a.
(Shape sh, Elt a) =>
Acc (Array sh a) -> Acc (Array sh (sh, a))
A.indexed (Acc (Array ((Z :. Int) :. Int) a) -> Map (Int, Int) a)
-> Acc (Array ((Z :. Int) :. Int) a) -> Map (Int, Int) a
forall a b. (a -> b) -> a -> b
$ Array ((Z :. Int) :. Int) a -> Acc (Array ((Z :. Int) :. Int) a)
forall arrays. Arrays arrays => arrays -> Acc arrays
A.use Array ((Z :. Int) :. Int) a
m
  where
    -- Z :. _ :. n = A.arrayShape m
    f :: ((Z :. a) :. b, b) -> ((a, b), b)
f ((Z
Z :. a
i :. b
j), b
x) = ((a
i, b
j), b
x)

-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
toIndex :: Ord t
        => Map t Index
        -> Map (t,t) a
        -> Map (Index,Index) a
toIndex :: Map t Int -> Map (t, t) a -> Map (Int, Int) a
toIndex = Map t Int -> Map (t, t) a -> Map (Int, Int) a
forall b k a.
(Ord b, Ord k) =>
Map k b -> Map (k, k) a -> Map (b, b) a
indexConversion

fromIndex :: Ord t => Map Index t -> Map (Index, Index) a -> Map (t,t) a
fromIndex :: Map Int t -> Map (Int, Int) a -> Map (t, t) a
fromIndex Map Int t
ni Map (Int, Int) a
ns = Map Int t -> Map (Int, Int) a -> Map (t, t) a
forall b k a.
(Ord b, Ord k) =>
Map k b -> Map (k, k) a -> Map (b, b) a
indexConversion Map Int t
ni Map (Int, Int) a
ns

indexConversion :: (Ord b, Ord k) => Map k b -> Map (k,k) a -> Map (b, b) a
indexConversion :: Map k b -> Map (k, k) a -> Map (b, b) a
indexConversion Map k b
index Map (k, k) a
ms = [((b, b), a)] -> Map (b, b) a
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
                         ([((b, b), a)] -> Map (b, b) a) -> [((b, b), a)] -> Map (b, b) a
forall a b. (a -> b) -> a -> b
$ [Maybe ((b, b), a)] -> [((b, b), a)]
forall a. [Maybe a] -> [a]
catMaybes
                         ([Maybe ((b, b), a)] -> [((b, b), a)])
-> [Maybe ((b, b), a)] -> [((b, b), a)]
forall a b. (a -> b) -> a -> b
$ (((k, k), a) -> Maybe ((b, b), a))
-> [((k, k), a)] -> [Maybe ((b, b), a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\((k
k1,k
k2),a
c) -> ((,) ((b, b) -> a -> ((b, b), a))
-> Maybe (b, b) -> Maybe (a -> ((b, b), a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,) (b -> b -> (b, b)) -> Maybe b -> Maybe (b -> (b, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> Map k b -> Maybe b
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
k1 Map k b
index Maybe (b -> (b, b)) -> Maybe b -> Maybe (b, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> k -> Map k b -> Maybe b
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
k2 Map k b
index)
                                                      Maybe (a -> ((b, b), a)) -> Maybe a -> Maybe ((b, b), a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> Maybe a
forall a. a -> Maybe a
Just a
c)
                                )
                         ([((k, k), a)] -> [Maybe ((b, b), a)])
-> [((k, k), a)] -> [Maybe ((b, b), a)]
forall a b. (a -> b) -> a -> b
$ Map (k, k) a -> [((k, k), a)]
forall k a. Map k a -> [(k, a)]
M.toList Map (k, k) a
ms
---------------------------------------------------------------------------------

-------------------------------------------------------------------------------
--fromIndex' :: Ord t => Vector t -> Map (Index, Index) a -> Map (t,t) a
--fromIndex' vi ns = undefined

-- TODO: returing a Vector should be faster than a Map
-- createIndices' :: Ord t => Map (t, t) b -> (Map t Index, Vector t)
-- createIndices' = undefined

createIndices :: Ord t => Map (t, t) b -> (Map t Index, Map Index t)
createIndices :: Map (t, t) b -> (Map t Int, Map Int t)
createIndices = Set t -> (Map t Int, Map Int t)
forall t. Ord t => Set t -> (Map t Int, Map Int t)
set2indices (Set t -> (Map t Int, Map Int t))
-> (Map (t, t) b -> Set t)
-> Map (t, t) b
-> (Map t Int, Map Int t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (t, t) b -> Set t
forall t a. Ord t => Map (t, t) a -> Set t
map2set
  where
    map2set :: Ord t => Map (t, t) a -> Set t
    map2set :: Map (t, t) a -> Set t
map2set Map (t, t) a
cs' = (Set t -> ((t, t), a) -> Set t) -> Set t -> [((t, t), a)] -> Set t
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Set t
s ((t
t1,t
t2),a
_) -> [t] -> Set t -> Set t
forall (t :: * -> *) a.
(Foldable t, Ord a) =>
t a -> Set a -> Set a
insert [t
t1,t
t2] Set t
s ) Set t
forall a. Set a
S.empty (Map (t, t) a -> [((t, t), a)]
forall k a. Map k a -> [(k, a)]
M.toList Map (t, t) a
cs')
      where
        insert :: t a -> Set a -> Set a
insert t a
as Set a
s = (Set a -> a -> Set a) -> Set a -> t a -> Set a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Set a
s' a
t -> a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
S.insert a
t Set a
s') Set a
s t a
as

    set2indices :: Ord t => Set t -> (Map t Index, Map Index t)
    set2indices :: Set t -> (Map t Int, Map Int t)
set2indices Set t
s = ([(t, Int)] -> Map t Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(t, Int)]
toIndex', [(Int, t)] -> Map Int t
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Int, t)]
fromIndex')
      where
        fromIndex' :: [(Int, t)]
fromIndex' = [Int] -> [t] -> [(Int, t)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [t]
xs
        toIndex' :: [(t, Int)]
toIndex'   = [t] -> [Int] -> [(t, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [t]
xs [Int
0..]
        xs :: [t]
xs         = Set t -> [t]
forall a. Set a -> [a]
S.toList Set t
s