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

-}

{-# LANGUAGE ScopedTypeVariables #-}

module Gargantext.Core.Viz.Graph.Tools
  where

-- import Data.Graph.Clustering.Louvain (hLouvain, {-iLouvainMap-})
import Data.HashMap.Strict (HashMap)
import Data.Map (Map)
import Data.Text (Text)
-- import Debug.Trace (trace)
import GHC.Float (sin, cos)
import Gargantext.API.Ngrams.Types (NgramsTerm(..))
import Gargantext.Core.Methods.Distances.Conditional (conditional)
import Gargantext.Core.Methods.Distances (Distance(..), measure)
import Gargantext.Core.Methods.Graph.BAC.Proxemy (confluence)
import Gargantext.Core.Statistics
import Gargantext.Core.Viz.Graph
import Gargantext.Core.Viz.Graph.Utils (edgesFilter)
import Gargantext.Core.Viz.Graph.Bridgeness (bridgeness, Partitions, ToComId(..))
import Gargantext.Core.Viz.Graph.Index (createIndices, toIndex, map2mat, mat2map, Index, MatrixShape(..))
import Gargantext.Core.Viz.Graph.Tools.IGraph (mkGraphUfromEdges, spinglass)
import Gargantext.Core.Viz.Graph.Types (ClusterNode)
import Gargantext.Prelude
-- import qualified Graph.BAC.ProxemyOptim as BAC
import IGraph.Random -- (Gen(..))
import qualified Data.HashMap.Strict      as HashMap
import qualified Data.List                as List
import qualified Data.Map                 as Map
import qualified Data.Set                 as Set
import qualified Data.Vector.Storable     as Vec
import qualified IGraph                   as Igraph
import qualified IGraph.Algorithms.Layout as Layout


-------------------------------------------------------------
defaultClustering :: Map (Int, Int) Double -> IO [ClusterNode]
-- defaultClustering x = pure $ BAC.defaultClustering x
defaultClustering :: Map (Int, Int) Double -> IO [ClusterNode]
defaultClustering Map (Int, Int) Double
x = Int -> Map (Int, Int) Double -> IO [ClusterNode]
spinglass Int
1 Map (Int, Int) Double
x

-------------------------------------------------------------
type Threshold = Double


cooc2graph' :: Ord t => Distance
                     -> Double
                     -> Map (t, t) Int
                     -> Map (Index, Index) Double
cooc2graph' :: Distance -> Double -> Map (t, t) Int -> Map (Int, Int) Double
cooc2graph' Distance
distance Double
threshold Map (t, t) Int
myCooc
    = (Double -> Bool) -> Map (Int, Int) Double -> Map (Int, Int) Double
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
threshold)
    (Map (Int, Int) Double -> Map (Int, Int) Double)
-> Map (Int, Int) Double -> Map (Int, Int) Double
forall a b. (a -> b) -> a -> b
$ Array ((Z :. Int) :. Int) Double -> Map (Int, Int) Double
forall a.
(Elt a, Shape (Z :. Int)) =>
Array ((Z :. Int) :. Int) a -> Map (Int, Int) a
mat2map
    (Array ((Z :. Int) :. Int) Double -> Map (Int, Int) Double)
-> Array ((Z :. Int) :. Int) Double -> Map (Int, Int) Double
forall a b. (a -> b) -> a -> b
$ Distance -> Matrix Int -> Array ((Z :. Int) :. Int) Double
measure Distance
distance
    (Matrix Int -> Array ((Z :. Int) :. Int) Double)
-> Matrix Int -> Array ((Z :. Int) :. Int) Double
forall a b. (a -> b) -> a -> b
$ case Distance
distance of
        Distance
Conditional    -> MatrixShape -> Int -> Int -> Map (Int, Int) Int -> Matrix Int
forall a.
Elt a =>
MatrixShape -> a -> Int -> Map (Int, Int) a -> Matrix a
map2mat MatrixShape
Triangle Int
0 Int
tiSize
        Distance
Distributional -> MatrixShape -> Int -> Int -> Map (Int, Int) Int -> Matrix Int
forall a.
Elt a =>
MatrixShape -> a -> Int -> Map (Int, Int) a -> Matrix a
map2mat MatrixShape
Square   Int
0 Int
tiSize
    (Map (Int, Int) Int -> Matrix Int)
-> Map (Int, Int) Int -> Matrix Int
forall a b. (a -> b) -> a -> b
$ (Int -> Bool) -> Map (Int, Int) Int -> Map (Int, Int) Int
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) Map (Int, Int) Int
myCooc'

     where
        (Map t Int
ti, Map Int t
_) = 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
myCooc
        tiSize :: Int
tiSize  = Map t Int -> Int
forall k a. Map k a -> Int
Map.size Map t Int
ti
        myCooc' :: Map (Int, Int) Int
myCooc' = 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
myCooc


data PartitionMethod = Louvain | Spinglass
-- Bac

-- coocurrences graph computation
cooc2graphWith :: PartitionMethod
               -> Distance
               -> Threshold
               -> HashMap (NgramsTerm, NgramsTerm) Int
               -> IO Graph
cooc2graphWith :: PartitionMethod
-> Distance
-> Double
-> HashMap (NgramsTerm, NgramsTerm) Int
-> IO Graph
cooc2graphWith PartitionMethod
Louvain   = Distance
-> Double -> HashMap (NgramsTerm, NgramsTerm) Int -> IO Graph
forall a. HasCallStack => a
undefined
cooc2graphWith PartitionMethod
Spinglass = (Map (Int, Int) Double -> IO [ClusterNode])
-> Distance
-> Double
-> HashMap (NgramsTerm, NgramsTerm) Int
-> IO Graph
forall a.
ToComId a =>
Partitions a
-> Distance
-> Double
-> HashMap (NgramsTerm, NgramsTerm) Int
-> IO Graph
cooc2graphWith' (Int -> Map (Int, Int) Double -> IO [ClusterNode]
spinglass Int
1)
-- cooc2graphWith Bac       = cooc2graphWith' (\x -> pure $ BAC.defaultClustering x)


cooc2graphWith' :: ToComId a
               => Partitions a
               -> Distance
               -> Threshold
               -> HashMap (NgramsTerm, NgramsTerm) Int
               -> IO Graph
cooc2graphWith' :: Partitions a
-> Distance
-> Double
-> HashMap (NgramsTerm, NgramsTerm) Int
-> IO Graph
cooc2graphWith' Partitions a
doPartitions Distance
distance Double
threshold HashMap (NgramsTerm, NgramsTerm) Int
myCooc = do
  let
    (Map (Int, Int) Double
distanceMap, Map (Int, Int) Int
diag, Map NgramsTerm Int
ti) = Distance
-> Double
-> HashMap (NgramsTerm, NgramsTerm) Int
-> (Map (Int, Int) Double, Map (Int, Int) Int, Map NgramsTerm Int)
doDistanceMap Distance
distance Double
threshold HashMap (NgramsTerm, NgramsTerm) Int
myCooc

    nodesApprox :: Int
    nodesApprox :: Int
nodesApprox = Int
n'
      where
        ([Int]
as, [Int]
bs) = [(Int, Int)] -> ([Int], [Int])
forall a b. [(a, b)] -> ([a], [b])
List.unzip ([(Int, Int)] -> ([Int], [Int])) -> [(Int, Int)] -> ([Int], [Int])
forall a b. (a -> b) -> a -> b
$ Map (Int, Int) Double -> [(Int, Int)]
forall k a. Map k a -> [k]
Map.keys Map (Int, Int) Double
distanceMap
        n' :: Int
n' = Set Int -> Int
forall a. Set a -> Int
Set.size (Set Int -> Int) -> Set Int -> Int
forall a b. (a -> b) -> a -> b
$ [Int] -> Set Int
forall a. Ord a => [a] -> Set a
Set.fromList ([Int] -> Set Int) -> [Int] -> Set Int
forall a b. (a -> b) -> a -> b
$ [Int]
as [Int] -> [Int] -> [Int]
forall a. Semigroup a => a -> a -> a
<> [Int]
bs

{- -- Debug
  saveAsFileDebug "debug/distanceMap" distanceMap
  printDebug "similarities" similarities
-}

  [a]
partitions <- if (Map (Int, Int) Double -> Int
forall k a. Map k a -> Int
Map.size Map (Int, Int) Double
distanceMap Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0)
      then Partitions a
doPartitions Map (Int, Int) Double
distanceMap
      else Text -> IO [a]
forall a. HasCallStack => Text -> a
panic Text
"Text.Flow: DistanceMap is empty"

  let
    bridgeness' :: Map (Int, Int) Double
bridgeness' = Double -> [a] -> Map (Int, Int) Double -> Map (Int, Int) Double
forall a.
ToComId a =>
Double -> [a] -> Map (Int, Int) Double -> Map (Int, Int) Double
bridgeness (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nodesApprox) [a]
partitions Map (Int, Int) Double
distanceMap

    confluence' :: Map (Int, Int) Double
confluence' = [(Int, Int)] -> Int -> Bool -> Bool -> Map (Int, Int) Double
confluence (Map (Int, Int) Double -> [(Int, Int)]
forall k a. Map k a -> [k]
Map.keys Map (Int, Int) Double
bridgeness') Int
3 Bool
True Bool
False

  Graph -> IO Graph
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Graph -> IO Graph) -> Graph -> IO Graph
forall a b. (a -> b) -> a -> b
$ [(Text, Int)]
-> Map (Int, Int) Int
-> Map (Int, Int) Double
-> Map (Int, Int) Double
-> [a]
-> Graph
forall a.
ToComId a =>
[(Text, Int)]
-> Map (Int, Int) Int
-> Map (Int, Int) Double
-> Map (Int, Int) Double
-> [a]
-> Graph
data2graph (Map Text Int -> [(Text, Int)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map Text Int -> [(Text, Int)]) -> Map Text Int -> [(Text, Int)]
forall a b. (a -> b) -> a -> b
$ (NgramsTerm -> Text) -> Map NgramsTerm Int -> Map Text Int
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys NgramsTerm -> Text
unNgramsTerm Map NgramsTerm Int
ti)
                    Map (Int, Int) Int
diag Map (Int, Int) Double
bridgeness' Map (Int, Int) Double
confluence' [a]
partitions


doDistanceMap :: Distance
              -> Threshold
              -> HashMap (NgramsTerm, NgramsTerm) Int
              -> ( Map (Int,Int) Double
                 , Map (Index, Index) Int
                 , Map NgramsTerm Index
                 )
doDistanceMap :: Distance
-> Double
-> HashMap (NgramsTerm, NgramsTerm) Int
-> (Map (Int, Int) Double, Map (Int, Int) Int, Map NgramsTerm Int)
doDistanceMap Distance
Distributional Double
threshold HashMap (NgramsTerm, NgramsTerm) Int
myCooc = (Map (Int, Int) Double
distanceMap, Map NgramsTerm Int
-> Map (NgramsTerm, NgramsTerm) Int -> Map (Int, Int) Int
forall t a. Ord t => Map t Int -> Map (t, t) a -> Map (Int, Int) a
toIndex Map NgramsTerm Int
ti Map (NgramsTerm, NgramsTerm) Int
diag, Map NgramsTerm Int
ti)
  where
    -- TODO remove below
    (Map (NgramsTerm, NgramsTerm) Int
diag, Map (NgramsTerm, NgramsTerm) Int
theMatrix) = ((NgramsTerm, NgramsTerm) -> Int -> Bool)
-> Map (NgramsTerm, NgramsTerm) Int
-> (Map (NgramsTerm, NgramsTerm) Int,
    Map (NgramsTerm, NgramsTerm) Int)
forall k a. (k -> a -> Bool) -> Map k a -> (Map k a, Map k a)
Map.partitionWithKey (\(NgramsTerm
x,NgramsTerm
y) Int
_ -> NgramsTerm
x NgramsTerm -> NgramsTerm -> Bool
forall a. Eq a => a -> a -> Bool
== NgramsTerm
y)
                      (Map (NgramsTerm, NgramsTerm) Int
 -> (Map (NgramsTerm, NgramsTerm) Int,
     Map (NgramsTerm, NgramsTerm) Int))
-> Map (NgramsTerm, NgramsTerm) Int
-> (Map (NgramsTerm, NgramsTerm) Int,
    Map (NgramsTerm, NgramsTerm) Int)
forall a b. (a -> b) -> a -> b
$ [((NgramsTerm, NgramsTerm), Int)]
-> Map (NgramsTerm, NgramsTerm) Int
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                      ([((NgramsTerm, NgramsTerm), Int)]
 -> Map (NgramsTerm, NgramsTerm) Int)
-> [((NgramsTerm, NgramsTerm), Int)]
-> Map (NgramsTerm, NgramsTerm) Int
forall a b. (a -> b) -> a -> b
$ HashMap (NgramsTerm, NgramsTerm) Int
-> [((NgramsTerm, NgramsTerm), Int)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap (NgramsTerm, NgramsTerm) Int
myCooc

    (Map NgramsTerm Int
ti, Map Int NgramsTerm
_it) = Map (NgramsTerm, NgramsTerm) Int
-> (Map NgramsTerm Int, Map Int NgramsTerm)
forall t b. Ord t => Map (t, t) b -> (Map t Int, Map Int t)
createIndices Map (NgramsTerm, NgramsTerm) Int
theMatrix
    tiSize :: Int
tiSize  = Map NgramsTerm Int -> Int
forall k a. Map k a -> Int
Map.size Map NgramsTerm Int
ti

{-
    matCooc = case distance of  -- Shape of the Matrix
                Conditional    -> map2mat Triangle 0 tiSize
                Distributional -> map2mat Square   0 tiSize
            $ toIndex ti theMatrix
    similarities = measure distance matCooc
-}

    similarities :: Array ((Z :. Int) :. Int) Double
similarities = Distance -> Matrix Int -> Array ((Z :. Int) :. Int) Double
measure Distance
Distributional
                 (Matrix Int -> Array ((Z :. Int) :. Int) Double)
-> Matrix Int -> Array ((Z :. Int) :. Int) Double
forall a b. (a -> b) -> a -> b
$ MatrixShape -> Int -> Int -> Map (Int, Int) Int -> Matrix Int
forall a.
Elt a =>
MatrixShape -> a -> Int -> Map (Int, Int) a -> Matrix a
map2mat MatrixShape
Square Int
0 Int
tiSize
                 (Map (Int, Int) Int -> Matrix Int)
-> Map (Int, Int) Int -> Matrix Int
forall a b. (a -> b) -> a -> b
$ Map NgramsTerm Int
-> Map (NgramsTerm, NgramsTerm) Int -> Map (Int, Int) Int
forall t a. Ord t => Map t Int -> Map (t, t) a -> Map (Int, Int) a
toIndex Map NgramsTerm Int
ti Map (NgramsTerm, NgramsTerm) Int
theMatrix

    links :: Int
links = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (let Double
n :: Double = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
tiSize in Double
n Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
log Double
n)

    distanceMap :: Map (Int, Int) Double
distanceMap = [((Int, Int), Double)] -> Map (Int, Int) Double
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                ([((Int, Int), Double)] -> Map (Int, Int) Double)
-> [((Int, Int), Double)] -> Map (Int, Int) Double
forall a b. (a -> b) -> a -> b
$ Int -> [((Int, Int), Double)] -> [((Int, Int), Double)]
forall a. Int -> [a] -> [a]
List.take Int
links
                ([((Int, Int), Double)] -> [((Int, Int), Double)])
-> [((Int, Int), Double)] -> [((Int, Int), Double)]
forall a b. (a -> b) -> a -> b
$ (((Int, Int), Double) -> Double)
-> [((Int, Int), Double)] -> [((Int, Int), Double)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn ((Int, Int), Double) -> Double
forall a b. (a, b) -> b
snd
                ([((Int, Int), Double)] -> [((Int, Int), Double)])
-> [((Int, Int), Double)] -> [((Int, Int), Double)]
forall a b. (a -> b) -> a -> b
$ Map (Int, Int) Double -> [((Int, Int), Double)]
forall k a. Map k a -> [(k, a)]
Map.toList
                (Map (Int, Int) Double -> [((Int, Int), Double)])
-> Map (Int, Int) Double -> [((Int, Int), Double)]
forall a b. (a -> b) -> a -> b
$ Map (Int, Int) Double -> Map (Int, Int) Double
forall a b. (Ord a, Ord b) => Map (a, a) b -> Map (a, a) b
edgesFilter
                (Map (Int, Int) Double -> Map (Int, Int) Double)
-> Map (Int, Int) Double -> Map (Int, Int) Double
forall a b. (a -> b) -> a -> b
$ (Double -> Bool) -> Map (Int, Int) Double -> Map (Int, Int) Double
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
threshold)
                (Map (Int, Int) Double -> Map (Int, Int) Double)
-> Map (Int, Int) Double -> Map (Int, Int) Double
forall a b. (a -> b) -> a -> b
$ Array ((Z :. Int) :. Int) Double -> Map (Int, Int) Double
forall a.
(Elt a, Shape (Z :. Int)) =>
Array ((Z :. Int) :. Int) a -> Map (Int, Int) a
mat2map Array ((Z :. Int) :. Int) Double
similarities

doDistanceMap Distance
Conditional Double
_threshold HashMap (NgramsTerm, NgramsTerm) Int
myCooc = (Map (Int, Int) Double
distanceMap, Map NgramsTerm Int
-> Map (NgramsTerm, NgramsTerm) Int -> Map (Int, Int) Int
forall t a. Ord t => Map t Int -> Map (t, t) a -> Map (Int, Int) a
toIndex Map NgramsTerm Int
ti Map (NgramsTerm, NgramsTerm) Int
myCooc', Map NgramsTerm Int
ti)
  where
    myCooc' :: Map (NgramsTerm, NgramsTerm) Int
myCooc' = [((NgramsTerm, NgramsTerm), Int)]
-> Map (NgramsTerm, NgramsTerm) Int
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([((NgramsTerm, NgramsTerm), Int)]
 -> Map (NgramsTerm, NgramsTerm) Int)
-> [((NgramsTerm, NgramsTerm), Int)]
-> Map (NgramsTerm, NgramsTerm) Int
forall a b. (a -> b) -> a -> b
$ HashMap (NgramsTerm, NgramsTerm) Int
-> [((NgramsTerm, NgramsTerm), Int)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap (NgramsTerm, NgramsTerm) Int
myCooc
    (Map NgramsTerm Int
ti, Map Int NgramsTerm
_it) = Map (NgramsTerm, NgramsTerm) Int
-> (Map NgramsTerm Int, Map Int NgramsTerm)
forall t b. Ord t => Map (t, t) b -> (Map t Int, Map Int t)
createIndices Map (NgramsTerm, NgramsTerm) Int
myCooc'
    -- tiSize  = Map.size ti

    -- links = round (let n :: Double = fromIntegral tiSize in n * log n)

    distanceMap :: Map (Int, Int) Double
distanceMap = Map NgramsTerm Int
-> Map (NgramsTerm, NgramsTerm) Double -> Map (Int, Int) Double
forall t a. Ord t => Map t Int -> Map (t, t) a -> Map (Int, Int) a
toIndex Map NgramsTerm Int
ti
                (Map (NgramsTerm, NgramsTerm) Double -> Map (Int, Int) Double)
-> Map (NgramsTerm, NgramsTerm) Double -> Map (Int, Int) Double
forall a b. (a -> b) -> a -> b
$ [((NgramsTerm, NgramsTerm), Double)]
-> Map (NgramsTerm, NgramsTerm) Double
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                -- List.take links
                -- List.sortOn snd
                ([((NgramsTerm, NgramsTerm), Double)]
 -> Map (NgramsTerm, NgramsTerm) Double)
-> [((NgramsTerm, NgramsTerm), Double)]
-> Map (NgramsTerm, NgramsTerm) Double
forall a b. (a -> b) -> a -> b
$ HashMap (NgramsTerm, NgramsTerm) Double
-> [((NgramsTerm, NgramsTerm), Double)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList
                -- HashMap.filter (> threshold)
                (HashMap (NgramsTerm, NgramsTerm) Double
 -> [((NgramsTerm, NgramsTerm), Double)])
-> HashMap (NgramsTerm, NgramsTerm) Double
-> [((NgramsTerm, NgramsTerm), Double)]
forall a b. (a -> b) -> a -> b
$ HashMap (NgramsTerm, NgramsTerm) Int
-> HashMap (NgramsTerm, NgramsTerm) Double
forall a.
(Ord a, Hashable a, NFData a) =>
HashMap (a, a) Int -> HashMap (a, a) Double
conditional HashMap (NgramsTerm, NgramsTerm) Int
myCooc



----------------------------------------------------------
-- | From data to Graph

type Occurrences  = Map (Int,  Int) Int

data2graph :: ToComId a 
           => [(Text, Int)]
           -> Occurrences
           -> Map (Int, Int) Double
           -> Map (Int, Int) Double
           -> [a]
           -> Graph
data2graph :: [(Text, Int)]
-> Map (Int, Int) Int
-> Map (Int, Int) Double
-> Map (Int, Int) Double
-> [a]
-> Graph
data2graph [(Text, Int)]
labels Map (Int, Int) Int
occurences Map (Int, Int) Double
bridge Map (Int, Int) Double
conf [a]
partitions = Graph :: [Node] -> [Edge] -> Maybe GraphMetadata -> Graph
Graph { _graph_nodes :: [Node]
_graph_nodes = [Node]
nodes
                                                            , _graph_edges :: [Edge]
_graph_edges = [Edge]
edges
                                                            , _graph_metadata :: Maybe GraphMetadata
_graph_metadata = Maybe GraphMetadata
forall a. Maybe a
Nothing
                                                            }
  where

    community_id_by_node_id :: Map Int Int
community_id_by_node_id = [(Int, Int)] -> Map Int Int
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                            ([(Int, Int)] -> Map Int Int) -> [(Int, Int)] -> Map Int Int
forall a b. (a -> b) -> a -> b
$ (a -> (Int, Int)) -> [a] -> [(Int, Int)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map a -> (Int, Int)
forall a. ToComId a => a -> (Int, Int)
nodeId2comId [a]
partitions

    nodes :: [Node]
nodes = ((Int, Node) -> Node) -> [(Int, Node)] -> [Node]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Layout
-> [(Text, Int)] -> Map (Int, Int) Double -> (Int, Node) -> Node
forall a.
Ord a =>
Layout
-> [(a, Int)] -> Map (Int, Int) Double -> (Int, Node) -> Node
setCoord Layout
ForceAtlas [(Text, Int)]
labels Map (Int, Int) Double
bridge)
          [ (Int
n, Node :: Int
-> TypeNode
-> Text
-> Text
-> Double
-> Double
-> Attributes
-> [Text]
-> Node
Node { node_size :: Int
node_size    = Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 Int -> Int
forall a. a -> a
identity ((Int, Int) -> Map (Int, Int) Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Int
n,Int
n) Map (Int, Int) Int
occurences)
                     , node_type :: TypeNode
node_type    = TypeNode
Terms -- or Unknown
                     , node_id :: Text
node_id      = String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show Int
n)
                     , node_label :: Text
node_label   = Text
l
                     , node_x_coord :: Double
node_x_coord = Double
0
                     , node_y_coord :: Double
node_y_coord = Double
0
                     , node_attributes :: Attributes
node_attributes =
                       Attributes :: Int -> Attributes
Attributes { clust_default :: Int
clust_default = Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 Int -> Int
forall a. a -> a
identity
                                    (Int -> Map Int Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
n Map Int Int
community_id_by_node_id) }
                     , node_children :: [Text]
node_children = [] }
               )
            | (Text
l, Int
n) <- [(Text, Int)]
labels
            , Int -> Set Int -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Int
n (Set Int -> Bool) -> Set Int -> Bool
forall a b. (a -> b) -> a -> b
$ [Int] -> Set Int
forall a. Ord a => [a] -> Set a
Set.fromList
                           ([Int] -> Set Int) -> [Int] -> Set Int
forall a b. (a -> b) -> a -> b
$ [[Int]] -> [Int]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
List.concat
                           ([[Int]] -> [Int]) -> [[Int]] -> [Int]
forall a b. (a -> b) -> a -> b
$ (((Int, Int), Double) -> [Int])
-> [((Int, Int), Double)] -> [[Int]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\((Int
s,Int
t),Double
d) -> if Double
d Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 Bool -> Bool -> Bool
&& Int
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/=Int
t then [Int
s,Int
t] else [])
                           ([((Int, Int), Double)] -> [[Int]])
-> [((Int, Int), Double)] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ Map (Int, Int) Double -> [((Int, Int), Double)]
forall k a. Map k a -> [(k, a)]
Map.toList Map (Int, Int) Double
bridge
            ]

    edges :: [Edge]
edges = [ Edge :: Text -> Text -> Double -> Double -> Text -> Edge
Edge { edge_source :: Text
edge_source = String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show Int
s)
                       , edge_target :: Text
edge_target = String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show Int
t)
                       , edge_weight :: Double
edge_weight = Double
weight
                       , edge_confluence :: Double
edge_confluence = Double -> (Double -> Double) -> Maybe Double -> Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Double
0 Double -> Double
forall a. a -> a
identity (Maybe Double -> Double) -> Maybe Double -> Double
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Map (Int, Int) Double -> Maybe Double
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Int
s,Int
t) Map (Int, Int) Double
conf
                   -- , edge_confluence = maybe (panic "E: data2graph edges") identity $ Map.lookup (s,t) conf
                       , edge_id :: Text
edge_id     = String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Integer -> String
forall a. Show a => a -> String
show Integer
i)
                   }
            | (Integer
i, ((Int
s,Int
t), Double
weight)) <- [Integer]
-> [((Int, Int), Double)] -> [(Integer, ((Int, Int), Double))]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Integer
0..]::[Integer] )
                                     (Map (Int, Int) Double -> [((Int, Int), Double)]
forall k a. Map k a -> [(k, a)]
Map.toList Map (Int, Int) Double
bridge)
            , Int
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
t
            , Double
weight Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0
            ]


------------------------------------------------------------------------

data Layout = KamadaKawai | ACP | ForceAtlas


setCoord' :: (Int -> (Double, Double)) -> (Int, Node) -> Node
setCoord' :: (Int -> (Double, Double)) -> (Int, Node) -> Node
setCoord' Int -> (Double, Double)
f (Int
i,Node
n) = Node
n { node_x_coord :: Double
node_x_coord = Double
x, node_y_coord :: Double
node_y_coord = Double
y }
  where
    (Double
x,Double
y) = Int -> (Double, Double)
f Int
i


-- | ACP
setCoord :: Ord a => Layout -> [(a, Int)] -> Map (Int, Int) Double -> (Int, Node) -> Node
setCoord :: Layout
-> [(a, Int)] -> Map (Int, Int) Double -> (Int, Node) -> Node
setCoord Layout
l [(a, Int)]
labels Map (Int, Int) Double
m (Int
n,Node
node) = Node
node { node_x_coord :: Double
node_x_coord = Double
x
                                    , node_y_coord :: Double
node_y_coord = Double
y
                                    }
  where
    (Double
x,Double
y) = Layout
-> [(a, Int)] -> Map (Int, Int) Double -> Int -> (Double, Double)
forall a.
Ord a =>
Layout
-> [(a, Int)] -> Map (Int, Int) Double -> Int -> (Double, Double)
getCoord Layout
l [(a, Int)]
labels Map (Int, Int) Double
m Int
n


getCoord :: Ord a
         => Layout
         -> [(a, Int)]
         -> Map (Int, Int) Double
         -> Int
         -> (Double, Double)
getCoord :: Layout
-> [(a, Int)] -> Map (Int, Int) Double -> Int -> (Double, Double)
getCoord Layout
KamadaKawai [(a, Int)]
_ Map (Int, Int) Double
_m Int
_n = (Double, Double)
forall a. HasCallStack => a
undefined -- layout m n

getCoord Layout
ForceAtlas [(a, Int)]
_ Map (Int, Int) Double
_ Int
n = (Double -> Double
forall a. Floating a => a -> a
sin Double
d, Double -> Double
forall a. Floating a => a -> a
cos Double
d)
  where
    d :: Double
d = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n

getCoord Layout
ACP [(a, Int)]
labels Map (Int, Int) Double
m Int
n = Vector Double -> (Double, Double)
to2d (Vector Double -> (Double, Double))
-> Vector Double -> (Double, Double)
forall a b. (a -> b) -> a -> b
$ Vector Double
-> (Vector Double -> Vector Double)
-> Maybe (Vector Double)
-> Vector Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Vector Double
forall a. HasCallStack => Text -> a
panic Text
"Graph.Tools no coordinate") Vector Double -> Vector Double
forall a. a -> a
identity
             (Maybe (Vector Double) -> Vector Double)
-> Maybe (Vector Double) -> Vector Double
forall a b. (a -> b) -> a -> b
$ Int -> Map Int (Vector Double) -> Maybe (Vector Double)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
n
             (Map Int (Vector Double) -> Maybe (Vector Double))
-> Map Int (Vector Double) -> Maybe (Vector Double)
forall a b. (a -> b) -> a -> b
$ Dimension -> Map Int (Vector Double) -> Map Int (Vector Double)
forall t.
Ord t =>
Dimension -> Map t (Vector Double) -> Map t (Vector Double)
pcaReduceTo (Int -> Dimension
Dimension Int
2)
             (Map Int (Vector Double) -> Map Int (Vector Double))
-> Map Int (Vector Double) -> Map Int (Vector Double)
forall a b. (a -> b) -> a -> b
$ [(a, Int)] -> Map (Int, Int) Double -> Map Int (Vector Double)
forall a.
Ord a =>
[(a, Int)] -> Map (Int, Int) Double -> Map Int (Vector Double)
mapArray [(a, Int)]
labels Map (Int, Int) Double
m
  where
    to2d :: Vec.Vector Double -> (Double, Double)
    to2d :: Vector Double -> (Double, Double)
to2d Vector Double
v  = (Double
x',Double
y')
      where
        ds :: [Double]
ds = Int -> [Double] -> [Double]
forall a. Int -> [a] -> [a]
take Int
2 ([Double] -> [Double]) -> [Double] -> [Double]
forall a b. (a -> b) -> a -> b
$ Vector Double -> [Double]
forall a. Storable a => Vector a -> [a]
Vec.toList Vector Double
v
        x' :: Double
x'  = Text -> [Double] -> Double
forall a. Text -> [a] -> a
head' Text
"to2d" [Double]
ds
        y' :: Double
y'  = Text -> [Double] -> Double
forall a. Text -> [a] -> a
last' Text
"to2d" [Double]
ds

    mapArray :: Ord a => [(a, Int)] -> Map (Int, Int) Double -> Map Int (Vec.Vector Double)
    mapArray :: [(a, Int)] -> Map (Int, Int) Double -> Map Int (Vector Double)
mapArray [(a, Int)]
items Map (Int, Int) Double
m' = [(Int, Vector Double)] -> Map Int (Vector Double)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ Int -> [Int] -> Map (Int, Int) Double -> (Int, Vector Double)
toVec Int
n' [Int]
ns Map (Int, Int) Double
m' | Int
n' <- [Int]
ns ]
      where
        ns :: [Int]
ns = ((a, Int) -> Int) -> [(a, Int)] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (a, Int) -> Int
forall a b. (a, b) -> b
snd [(a, Int)]
items

    toVec :: Int -> [Int] -> Map (Int,Int) Double -> (Int, Vec.Vector Double)
    toVec :: Int -> [Int] -> Map (Int, Int) Double -> (Int, Vector Double)
toVec Int
n' [Int]
ns' Map (Int, Int) Double
m' = (Int
n', [Double] -> Vector Double
forall a. Storable a => [a] -> Vector a
Vec.fromList ([Double] -> Vector Double) -> [Double] -> Vector Double
forall a b. (a -> b) -> a -> b
$ (Int -> Double) -> [Int] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\Int
n'' -> Double -> (Double -> Double) -> Maybe Double -> Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Double
0 Double -> Double
forall a. a -> a
identity (Maybe Double -> Double) -> Maybe Double -> Double
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Map (Int, Int) Double -> Maybe Double
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Int
n',Int
n'') Map (Int, Int) Double
m') [Int]
ns')
------------------------------------------------------------------------

-- | KamadaKawai Layout
-- TODO TEST: check labels, nodeId and coordinates
layout :: Map (Int, Int) Double -> Int -> Gen -> (Double, Double)
layout :: Map (Int, Int) Double -> Int -> Gen -> (Double, Double)
layout Map (Int, Int) Double
m Int
n Gen
gen = (Double, Double)
-> ((Double, Double) -> (Double, Double))
-> Maybe (Double, Double)
-> (Double, Double)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> (Double, Double)
forall a. HasCallStack => Text -> a
panic Text
"") (Double, Double) -> (Double, Double)
forall a. a -> a
identity (Maybe (Double, Double) -> (Double, Double))
-> Maybe (Double, Double) -> (Double, Double)
forall a b. (a -> b) -> a -> b
$ Int -> Map Int (Double, Double) -> Maybe (Double, Double)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
n (Map Int (Double, Double) -> Maybe (Double, Double))
-> Map Int (Double, Double) -> Maybe (Double, Double)
forall a b. (a -> b) -> a -> b
$ Map Int (Double, Double)
coord
  where
    coord :: (Map Int (Double,Double))
    coord :: Map Int (Double, Double)
coord = [(Int, (Double, Double))] -> Map Int (Double, Double)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Int, (Double, Double))] -> Map Int (Double, Double))
-> [(Int, (Double, Double))] -> Map Int (Double, Double)
forall a b. (a -> b) -> a -> b
$ [Int] -> [(Double, Double)] -> [(Int, (Double, Double))]
forall a b. [a] -> [b] -> [(a, b)]
List.zip (Graph 'U () () -> [Int]
forall (d :: EdgeType) v e. Graph d v e -> [Int]
Igraph.nodes Graph 'U () ()
g) ([(Double, Double)] -> [(Int, (Double, Double))])
-> [(Double, Double)] -> [(Int, (Double, Double))]
forall a b. (a -> b) -> a -> b
$ (Graph 'U () () -> LayoutMethod -> Gen -> [(Double, Double)]
forall (d :: EdgeType) v e.
Graph d v e -> LayoutMethod -> Gen -> [(Double, Double)]
Layout.layout Graph 'U () ()
g LayoutMethod
p Gen
gen)
    --p = Layout.defaultLGL
    p :: LayoutMethod
p = LayoutMethod
Layout.kamadaKawai
    g :: Graph 'U () ()
g = [(Int, Int)] -> Graph 'U () ()
mkGraphUfromEdges ([(Int, Int)] -> Graph 'U () ()) -> [(Int, Int)] -> Graph 'U () ()
forall a b. (a -> b) -> a -> b
$ (((Int, Int), Double) -> (Int, Int))
-> [((Int, Int), Double)] -> [(Int, Int)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ((Int, Int), Double) -> (Int, Int)
forall a b. (a, b) -> a
fst ([((Int, Int), Double)] -> [(Int, Int)])
-> [((Int, Int), Double)] -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ (((Int, Int), Double) -> Bool)
-> [((Int, Int), Double)] -> [((Int, Int), Double)]
forall a. (a -> Bool) -> [a] -> [a]
List.filter (\((Int, Int), Double)
e -> ((Int, Int), Double) -> Double
forall a b. (a, b) -> b
snd ((Int, Int), Double)
e Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0) ([((Int, Int), Double)] -> [((Int, Int), Double)])
-> [((Int, Int), Double)] -> [((Int, Int), Double)]
forall a b. (a -> b) -> a -> b
$ Map (Int, Int) Double -> [((Int, Int), Double)]
forall k a. Map k a -> [(k, a)]
Map.toList Map (Int, Int) Double
m

-----------------------------------------------------------------------------
-- MISC Tools
cooc2graph'' :: Ord t => Distance
                      -> Double
                      -> Map (t, t) Int
                      -> Map (Index, Index) Double
cooc2graph'' :: Distance -> Double -> Map (t, t) Int -> Map (Int, Int) Double
cooc2graph'' Distance
distance Double
threshold Map (t, t) Int
myCooc = Map (Int, Int) Double
neighbourMap
  where
    (Map t Int
ti, Map Int t
_) = 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
myCooc
    myCooc' :: Map (Int, Int) Int
myCooc' = 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
myCooc
    matCooc :: Matrix Int
matCooc = MatrixShape -> Int -> Int -> Map (Int, Int) Int -> Matrix Int
forall a.
Elt a =>
MatrixShape -> a -> Int -> Map (Int, Int) a -> Matrix a
map2mat MatrixShape
Triangle Int
0 (Map t Int -> Int
forall k a. Map k a -> Int
Map.size Map t Int
ti) (Map (Int, Int) Int -> Matrix Int)
-> Map (Int, Int) Int -> Matrix Int
forall a b. (a -> b) -> a -> b
$ (Int -> Bool) -> Map (Int, Int) Int -> Map (Int, Int) Int
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) Map (Int, Int) Int
myCooc'
    distanceMat :: Array ((Z :. Int) :. Int) Double
distanceMat = Distance -> Matrix Int -> Array ((Z :. Int) :. Int) Double
measure Distance
distance Matrix Int
matCooc
    neighbourMap :: Map (Int, Int) Double
neighbourMap = Double -> Map (Int, Int) Double -> Map (Int, Int) Double
filterByNeighbours Double
threshold
                 (Map (Int, Int) Double -> Map (Int, Int) Double)
-> Map (Int, Int) Double -> Map (Int, Int) Double
forall a b. (a -> b) -> a -> b
$ Array ((Z :. Int) :. Int) Double -> Map (Int, Int) Double
forall a.
(Elt a, Shape (Z :. Int)) =>
Array ((Z :. Int) :. Int) a -> Map (Int, Int) a
mat2map Array ((Z :. Int) :. Int) Double
distanceMat

-- Quentin
filterByNeighbours :: Double -> Map (Index, Index) Double -> Map (Index, Index) Double
filterByNeighbours :: Double -> Map (Int, Int) Double -> Map (Int, Int) Double
filterByNeighbours Double
threshold Map (Int, Int) Double
distanceMap = Map (Int, Int) Double
filteredMap
  where 
    indexes :: [Index]
    indexes :: [Int]
indexes = [Int] -> [Int]
forall a. Eq a => [a] -> [a]
List.nub ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ [[Int]] -> [Int]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
List.concat ([[Int]] -> [Int]) -> [[Int]] -> [Int]
forall a b. (a -> b) -> a -> b
$ ((Int, Int) -> [Int]) -> [(Int, Int)] -> [[Int]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\(Int
idx,Int
idx') -> [Int
idx,Int
idx'] ) ([(Int, Int)] -> [[Int]]) -> [(Int, Int)] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ Map (Int, Int) Double -> [(Int, Int)]
forall k a. Map k a -> [k]
Map.keys Map (Int, Int) Double
distanceMap
    filteredMap :: Map (Index, Index) Double
    filteredMap :: Map (Int, Int) Double
filteredMap = [((Int, Int), Double)] -> Map (Int, Int) Double
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                ([((Int, Int), Double)] -> Map (Int, Int) Double)
-> [((Int, Int), Double)] -> Map (Int, Int) Double
forall a b. (a -> b) -> a -> b
$ [[((Int, Int), Double)]] -> [((Int, Int), Double)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
List.concat 
                ([[((Int, Int), Double)]] -> [((Int, Int), Double)])
-> [[((Int, Int), Double)]] -> [((Int, Int), Double)]
forall a b. (a -> b) -> a -> b
$ (Int -> [((Int, Int), Double)])
-> [Int] -> [[((Int, Int), Double)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\Int
idx -> 
                          let selected :: [((Int, Int), Double)]
selected = [((Int, Int), Double)] -> [((Int, Int), Double)]
forall a. [a] -> [a]
List.reverse
                                       ([((Int, Int), Double)] -> [((Int, Int), Double)])
-> [((Int, Int), Double)] -> [((Int, Int), Double)]
forall a b. (a -> b) -> a -> b
$ (((Int, Int), Double) -> Double)
-> [((Int, Int), Double)] -> [((Int, Int), Double)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn ((Int, Int), Double) -> Double
forall a b. (a, b) -> b
snd
                                       ([((Int, Int), Double)] -> [((Int, Int), Double)])
-> [((Int, Int), Double)] -> [((Int, Int), Double)]
forall a b. (a -> b) -> a -> b
$ Map (Int, Int) Double -> [((Int, Int), Double)]
forall k a. Map k a -> [(k, a)]
Map.toList 
                                       (Map (Int, Int) Double -> [((Int, Int), Double)])
-> Map (Int, Int) Double -> [((Int, Int), Double)]
forall a b. (a -> b) -> a -> b
$ (Double -> Bool) -> Map (Int, Int) Double -> Map (Int, Int) Double
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0)
                                       (Map (Int, Int) Double -> Map (Int, Int) Double)
-> Map (Int, Int) Double -> Map (Int, Int) Double
forall a b. (a -> b) -> a -> b
$ ((Int, Int) -> Double -> Bool)
-> Map (Int, Int) Double -> Map (Int, Int) Double
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\(Int
from,Int
_) Double
_ -> Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
from) Map (Int, Int) Double
distanceMap
                           in Int -> [((Int, Int), Double)] -> [((Int, Int), Double)]
forall a. Int -> [a] -> [a]
List.take (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round Double
threshold) [((Int, Int), Double)]
selected
                      ) [Int]
indexes