merge done

.gitignore

+*back
+
+*lock
+
 # Cabal
 *.cabal
 

bin/gargantext-adaptative-phylo/Main.hs

@@ -33,6 +33,7 @@ import Gargantext.Core.Viz.AdaptativePhylo
 import Gargantext.Core.Viz.Phylo.PhyloMaker  (toPhylo, toPhyloStep)
 import Gargantext.Core.Viz.Phylo.PhyloTools  (printIOMsg, printIOComment, setConfig)
 import Gargantext.Core.Viz.Phylo.PhyloExport (toPhyloExport, dotToFile)
+-- import Gargantext.API.Ngrams.Prelude (toTermList)
 
 import GHC.IO (FilePath) 
 import Prelude (Either(Left, Right))

bin/gargantext-hs.gource

+#!/bin/bash
+
+DATE="2018-03-08 07:18:18"
+
+# record my desktop + title + scp-gargantext
+# use tutoriel code
+
+#tmux -d video
+xterm -e "tutoriel"
+
+gource --start-date $DATE ../gargantext-hs &
+gource --start-date $DATE gargantext-hs/purescript-gargantext
+#tmux -a video
+
+# Share video ?
+
+
+

bin/gargantext-phylo/Main.hs

@@ -18,15 +18,13 @@ Phylo binaries
 module Main where
 
 import Control.Concurrent.Async as CCA (mapConcurrently)
-import Control.Monad (mapM)
 import Data.Aeson
 import Data.List ((++),concat)
 import Data.Maybe
-import Data.Text (Text, unwords, unlines)
+import Data.Text (Text, unwords)
 import GHC.Generics
 import GHC.IO (FilePath)
 import Gargantext.Database.Admin.Types.Hyperdata
-import Gargantext.Database.Admin.Types.Node
 import Gargantext.Prelude
 import Gargantext.Core.Text.Context (TermList)
 import Gargantext.Core.Text.Corpus.Parsers (FileFormat(..),parseFile)

bin/gargantext-upgrade/Main.hs

@@ -19,9 +19,6 @@ import Gargantext.API.Admin.EnvTypes (DevEnv)
 import Gargantext.API.Dev (withDevEnv, runCmdDev)
 import Gargantext.API.Prelude (GargError)
 import Gargantext.API.Node () -- instances only
-import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Admin.Types.Hyperdata
-import Gargantext.Database.Query.Table.Node.UpdateOpaleye
 import Gargantext.Database.Prelude (Cmd'', )
 import Gargantext.Prelude
 import System.Environment (getArgs)
@@ -29,7 +26,6 @@ import Prelude (getLine)
 
 -- | PosTag
 import Gargantext.Database.Action.Flow (indexAllDocumentsWithPosTag)
-import Gargantext.Database.Query.Table.NgramsPostag (createTable_NgramsPostag)
 
 main :: IO ()
 main = do

bin/gargantext_stop

+#!/bin/bash
+
+tmux kill-session -t gargantext

bin/gargantext_tmux

+#!/bin/bash
+
+tmux new -d -s gargantext './server' \; \
+            split-window -h -d 'cd ./purescript-gargantext ; ./server' \; \
+            select-pane -t 1 \; \
+            split-window -d    'cd deps/CoreNLP ; ./startServer.sh' \; \

bin/psql

+#!/bin/bash
+
+psql postgresql://gargantua:C8kdcUrAQy66U12341@localhost/gargandbV5
+

bin/sql

+
+SELECT
+"result1_0_3" as "result1_4",
+"result1_1_3" as "result2_4",
+"result1_2_3" as "result3_4",
+"result1_3_3" as "result4_4",
+"result1_4_3" as "result5_4",
+"result1_5_3" as "result6_4",
+"result1_6_3" as "result7_4",
+"result2_1_3" as "result8_4"
+FROM (SELECT
+      *
+      FROM (SELECT *
+            FROM
+            (SELECT
+             "id0_1" as "result1_0_3",
+             "typename1_1" as "result1_1_3",
+             "user_id2_1" as "result1_2_3",
+             "parent_id3_1" as "result1_3_3",
+             "name4_1" as "result1_4_3",
+             "date5_1" as "result1_5_3",
+             "hyperdata6_1" as "result1_6_3",
+             *
+             FROM (SELECT
+                   *
+                   FROM (SELECT
+                         "id" as "id0_1",
+                         "typename" as "typename1_1",
+                         "user_id" as "user_id2_1",
+                         "parent_id" as "parent_id3_1",
+                         "name" as "name4_1",
+                         "date" as "date5_1",
+                         "hyperdata" as "hyperdata6_1"
+                         FROM "nodes" as "T1") as "T1") as "T1") as "T1"
+            LEFT OUTER JOIN
+            (SELECT
+             "node1_id0_2" as "result2_0_3",
+             "node2_id1_2" as "result2_1_3",
+             "score2_2" as "result2_2_3",
+             "category3_2" as "result2_3_3",
+             *
+             FROM (SELECT
+                   *
+                   FROM (SELECT
+                         "node1_id" as "node1_id0_2",
+                         "node2_id" as "node2_id1_2",
+                         "score" as "score2_2",
+                         "category" as "category3_2"
+                         FROM "nodes_nodes" as "T1") as "T1") as "T1") as "T2"
+            ON
+            ("node1_id0_2") = ("id0_1")) as "T1"
+      WHERE (("result1_1_3") = (CAST(22 AS integer)))) as "T1"

devops/debian/docker

+#!/bin/bash
+
+sudo apt-get -y remove --purge docker docker-engine docker.io containerd runc
+
+
+sudo apt-get -y install \
+    apt-transport-https \
+    ca-certificates \
+    curl \
+    gnupg-agent \
+    software-properties-common
+
+curl -fsSL https://download.docker.com/linux/debian/gpg | sudo apt-key add -
+sudo apt-key fingerprint 0EBFCD88
+
+sudo add-apt-repository \
+   "deb [arch=amd64] https://download.docker.com/linux/debian \
+   $(lsb_release -cs) \
+   stable"
+
+sudo apt update
+
+sudo apt-get -y install docker-ce docker-ce-cli containerd.io
+sudo apt -y install docker-compose
+
+sudo addgroup gargantua docker
+

devops/debian/install

@@ -22,13 +22,13 @@ sudo apt install tmux htop
 
 ########################################################################
 sudo sed -i "s/stretch/buster/g" /etc/apt/sources.list
-#sudo apt update
+sudo apt update
 sudo apt dist-upgrade
 # sudo reboot #recommended
 ########################################################################
 
 #sudo apt update
-sudo apt install liblzma-dev libpcre3-dev libblas-dev liblapack-dev pkg-config libgsl-dev libbz2-dev postgresql postgresql-server-dev-11 nginx libigraph0-dev libgfortran-8-dev
+sudo apt install liblzma-dev libpcre3-dev libblas-dev liblapack-dev pkg-config libgsl-dev libbz2-dev postgresql postgresql-server-dev-11 nginx libigraph0-dev libgfortran-9-dev
 
 sudo apt install git
 #git config --global user.email "contact@gargantext.org"
@@ -75,10 +75,6 @@ if [[ ! -d "deps" ]]; then
   mkdir -v deps
   cd deps
 
-  if [[ ! -d "clustering-louvain-cplusplus" ]]; then
-    ../devops/debian/install-clustering-louvain
-  fi
-
   sudo apt install default-jdk
   if [[ ! -f "coreNLP.tar.bz2" ]]; then
     wget https://dl.gargantext.org/coreNLP.tar.bz2
@@ -123,58 +119,3 @@ fi
 # configure the database with script in devops/postgres
 # edit gargantext.ini
 
-
-
-                        ..........,,;;;;,,,oKXNNNNNNNNNXXXXXKK0OOxdl::ccc:::::;;;;,,,'..                                 
-              .........';;;;;;,,,,'''''''''dXNMMMMMMMMMMMMMMMMMMMWWWNNNWNNNNNNXXXXKKK0Oxddlcc::::::::;;;,,,'....         
-    .........',,,;;;;,,,'''''''''''''''''''oXNMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWWWWWNNNNNNNXXXXKKK0Oxddlcccc::;;
-   .::cccllc:;''''''''''''''''''''.''''''''oXNMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWNNNXXXXKK0O
-...';;;;;;;;;,'''''''''''''''''''''''''''''oXNMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWWWWNNNNNNX0
-;;,,'''''''''''''''''''''''''''''''''''''''oXNMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX
-'''''''''''''''''''''''''''''''''',;:::cclldkOOOOO00000KKKXXNWWMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMNX
-'''''''''''''''''''''''''''';:loodkkOO0KKXXkc:;;;;:::::cccloodxkkO0NMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMNX
-''''''''''''''''''','''''',,:okKKNMMMMMMMMMk;,'''''''',''''''',;;cd0MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMNX
-''''''''''''''''''''''',:lxxk0KNNWMWWWNXKKKkoooolllcc:;,''''''',,:lOMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX
-''''''''''''''''''',:llx0XWWMMWWWX0kddolcccx0KXXXXKKK0Okxxo:;'''';:OMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX
-'''''''''''''''''':oOXXNMMMMNXOddl:,'''''''oXNMMMMMMMMMMWWX0l'''';:kMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX
-'''''''''''''''':lONWMMMMNXXkl:,,''''''''''dXNMMMMMMMMMMMMWWx,,'';:kMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX
-,'''''''''''',::xXNMMMMWWOoo:''''''''''''''dXNMMMMWNNNNWWWMMk:;'';cOMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX
-,'''''''''''':oo0MMMMMMWXd,,,,''''''''''',,dXNMMMMNXXXXNWWMMOc;'';cOMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX
-'''''''''''''lOOXMMMMMMXkl'''''''''''''''''dXNMMWNKOOOO0KKNMKxoccod0MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX
-,'''''''''',:kWWWMMMWWWk:,'''''''''''''''''dXNMMXOkxxxxxxx0NNNXKKKXNMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX
-,''''''''''cxKMMMMMMNKKo'''''''''''''''''''dXNMMXOkxxxxxxx0NWMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX
-'''''''''''oKNMMMMMMKddc'''''''''''''''''''dXWMMNX0OOOkO00XWMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX
-,''''''''''dNWMMMMMM0oo:'''''''''''''''''''oXNMMWWX000OKNNWMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX
-,'''''''',,xWWMMMMMMOcc;'''''''''''''''''''oXNMMMWNNNXXNWWWMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX
-,''''''',;;kMMMMMMMMk;;,'''''''''''''''''''dXWMMMMMMMMWMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX
-,''''''',::kMMMMMMMMk;;,'''''''''''''''''''dXNMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX
-,''''''';::kMMMMMMMMk;;,'''''''''''''''''''dXNMMNKOkkkkkkkkkkkkkkkkkkkkkOOOXMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX
-,''''''',;;kMMMMMMMMO::;'''''''''''''''''''dXNMMKxo::::;,,,,,,,,,,,;;;;:cll0MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX
-,''''''',,,kMMMMMMMMOcc;'''''''''''''''''''oXNMMXkocc::;,,,''''''''',,;:loo0MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX
-,'''''''',,xWWMMMMMM0ll:'''''''''''''''''''oXNMMNX0OOOkkxxc'''''',,cxxkkO00XMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX
-,''''''''''oKNMMMMMMKkkc'''''''''''''''''''dXWMMMMMMMMMWWWx,,'''',;kMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX
-,''''''''''cdKMMMMMMNXXo'''''''''''''''''''dXWMMMMMMMMMMMMk,,'''',:kMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX
-,'''''''''',;xWWWMMMMWWk:;'''''''''''''''''dXNMMMMMMMMMMMMk,,'''',:kMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMNX
-,''''''''''''lkkKMMMMMMX0o'''''''''''''''''dXNMMMMMMMMMMMMx,,'''',:kMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX
-,'''''''''''':llOMMMMMMWWx,,,''''''''''''''dXNWWMMMMMMMMMMk,,'''',:kMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX
-,'''''''''''',::xXNMMMMMW0oo:''''''''''''''dXNMMMMMMMMMMMMk,,'''',;kMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWX
-;,,''''''''''''':lONWMMMMWNNOl:''''''''''''oXNMMMMMMMMMMMMx,,'''',:kMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMNX
-.';,,,,''''''''''':dONNWMMMMWXOddl:,'''''''dXNMMMMMMMMMMMMk,,'''',:kMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMNX
-  .',,,;,''''',,''',:ookKNMMMMWWWXOxddlc:;;xXNWWWWWWWNXXKKd,,'''',:kMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMNX
-   .'',:;''''''''''''''cxKMMMMMMMMMWNN0xollxKXWWWWNXXK0Okkl,''''';:kWWMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMNX
-    ....';;,''''''''''';cokk0XWMMMMWWWXK0OOkxxxxdddddoolcc;'''',,:lOMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWNK0
-        ...,;,,,,'''',,'',,,:odkkO0KXXNNWWWk:;'''',,,;;:ccclodxkkO0XMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWNNNX0kko:;,
-            .';;;;,'''''''''''',,;:clloodddxxxxxxxkkkOO000KXNWWMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWNNXX0kocc:;'..    
-              ....';,''''''''''''''''''''''dXNMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWNNXX0koc:;;'.            
-                  ..,;;;,''''''''''''''''''dXNMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWWWNXKOOd::;;'.                   
-                    .cc:,''''''''''''''''''dXWMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMNXXK0dcc.                         
-                    ...,;;,,,''''''''''''''dXWMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMWNNNNKOdcc::,...                         
-                        ..'',;,''''''''''''oXNMMMMMMMMMMMMMMMMMMMMMMMMMMWNNNXKOOd::::,..                                 
-                            ..';;,'''''''''oKNMMMMMMMMMMMMMMMMMMMWWNXXKOd::::,...                                        
-                               ..';;,,,''''oXNMMMMMMMMMMMMWWNXKOOdc:;;,.. TODO, too big, what diet for this ascii art ?  
-                                 .::;;,''''oXNWWMMMMMMMMMMWNK0d::.                                                       
-                                 ..',,,,,''oKNMMMMWWWNX0OOdc:;,..                                                        
-                                    ....';;o0KXXKOdcc:;,...                                                              
-                                        .ccdOO00xl.                                                                      
-
-

devops/debian/install-purescript

@@ -12,5 +12,5 @@ sudo apt install yarn
 yarn install && yarn install-ps && yarn build
 
 # temporary bug (help welcome)
-cp src/index.html dist/index.html
-cd ..
+#cp src/index.html dist/index.html
+#cd ..

gargantext.ini_toModify

@@ -26,7 +26,9 @@ REPO_FILEPATH = FILEPATH_TO_CHANGE
 
 # [external]
 # FRAMES (i.e. iframe sources used in various places on the frontend)
+#FRAME_WRITE_URL = http://write.frame.gargantext.org/
 FRAME_WRITE_URL = URL_TO_CHANGE
+#FRAME_CALC_URL = http://calc.frame.gargantext.org/
 FRAME_CALC_URL  = URL_TO_CHANGE
 
 FRAME_SEARX_URL  = URL_TO_CHANGE

package.yaml

 name: gargantext
-version: '0.0.2.8'
+version: '0.0.2.9.2'
 synopsis: Search, map, share
 description: Please see README.md
 category: Data
@@ -124,7 +124,6 @@ library:
   - cassava
   - cereal     # (IGraph)
   - clock
-  - clustering-louvain
   - conduit
   - conduit-extra
   - containers

shell.nix

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

src/Gargantext/API/Ngrams/List.hs

@@ -17,29 +17,27 @@ module Gargantext.API.Ngrams.List
 
 import Control.Lens hiding (elements)
 import Data.Aeson
-import Data.Map (Map, toList, fromList)
+import Data.Map (toList, fromList)
 import Data.Swagger (ToSchema, declareNamedSchema, genericDeclareNamedSchema)
 import Data.Text (Text, concat, pack)
 import GHC.Generics (Generic)
-import Network.HTTP.Media ((//), (/:))
-import Servant
-import Servant.Job.Async
-import Servant.Job.Utils (jsonOptions)
-import Web.FormUrlEncoded (FromForm)
-
 import Gargantext.API.Admin.Orchestrator.Types
 import Gargantext.API.Ngrams (getNgramsTableMap, setListNgrams)
-import Gargantext.API.Ngrams.Types (NgramsTableMap, RepoCmdM, Versioned(..))
+import Gargantext.API.Ngrams.Types (RepoCmdM, Versioned(..), NgramsList)
 import Gargantext.API.Node.Corpus.New.File (FileType(..))
 import Gargantext.API.Prelude (GargServer)
 import Gargantext.Core.Utils.Prefix (unPrefixSwagger)
 import Gargantext.Database.Action.Flow.Types (FlowCmdM)
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Schema.Ngrams (NgramsType(..), ngramsTypes)
+import Gargantext.Database.Schema.Ngrams (ngramsTypes)
 import Gargantext.Prelude
-
+import Network.HTTP.Media ((//), (/:))
+import Servant
+import Servant.Job.Async
+import Servant.Job.Utils (jsonOptions)
+import Web.FormUrlEncoded (FromForm)
 ------------------------------------------------------------------------
-type NgramsList = (Map NgramsType (Versioned NgramsTableMap))
+
 ------------------------------------------------------------------------
 type API =  Get '[JSON, HTML] (Headers '[Header "Content-Disposition" Text] NgramsList)
        -- :<|> ReqBody '[JSON] NgramsList :> Post '[JSON] Bool

src/Gargantext/API/Ngrams/NgramsTree.hs

@@ -68,7 +68,8 @@ toTree lt vs m = map toNgramsTree $ unfoldForest buildNode roots
                     $ List.nub
                     $ map (\(c, c') -> case _nre_root c' of
                                        Nothing -> Just c
-                                       _ -> _nre_root c') (HashMap.toList m)
+                                       _ -> _nre_root c'
+                          ) (HashMap.toList m)
 
     roots = map fst
           $ filter (\(_,l) -> l == lt)

src/Gargantext/API/Ngrams/Prelude.hs

+{-|
+Module      : Gargantext.API.Ngrams.Prelude
+Description : Tools to manage Ngrams Elements (from the API)
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+{-# LANGUAGE TypeFamilies #-}
+
+module Gargantext.API.Ngrams.Prelude
+  where
+
+import Data.Maybe (catMaybes)
+import Control.Lens (view)
+import Data.Hashable (Hashable)
+import Data.Validity
+import Gargantext.API.Ngrams.Types
+import Gargantext.Core.Types (ListType)
+import Gargantext.Database.Schema.Ngrams (NgramsType)
+import Gargantext.Prelude
+import Gargantext.Core.Text.List.Social.Prelude
+import Gargantext.Core.Text.Context (TermList)
+import qualified Data.HashMap.Strict as HM
+import qualified Data.Map.Strict as Map
+import qualified Data.List as List
+import qualified Data.Text as Text
+
+------------------------------------------------------------------------
+-- | Tools
+-- Usage example: toTermList MapTerm NgramsTerms ngramsList
+toTermList :: ListType -> NgramsType -> NgramsList -> Maybe TermList
+toTermList lt nt nl = toTermList' lt <$> Map.lookup nt nl
+  where
+    toTermList' :: ListType -> Versioned NgramsTableMap -> TermList
+    toTermList' lt' = (toTermList'' lt') . Map.toList . view v_data
+
+    toTermList'' :: ListType -> [(NgramsTerm, NgramsRepoElement)] -> TermList
+    toTermList'' lt'' ns = Map.toList
+                       $ Map.mapKeys toTerm
+                       $ Map.fromListWith (<>) (roots' <> children')
+      where
+        toTerm = Text.splitOn " " . unNgramsTerm
+
+        (roots, children) = List.partition (\(_t, nre) -> view nre_root nre == Nothing)
+                          $ List.filter (\(_t,nre) -> view nre_list nre == lt'') ns
+
+        roots'    = catMaybes
+                   $ map (\(t,nre) -> (,) <$> Just t
+                                           <*> Just (map toTerm $ unMSet 
+                                                                $ view nre_children nre
+                                                    )
+                         ) roots
+
+        children' = catMaybes
+                  $ map (\(t,nre) -> (,) <$> view nre_root nre
+                                          <*> Just (map toTerm $ [t] 
+                                                              <> (unMSet $ view nre_children nre)
+                                                   )
+                        ) children 
+
+------------------------------------------
+patchMSet_toList :: (Ord a, Hashable a) => PatchMSet a -> [(a,AddRem)]
+patchMSet_toList = HM.toList . unPatchMapToHashMap . unPatchMSet
+
+unMSet :: MSet a -> [a]
+unMSet (MSet a) = Map.keys a
+

src/Gargantext/API/Ngrams/Tools.hs

@@ -142,3 +142,5 @@ getCoocByNgrams' f (Diagonal diag) m =
               ]
 
   where ks = HM.keys m
+
+------------------------------------------

src/Gargantext/API/Ngrams/Types.hs

@@ -55,6 +55,9 @@ import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixUntagged, unPrefixSwagger
 import Gargantext.Database.Prelude (fromField', CmdM', HasConnectionPool, HasConfig)
 import qualified Gargantext.Database.Query.Table.Ngrams as TableNgrams
 
+------------------------------------------------------------------------
+
+
 ------------------------------------------------------------------------
 --data FacetFormat = Table | Chart
 data TabType   = Docs   | Trash   | MoreFav | MoreTrash
@@ -218,7 +221,7 @@ instance Arbitrary NgramsElement where
 newtype NgramsTable = NgramsTable [NgramsElement]
   deriving (Ord, Eq, Generic, ToJSON, FromJSON, Show)
 
-type NgramsList = NgramsTable
+-- type NgramsList = NgramsTable
 
 makePrisms ''NgramsTable
 
@@ -753,12 +756,10 @@ instance Arbitrary NgramsRepoElement where
     where
       NgramsTable ns = mockTable
 
---{-
 instance FromHttpApiData (Map TableNgrams.NgramsType (Versioned NgramsTableMap))
   where
     parseUrlPiece x = maybeToEither x (decode $ cs x)
 
-
 ngramsTypeFromTabType :: TabType -> TableNgrams.NgramsType
 ngramsTypeFromTabType tabType =
   let lieu = "Garg.API.Ngrams: " :: Text in
@@ -783,3 +784,7 @@ instance FromJSON UpdateTableNgramsCharts where
   parseJSON = genericParseJSON $ jsonOptions "_utn_"
 instance ToSchema UpdateTableNgramsCharts where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_utn_")
+
+------------------------------------------------------------------------
+type NgramsList = (Map TableNgrams.NgramsType (Versioned NgramsTableMap))
+

src/Gargantext/API/Node/Update.hs

@@ -30,7 +30,7 @@ import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
 import Gargantext.API.Admin.Types (HasSettings)
 import Gargantext.API.Prelude (GargServer, simuLogs)
 import Gargantext.Core.Viz.Graph.API (recomputeGraph)
-import Gargantext.Core.Methods.Distances (GraphMetric(..), Distance(..))
+import Gargantext.Core.Methods.Distances (GraphMetric(..))
 import Gargantext.Database.Action.Flow.Pairing (pairing)
 import Gargantext.Database.Action.Flow.Types (FlowCmdM)
 import Gargantext.Database.Admin.Types.Node
@@ -86,9 +86,7 @@ updateNode uId nId (UpdateNodeParamsGraph metric) logStatus = do
                    , _scst_events    = Just []
                    }
 
-  _ <- case metric of
-    Order1 -> recomputeGraph uId nId Conditional
-    Order2 -> recomputeGraph uId nId Distributional
+  _ <- recomputeGraph uId nId (Just metric)
 
   pure  JobLog { _scst_succeeded = Just 2
                , _scst_failed    = Just 0

src/Gargantext/Core/Methods/Distances.hs

@@ -18,10 +18,10 @@ import Data.Aeson
 import Data.Array.Accelerate (Matrix)
 import Data.Swagger
 import GHC.Generics (Generic)
+import Gargantext.Core.Methods.Distances.Accelerate.Conditional (measureConditional)
+import Gargantext.Core.Methods.Distances.Accelerate.Distributional (logDistributional)
 import Gargantext.Prelude (Ord, Eq, Int, Double)
 import Gargantext.Prelude (Show)
-import Gargantext.Core.Methods.Distances.Accelerate.Conditional (measureConditional)
-import Gargantext.Core.Methods.Distances.Accelerate.Distributional (distributional)
 import Prelude (Enum, Bounded, minBound, maxBound)
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary
@@ -32,12 +32,12 @@ data Distance = Conditional | Distributional
 
 measure :: Distance -> Matrix Int -> Matrix Double
 measure Conditional    = measureConditional
-measure Distributional = distributional
-------------------------------------------------------------------------
+measure Distributional = logDistributional
 
-withMetric :: GraphMetric -> Matrix Int -> Matrix Double
-withMetric Order1 = measureConditional
-withMetric Order2 = distributional
+------------------------------------------------------------------------
+withMetric :: GraphMetric -> Distance
+withMetric Order1 = Conditional
+withMetric Order2 = Distributional
 
 ------------------------------------------------------------------------
 data GraphMetric = Order1 | Order2

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

@@ -116,10 +116,14 @@ distributional m' = run result
     result = termDivNan z_1 z_2
 
 logDistributional :: Matrix Int -> Matrix Double
-logDistributional m' = run result
+logDistributional m = run $ diagNull n $ matMiniMax $ logDistributional' n m
+  where
+    n = dim m
+
+logDistributional' :: Int -> Matrix Int -> Acc (Matrix Double)
+logDistributional' n m' = result
  where
     m = map fromIntegral $ use m'
-    n = dim m'
 
     -- Scalar. Sum of all elements of m.
     to = the $ sum (flatten m)
@@ -234,6 +238,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 (theMatrixInt n)
+distriTest n = logDistributional (theMatrixInt n)
 
 

src/Gargantext/Core/Methods/Distances/Conditional.hs

@@ -15,24 +15,17 @@ Motivation and definition of the @Conditional@ distance.
 module Gargantext.Core.Methods.Distances.Conditional
   where
 
-import Data.Matrix hiding (identity)
-
 import Data.List (sortOn)
-
 import Data.Map (Map)
+import Data.Matrix hiding (identity)
+import Gargantext.Core.Viz.Graph.Utils
+import Gargantext.Prelude
 import qualified Data.Map as M
-
 import qualified Data.Set as S
-
 import qualified Data.Vector as V
 
-import Gargantext.Prelude
-import Gargantext.Core.Viz.Graph.Utils
-
-------------------------------------------------------------------------
 ------------------------------------------------------------------------
 -- | Optimisation issue
-
 toBeOptimized :: (Num a, Fractional a, Ord a) => Matrix a -> Matrix a
 toBeOptimized m = proba Col m
 
@@ -56,7 +49,6 @@ mapOnly Row = mapRow
 mapAll :: (a -> a) -> Matrix a -> Matrix a
 mapAll f m = mapOn Col (\_ -> f) m
 
-
 ---------------------------------------------------------------
 -- | Compute a distance from axis
 -- xs = (sum Col x') - x'

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

@@ -242,7 +242,7 @@ matMiniMax :: (Elt a, Ord a, P.Num a)
            -> Acc (Matrix a)
 matMiniMax m = filterWith' miniMax' (constant 0) m
   where
-    miniMax' = the $ minimum $ maximum m
+    miniMax' = the $ maximum $ minimum m
 
 
 -- | Filters the matrix with a constant

src/Gargantext/Core/Text/Examples.hs

@@ -112,7 +112,7 @@ ex_cooc_mat :: IO (Map Label Index, Matrix Int, Matrix Double, (DAA.Vector Gener
 ex_cooc_mat = do
   m <- ex_cooc
   let (ti,_) = createIndices m
-  let mat_cooc = cooc2mat ti m
+  let mat_cooc = cooc2mat Triangular ti m
   pure ( ti
        , mat_cooc
        , incExcSpeGen_proba  mat_cooc
@@ -123,7 +123,7 @@ ex_incExcSpeGen :: IO ([(Label, Double)], [(Label, Double)])
 ex_incExcSpeGen = incExcSpeGen_sorted <$> ex_cooc
 
 incExcSpeGen_sorted :: Ord t => Map (t,t) Int -> ([(t,Double)],[(t,Double)])
-incExcSpeGen_sorted m = both ordonne (incExcSpeGen $ cooc2mat ti m)
+incExcSpeGen_sorted m = both ordonne (incExcSpeGen $ cooc2mat Triangular ti m)
   where
     (ti,fi) = createIndices m
     ordonne x = sortWith (Down . snd)

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

@@ -18,6 +18,7 @@ import Data.HashMap.Strict (HashMap)
 import Data.Monoid
 import Data.Semigroup
 import Gargantext.API.Ngrams.Types
+import Gargantext.API.Ngrams.Prelude (unMSet, patchMSet_toList)
 import Gargantext.Core.Text.List.Social.Prelude
 import Gargantext.Core.Types (ListId)
 import Gargantext.Database.Schema.Ngrams (NgramsType(..))
@@ -28,9 +29,9 @@ import qualified Data.HashMap.Strict as HashMap
 import qualified Data.Patch.Class    as Patch (Replace(..))
 
 addScorePatches :: NgramsType -> [ListId]
-               -> FlowCont NgramsTerm FlowListScores
-               -> Map NgramsType (Map ListId [HashMap NgramsTerm NgramsPatch])
-               -> FlowCont NgramsTerm FlowListScores
+                -> FlowCont NgramsTerm FlowListScores
+                -> Map NgramsType (Map ListId [HashMap NgramsTerm NgramsPatch])
+                -> FlowCont NgramsTerm FlowListScores
 addScorePatches nt listes fl repo = foldl' (addScorePatchesList nt repo) fl listes
 
 
@@ -136,9 +137,4 @@ score field list n m = (Just mempty <> m)
                      %~ (<> Just n)
 
 ------------------------------------------------------------------------
-patchMSet_toList :: (Ord a, Hashable a) => PatchMSet a -> [(a,AddRem)]
-patchMSet_toList = HashMap.toList . unPatchMapToHashMap . unPatchMSet
-
-unMSet :: MSet a -> [a]
-unMSet (MSet a) = Map.keys a
 

src/Gargantext/Core/Text/Metrics.hs

@@ -70,7 +70,7 @@ localMetrics' m = Map.fromList $ zipWith (\(_,t) (inc,spe) -> (t, Vec.fromList [
                                           scores
   where
     (ti, fi) = createIndices m
-    (is, ss) = incExcSpeGen $ cooc2mat ti m
+    (is, ss) = incExcSpeGen $ cooc2mat Triangular ti m
     scores   = DAA.toList
              $ DAA.run
              $ DAA.zip (DAA.use is) (DAA.use ss)
@@ -82,7 +82,7 @@ scored' :: Ord t => Map (t,t) Int -> [Scored t]
 scored' m = zipWith (\(_,t) (inc,spe) -> Scored t inc spe) (Map.toList fi) scores
   where
     (ti, fi) = createIndices m
-    (is, ss) = incExcSpeGen $ cooc2mat ti m
+    (is, ss) = incExcSpeGen $ cooc2mat Triangular ti m
     scores   = DAA.toList
              $ DAA.run
              $ DAA.zip (DAA.use is) (DAA.use ss)

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

@@ -18,6 +18,7 @@ module Gargantext.Core.Viz.Graph.API
 
 import Control.Lens (set, (^.), _Just, (^?))
 import Data.Aeson
+import Data.Maybe (fromMaybe)
 import Data.Swagger
 import Data.Text
 import Debug.Trace (trace)
@@ -26,7 +27,7 @@ import Gargantext.API.Admin.Orchestrator.Types
 import Gargantext.API.Ngrams.Tools
 import Gargantext.API.Ngrams.Types (NgramsRepo, r_version)
 import Gargantext.API.Prelude
-import Gargantext.Core.Methods.Distances (Distance(..), GraphMetric(..))
+import Gargantext.Core.Methods.Distances (Distance(..), GraphMetric(..), withMetric)
 import Gargantext.Core.Types.Main
 import Gargantext.Core.Viz.Graph
 import Gargantext.Core.Viz.Graph.GEXF ()
@@ -79,23 +80,24 @@ graphAPI u n = getGraph         u n
 getGraph :: UserId -> NodeId -> GargNoServer HyperdataGraphAPI
 getGraph _uId nId = do
   nodeGraph <- getNodeWith nId (Proxy :: Proxy HyperdataGraph)
-  let graph  = nodeGraph ^. node_hyperdata . hyperdataGraph
-  let camera = nodeGraph ^. node_hyperdata . hyperdataCamera
-
   repo <- getRepo
 
-  let cId = maybe (panic "[G.V.G.API] Node has no parent")
+  let
+    graph  = nodeGraph ^. node_hyperdata . hyperdataGraph
+    camera = nodeGraph ^. node_hyperdata . hyperdataCamera
+    cId = maybe (panic "[G.V.G.API] Node has no parent")
                   identity
                   $ nodeGraph ^. node_parentId
 
   -- 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'
-        let hg = HyperdataGraphAPI graph'' camera
+        let defaultMetric = Order1
+        graph' <- computeGraph cId (withMetric defaultMetric) NgramsTerms repo
+        mt     <- defaultGraphMetadata cId "Title" repo defaultMetric
+        let
+          graph'' = set graph_metadata (Just mt) graph'
+          hg = HyperdataGraphAPI graph'' camera
        -- _      <- updateHyperdata nId hg
         _ <- updateHyperdata nId (HyperdataGraph (Just graph'') camera)
         pure $ trace "[G.V.G.API] Graph empty, computing" hg
@@ -104,24 +106,32 @@ getGraph _uId nId = do
         HyperdataGraphAPI graph' camera
 
 
-recomputeGraph :: UserId -> NodeId -> Distance -> GargNoServer Graph
-recomputeGraph _uId nId d = do
+recomputeGraph :: UserId -> NodeId -> Maybe GraphMetric -> GargNoServer Graph
+recomputeGraph _uId nId maybeDistance = do
   nodeGraph <- getNodeWith nId (Proxy :: Proxy HyperdataGraph)
-  let graph  = nodeGraph ^. node_hyperdata . hyperdataGraph
-  let camera = nodeGraph ^. node_hyperdata . hyperdataCamera
-  let graphMetadata = graph ^? _Just . graph_metadata . _Just
-  let listVersion   = graph ^? _Just . graph_metadata . _Just . gm_list . lfg_version
+  let
+    graph  = nodeGraph ^. node_hyperdata . hyperdataGraph
+    camera = nodeGraph ^. node_hyperdata . hyperdataCamera
+    graphMetadata = graph ^? _Just . graph_metadata . _Just
+    listVersion   = graph ^? _Just . graph_metadata . _Just . gm_list . lfg_version
+    graphMetric   = case maybeDistance of
+                      Nothing -> graph ^? _Just . graph_metadata . _Just . gm_metric
+                      _       -> maybeDistance
 
   repo <- getRepo
-  let v   = repo ^. r_version
-  let cId = maybe (panic "[G.V.G.API.recomputeGraph] Node has no parent")
+  let
+    v   = repo ^. r_version
+    cId = maybe (panic "[G.V.G.API.recomputeGraph] Node has no parent")
                   identity
                   $ nodeGraph ^. node_parentId
+    similarity = case graphMetric of
+                   Nothing -> withMetric Order2
+                   Just m  -> withMetric m
 
   case graph of
     Nothing     -> do
-      graph' <- computeGraph cId d NgramsTerms repo
-      mt     <- defaultGraphMetadata cId "Title" repo
+      graph' <- computeGraph cId similarity NgramsTerms repo
+      mt     <- defaultGraphMetadata cId "Title" repo (fromMaybe Order1 maybeDistance)
       let graph'' = set graph_metadata (Just mt) graph'
       _ <- updateHyperdata nId (HyperdataGraph (Just graph'') camera)
       pure $ trace "[G.V.G.API.recomputeGraph] Graph empty, computed" graph''
@@ -129,7 +139,7 @@ recomputeGraph _uId nId d = do
     Just graph' -> if listVersion == Just v
                      then pure graph'
                      else do
-                       graph'' <- computeGraph cId d NgramsTerms repo
+                       graph'' <- computeGraph cId similarity NgramsTerms repo
                        let graph''' = set graph_metadata graphMetadata graph''
                        _ <- updateHyperdata nId (HyperdataGraph (Just graph''') camera)
                        pure $ trace "[G.V.G.API] Graph exists, recomputing" graph'''
@@ -144,18 +154,19 @@ computeGraph :: HasNodeError err
              -> Cmd err Graph
 computeGraph cId d nt repo = do
   lId  <- defaultList cId
-
   lIds <- selectNodesWithUsername NodeList userMaster
-  let ngs = filterListWithRoot MapTerm $ mapTermListRoot [lId] nt repo
 
-  -- TODO split diagonal
-  myCooc <- HashMap.filter (>1)
+  let ngs = filterListWithRoot MapTerm
+          $ mapTermListRoot [lId] nt repo
+
+  myCooc <- HashMap.filter (>1) -- Removing the hapax (ngrams with 1 cooc)
          <$> getCoocByNgrams (Diagonal True)
          <$> groupNodesByNgrams ngs
          <$> getNodesByNgramsOnlyUser cId (lIds <> [lId]) nt (HashMap.keys ngs)
 
-  graph <- liftBase $ cooc2graphWith Spinglass d 0 myCooc
+  -- printDebug "myCooc" myCooc
 
+  graph <- liftBase $ cooc2graphWith Spinglass d 0 myCooc
   pure graph
 
 
@@ -163,13 +174,14 @@ defaultGraphMetadata :: HasNodeError err
                      => CorpusId
                      -> Text
                      -> NgramsRepo
+                     -> GraphMetric
                      -> Cmd err GraphMetadata
-defaultGraphMetadata cId t repo = do
+defaultGraphMetadata cId t repo gm = do
   lId  <- defaultList cId
 
   pure $ GraphMetadata {
       _gm_title = t
-    , _gm_metric = Order1
+    , _gm_metric = gm
     , _gm_corpusId = [cId]
     , _gm_legend = [
           LegendField 1 "#FFF" "Cluster1"
@@ -205,7 +217,7 @@ graphRecompute u n logStatus = do
                    , _scst_remaining = Just 1
                    , _scst_events    = Just []
                    }
-  _g <- trace (show u) $ recomputeGraph u n Conditional -- Distributional
+  _g <- trace (show u) $ recomputeGraph u n Nothing
   pure  JobLog { _scst_succeeded = Just 1
                , _scst_failed    = Just 0
                , _scst_remaining = Just 0
@@ -226,12 +238,17 @@ graphVersionsAPI u n =
 graphVersions :: NodeId -> GargNoServer GraphVersions
 graphVersions nId = do
   nodeGraph <- getNodeWith nId (Proxy :: Proxy HyperdataGraph)
-  let graph = nodeGraph ^. node_hyperdata . hyperdataGraph
-  let listVersion = graph ^? _Just
-                            . graph_metadata
-                            . _Just
-                            . gm_list
-                            . lfg_version
+  let
+    graph =  nodeGraph
+          ^. node_hyperdata
+           . hyperdataGraph
+
+    listVersion =  graph
+                ^? _Just
+                . graph_metadata
+                . _Just
+                . gm_list
+                . lfg_version
 
   repo <- getRepo
   let v = repo ^. r_version
@@ -240,7 +257,7 @@ graphVersions nId = do
                        , gv_repo = v }
 
 recomputeVersions :: UserId -> NodeId -> GargNoServer Graph
-recomputeVersions uId nId = recomputeGraph uId nId Conditional -- Distributional
+recomputeVersions uId nId = recomputeGraph uId nId Nothing
 
 ------------------------------------------------------------
 graphClone :: UserId

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

@@ -18,7 +18,6 @@ TODO use Map LouvainNodeId (Map LouvainNodeId)
 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)
@@ -37,9 +36,6 @@ 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)
 

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

@@ -44,25 +44,34 @@ type Index    = Int
 
 -------------------------------------------------------------------------------
 -------------------------------------------------------------------------------
-score :: (Ord t) => (A.Matrix Int -> A.Matrix Double)
-                -> Map (t, t) Int
-                -> Map (t, t) Double
-score f m = fromIndex fromI . mat2map . f $ cooc2mat toI m
+score :: (Ord t) => MatrixShape
+                 -> (A.Matrix Int -> A.Matrix Double)
+                 -> Map (t, t) Int
+                 -> Map (t, t) Double
+score s f m = fromIndex fromI . mat2map . f $ cooc2mat s toI m
   where
     (toI, fromI) = createIndices m
 
 -------------------------------------------------------------------------------
 -------------------------------------------------------------------------------
-cooc2mat :: Ord t => Map t Index -> Map (t, t) Int -> Matrix Int
-cooc2mat ti m = map2mat 0 n idx
+cooc2mat :: Ord t => MatrixShape -> Map t Index -> Map (t, t) Int -> Matrix Int
+cooc2mat sym ti m = map2mat sym 0 n idx
   where
     n = M.size ti
     idx = toIndex ti m -- it is important to make sure that toIndex is ran only once.
 
-map2mat :: Elt a => a -> Int -> Map (Index, Index) a -> Matrix a
-map2mat def n m = A.fromFunction shape (\(Z :. x :. y) -> fromMaybe def $ M.lookup (x, y) m)
+data MatrixShape = Triangular | Square
+
+map2mat :: Elt a => MatrixShape -> a -> Int -> Map (Index, Index) a -> Matrix a
+map2mat sym def n m = A.fromFunction shape getData
   where
-    shape = (Z :. n :. n)
+    getData = (\(Z :. x :. y) ->
+      case sym of
+        Triangular -> fromMaybe def (M.lookup (x,y) m)
+        Square -> fromMaybe (fromMaybe def $ M.lookup (y,x) m)
+                                           $ M.lookup (x, y) m
+                                           )
+    shape   = (Z :. n :. n)
 
 mat2map :: (Elt a, Shape (Z :. Index)) =>
             A.Array (Z :. Index :. Index) a -> Map (Index, Index) a
@@ -73,15 +82,19 @@ mat2map m = M.fromList . map f . A.toList . A.run . A.indexed $ A.use m
 
 -------------------------------------------------------------------------------
 -------------------------------------------------------------------------------
-toIndex :: Ord t => Map t Index -> Map (t,t) a -> Map (Index,Index) a
-toIndex ni ns = indexConversion ni ns
+toIndex :: Ord t
+        => Map t Index
+        -> Map (t,t) a
+        -> Map (Index,Index) a
+toIndex = indexConversion
 
 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)
+                         $ map (\((k1,k2),c) -> ( ((M.!) index k1, (M.!) index k2), c))
+                               (M.toList ms)
 ---------------------------------------------------------------------------------
 
 -------------------------------------------------------------------------------

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

@@ -9,13 +9,14 @@ Portability : POSIX
 
 -}
 
+{-# LANGUAGE ScopedTypeVariables #-}
+
 module Gargantext.Core.Viz.Graph.Tools
   where
 
 -- import Data.Graph.Clustering.Louvain (hLouvain, {-iLouvainMap-})
-import Data.Graph.Clustering.Louvain.CplusPlus (cLouvain)
-import Data.Map (Map)
 import Data.HashMap.Strict (HashMap)
+import Data.Map (Map)
 import Data.Text (Text)
 import Debug.Trace (trace)
 import GHC.Float (sin, cos)
@@ -25,10 +26,11 @@ import Gargantext.Core.Methods.Graph.BAC.Proxemy (confluence)
 import Gargantext.Core.Statistics
 import Gargantext.Core.Viz.Graph
 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.Core.Viz.Graph.Index (createIndices, toIndex, map2mat, mat2map, Index, MatrixShape(..))
+import Gargantext.Core.Viz.Graph.Tools.IGraph (mkGraphUfromEdges, spinglass, ClusterNode)
 import Gargantext.Prelude
 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
@@ -39,22 +41,36 @@ import qualified IGraph.Algorithms.Layout as Layout
 -- import qualified Data.Map  as Map
 -- import qualified Data.List as List
 -- import Debug.Trace (trace)
-import qualified Data.HashMap.Strict      as HashMap
+-- import qualified Data.HashMap.Strict      as HashMap
 
-type Threshold = Double
 
+-------------------------------------------------------------
+
+defaultClustering :: Map (Int, Int) Double -> IO [ClusterNode]
+defaultClustering = spinglass 1
+
+-------------------------------------------------------------
+
+type Threshold = Double
 
 cooc2graph' :: Ord t => Distance
                      -> Double
                      -> Map (t, t) Int
                      -> Map (Index, Index) Double
-cooc2graph' distance threshold myCooc = distanceMap
-  where
-    (ti, _) = createIndices myCooc
-    myCooc' = toIndex ti myCooc
-    matCooc = map2mat 0 (Map.size ti) $ Map.filter (> 1) myCooc'
-    distanceMat = measure distance matCooc
-    distanceMap = Map.filter (> threshold) $ mat2map distanceMat
+cooc2graph' distance threshold myCooc
+    = Map.filter (> threshold)
+    $ mat2map
+    $ measure distance
+    $ case distance of
+        Conditional    -> map2mat Triangular 0 tiSize
+        Distributional -> map2mat Square     0 tiSize
+    $ Map.filter (> 1) myCooc'
+
+     where
+        (ti, _) = createIndices myCooc
+        tiSize  = Map.size ti
+        myCooc' = toIndex ti myCooc
+
 
 data PartitionMethod = Louvain | Spinglass
 
@@ -63,7 +79,7 @@ cooc2graphWith :: PartitionMethod
                -> Threshold
                -> HashMap (NgramsTerm, NgramsTerm) Int
                -> IO Graph
-cooc2graphWith Louvain   = cooc2graphWith' (cLouvain "1")
+cooc2graphWith Louvain   = undefined -- TODO use IGraph bindings
 cooc2graphWith Spinglass = cooc2graphWith' (spinglass 1)
 
 cooc2graph'' :: Ord t => Distance
@@ -74,10 +90,13 @@ cooc2graph'' distance threshold myCooc = neighbouMap
   where
     (ti, _) = createIndices myCooc
     myCooc' = toIndex ti myCooc
-    matCooc = map2mat 0 (Map.size ti) $ Map.filter (> 1) myCooc'
-    distanceMat = measure distance matCooc
-    neighbouMap = filterByNeighbours threshold
-                $ mat2map distanceMat
+    matCooc = mat2map
+            $ measure distance
+            $ case distance of
+                Conditional    -> map2mat Triangular 0 (Map.size ti)
+                Distributional -> map2mat Square     0 (Map.size ti)
+            $ Map.filter (> 1) myCooc'
+    neighbouMap = filterByNeighbours threshold matCooc
 
 
 -- Quentin
@@ -105,17 +124,32 @@ cooc2graphWith' :: ToComId a
                -> HashMap (NgramsTerm, NgramsTerm) Int
                -> IO Graph
 cooc2graphWith' doPartitions distance threshold myCooc = do
-  printDebug "cooc2graph" distance
   let
     -- TODO remove below
-    theMatrix = Map.fromList $ HashMap.toList myCooc
+    theMatrix = Map.fromList
+              $ HashMap.toList myCooc
+
     (ti, _) = createIndices theMatrix
+    tiSize  = Map.size ti
     myCooc' = toIndex ti theMatrix
-    matCooc = map2mat 0 (Map.size ti)
-            $ Map.filterWithKey (\(a,b) _ -> a /= b) 
-            $ Map.filter (> 1) myCooc'
-    distanceMat = measure distance matCooc
-    distanceMap = Map.filter (> threshold) $ mat2map distanceMat
+    matCooc = case distance of  -- Shape of the Matrix
+                Conditional    -> map2mat Triangular 0 tiSize
+                Distributional -> map2mat Square     0 tiSize
+            $ case distance of   -- Removing the Diagonal ?
+                Conditional     -> Map.filterWithKey (\(a,b) _ -> a /= b)
+                Distributional  -> identity
+            $ Map.filter (>1) myCooc'
+
+    similarities = measure distance matCooc
+    links = round (let n :: Double = fromIntegral tiSize in n * log n)
+    distanceMap  = Map.fromList
+                 $ List.take links
+                 $ List.sortOn snd
+                 $ Map.toList
+                 $ case distance of
+                     Conditional    -> Map.filter (> threshold)
+                     Distributional -> Map.filter (> 0)
+                 $ mat2map similarities
 
     nodesApprox :: Int
     nodesApprox = n'
@@ -124,18 +158,17 @@ cooc2graphWith' doPartitions distance threshold myCooc = do
         n' = Set.size $ Set.fromList $ as <> bs
     ClustersParams rivers _level = clustersParams nodesApprox
 
-  printDebug "Start" ("partitions" :: Text)
+  printDebug "similarities" similarities
+
   partitions <- if (Map.size distanceMap > 0)
-      -- then iLouvainMap 100 10 distanceMap
-      -- then hLouvain distanceMap
       then doPartitions distanceMap
       else panic "Text.Flow: DistanceMap is empty"
-  printDebug "End" ("partitions" :: Text)
 
   let
     -- bridgeness' = distanceMap
     bridgeness' = trace ("Rivers: " <> show rivers)
                 $ bridgeness rivers partitions distanceMap
+
     confluence' = confluence (Map.keys bridgeness') 3 True False
 
   pure $ data2graph (Map.toList $ Map.mapKeys unNgramsTerm ti)
@@ -308,4 +341,14 @@ layout m n gen = maybe (panic "") identity $ Map.lookup n $ coord
     --p = Layout.defaultLGL
     p = Layout.kamadaKawai
     g = mkGraphUfromEdges $ map fst $ List.filter (\e -> snd e > 0) $ Map.toList m
-
+-----------------------------------------------------------------------------
+-----------------------------------------------------------------------------
+-----------------------------------------------------------------------------
+-- Debug
+{-
+-- measure logDistributional
+dataDebug = map2mat Square (0::Int) 19 dataBug'
+
+dataBug' :: Map (Int, Int) Int
+dataBug' = Map.fromList [((0,0),28),((0,1),8),((0,2),6),((0,3),2),((0,5),4),((0,6),4),((0,7),2),((0,9),7),((0,10),4),((0,13),4),((0,14),2),((0,15),5),((0,16),8),((0,17),3),((1,1),28),((1,2),6),((1,3),7),((1,4),5),((1,5),7),((1,6),5),((1,7),2),((1,9),6),((1,10),7),((1,11),5),((1,13),6),((1,15),6),((1,16),14),((1,18),4),((2,2),39),((2,3),5),((2,4),4),((2,5),3),((2,6),4),((2,7),4),((2,8),3),((2,9),17),((2,10),4),((2,11),8),((2,12),2),((2,13),15),((2,14),4),((2,15),5),((2,16),21),((2,18),4),((3,3),48),((3,4),10),((3,5),7),((3,6),3),((3,7),7),((3,8),6),((3,9),12),((3,10),9),((3,11),8),((3,12),5),((3,13),15),((3,14),5),((3,15),9),((3,16),17),((3,18),4),((4,4),33),((4,5),2),((4,6),5),((4,7),7),((4,8),4),((4,9),6),((4,10),12),((4,11),8),((4,12),3),((4,13),16),((4,14),4),((4,15),4),((4,16),5),((4,17),2),((4,18),12),((5,5),27),((5,6),2),((5,8),3),((5,9),12),((5,10),6),((5,11),9),((5,13),4),((5,14),2),((5,15),7),((5,16),11),((5,18),4),((6,6),34),((6,7),4),((6,8),3),((6,9),12),((6,10),8),((6,11),2),((6,12),5),((6,13),6),((6,14),6),((6,15),5),((6,16),22),((6,17),8),((6,18),4),((7,7),27),((7,8),2),((7,9),6),((7,10),2),((7,11),4),((7,13),13),((7,15),2),((7,16),8),((7,17),6),((7,18),4),((8,8),30),((8,9),9),((8,10),6),((8,11),9),((8,12),6),((8,13),3),((8,14),3),((8,15),4),((8,16),15),((8,17),3),((8,18),5),((9,9),69),((9,10),9),((9,11),22),((9,12),15),((9,13),18),((9,14),10),((9,15),14),((9,16),48),((9,17),6),((9,18),9),((10,10),39),((10,11),15),((10,12),5),((10,13),11),((10,14),2),((10,15),4),((10,16),19),((10,17),3),((10,18),11),((11,11),48),((11,12),9),((11,13),20),((11,14),2),((11,15),13),((11,16),29),((11,18),13),((12,12),30),((12,13),4),((12,15),5),((12,16),16),((12,17),6),((12,18),2),((13,13),65),((13,14),10),((13,15),14),((13,16),23),((13,17),6),((13,18),10),((14,14),25),((14,16),9),((14,17),3),((14,18),3),((15,15),38),((15,16),17),((15,18),4),((16,16),99),((16,17),11),((16,18),14),((17,17),29),((18,18),23)]
+-}

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

@@ -24,6 +24,7 @@ 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.Algorithms.Structure as IG
 import qualified IGraph.Random               as IG
 import qualified Data.Map                    as Map
 
@@ -61,11 +62,15 @@ 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''
+             <$> partitions_spinglass' s g'''
   where
-    g'' = mkGraphUfromEdges (Map.keys g')
+    g'   = toIndex toI g
+    g''  = mkGraphUfromEdges (Map.keys g')
+    g''' = case IG.isConnected g'' of
+      True -> g''
+      False -> panic "[G.C.V.G.T.Igraph: not connected graph]"
+
     (toI, fromI) = createIndices g
-    g' = toIndex toI g
 
 -- | Tools to analyze graphs
 partitions_spinglass' :: (Serialize v, Serialize e)

stack.yaml

@@ -6,7 +6,6 @@ packages:
 #- 'deps/patches-class'
 #- 'deps/patches-map'
 #- 'deps/servant-job'
-#- 'deps/clustering-louvain'
 #- 'deps/accelerate'
 #- 'deps/accelerate-utility'
 
@@ -71,8 +70,6 @@ extra-deps:
   # Graph libs
 - git: https://github.com/kaizhang/haskell-igraph.git
   commit: 34553acc4ebdcae7065311dcefb426e0fd58c5a0
-- git: https://gitlab.iscpif.fr/gargantext/clustering-louvain.git
-  commit: 7d74f96dfea8e51fbab1793cc0429b2fe741f73d
 
   # Accelerate Linear Algebra and specific instances
   # (UndecidableInstances for newer GHC version)