Commit 7fdba0d9 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

Merge branch 'dev' into dev-test

parents 8abc41f1 9a5c6eee
Pipeline #1499 failed with stage
in 42 minutes and 5 seconds
...@@ -49,6 +49,7 @@ library: ...@@ -49,6 +49,7 @@ library:
- Gargantext.API.Admin.Types - Gargantext.API.Admin.Types
- Gargantext.API.Prelude - Gargantext.API.Prelude
- Gargantext.Core - Gargantext.Core
- Gargantext.Core.Methods.Distances
- Gargantext.Core.Types - Gargantext.Core.Types
- Gargantext.Core.Types.Individu - Gargantext.Core.Types.Individu
- Gargantext.Core.Types.Main - Gargantext.Core.Types.Main
...@@ -67,6 +68,8 @@ library: ...@@ -67,6 +68,8 @@ library:
- Gargantext.Prelude - Gargantext.Prelude
- Gargantext.Prelude.Crypto.Pass.User - Gargantext.Prelude.Crypto.Pass.User
- Gargantext.Prelude.GargDB - Gargantext.Prelude.GargDB
- Gargantext.Prelude.Crypto.Hash
- Gargantext.Prelude.Utils
- Gargantext.Core.Text - Gargantext.Core.Text
- Gargantext.Core.Text.Context - Gargantext.Core.Text.Context
- Gargantext.Core.Text.Corpus.Parsers - Gargantext.Core.Text.Corpus.Parsers
...@@ -88,6 +91,8 @@ library: ...@@ -88,6 +91,8 @@ library:
- Gargantext.Core.Text.Terms.WithList - Gargantext.Core.Text.Terms.WithList
- Gargantext.Core.Text.Flow - Gargantext.Core.Text.Flow
- Gargantext.Core.Viz.Graph - Gargantext.Core.Viz.Graph
- Gargantext.Core.Viz.Graph.Tools
- Gargantext.Core.Viz.Graph.Tools.IGraph
- Gargantext.Core.Viz.Graph.Index - Gargantext.Core.Viz.Graph.Index
- Gargantext.Core.Viz.AdaptativePhylo - Gargantext.Core.Viz.AdaptativePhylo
- Gargantext.Core.Viz.Phylo.PhyloMaker - Gargantext.Core.Viz.Phylo.PhyloMaker
...@@ -431,6 +436,7 @@ tests: ...@@ -431,6 +436,7 @@ tests:
- parsec - parsec
- duckling - duckling
- text - text
- unordered-containers
# garg-doctest: # garg-doctest:
# main: Main.hs # main: Main.hs
# source-dirs: src-doctest # source-dirs: src-doctest
......
This diff is collapsed.
...@@ -17,6 +17,7 @@ module Graph.Distance where ...@@ -17,6 +17,7 @@ module Graph.Distance where
import Test.Hspec import Test.Hspec
{-
import Gargantext.Core.Methods.Matrix.Accelerate.Utils (cross', matrix) import Gargantext.Core.Methods.Matrix.Accelerate.Utils (cross', matrix)
import Gargantext.Prelude import Gargantext.Prelude
...@@ -26,4 +27,4 @@ test = hspec $ do ...@@ -26,4 +27,4 @@ test = hspec $ do
let result = cross' $ matrix 3 ([1,1..] :: [Double]) let result = cross' $ matrix 3 ([1,1..] :: [Double])
it "compare" $ do it "compare" $ do
shouldBe result (matrix 3 ([2,2..] :: [Double])) shouldBe result (matrix 3 ([2,2..] :: [Double]))
-}
...@@ -14,10 +14,11 @@ import Gargantext.Core (Lang(..)) ...@@ -14,10 +14,11 @@ import Gargantext.Core (Lang(..))
--import qualified Ngrams.Lang.Fr as Fr --import qualified Ngrams.Lang.Fr as Fr
--import qualified Ngrams.Lang as Lang --import qualified Ngrams.Lang as Lang
import qualified Ngrams.Lang.Occurrences as Occ import qualified Ngrams.Lang.Occurrences as Occ
import qualified Ngrams.Metrics as Metrics import qualified Ngrams.Metrics as Metrics
import qualified Parsers.Date as PD import qualified Parsers.Date as PD
import qualified Graph.Distance as GD -- import qualified Graph.Distance as GD
import qualified Utils.Crypto as Crypto import qualified Graph.Clustering as Graph
import qualified Utils.Crypto as Crypto
main :: IO () main :: IO ()
main = do main = do
...@@ -25,6 +26,7 @@ main = do ...@@ -25,6 +26,7 @@ main = do
-- Lang.ngramsExtractionTest FR -- Lang.ngramsExtractionTest FR
-- Lang.ngramsExtractionTest EN -- Lang.ngramsExtractionTest EN
-- Metrics.main -- Metrics.main
PD.testFromRFC3339 Graph.test
PD.testFromRFC3339
-- GD.test -- GD.test
Crypto.test Crypto.test
...@@ -168,6 +168,7 @@ computeGraph cId d nt repo = do ...@@ -168,6 +168,7 @@ computeGraph cId d nt repo = do
saveAsFileDebug "debug/my-cooc" myCooc saveAsFileDebug "debug/my-cooc" myCooc
graph <- liftBase $ cooc2graphWith Spinglass d 0 myCooc graph <- liftBase $ cooc2graphWith Spinglass d 0 myCooc
saveAsFileDebug "debug/graph" graph
pure graph pure graph
...@@ -289,3 +290,9 @@ getGraphGexf :: UserId ...@@ -289,3 +290,9 @@ getGraphGexf :: UserId
getGraphGexf uId nId = do getGraphGexf uId nId = do
HyperdataGraphAPI { _hyperdataAPIGraph = graph } <- getGraph uId nId HyperdataGraphAPI { _hyperdataAPIGraph = graph } <- getGraph uId nId
pure $ addHeader "attachment; filename=graph.gexf" graph pure $ addHeader "attachment; filename=graph.gexf" graph
...@@ -110,14 +110,13 @@ filterByNeighbours threshold distanceMap = filteredMap ...@@ -110,14 +110,13 @@ filterByNeighbours threshold distanceMap = filteredMap
in List.take (round threshold) selected in List.take (round threshold) selected
) indexes ) indexes
cooc2graphWith' :: ToComId a
=> Partitions a doDistanceMap :: Distance
-> Distance
-> Threshold -> Threshold
-> HashMap (NgramsTerm, NgramsTerm) Int -> HashMap (NgramsTerm, NgramsTerm) Int
-> IO Graph -> (Map (Int,Int) Double, Map (Index, Index) Int, Map NgramsTerm Index)
cooc2graphWith' doPartitions distance threshold myCooc = do doDistanceMap distance threshold myCooc = (distanceMap, myCooc', ti)
let where
-- TODO remove below -- TODO remove below
theMatrix = Map.fromList theMatrix = Map.fromList
$ HashMap.toList myCooc $ HashMap.toList myCooc
...@@ -135,8 +134,8 @@ cooc2graphWith' doPartitions distance threshold myCooc = do ...@@ -135,8 +134,8 @@ cooc2graphWith' doPartitions distance threshold myCooc = do
similarities = measure distance matCooc similarities = measure distance matCooc
links = round (let n :: Double = fromIntegral tiSize in n * log n) links = round (let n :: Double = fromIntegral tiSize in n * log n)
distanceMap = Map.fromList
$ List.take links distanceMap = Map.fromList $ List.take links
$ List.sortOn snd $ List.sortOn snd
$ Map.toList $ Map.toList
$ case distance of $ case distance of
...@@ -144,6 +143,16 @@ cooc2graphWith' doPartitions distance threshold myCooc = do ...@@ -144,6 +143,16 @@ cooc2graphWith' doPartitions distance threshold myCooc = do
Distributional -> Map.filter (> 0) Distributional -> Map.filter (> 0)
$ mat2map similarities $ mat2map similarities
cooc2graphWith' :: ToComId a
=> Partitions a
-> Distance
-> Threshold
-> HashMap (NgramsTerm, NgramsTerm) Int
-> IO Graph
cooc2graphWith' doPartitions distance threshold myCooc = do
let
(distanceMap, myCooc', ti) = doDistanceMap distance threshold myCooc
nodesApprox :: Int nodesApprox :: Int
nodesApprox = n' nodesApprox = n'
where where
...@@ -151,15 +160,10 @@ cooc2graphWith' doPartitions distance threshold myCooc = do ...@@ -151,15 +160,10 @@ cooc2graphWith' doPartitions distance threshold myCooc = do
n' = Set.size $ Set.fromList $ as <> bs n' = Set.size $ Set.fromList $ as <> bs
ClustersParams rivers _level = clustersParams nodesApprox ClustersParams rivers _level = clustersParams nodesApprox
saveAsFileDebug "debug/the-matrix" theMatrix {- | Debug
saveAsFileDebug "debug/my-cooc-prime" myCooc'
saveAsFileDebug "debug/mat-cooc" matCooc
saveAsFileDebug "debug/similarities" similarities
saveAsFileDebug "debug/links" links
saveAsFileDebug "debug/distanceMap" distanceMap saveAsFileDebug "debug/distanceMap" distanceMap
saveAsFileDebug "debug/nodesApprox" nodesApprox
printDebug "similarities" similarities printDebug "similarities" similarities
-}
-- partitions <- if (Map.size distanceMap > 0) -- partitions <- if (Map.size distanceMap > 0)
-- then doPartitions distanceMap -- then doPartitions distanceMap
...@@ -177,48 +181,6 @@ cooc2graphWith' doPartitions distance threshold myCooc = do ...@@ -177,48 +181,6 @@ cooc2graphWith' doPartitions distance threshold myCooc = do
myCooc' bridgeness' confluence' partitions myCooc' bridgeness' confluence' partitions
-- cooc2graph :: Distance
-- -> Threshold
-- -> (Map (Text, Text) Int)
-- -> IO Graph
-- cooc2graph distance threshold myCooc = do
-- printDebug "cooc2graph" distance
-- let
-- -- TODO remove below
-- theMatrix = Map.fromList $ HashMap.toList myCooc
-- (ti, _) = createIndices theMatrix
-- 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
-- nodesApprox :: Int
-- nodesApprox = n'
-- where
-- (as, bs) = List.unzip $ Map.keys distanceMap
-- 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 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)
-- myCooc' bridgeness' confluence' partitions
------------------------------------------------------------------------ ------------------------------------------------------------------------
------------------------------------------------------------------------ ------------------------------------------------------------------------
data ClustersParams = ClustersParams { bridgness :: Double data ClustersParams = ClustersParams { bridgness :: Double
......
...@@ -82,14 +82,18 @@ import qualified Data.List as L hiding (head, sum) ...@@ -82,14 +82,18 @@ import qualified Data.List as L hiding (head, sum)
import qualified Data.Map as M import qualified Data.Map as M
import qualified Data.Set as Set import qualified Data.Set as Set
import qualified Data.Vector as V import qualified Data.Vector as V
import System.FilePath.Posix (takeDirectory)
import System.Directory (createDirectoryIfMissing)
printDebug :: (Show a, MonadBase IO m) => [Char] -> a -> m () printDebug :: (Show a, MonadBase IO m) => [Char] -> a -> m ()
printDebug msg x = liftBase . putStrLn $ msg <> " " <> show x printDebug msg x = liftBase . putStrLn $ msg <> " " <> show x
-- printDebug _ _ = pure () -- printDebug _ _ = pure ()
saveAsFileDebug :: (Show a, MonadBase IO m) => [Char] -> a -> m () saveAsFileDebug :: (Show a, MonadBase IO m) => [Char] -> a -> m ()
saveAsFileDebug fname x = liftBase . Protolude.writeFile fname $ pack $ show x saveAsFileDebug fname x = do
let dir = takeDirectory fname
_ <- liftBase $ createDirectoryIfMissing True dir
liftBase . Protolude.writeFile fname $ pack $ show x
-- | splitEvery n == chunkAlong n n -- | splitEvery n == chunkAlong n n
......
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