Skip to content

haskell-gargantext
haskell-gargantext
Commit 6af9b3d6 authored by Alexandre Delanoë's avatar Alexandre Delanoë
Browse files
Options

merge

parents 5f8819bd de250f25
Show whitespace changes
Inline Side-by-side
Showing with 338 additions and 96 deletions
devops/docker/docker-compose.yaml
View file @ 6af9b3d6
......@@ -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
View file @ 6af9b3d6
......@@ -108,6 +108,8 @@ library:
- SHA
- Unique
- accelerate
- accelerate-utility
- accelerate-arithmetic
- aeson
- aeson-lens
- aeson-pretty
......
pinned-20.09.nix
View file @ 6af9b3d6
......@@ -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
View file @ 6af9b3d6
......@@ -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
View file @ 6af9b3d6
......@@ -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
View file @ 6af9b3d6
......@@ -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
View file @ 6af9b3d6
......@@ -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
View file @ 6af9b3d6
......@@ -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
View file @ 6af9b3d6
......@@ -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
View file @ 6af9b3d6
......@@ -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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment