merge

devops/docker/docker-compose.yaml

@@ -4,8 +4,8 @@ services:
   postgres:
     image: 'postgres:latest'
     network_mode: host
-    ports:
-      - 5432:5432
+    #ports:
+      #- 5432:5432
     environment:
       POSTGRES_USER: gargantua
       POSTGRES_PASSWORD: C8kdcUrAQy66U
@@ -21,11 +21,13 @@ services:
     ports:
       - 8081:80
     environment:
-      PGADMIN_DEFAULT_EMAIL: admin
+      PGADMIN_DEFAULT_EMAIL: admin@localhost
       PGADMIN_DEFAULT_PASSWORD: admin
 
     depends_on:
       - postgres
+    links:
+      - postgres
 
   corenlp:
     image: 'cgenie/corenlp-garg'

package.yaml

@@ -108,6 +108,8 @@ library:
   - SHA
   - Unique
   - accelerate
+  - accelerate-utility
+  - accelerate-arithmetic
   - aeson
   - aeson-lens
   - aeson-pretty

pinned-20.09.nix

@@ -4,7 +4,6 @@ import (builtins.fetchGit {
   # Descriptive name to make the store path easier to identify
   name = "nixos-20.09";
   url = "https://github.com/nixos/nixpkgs/";
-  # Last commit hash for nixos-unstable
   # `git ls-remote https://github.com/nixos/nixpkgs-channels nixos-20.09`
   ref = "refs/heads/nixos-20.09";
   rev = "19db3e5ea2777daa874563b5986288151f502e27";

shell.nix

@@ -6,10 +6,12 @@ pkgs.mkShell {
     #glibc
     #gmp
     #gsl
+    haskell-language-server
     #igraph
+    lorri
     #pcre
     #postgresql
-    #stack
+    stack
     #xz
   ];
 }

src/Gargantext/Core/Methods/Distances/Accelerate/Distributional.hs

@@ -7,11 +7,31 @@ Maintainer  : team@gargantext.org
 Stability   : experimental
 Portability : POSIX
 
-This module aims at implementig distances of terms context by context is
-the same referential of corpus.
 
-Implementation use Accelerate library which enables GPU and CPU computation
-See Gargantext.Core.Methods.Graph.Accelerate)
+* Distributional Distance metric
+__Definition :__ Distributional metric is a relative metric which depends on the
+selected list, it represents structural equivalence of mutual information.
+
+__Objective :__ We want to compute with matrices processing the similarity between term $i$ and term $j$ :
+ distr(i,j)=$\frac{\Sigma_{k \neq i,j} min(\frac{n_{ik}^2}{n_{ii}n_{kk}},\frac{n_{jk}^2}{n_{jj}n_{kk}})}{\Sigma_{k \neq i}\frac{n_{ik}^2}{ n_{ii}n_{kk}}}$
+
+where $n_{ij}$ is the cooccurrence between term $i$ and term $j$
+
+* For a vector V=[$x_1$ ... $x_n$], we note $|V|_1=\Sigma_ix_i$
+* operator : .* and ./ cell by cell multiplication and division of the matrix
+* operator * is the matrix multiplication
+* Matrice M=[$n_{ij}$]$_{i,j}$
+* opérateur : Diag(M)=[$n_{ii}$]$_i$ (vecteur)
+* Id= identity matrix
+* O=[1]$_{i,j}$ (matrice one)
+* D(M)=Id .* M
+* O * D(M) =[$n_{jj}$]$_{i,j}$
+* D(M) * O =[$n_{ii}$]$_{i,j}$
+* $V_i=[0~0~0~1~0~0~0]'$ en i
+* MI=(M ./ O * D(M)) .* (M / D(M) * O )
+* distr(i,j)=$\frac{|min(V'_i * (MI-D(MI)),V'_j * (MI-D(MI)))|_1}{|V'_i.(MI-D(MI))|_1}$
+
+[Specifications written by David Chavalarias on Garg v4 shared NodeWrite, team Pyremiel 2020]
 
 -}
 
@@ -30,15 +50,72 @@ import Data.Array.Accelerate.Interpreter (run)
 import Gargantext.Core.Methods.Matrix.Accelerate.Utils
 import qualified Gargantext.Prelude as P
 
+-- | `distributional m` returns the distributional distance between terms each
+-- pair of terms as a matrix.  The argument m is the matrix $[n_{ij}]_{i,j}$
+-- where $n_{ij}$ is the coocccurrence between term $i$ and term $j$.
+--
+-- ## Basic example with Matrix of size 3: 
+--
+-- >>> theMatrixInt 3
+-- Matrix (Z :. 3 :. 3)
+--   [ 7, 4, 0,
+--     4, 5, 3,
+--     0, 3, 4]
+--
+-- >>> distributional $ theMatrixInt 3
+-- Matrix (Z :. 3 :. 3)
+--   [ 1.0, 0.0, 0.9843749999999999,
+--     0.0, 1.0,                0.0,
+--     1.0, 0.0,                1.0]
+--
+-- ## Basic example with Matrix of size 4: 
+--
+-- >>> theMatrixInt 4
+-- Matrix (Z :. 4 :. 4)
+--   [ 4, 1, 2, 1,
+--     1, 4, 0, 0,
+--     2, 0, 3, 3,
+--     1, 0, 3, 3]
+--
+-- >>> distributional $ theMatrixInt 4
+-- Matrix (Z :. 4 :. 4)
+--   [                  1.0,                   0.0, 0.5714285714285715, 0.8421052631578947,
+--                      0.0,                   1.0,                1.0,                1.0,
+--     8.333333333333333e-2,             4.6875e-2,                1.0,               0.25,
+--       0.3333333333333333, 5.7692307692307696e-2,                1.0,                1.0]
+--
+distributional :: Matrix Int -> Matrix Double
+distributional m' = run result
+ where
+    m = map fromIntegral $ use m'
+    n = dim m'
+
+    diag_m = diag m
+
+    d_1 = replicate (constant (Z :. n :. All)) diag_m
+    d_2 = replicate (constant (Z :. All :. n)) diag_m
+
+    mi    = (.*) ((./) m d_1) ((./) m d_2)
+
+    -- w = (.-) mi d_mi
+    
+    -- The matrix permutations is taken care of below by directly replicating
+    -- the matrix mi, making the matrix w unneccessary and saving one step.
+    w_1 = replicate (constant (Z :. All :. n :. All)) mi
+    w_2 = replicate (constant (Z :. n :. All :. All)) mi
+    w' = zipWith min w_1 w_2
+
+    -- The matrix ii = [r_{i,j,k}]_{i,j,k} has r_(i,j,k) = 0 if k = i OR k = j 
+    -- and r_(i,j,k) = 1 otherwise (i.e. k /= i AND k /= j). 
+    ii = generate (constant (Z :. n :. n :. n)) 
+        (lift1 (\(Z :. i :. j :. k) -> cond ((&&) ((/=) k i) ((/=) k j)) 1 0))
+
+    z_1 = sum ((.*) w' ii)
+    z_2 = sum ((.*) w_1 ii)
+
+    result = termDivNan z_1 z_2
 
--- * Metrics of proximity
------------------------------------------------------------------------
--- ** Distributional Distance
 
--- | Distributional Distance metric
---
--- Distributional metric is a relative metric which depends on the
--- selected list, it represents structural equivalence of mutual information.
 --
 -- The distributional metric P(c) of @i@ and @j@ terms is: \[
 -- S_{MI} = \frac {\sum_{k \neq i,j ; MI_{ik} >0}^{} \min(MI_{ik},
@@ -59,8 +136,9 @@ import qualified Gargantext.Prelude as P
 -- Total cooccurrences of terms given a map list of size @m@
 --            \[N_{m} = \sum_{i,i \neq i}^{m} \sum_{j, j \neq j}^{m} S_{ij}\]
 --
-distributional :: Matrix Int -> Matrix Double
-distributional m = -- run {- $ matMiniMax -}
+
+distributional'' :: Matrix Int -> Matrix Double
+distributional'' m = -- run {- $ matMiniMax -}
                    run  $ diagNull n
                        $ rIJ n
                        $ filterWith 0 100
@@ -107,6 +185,6 @@ rIJ n m = matMiniMax $ divide a b
 -- | Test perfermance with this matrix
 -- TODO : add this in a benchmark folder
 distriTest :: Int -> Matrix Double
-distriTest n = distributional (theMatrix n)
+distriTest n = distributional (theMatrixInt n)
 
 

src/Gargantext/Core/Methods/Matrix/Accelerate/Utils.hs

@@ -36,9 +36,96 @@ import Data.Array.Accelerate
 import Data.Array.Accelerate.Interpreter (run)
 import qualified Gargantext.Prelude as P
 
+-- | Matrix cell by cell multiplication
+(.*) :: ( Shape ix
+        , Slice ix
+        , Elt a
+        , P.Num (Exp a)
+        )
+     => Acc (Array ((ix :. Int) :. Int) a)
+     -> Acc (Array ((ix :. Int) :. Int) a)
+     -> Acc (Array ((ix :. Int) :. Int) a)
+(.*) = zipWith (*)
+
+
+(./) :: ( Shape ix
+        , Slice ix
+        , Elt a
+        , P.Num (Exp a)
+        , P.Fractional (Exp a)
+        )
+     => Acc (Array ((ix :. Int) :. Int) a)
+     -> Acc (Array ((ix :. Int) :. Int) a)
+     -> Acc (Array ((ix :. Int) :. Int) a)
+(./) = zipWith (/)
+
+-- | Term by term division where divisions by 0 produce 0 rather than NaN. 
+termDivNan :: ( Shape ix
+        , Slice ix
+        , Elt a
+        , Eq a
+        , P.Num (Exp a)
+        , P.Fractional (Exp a)
+        )
+     => Acc (Array ((ix :. Int) :. Int) a)
+     -> Acc (Array ((ix :. Int) :. Int) a)
+     -> Acc (Array ((ix :. Int) :. Int) a)
+termDivNan = zipWith (\i j -> cond ((==) j 0) 0 ((/) i j))
+
+(.-) :: ( Shape ix
+        , Slice ix
+        , Elt a
+        , P.Num (Exp a)
+        , P.Fractional (Exp a)
+        )
+     => Acc (Array ((ix :. Int) :. Int) a)
+     -> Acc (Array ((ix :. Int) :. Int) a)
+     -> Acc (Array ((ix :. Int) :. Int) a)
+(.-) = zipWith (-)
+
+(.+) :: ( Shape ix
+        , Slice ix
+        , Elt a
+        , P.Num (Exp a)
+        , P.Fractional (Exp a)
+        )
+     => Acc (Array ((ix :. Int) :. Int) a)
+     -> Acc (Array ((ix :. Int) :. Int) a)
+     -> Acc (Array ((ix :. Int) :. Int) a)
+(.+) = zipWith (+)
+
+-----------------------------------------------------------------------
+matrixOne :: Num a => Dim -> Acc (Matrix a)
+matrixOne n' = ones
+  where
+    ones  = fill (index2 n n) 1
+    n     = constant n'
+
+
+matrixIdentity :: Num a => Dim -> Acc (Matrix a)
+matrixIdentity n' =
+        let zeros = fill (index2 n n) 0
+            ones  = fill (index1 n)   1
+            n = constant n'
+        in
+        permute const zeros (\(unindex1 -> i) -> index2 i i) ones
+
+
+matrixEye :: Num a => Dim -> Acc (Matrix a)
+matrixEye n' =
+        let ones   = fill (index2 n n) 1
+            zeros  = fill (index1 n)   0
+            n = constant n'
+        in
+        permute const ones (\(unindex1 -> i) -> index2 i i) zeros
+
+
+diagNull :: Num a => Dim -> Acc (Matrix a) -> Acc (Matrix a)
+diagNull n m = zipWith (*) m (matrixEye n)
+
 -----------------------------------------------------------------------
-runExp :: Elt e => Exp e -> e
-runExp e = indexArray (run (unit e)) Z
+_runExp :: Elt e => Exp e -> e
+_runExp e = indexArray (run (unit e)) Z
 
 -----------------------------------------------------------------------
 -- | Define a vector
@@ -89,10 +176,10 @@ dim m = n
 --   [ 12.0, 15.0, 18.0,
 --     12.0, 15.0, 18.0,
 --     12.0, 15.0, 18.0]
-matSumCol :: Dim -> Acc (Matrix Double) -> Acc (Matrix Double)
+matSumCol :: (Elt a, P.Num (Exp a)) => Dim -> Acc (Matrix a) -> Acc (Matrix a)
 matSumCol r mat = replicate (constant (Z :. (r :: Int) :. All)) $ sum $ transpose mat
 
-matSumCol' :: Matrix Double -> Matrix Double
+matSumCol' :: (Elt a, P.Num (Exp a)) => Matrix a -> Matrix a
 matSumCol' m = run $ matSumCol n m'
   where
     n  = dim m
@@ -164,24 +251,11 @@ filterWith' :: (Elt a, Ord a) => Exp a -> Exp a -> Acc (Matrix a) -> Acc (Matrix
 filterWith' t v m = map (\x -> ifThenElse (x > t) x v) m
 
 
+------------------------------------------------------------------------
+------------------------------------------------------------------------
 
--- run $ (identityMatrix (DAA.constant (10::Int)) :: DAA.Acc (DAA.Matrix Int)) Matrix (Z :. 10 :. 10)
-identityMatrix :: Num a => Exp Int -> Acc (Matrix a)
-identityMatrix n =
-        let zeros = fill (index2 n n) 0
-            ones  = fill (index1 n)   1
-        in
-        permute const zeros (\(unindex1 -> i) -> index2 i i) ones
 
 
-eyeMatrix :: Num a => Dim -> Acc (Matrix a)
-eyeMatrix n' =
-        let ones   = fill (index2 n n) 1
-            zeros  = fill (index1 n)   0
-            n = constant n'
-        in
-        permute const ones (\(unindex1 -> i) -> index2 i i) zeros
-
 -- | TODO use Lenses
 data Direction = MatCol (Exp Int) | MatRow (Exp Int) | Diag
 
@@ -259,11 +333,6 @@ selfMatrix' m' = run $ selfMatrix n
     m = use m'
 -}
 -------------------------------------------------
-diagNull :: Num a => Dim -> Acc (Matrix a) -> Acc (Matrix a)
-diagNull n m = zipWith (*) m eye
-  where
-    eye = eyeMatrix n
-
 -------------------------------------------------
 crossProduct :: Dim -> Acc (Matrix Double) -> Acc (Matrix Double)
 crossProduct n m = {-trace (P.show (run m',run m'')) $-} zipWith (*) m' m''
@@ -313,23 +382,28 @@ p_ m = zipWith (/) m (n_ m)
                          ) m
 -}
 
-theMatrix :: Int -> Matrix Int
-theMatrix n = matrix n (dataMatrix n)
+theMatrixDouble :: Int -> Matrix Double
+theMatrixDouble n = run $ map fromIntegral (use $ theMatrixInt n)
+
+theMatrixInt :: Int -> Matrix Int
+theMatrixInt n = matrix n (dataMatrix n)
   where
     dataMatrix :: Int -> [Int]
     dataMatrix x | (P.==) x 2 = [ 1, 1
                                 , 1, 2
                                 ]
 
-                 | (P.==) x 3 =  [ 1, 1, 2
-                                 , 1, 2, 3
-                                 , 2, 3, 4
+                 | (P.==) x 3 =  [ 7, 4, 0
+                                 , 4, 5, 3
+                                 , 0, 3, 4
                                  ]
-                 | (P.==) x 4 =  [ 1, 1, 2, 3
-                                 , 1, 2, 3, 4
-                                 , 2, 3, 4, 5
-                                 , 3, 4, 5, 6
+                 | (P.==) x 4 =  [ 4, 1, 2, 1
+                                 , 1, 4, 0, 0
+                                 , 2, 0, 3, 3
+                                 , 1, 0, 3, 3
                                  ]
+
+
                  | P.otherwise = P.undefined
 
 {-

src/Gargantext/Core/Text/List/Social/Find.hs

@@ -13,6 +13,7 @@ module Gargantext.Core.Text.List.Social.Find
 
 -- findList imports
 import Control.Lens (view)
+
 import Gargantext.Core.Types.Individu
 import Gargantext.Database.Admin.Config
 import Gargantext.Database.Admin.Types.Node
@@ -36,7 +37,7 @@ findListsId u mode = do
 -- | TODO not clear enough:
 -- | Shared is for Shared with me but I am not the owner of it
 -- | Private is for all Lists I have created
-findNodes' :: HasTreeError err
+findNodes' :: (HasTreeError err, HasNodeError err)
           => RootId
           -> NodeMode
           -> Cmd err [DbTreeNode]
@@ -45,6 +46,7 @@ findNodes' r Private = do
   sh <- (findNodes' r Shared)
   pure $ pv <> sh
 findNodes' r Shared       = findNodes r Shared  $ [NodeFolderShared, NodeTeam] <> commonNodes
+findNodes' r SharedDirect = findNodes r Shared  $ [NodeFolderShared, NodeTeam] <> commonNodes
 findNodes' r Public       = findNodes r Public  $ [NodeFolderPublic ]          <> commonNodes
 
 commonNodes:: [NodeType]

src/Gargantext/Core/Viz/Graph/API.hs

@@ -91,6 +91,7 @@ getGraph _uId nId = do
   -- TODO Distance in Graph params
   case graph of
     Nothing     -> do
+        -- graph' <- computeGraph cId Distributional NgramsTerms repo
         graph' <- computeGraph cId Conditional NgramsTerms repo
         mt     <- defaultGraphMetadata cId "Title" repo
         let graph'' = set graph_metadata (Just mt) graph'
@@ -204,7 +205,7 @@ graphRecompute u n logStatus = do
                    , _scst_remaining = Just 1
                    , _scst_events    = Just []
                    }
-  _g <- trace (show u) $ recomputeGraph u n Conditional
+  _g <- trace (show u) $ recomputeGraph u n Conditional -- Distributional
   pure  JobLog { _scst_succeeded = Just 1
                , _scst_failed    = Just 0
                , _scst_remaining = Just 0
@@ -239,7 +240,7 @@ graphVersions nId = do
                        , gv_repo = v }
 
 recomputeVersions :: UserId -> NodeId -> GargNoServer Graph
-recomputeVersions uId nId = recomputeGraph uId nId Conditional
+recomputeVersions uId nId = recomputeGraph uId nId Conditional -- Distributional
 
 ------------------------------------------------------------
 graphClone :: UserId

src/Gargantext/Database/Query/Tree.hs

@@ -32,15 +32,21 @@ module Gargantext.Database.Query.Tree
   , findNodes
   , findNodesWithType
   , NodeMode(..)
+
+  , sharedTreeUpdate
+  , dbTree
+  , updateTree
   )
   where
 
 import Control.Lens (view, toListOf, at, each, _Just, to, set, makeLenses)
 import Control.Monad.Error.Class (MonadError())
 import Data.List (tail, concat, nub)
-import Data.Map (Map, fromListWith, lookup)
-import qualified Data.Set  as Set
 import qualified Data.List as List
+import Data.Map (Map, fromListWith, lookup)
+-- import Data.Monoid (mconcat)
+import Data.Proxy
+-- import qualified Data.Set  as Set
 import Data.Text (Text)
 import Database.PostgreSQL.Simple
 import Database.PostgreSQL.Simple.SqlQQ
@@ -48,11 +54,15 @@ import Database.PostgreSQL.Simple.SqlQQ
 import Gargantext.Prelude
 import Gargantext.Core
 import Gargantext.Core.Types.Main (NodeTree(..), Tree(..))
-import Gargantext.Database.Admin.Config hiding (nodeTypes)
+import Gargantext.Database.Admin.Config (fromNodeTypeId, nodeTypeId, fromNodeTypeId)
+import Gargantext.Database.Admin.Types.Hyperdata.Any (HyperdataAny)
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Prelude (Cmd, runPGSQuery)
+import Gargantext.Database.Query.Table.Node (getNodeWith)
+import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Query.Table.NodeNode (getNodeNode)
 import Gargantext.Database.Query.Tree.Error
+import Gargantext.Database.Schema.Node (NodePoly(..))
 import Gargantext.Database.Schema.NodeNode (NodeNodePoly(..))
 
 ------------------------------------------------------------------------
@@ -72,7 +82,7 @@ instance Eq DbTreeNode where
 data TreeMode = TreeBasic | TreeAdvanced | TreeFirstLevel
 
 -- | Returns the Tree of Nodes in Database
-tree :: HasTreeError err
+tree :: (HasTreeError err, HasNodeError err)
      => TreeMode
      -> RootId
      -> [NodeType]
@@ -84,7 +94,8 @@ tree TreeFirstLevel = tree_first_level
 -- | Tree basic returns the Tree of Nodes in Database
 -- (without shared folders)
 -- keeping this for teaching purpose only
-tree_basic :: HasTreeError err
+tree_basic :: (HasTreeError err, HasNodeError err)
+
            => RootId
            -> [NodeType]
            -> Cmd err (Tree NodeTree)
@@ -94,41 +105,58 @@ tree_basic r nodeTypes =
   -- toTree =<< (toTreeParent <$> dbTree r nodeTypes)
 
 -- | Advanced mode of the Tree enables shared nodes
-tree_advanced :: HasTreeError err
+tree_advanced :: (HasTreeError err, HasNodeError err)
               => RootId
               -> [NodeType]
               -> Cmd err (Tree NodeTree)
 tree_advanced r nodeTypes = do
+  -- let rPrefix s = "[tree_advanced] root = " <> show r <> " " <> s
   mainRoot    <- findNodes r Private nodeTypes
-  sharedRoots <- findNodes r Shared  nodeTypes
+  -- printDebug (rPrefix "mainRoot") mainRoot
   publicRoots <- findNodes r Public  nodeTypes
+  -- printDebug (rPrefix "publicRoots") publicRoots
+  sharedRoots <- findNodes r Shared  nodeTypes
+  -- printDebug (rPrefix "sharedRoots") sharedRoots
   toTree      $ toTreeParent (mainRoot <> sharedRoots <> publicRoots)
 
 -- | Fetch only first level of tree
-tree_first_level :: HasTreeError err
+tree_first_level :: (HasTreeError err, HasNodeError err)
                  => RootId
                  -> [NodeType]
                  -> Cmd err (Tree NodeTree)
 tree_first_level r nodeTypes = do
+  -- let rPrefix s = mconcat [ "[tree_first_level] root = "
+  --                         , show r
+  --                         , ", nodeTypes = "
+  --                         , show nodeTypes
+  --                         , " "
+  --                         , s ]
   mainRoot    <- findNodes r Private nodeTypes
-  sharedRoots <- findNodes r Shared  nodeTypes
+  -- printDebug (rPrefix "mainRoot") mainRoot
   publicRoots <- findNodes r Public  nodeTypes
-  toTree $ toSubtreeParent (mainRoot <> sharedRoots <> publicRoots)
+  -- printDebug (rPrefix "publicRoots") publicRoots
+  sharedRoots <- findNodes r SharedDirect  nodeTypes
+  -- printDebug (rPrefix "sharedRoots") sharedRoots
+  ret <- toTree $ toSubtreeParent r (mainRoot <> sharedRoots <> publicRoots)
+  -- printDebug (rPrefix "tree") ret
+  pure ret
 
 ------------------------------------------------------------------------
-data NodeMode = Private | Shared | Public
+data NodeMode = Private | Shared | Public | SharedDirect
 
-findNodes :: HasTreeError err
+findNodes :: (HasTreeError err, HasNodeError err)
           => RootId
           -> NodeMode
           -> [NodeType]
           -> Cmd err [DbTreeNode]
 findNodes r Private nt       = dbTree r nt
 findNodes r Shared  nt       = findShared r NodeFolderShared nt sharedTreeUpdate
+findNodes r SharedDirect  nt = findSharedDirect r NodeFolderShared nt sharedTreeUpdate
 findNodes r Public  nt       = findShared r NodeFolderPublic nt publicTreeUpdate
 
 ------------------------------------------------------------------------
 -- | Collaborative Nodes in the Tree
+--   Queries the `nodes_nodes` table.
 findShared :: HasTreeError err
            => RootId -> NodeType -> [NodeType] -> UpdateTree err
            -> Cmd err [DbTreeNode]
@@ -137,6 +165,32 @@ findShared r nt nts fun = do
   trees           <- mapM (updateTree nts fun) foldersSharedId
   pure $ concat trees
 
+-- | Find shared folders with "direct" access, i.e. when fetching only
+-- first-level subcomponents. This works in a simplified manner: fetch the node
+-- and get the tree for its parent.
+findSharedDirect :: (HasTreeError err, HasNodeError err)
+                 => RootId -> NodeType -> [NodeType] -> UpdateTree err
+                 -> Cmd err [DbTreeNode]
+findSharedDirect r nt nts fun = do
+  -- let rPrefix s = mconcat [ "[findSharedDirect] r = "
+  --                         , show r
+  --                         , ", nt = "
+  --                         , show nt
+  --                         , ", nts = "
+  --                         , show nts
+  --                         , " "
+  --                         , s ]
+  parent <- getNodeWith r (Proxy :: Proxy HyperdataAny)
+  let mParent = _node_parentId parent
+  case mParent of
+    Nothing -> pure []
+    Just parentId -> do
+      foldersSharedId <- findNodesId parentId [nt]
+      -- printDebug (rPrefix "foldersSharedId") foldersSharedId
+      trees           <- mapM (updateTree nts fun) foldersSharedId
+      -- printDebug (rPrefix "trees") trees
+      pure $ concat trees
+
 
 type UpdateTree err = ParentId -> [NodeType] -> NodeId -> Cmd err [DbTreeNode]
 
@@ -214,24 +268,43 @@ toTreeParent :: [DbTreeNode]
              -> Map (Maybe ParentId) [DbTreeNode]
 toTreeParent = fromListWith (\a b -> nub $ a <> b) . map (\n -> (_dt_parentId n, [n]))
 ------------------------------------------------------------------------
-toSubtreeParent :: [DbTreeNode]
+-- toSubtreeParent' :: [DbTreeNode]
+--                 -> Map (Maybe ParentId) [DbTreeNode]
+-- toSubtreeParent' ns = fromListWith (\a b -> nub $ a <> b) . map (\n -> (_dt_parentId n, [n])) $ nullifiedParents
+--   where
+--     nodeIds = Set.fromList $ map (\n -> unNodeId $ _dt_nodeId n) ns
+--     nullifiedParents = map nullifyParent ns
+--     nullifyParent dt@(DbTreeNode { _dt_parentId = Nothing }) = dt
+--     nullifyParent dt@(DbTreeNode { _dt_nodeId = nId
+--                                  , _dt_parentId = Just pId
+--                                  , _dt_typeId = tId
+--                                  , _dt_name = name }) =
+--       if Set.member (unNodeId pId) nodeIds then
+--         dt
+--       else
+--         DbTreeNode { _dt_nodeId = nId
+--                    , _dt_typeId = tId
+--                    , _dt_parentId = Nothing
+--                    , _dt_name = name }
+------------------------------------------------------------------------
+toSubtreeParent :: RootId
+                -> [DbTreeNode]
                 -> Map (Maybe ParentId) [DbTreeNode]
-toSubtreeParent ns = fromListWith (\a b -> nub $ a <> b) . map (\n -> (_dt_parentId n, [n])) $ nullifiedParents
+toSubtreeParent r ns = fromListWith (\a b -> nub $ a <> b) . map (\n -> (_dt_parentId n, [n])) $ nullifiedParents
   where
-    nodeIds = Set.fromList $ map (\n -> unNodeId $ _dt_nodeId n) ns
     nullifiedParents = map nullifyParent ns
     nullifyParent dt@(DbTreeNode { _dt_parentId = Nothing }) = dt
     nullifyParent dt@(DbTreeNode { _dt_nodeId = nId
-                                 , _dt_parentId = Just pId
+                                 , _dt_parentId = _pId
                                  , _dt_typeId = tId
                                  , _dt_name = name }) =
-      if Set.member (unNodeId pId) nodeIds then
-        dt
-      else
+      if r == nId then
         DbTreeNode { _dt_nodeId = nId
                    , _dt_typeId = tId
                    , _dt_parentId = Nothing
                    , _dt_name = name }
+      else
+        dt
 ------------------------------------------------------------------------
 -- | Main DB Tree function
 dbTree :: RootId

stack.yaml

@@ -7,6 +7,8 @@ packages:
 #- 'deps/patches-map'
 #- 'deps/servant-job'
 #- 'deps/clustering-louvain'
+#- 'deps/accelerate'
+#- 'deps/accelerate-utility'
 
 docker:
   enable: false
@@ -20,6 +22,7 @@ nix:
   shell-file: build-shell.nix
 
 allow-newer: true
+
 extra-deps:
 
   # Data Mining Libs
@@ -71,10 +74,18 @@ extra-deps:
 - git: https://gitlab.iscpif.fr/gargantext/clustering-louvain.git
   commit: 7d74f96dfea8e51fbab1793cc0429b2fe741f73d
 
+  # Accelerate Linear Algebra and specific instances
+  # (UndecidableInstances for newer GHC version)
+- git: https://gitlab.iscpif.fr/anoe/accelerate.git
+  commit: f5c0e0071ec7b6532f9a9cd3eb33d14f340fbcc9
+- git: https://gitlab.iscpif.fr/anoe/accelerate-utility.git
+  commit: 83ada76e78ac10d9559af8ed6bd4064ec81308e4
+- accelerate-arithmetic-1.0.0.1@sha256:555639232aa5cad411e89247b27871d09352b987a754230a288c690b6de6d888,2096
+
   # Others dependencies (with stack resolver)
 - KMP-0.2.0.0@sha256:6dfbac03ef00ebd9347234732cb86a40f62ab5a80c0cc6bedb8eb51766f7df28,2562
 - Unique-0.4.7.7@sha256:2269d3528271e25d34542e7c24a4e541e27ec33460e1ea00845da95b82eec6fa,2777
-- accelerate-1.2.0.1@sha256:bb1928efe602545df4043692916ed427c959110cbd678d03c3f9c3be25d1ae88,20112
+- dependent-sum-0.4@sha256:40c705604f52374fb72616e10234635104a626ede737ddde899777b719df120b,1907
 - duckling-0.1.6.1@sha256:dab60953f405b45fe93e1e745f8cc83e5166e1788b1f4999cc06382e131153d8,47147
 - fclabels-2.0.4@sha256:efcc20c6c903d0a59e36eb1cb547a7bbbbba93b6e20b84b06e919c350891beb2,4492
 - full-text-search-0.2.1.4@sha256:81f6df3327e5b604f99b15e78635e5d6ca996e504c21d268a6d751d7d131aa36,6032
@@ -91,6 +102,4 @@ extra-deps:
 - smtp-mail-0.2.0.0@sha256:b91c81f6dbb41a9ceee8c443385118684ecec55006b77f7d3c0e49cffd2468cf,1211
 - stemmer-0.5.2@sha256:823aec56249ec2619f60a2c0d1384b732894dbbbe642856d337ebfe9629a0efd,4082
 - xmlbf-0.6.1@sha256:57867fcb39e0514d17b3328ff5de8d241a18482fc89bb742d9ed820a6a2a5187,1540
-- dependent-sum-0.4@sha256:40c705604f52374fb72616e10234635104a626ede737ddde899777b719df120b,1907
 - xmlbf-xeno-0.2@sha256:39f70fced6052524c290cf595f114661c721452e65fc3e0953a44e7682a6a6b0,950
-