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