Merge branch 'dev' into dev-small-fixes

README.md

@@ -102,7 +102,7 @@ For Docker env, first create the appropriate image:
 
 ``` sh
 cd devops/docker
-docker build -t fpco/stack-build:lts-14.27-garg .
+docker build -t fpco/stack-build:lts-16.26-garg .
 ```
 
 then run:

devops/docker/docker-install

@@ -54,7 +54,7 @@ git clone https://gitlab.iscpif.fr/gargantext/purescript-gargantext
 ../install-deps $(pwd)
 
 pushd devops/docker
-docker build --pull -t fpco/stack-build:lts-14.22-garg .
+docker build --pull -t fpco/stack-build:lts-16.26-garg .
 popd
 
 #stack docker pull

package.yaml

 name: gargantext
-version: '0.0.2.7.1'
+version: '0.0.2.8'
 synopsis: Search, map, share
 description: Please see README.md
 category: Data

src/Gargantext/API/Node.hs

@@ -133,6 +133,7 @@ type NodeAPI a = Get '[JSON] (Node a)
              :<|> "ngrams"     :> TableNgramsApi
 
              :<|> "category"   :> CatApi
+             :<|> "score"      :> ScoreApi
              :<|> "search"     :> (Search.API Search.SearchResult)
              :<|> "share"      :> Share.API
 
@@ -212,6 +213,7 @@ nodeAPI p uId id' = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode
            :<|> apiNgramsTableCorpus id'
 
            :<|> catApi      id'
+           :<|> scoreApi    id'
            :<|> Search.api  id'
            :<|> Share.api   (RootId $ NodeId uId) id'
            -- Pairing Tools
@@ -260,6 +262,27 @@ catApi = putCat
     putCat :: CorpusId -> NodesToCategory -> Cmd err [Int]
     putCat cId cs' = nodeNodesCategory $ map (\n -> (cId, n, ntc_category cs')) (ntc_nodesId cs')
 
+------------------------------------------------------------------------
+type ScoreApi =  Summary " To Score NodeNodes"
+            :> ReqBody '[JSON] NodesToScore
+            :> Put     '[JSON] [Int]
+
+data NodesToScore = NodesToScore { nts_nodesId :: [NodeId]
+                                 , nts_score :: Int
+                                 }
+  deriving (Generic)
+
+-- TODO unPrefix "ntc_" FromJSON, ToJSON, ToSchema, adapt frontend.
+instance FromJSON  NodesToScore
+instance ToJSON    NodesToScore
+instance ToSchema  NodesToScore
+
+scoreApi :: CorpusId -> GargServer ScoreApi
+scoreApi = putScore
+  where
+    putScore :: CorpusId -> NodesToScore -> Cmd err [Int]
+    putScore cId cs' = nodeNodesScore $ map (\n -> (cId, n, nts_score cs')) (nts_nodesId cs')
+
 ------------------------------------------------------------------------
 -- TODO adapt FacetDoc -> ListDoc (and add type of document as column)
 -- Pairing utilities to move elsewhere

src/Gargantext/API/Table.hs

@@ -45,11 +45,11 @@ import Gargantext.API.Ngrams.Types (TabType(..))
 import Gargantext.API.Prelude (GargServer)
 import Gargantext.Core.Types (Offset, Limit, TableResult(..))
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
-import Gargantext.Database.Query.Facet (FacetDoc , runViewDocuments, runCountDocuments, OrderBy(..), runViewAuthorsDoc)
 import Gargantext.Database.Action.Learn (FavOrTrash(..), moreLike)
 import Gargantext.Database.Action.Search
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Prelude -- (Cmd, CmdM)
+import Gargantext.Database.Query.Facet (FacetDoc , runViewDocuments, runCountDocuments, OrderBy(..), runViewAuthorsDoc)
 import Gargantext.Prelude
 
 ------------------------------------------------------------------------

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

@@ -45,7 +45,7 @@ module Gargantext.Core.Methods.Distances.Accelerate.Distributional
 
 -- import qualified Data.Foldable as P (foldl1)
 -- import Debug.Trace (trace)
-import Data.Array.Accelerate
+import Data.Array.Accelerate as A
 import Data.Array.Accelerate.Interpreter (run)
 import Gargantext.Core.Methods.Matrix.Accelerate.Utils
 import qualified Gargantext.Prelude as P
@@ -115,8 +115,57 @@ distributional m' = run result
 
     result = termDivNan z_1 z_2
 
+logDistributional :: Matrix Int -> Matrix Double
+logDistributional m' = run result
+ where
+    m = map fromIntegral $ use m'
+    n = dim m'
+
+    -- Scalar. Sum of all elements of m.
+    to = the $ sum (flatten m)
+
+    -- Diagonal matrix with the diagonal of m.
+    d_m = (.*) m (matrixIdentity n)
+
+    -- Size n vector. s = [s_i]_i
+    s = sum ((.-) m d_m)
+
+    -- Matrix nxn. Vector s replicated as rows. 
+    s_1 = replicate (constant (Z :. All :. n)) s
+    -- Matrix nxn. Vector s replicated as columns. 
+    s_2 = replicate (constant (Z :. n :. All)) s
+
+    -- Matrix nxn. ss = [s_i * s_j]_{i,j}. Outer product of s with itself. 
+    ss = (.*) s_1 s_2
+
+    -- Matrix nxn. mi = [m_{i,j}]_{i,j} where 
+    -- m_{i,j} = 0 if n_{i,j} = 0 or i = j, 
+    -- m_{i,j} = log(to * n_{i,j} / s_{i,j}) otherwise.
+    mi = (.*) (matrixEye n) 
+        (map (lift1 (\x -> cond (x == 0) 0 (log (x * to)))) ((./) m ss))
+
+    -- Tensor nxnxn. Matrix mi replicated along the 2nd axis.
+    w_1 = replicate (constant (Z :. All :. n :. All)) mi
+
+    -- Tensor nxnxn. Matrix mi replicated along the 1st axis.
+    w_2 = replicate (constant (Z :. n :. All :. All)) mi
+
+    -- Tensor nxnxn.
+    w' = zipWith min w_1 w_2
+
+    -- A predicate that is true when the input (i, j, k) satisfy 
+    -- k /= i AND k /= j
+    k_diff_i_and_j = lift1 (\(Z :. i :. j :. k) -> ((&&) ((/=) k i) ((/=) k j)))
+
+    -- Matrix nxn. 
+    sumMin = sum (condOrDefault k_diff_i_and_j 0 w')
+
+    -- Matrix nxn. All columns are the same.
+    sumM = sum (condOrDefault k_diff_i_and_j 0 w_1)
+
+    result = termDivNan sumMin sumM
+
 
---
 -- 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},
 -- MI_{jk})}{\sum_{k \neq i,j ; MI_{ik}>0}^{}} \]

src/Gargantext/Core/Methods/Graph/Louvain.hs

-{-|
-Module      : Gargantext.Core.Viz.Graph.Louvain
-Description :
-Copyright   : (c) CNRS, 2017-Present
-License     : AGPL + CECILL v3
-Maintainer  : team@gargantext.org
-Stability   : experimental
-Portability : POSIX
-
--}
-
-
-module Gargantext.Core.Methods.Graph.Louvain
-  where
-
-import Gargantext.Prelude
-import Data.Map (Map, fromList)
-import Data.Graph.Clustering.Louvain.Utils (LouvainNode(..))
-
-
-type LouvainNodeId = Int
-type CommunityId   = Int
-
-nodeId2comId :: [LouvainNode] -> Map LouvainNodeId CommunityId
-nodeId2comId ns = fromList [(nId,cId) | LouvainNode nId cId <- ns]
-
-comId2nodeId :: [LouvainNode] -> Map CommunityId LouvainNodeId
-comId2nodeId ns = fromList [(cId,nId) | LouvainNode nId cId <- ns]
-
-

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

@@ -123,6 +123,17 @@ matrixEye n' =
 diagNull :: Num a => Dim -> Acc (Matrix a) -> Acc (Matrix a)
 diagNull n m = zipWith (*) m (matrixEye n)
 
+
+-- Returns an N-dimensional array with the values of x for the indices where
+-- the condition is true, 0 everywhere else.
+condOrDefault 
+  :: forall sh a. (Shape sh, Elt a)
+  => (Exp sh -> Exp Bool) -> Exp a -> Acc (Array sh a) -> Acc (Array sh a)
+condOrDefault theCond def x = permute const zeros filterInd x
+  where 
+    zeros = fill (shape x) (def)
+    filterInd ix = (cond (theCond ix)) ix ignore
+
 -----------------------------------------------------------------------
 _runExp :: Elt e => Exp e -> e
 _runExp e = indexArray (run (unit e)) Z

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

@@ -154,7 +154,7 @@ computeGraph cId d nt repo = do
          <$> groupNodesByNgrams ngs
          <$> getNodesByNgramsOnlyUser cId (lIds <> [lId]) nt (HashMap.keys ngs)
 
-  graph <- liftBase $ cooc2graph d 0 myCooc
+  graph <- liftBase $ cooc2graphWith Spinglass d 0 myCooc
 
   pure graph
 

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

@@ -11,39 +11,65 @@ Let be a graph with partitions (from Louvain algo), Bridgeness uniformly
 filters inter-communities links.
 
 TODO rewrite Bridgeness with "equivalence structurale" metrics (Confluence)
-
 TODO use Map LouvainNodeId (Map LouvainNodeId)
 -}
 
 
-module Gargantext.Core.Viz.Graph.Bridgeness (bridgeness)
+module Gargantext.Core.Viz.Graph.Bridgeness -- (bridgeness)
   where
 
+import Data.Graph.Clustering.Louvain.Utils (LouvainNode(..))
+import Data.List (concat, sortOn)
+import Data.Map (Map, fromListWith, lookup, toList, mapWithKey, elems)
+import Data.Maybe (catMaybes)
 import Data.Ord (Down(..))
 import Gargantext.Prelude
-import Data.Map (Map, fromListWith, lookup, toList, mapWithKey, elems)
 import qualified Data.Map as DM
-import Data.Maybe (catMaybes)
-import Data.List (concat, sortOn)
-import Data.Graph.Clustering.Louvain.Utils (LouvainNode(..))
-import Gargantext.Core.Methods.Graph.Louvain (LouvainNodeId, CommunityId, nodeId2comId)
+import Gargantext.Core.Viz.Graph.Tools.IGraph (ClusterNode(..))
+
+----------------------------------------------------------------------
+type Partitions a = Map (Int, Int) Double -> IO [a]
+----------------------------------------------------------------------
+class ToComId a where
+  nodeId2comId :: a -> (NodeId,CommunityId)
+
+type NodeId        = Int
+type CommunityId   = Int
+
+----------------------------------------------------------------------
+instance ToComId LouvainNode where
+  nodeId2comId (LouvainNode i1 i2) = (i1, i2)
 
+instance ToComId ClusterNode where
+  nodeId2comId (ClusterNode i1 i2) = (i1, i2)
 
+----------------------------------------------------------------------
+----------------------------------------------------------------------
 type Bridgeness = Double
 
-bridgeness :: Bridgeness
-           -> [LouvainNode]
-           -> Map (LouvainNodeId, LouvainNodeId) Double
-           -> Map (LouvainNodeId, LouvainNodeId) Double
-bridgeness b ns = DM.fromList
+bridgeness :: ToComId a => Bridgeness
+           -> [a]
+           -> Map (NodeId, NodeId) Double
+           -> Map (NodeId, NodeId) Double
+bridgeness = bridgeness' nodeId2comId
+
+
+bridgeness' :: (a -> (Int, Int))
+           -> Bridgeness
+           -> [a]
+           -> Map (Int, Int) Double
+           -> Map (Int, Int) Double
+bridgeness' f b ns = DM.fromList
                    . concat
                    . DM.elems
                    . filterComs b
-                . groupEdges (nodeId2comId ns)
+                   . groupEdges (DM.fromList $ map f ns)
 
-groupEdges :: Map  LouvainNodeId CommunityId
-           -> Map (LouvainNodeId, LouvainNodeId) Double
-           -> Map (CommunityId, CommunityId) [((LouvainNodeId, LouvainNodeId), Double)]
+
+groupEdges :: (Ord a, Ord b1)
+           => Map b1 a
+           -> Map (b1, b1) b2
+           -> Map (a, a) [((b1, b1), b2)]
 groupEdges m = fromListWith (<>)
              . catMaybes
              . map (\((n1,n2), d)
@@ -55,9 +81,11 @@ groupEdges m = fromListWith (<>)
              . toList
 
 -- | TODO : sortOn Confluence
-filterComs :: Bridgeness
-           -> Map (CommunityId, CommunityId) [((LouvainNodeId, LouvainNodeId), Double)]
-           -> Map (CommunityId, CommunityId) [((LouvainNodeId, LouvainNodeId), Double)]
+
+filterComs :: (Ord n1, Eq n2) 
+           => p
+           -> Map (n2, n2) [(a3, n1)]
+           -> Map (n2, n2) [(a3, n1)]
 filterComs _b m = DM.filter (\n -> length n > 0) $ mapWithKey filter' m
   where
     filter' (c1,c2) a

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

@@ -80,7 +80,8 @@ fromIndex :: Ord t => Map Index t -> Map (Index, Index) a -> Map (t,t) a
 fromIndex ni ns = indexConversion ni ns
 
 indexConversion :: (Ord b, Ord k) => Map k b -> Map (k,k) a -> Map (b, b) a
-indexConversion index ms = M.fromList $ map (\((k1,k2),c) -> ( ((M.!) index k1, (M.!) index k2), c)) (M.toList ms)
+indexConversion index ms = M.fromList
+                         $ map (\((k1,k2),c) -> ( ((M.!) index k1, (M.!) index k2), c)) (M.toList ms)
 ---------------------------------------------------------------------------------
 
 -------------------------------------------------------------------------------

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

@@ -9,13 +9,11 @@ Portability : POSIX
 
 -}
 
-
 module Gargantext.Core.Viz.Graph.Tools
   where
 
 -- import Data.Graph.Clustering.Louvain (hLouvain, {-iLouvainMap-})
 import Data.Graph.Clustering.Louvain.CplusPlus (cLouvain)
-import Data.Graph.Clustering.Louvain.Utils (LouvainNode(..))
 import Data.Map (Map)
 import Data.HashMap.Strict (HashMap)
 import Data.Text (Text)
@@ -26,8 +24,8 @@ 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.Bridgeness (bridgeness)
-import Gargantext.Core.Viz.Graph.IGraph (mkGraphUfromEdges)
+import Gargantext.Core.Viz.Graph.Bridgeness (bridgeness, Partitions, ToComId(..))
+import Gargantext.Core.Viz.Graph.Tools.IGraph (mkGraphUfromEdges, spinglass)
 import Gargantext.Core.Viz.Graph.Index (createIndices, toIndex, map2mat, mat2map, Index)
 import Gargantext.Prelude
 import IGraph.Random -- (Gen(..))
@@ -54,12 +52,24 @@ cooc2graph' distance threshold myCooc = distanceMap
     distanceMat = measure distance matCooc
     distanceMap = Map.filter (> threshold) $ mat2map distanceMat
 
+data PartitionMethod = Louvain | Spinglass
+
+cooc2graphWith :: PartitionMethod
+               -> Distance
+               -> Threshold
+               -> HashMap (NgramsTerm, NgramsTerm) Int
+               -> IO Graph
+cooc2graphWith Louvain   = cooc2graphWith' (cLouvain "1")
+cooc2graphWith Spinglass = cooc2graphWith' (spinglass 1)
+
 
-cooc2graph :: Distance
+cooc2graphWith' :: ToComId a
+               => Partitions a
+               -> Distance
                -> Threshold
                -> HashMap (NgramsTerm, NgramsTerm) Int
                -> IO Graph
-cooc2graph distance threshold myCooc = do
+cooc2graphWith' doPartitions distance threshold myCooc = do
   printDebug "cooc2graph" distance
   let
     -- TODO remove below
@@ -79,12 +89,13 @@ cooc2graph distance threshold myCooc = do
         n' = Set.size $ Set.fromList $ as <> bs
     ClustersParams rivers _level = clustersParams nodesApprox
 
-
+  printDebug "Start" ("partitions" :: Text)
   partitions <- if (Map.size distanceMap > 0)
       -- then iLouvainMap 100 10 distanceMap
       -- then hLouvain distanceMap
-      then cLouvain "1" distanceMap
+      then doPartitions distanceMap
       else panic "Text.Flow: DistanceMap is empty"
+  printDebug "End" ("partitions" :: Text)
 
   let
     -- bridgeness' = distanceMap
@@ -92,10 +103,11 @@ cooc2graph distance threshold myCooc = do
                 $ bridgeness rivers partitions distanceMap
     confluence' = confluence (Map.keys bridgeness') 3 True False
 
-  pure $ data2graph (Map.toList $ Map.mapKeys unNgramsTerm ti) myCooc' bridgeness' confluence' partitions
-
-
+  pure $ data2graph (Map.toList $ Map.mapKeys unNgramsTerm ti)
+                    myCooc' bridgeness' confluence' partitions
 
+------------------------------------------------------------------------
+------------------------------------------------------------------------
 data ClustersParams = ClustersParams { bridgness :: Double
                                      , louvain   :: Text
                                      } deriving (Show)
@@ -112,16 +124,17 @@ clustersParams x = ClustersParams (fromIntegral x) "0.00000001" -- y
 
 ----------------------------------------------------------
 -- | From data to Graph
-data2graph :: [(Text, Int)]
+data2graph :: ToComId a 
+           => [(Text, Int)]
            -> Map (Int, Int) Int
            -> Map (Int, Int) Double
            -> Map (Int, Int) Double
-           -> [LouvainNode]
+           -> [a]
            -> Graph
 data2graph labels coocs bridge conf partitions = Graph nodes edges Nothing
   where
 
-    community_id_by_node_id = Map.fromList [ (n, c) | LouvainNode n c <- partitions ]
+    community_id_by_node_id = Map.fromList $ map nodeId2comId partitions
 
     nodes = map (setCoord ForceAtlas labels bridge)
           [ (n, Node { node_size = maybe 0 identity (Map.lookup (n,n) coocs)
@@ -146,8 +159,11 @@ data2graph labels coocs bridge conf partitions = Graph nodes edges Nothing
                        , edge_weight =  d
                        , edge_confluence = maybe 0 identity $ Map.lookup (s,t) conf
                    -- , edge_confluence = maybe (panic "E: data2graph edges") identity $ Map.lookup (s,t) conf
-                   , edge_id     = cs (show i) }
-                   | (i, ((s,t), d)) <- zip ([0..]::[Integer]) (Map.toList bridge), s /= t, d > 0
+                       , edge_id     = cs (show i)
+                   }
+                   | (i, ((s,t), d)) <- zip ([0..]::[Integer] )
+                                            (Map.toList bridge)
+                   , s /= t, d > 0
                    ]
 
 

src/Gargantext/Core/Viz/Graph/IGraph.hs → src/Gargantext/Core/Viz/Graph/Tools/IGraph.hs

-{-| Module      : Gargantext.Core.Viz.Graph.IGraph
-Description : IGraph main functions used in Garg
+{-|
+Module      : Gargantext.Core.Viz.Graph.Tools.IGraph
+Description : Tools to build Graph
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3
 Maintainer  : team@gargantext.org
 Stability   : experimental
 Portability : POSIX
 
-Main IGraph funs/types to ease portability with FGL.
-
 Reference:
 * Gábor Csárdi, Tamás Nepusz: The igraph software package for complex network research. InterJournal Complex Systems, 1695, 2006.
 
 -}
 
+module Gargantext.Core.Viz.Graph.Tools.IGraph
+  where
 
-module Gargantext.Core.Viz.Graph.IGraph where
-
-import Data.Serialize (Serialize)
+import Data.Serialize
 import Data.Singletons (SingI)
-import Gargantext.Prelude
 import IGraph hiding (mkGraph, neighbors, edges, nodes, Node, Graph)
-import IGraph.Algorithms.Clique as IAC
-import qualified IGraph as IG
+import Protolude
+import Gargantext.Core.Viz.Graph.Index
 import qualified Data.List                   as List
+import qualified IGraph                      as IG
+import qualified IGraph.Algorithms.Clique    as IG
+import qualified IGraph.Algorithms.Community as IG
+import qualified IGraph.Random               as IG
+import qualified Data.Map                    as Map
 
 ------------------------------------------------------------------
 -- | Main Types
@@ -33,39 +36,68 @@ type Node = IG.Node
 type Graph = IG.Graph
 
 ------------------------------------------------------------------
--- | Main Functions
-
-mkGraph :: (SingI d, Ord v,
-             Serialize v, Serialize e) =>
-     [v] -> [LEdge e] -> IG.Graph d v e
-mkGraph = IG.mkGraph
-
-neighbors :: IG.Graph d v e -> IG.Node -> [Node]
+-- | Main Graph management Functions
+neighbors :: IG.Graph d v e -> IG.Node -> [IG.Node]
 neighbors = IG.neighbors
 
 edges :: IG.Graph d v e -> [Edge]
 edges = IG.edges
 
-nodes :: IG.Graph d v e -> [Node]
+nodes :: IG.Graph d v e -> [IG.Node]
 nodes = IG.nodes
-------------------------------------------------------------------
 
--- | Tools
+------------------------------------------------------------------
+-- | Partitions
 maximalCliques :: IG.Graph d v e -> [[Int]]
-maximalCliques g = IAC.maximalCliques g (min',max')
+maximalCliques g = IG.maximalCliques g (min',max')
   where
     min' = 0
     max' = 0
 
 ------------------------------------------------------------------
--- | Main sugared functions
+type Seed = Int
+
+spinglass :: Seed -> Map (Int, Int) Double -> IO [ClusterNode]
+spinglass s g = toClusterNode
+             <$> map catMaybes
+             <$> map (map (\n -> Map.lookup n fromI))
+             <$> partitions_spinglass' s g''
+  where
+    g'' = mkGraphUfromEdges (Map.keys g')
+    (toI, fromI) = createIndices g
+    g' = toIndex toI g
+
+-- | Tools to analyze graphs
+partitions_spinglass' :: (Serialize v, Serialize e)
+                         => Seed -> IG.Graph 'U v e -> IO [[Int]]
+partitions_spinglass' s g = do
+  gen <- IG.withSeed s pure
+  pure $ IG.findCommunity g Nothing Nothing IG.spinglass gen
+
+
+data ClusterNode = ClusterNode { cl_node_id :: Int
+                               , cl_community_id :: Int
+                               }
+
+toClusterNode :: [[Int]] -> [ClusterNode]
+toClusterNode ns = List.concat
+                 $ map (\(cId, ns') -> map (\n -> ClusterNode n cId) ns')
+                 $ List.zip [1..] ns
+
+------------------------------------------------------------------
+mkGraph :: (SingI d, Ord v,
+             Serialize v, Serialize e) =>
+     [v] -> [LEdge e] -> IG.Graph d v e
+mkGraph = IG.mkGraph
+
+------------------------------------------------------------------
 mkGraphUfromEdges :: [(Int, Int)] -> Graph_Undirected
 mkGraphUfromEdges es = mkGraph (List.replicate n ()) $ zip es $ repeat ()
   where
     (a,b) = List.unzip es
     n = List.length (List.nub $ a <> b)
 
+{-
 mkGraphDfromEdges :: [(Int, Int)] -> Graph_Directed
 mkGraphDfromEdges = undefined
-
-
+-}

src/Gargantext/Database/Action/Delete.hs

@@ -53,7 +53,7 @@ deleteNode u nodeId = do
     nt | nt == toDBid NodeFile -> do
       node <- getNodeWith nodeId (Proxy :: Proxy HyperdataFile)
       let (HyperdataFile { _hff_path = path }) = node ^. node_hyperdata
-      GPU.removeFile $ unpack path
+      GPU.rmFile $ unpack path
       N.deleteNode nodeId
     _                             -> N.deleteNode nodeId
    

src/Gargantext/Database/Query/Facet.hs

@@ -24,6 +24,10 @@ module Gargantext.Database.Query.Facet
   , runCountDocuments
   , filterWith
 
+  , Category
+  , Score
+  , Title
+
   , Pair(..)
   , Facet(..)
   , FacetDoc
@@ -73,10 +77,11 @@ import Gargantext.Database.Schema.Node
 --instance ToJSON   Facet
 
 type Category = Int
+type Score    = Double
 type Title    = Text
 
 -- TODO remove Title
-type FacetDoc = Facet NodeId UTCTime Title HyperdataDocument (Maybe Category) (Maybe Double) (Maybe Double)
+type FacetDoc = Facet NodeId UTCTime Title HyperdataDocument (Maybe Category) (Maybe Double) (Maybe Score)
 -- type FacetSources = FacetDoc
 -- type FacetAuthors = FacetDoc
 -- type FacetTerms   = FacetDoc
@@ -346,17 +351,17 @@ filterWith :: (PGOrd date, PGOrd title, PGOrd category, PGOrd score, hyperdata ~
 filterWith o l order q = limit' l $ offset' o $ orderBy (orderWith order) q
 
 
-orderWith :: (PGOrd b1, PGOrd b2, PGOrd b3)
+orderWith :: (PGOrd b1, PGOrd b2, PGOrd b3, PGOrd b4)
           => Maybe OrderBy
-          -> Order (Facet id (Column b1) (Column b2) (Column SqlJsonb) (Column b3) ngramCount score)
+          -> Order (Facet id (Column b1) (Column b2) (Column SqlJsonb) (Column b3) ngramCount (Column b4))
 orderWith (Just DateAsc)   = asc  facetDoc_created
 orderWith (Just DateDesc)  = desc facetDoc_created
 
 orderWith (Just TitleAsc)  = asc  facetDoc_title
 orderWith (Just TitleDesc) = desc facetDoc_title
 
-orderWith (Just ScoreAsc)  = asc  facetDoc_category
-orderWith (Just ScoreDesc) = desc facetDoc_category
+orderWith (Just ScoreAsc)  = asc  facetDoc_score
+orderWith (Just ScoreDesc) = descNullsLast facetDoc_score
 
 orderWith (Just SourceAsc)  = asc  facetDoc_source
 orderWith (Just SourceDesc) = desc facetDoc_source

src/Gargantext/Database/Query/Table/NodeNode.hs

@@ -25,6 +25,7 @@ module Gargantext.Database.Query.Table.NodeNode
   , selectDocNodes
   , selectDocs
   , nodeNodesCategory
+  , nodeNodesScore
   , getNodeNode
   , insertNodeNode
   , deleteNodeNode
@@ -130,7 +131,7 @@ _nodeNodeCategory cId dId c = map (\(PGS.Only a) -> a) <$> runPGSQuery favQuery
                RETURNING node2_id;
                |]
 
-nodeNodesCategory :: [(CorpusId,DocId,Int)] -> Cmd err [Int]
+nodeNodesCategory :: [(CorpusId, DocId, Int)] -> Cmd err [Int]
 nodeNodesCategory inputData = map (\(PGS.Only a) -> a)
                             <$> runPGSQuery catQuery (PGS.Only $ Values fields inputData)
   where
@@ -144,6 +145,31 @@ nodeNodesCategory inputData = map (\(PGS.Only a) -> a)
                        RETURNING nn1.node2_id
                   |]
 
+------------------------------------------------------------------------
+-- | Score management
+_nodeNodeScore :: CorpusId -> DocId -> Int -> Cmd err [Int]
+_nodeNodeScore cId dId c = map (\(PGS.Only a) -> a) <$> runPGSQuery scoreQuery (c,cId,dId)
+  where
+    scoreQuery :: PGS.Query
+    scoreQuery = [sql|UPDATE nodes_nodes SET score = ?
+                  WHERE node1_id = ? AND node2_id = ?
+                  RETURNING node2_id;
+                  |]
+
+nodeNodesScore :: [(CorpusId, DocId, Int)] -> Cmd err [Int]
+nodeNodesScore inputData = map (\(PGS.Only a) -> a)
+                            <$> runPGSQuery catScore (PGS.Only $ Values fields inputData)
+  where
+    fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","int4"]
+    catScore :: PGS.Query
+    catScore = [sql| UPDATE nodes_nodes as nn0
+                      SET score = nn1.score
+                       FROM (?) as nn1(node1_id, node2_id, score)
+                       WHERE nn0.node1_id = nn1.node1_id
+                       AND   nn0.node2_id = nn1.node2_id
+                       RETURNING nn1.node2_id
+                  |]
+
 ------------------------------------------------------------------------
 selectCountDocs :: HasDBid NodeType => CorpusId -> Cmd err Int
 selectCountDocs cId = runCountOpaQuery (queryCountDocs cId)

src/Gargantext/Prelude/Utils.hs

@@ -7,99 +7,216 @@ Maintainer  : team@gargantext.org
 Stability   : experimental
 Portability : POSIX
 
+TODO_1: qualitative  tests (human)
+TODO_2: quantitative tests (coded)
 -}
 
 module Gargantext.Prelude.Utils
   where
 
+
 import Control.Exception
 import Control.Lens (view)
-import Control.Monad.Reader (MonadReader)
 import Control.Monad.Random.Class (MonadRandom)
+import Control.Monad.Reader (MonadReader)
+import Data.Aeson (ToJSON, toJSON)
 import Data.Text (Text)
-import qualified Data.Text             as Text
+import Data.Tuple.Extra (both)
 import GHC.IO (FilePath)
+import Gargantext.Database.Admin.Types.Node (NodeId, NodeType)
+import Gargantext.Database.Prelude (HasConfig(..))
+import Gargantext.Prelude
+import Gargantext.Prelude.Config
+import Gargantext.Prelude.Crypto.Hash
 import System.Directory (createDirectoryIfMissing)
-import qualified System.Directory as SD
 import System.IO.Error
 import System.Random (newStdGen)
+import qualified Data.Text             as Text
+import qualified System.Directory as SD
 import qualified System.Random.Shuffle as SRS
 
-import Gargantext.Prelude.Config
-import Gargantext.Prelude.Crypto.Hash
-import Gargantext.Database.Prelude (HasConfig(..))
-import Gargantext.Database.Admin.Types.Node (NodeId, NodeType)
-import Gargantext.Prelude
-
---------------------------------------------------------------------------
-shuffle :: MonadRandom m => [a] -> m [a]
-shuffle ns = SRS.shuffleM ns 
+-------------------------------------------------------------------
+-- | Main Class to use (just declare needed functions)
+class GargDB a where
+  write :: a        -> IO ()
+  read  :: FilePath -> IO a
 
---------------------------------------------------------------------------
-data NodeToHash = NodeToHash { nodeType :: NodeType
-                             , nodeId   :: NodeId
-                             }
+  rm    :: (a, FilePath) -> IO ()
+  mv    :: (a, FilePath) -> FilePath -> IO ()
 
-type FolderPath = FilePath
-type FileName   = FilePath
 
--- | toPath example of use:
--- toPath 2 "gargantexthello"
--- ("ga/rg","antexthello")
--- 
--- toPath 3 "gargantexthello"
--- ("gar/gan","texthello")
+-- | Why not this class too ?
+class ToJSON parameters => GargDB' parameters gargdata where
+  write' :: parameters -> gargdata -> IO ()
+  read'  :: parameters -> IO gargdata
 
+  rm'    :: gargdata -> parameters -> IO ()
+  mv'    :: gargdata -> parameters -> parameters -> IO ()
 
-toPath :: Int -> Text -> (FolderPath, FileName)
-toPath n x = (Text.unpack $ Text.intercalate "/" [x1,x2], Text.unpack xs)
-  where
-    (x1,x') = Text.splitAt n x
-    (x2,xs) = Text.splitAt n x'
-
+-------------------------------------------------------------------
+-- | Deprecated Class, use GargDB instead
 class SaveFile a where
   saveFile' :: FilePath -> a -> IO ()
 
 class ReadFile a where
   readFile' :: FilePath -> IO a
 
+-------------------------------------------------------------------
+-------------------------------------------------------------------
+type GargFilePath = (FolderPath, FileName)
+-- where
+type FolderPath = FilePath
+type FileName   = FilePath
 
-folderFilePath :: (MonadReader env m, MonadBase IO m) => m (FolderPath, FileName)
-folderFilePath = do
-  (foldPath, fileName)  <- liftBase $ (toPath 3) . hash . show <$> newStdGen
-
+           --------------------------------
+
+dataFilePath :: (ToJSON a) => a -> GargFilePath
+dataFilePath = toPath . hash . show . toJSON
+
+randomFilePath :: ( MonadReader  env m
+                  , MonadBase IO     m
+                  )
+               => m GargFilePath
+randomFilePath = do
+  (foldPath, fileName)  <- liftBase
+                         $ toPath
+                         . hash
+                         . show
+                         <$> newStdGen
   pure (foldPath, fileName)
 
 
-writeFile :: (MonadReader env m, MonadBase IO m, HasConfig env, SaveFile a)
+-- | toPath' : how to hash text to path
+{- example of use:
+>>> toPath' (1,2) ("","helloword")
+("/he","lloword")
+
+>>> toPath' (2,2) ("","helloword")
+("/he/ll","oword")
+
+>>> toPath' (2,3) ("","helloword")
+("/hel/low","ord")
+-}
+toPath :: Text -> (FolderPath, FileName)
+toPath tx = both Text.unpack $ toPath' (2,3) ("", tx)
+
+toPath' :: (Int,Int) -> (Text,Text) -> (Text,Text)
+toPath' (n,m) (t,x) = foldl' (\tx _ -> toPath'' m tx) (t,x) [1..n]
+
+toPath'' :: Int -> (Text, Text) -> (Text, Text)
+toPath'' n (fp,fn) = (fp'',fn')
+  where
+    (fp',fn') = Text.splitAt n fn
+    fp''      = Text.intercalate "/" [fp,fp']
+
+-------------------------------------------------------------------
+type DataPath   = FilePath
+toFilePath :: FilePath -> FilePath -> FilePath
+toFilePath fp1 fp2 = fp1 <> "/" <> fp2
+
+-------------------------------------------------------------------
+
+-- | Disk operations
+-- | For example, this write file with a random filepath
+-- better use a hash of json of Type used to parameter as input 
+-- the functions
+writeFile :: ( MonadReader env m
+             , HasConfig   env
+             , MonadBase IO    m
+             , SaveFile        a
+             )
           => a -> m FilePath
 writeFile a = do
   dataPath <- view $ hasConfig . gc_datafilepath
 
-  (foldPath, fileName) <- folderFilePath
+  (foldPath, fileName) <- randomFilePath
 
-  let filePath = foldPath <> "/" <> fileName
-      dataFoldPath = dataPath <> "/" <> foldPath
-      dataFileName = dataPath <> "/" <> filePath
+  let filePath     = toFilePath foldPath fileName
+      dataFoldPath = toFilePath dataPath foldPath
+      dataFileName = toFilePath dataPath filePath
 
   _ <- liftBase $ createDirectoryIfMissing True dataFoldPath
   _ <- liftBase $ saveFile' dataFileName a
 
   pure filePath
 
+---
 
-readFile :: (MonadReader env m, MonadBase IO m, HasConfig env, ReadFile a)
+-- | Example to read a file with Type 
+readFile :: ( MonadReader  env m
+            , HasConfig    env
+            , MonadBase IO     m
+            , ReadFile         a
+            )
          => FilePath -> m a
 readFile fp = do
   dataPath <- view $ hasConfig . gc_datafilepath
-  liftBase $ readFile' $ dataPath <> "/" <> fp
+  liftBase $ readFile' $ toFilePath dataPath fp
+
+---
 
-removeFile :: (MonadReader env m, MonadBase IO m, HasConfig env)
+rmFile :: ( MonadReader env m
+              , MonadBase IO m
+              , HasConfig env
+              )
            => FilePath -> m ()
-removeFile fp = do
+rmFile = onDisk_1 SD.removeFile
+
+cpFile :: (MonadReader env m, MonadBase IO m, HasConfig env)
+           => FilePath -> FilePath -> m ()
+cpFile = onDisk_2 SD.copyFile
+
+---
+
+mvFile :: (MonadReader env m, MonadBase IO m, HasConfig env)
+       => FilePath -> FilePath -> m ()
+mvFile fp1 fp2 = do
+  cpFile fp1 fp2
+  rmFile fp1
+  pure ()
+
+------------------------------------------------------------------------
+onDisk_1 :: ( MonadReader env m
+              , MonadBase IO m
+              , HasConfig env
+              )
+        => (FilePath -> IO ()) -> FilePath -> m ()
+onDisk_1 action fp = do
   dataPath <- view $ hasConfig . gc_datafilepath
-  liftBase $ SD.removeFile (dataPath <> "/" <> fp) `catch` handleExists
+  liftBase $ action (toFilePath dataPath fp) `catch` handleExists
     where
       handleExists e
         | isDoesNotExistError e = return ()
         | otherwise = throwIO e
+
+
+onDisk_2 :: ( MonadReader env m
+              , MonadBase IO m
+              , HasConfig env
+              )
+        => (FilePath -> FilePath -> IO ())
+        -> FilePath
+        -> FilePath
+        -> m ()
+onDisk_2 action fp1 fp2 = do
+  dataPath <- view $ hasConfig . gc_datafilepath
+  let fp1' = toFilePath dataPath fp1
+      fp2' = toFilePath dataPath fp2
+  liftBase $ action fp1' fp2' `catch` handleExists
+    where
+      handleExists e
+        | isDoesNotExistError e = return ()
+        | otherwise = throwIO e
+------------------------------------------------------------------------
+
+------------------------------------------------------------------------
+-- | Misc Utils
+shuffle :: MonadRandom m => [a] -> m [a]
+shuffle ns = SRS.shuffleM ns 
+--------------------------------------------------------------------------
+
+-- TODO gargDB instance for NodeType
+data NodeToHash = NodeToHash { nodeType :: NodeType
+                             , nodeId   :: NodeId
+                             }
+