Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
haskell-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
148
Issues
148
List
Board
Labels
Milestones
Merge Requests
10
Merge Requests
10
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
gargantext
haskell-gargantext
Commits
380bff87
Commit
380bff87
authored
Feb 14, 2020
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Plain Diff
Merge branch 'dev' into dev-getting-started-readme
parents
8b5a5757
f432d12c
Pipeline
#734
failed with stage
Changes
4
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
32 additions
and
13 deletions
+32
-13
API.hs
src/Gargantext/API.hs
+2
-2
API.hs
src/Gargantext/Viz/Graph/API.hs
+2
-2
MaxClique.hs
src/Gargantext/Viz/Graph/MaxClique.hs
+19
-0
Tools.hs
src/Gargantext/Viz/Graph/Tools.hs
+9
-9
No files found.
src/Gargantext/API.hs
View file @
380bff87
...
@@ -319,8 +319,8 @@ type GargPrivateAPI' =
...
@@ -319,8 +319,8 @@ type GargPrivateAPI' =
type
API
=
SwaggerAPI
type
API
=
SwaggerAPI
:<|>
FrontEndAPI
:<|>
FrontEndAPI
:<|>
GargAPI
:<|>
Get
'[
H
TML
]
Html
:<|>
Get
'[
H
TML
]
Html
:<|>
GargAPI
-- This is the concrete monad. It needs to be used as little as possible,
-- This is the concrete monad. It needs to be used as little as possible,
-- instead, prefer GargServer, GargServerT, GargServerC.
-- instead, prefer GargServer, GargServerT, GargServerC.
...
@@ -341,8 +341,8 @@ server env = do
...
@@ -341,8 +341,8 @@ server env = do
-- orchestrator <- scrapyOrchestrator env
-- orchestrator <- scrapyOrchestrator env
pure
$
schemaUiServer
swaggerDoc
pure
$
schemaUiServer
swaggerDoc
:<|>
frontEndServer
:<|>
frontEndServer
:<|>
hoistServerWithContext
(
Proxy
::
Proxy
GargAPI
)
(
Proxy
::
Proxy
AuthContext
)
transform
serverGargAPI
:<|>
serverStatic
:<|>
serverStatic
:<|>
hoistServerWithContext
(
Proxy
::
Proxy
GargAPI
)
(
Proxy
::
Proxy
AuthContext
)
transform
serverGargAPI
where
where
transform
::
forall
a
.
GargServerM
env
GargError
a
->
Handler
a
transform
::
forall
a
.
GargServerM
env
GargError
a
->
Handler
a
transform
=
Handler
.
withExceptT
showAsServantErr
.
(`
runReaderT
`
env
)
transform
=
Handler
.
withExceptT
showAsServantErr
.
(`
runReaderT
`
env
)
...
...
src/Gargantext/Viz/Graph/API.hs
View file @
380bff87
...
@@ -24,7 +24,7 @@ Portability : POSIX
...
@@ -24,7 +24,7 @@ Portability : POSIX
module
Gargantext.Viz.Graph.API
module
Gargantext.Viz.Graph.API
where
where
import
Debug.Trace
(
trace
)
--
import Debug.Trace (trace)
import
Control.Lens
(
set
,
(
^.
),
_Just
,
(
^?
))
import
Control.Lens
(
set
,
(
^.
),
_Just
,
(
^?
))
import
Control.Monad.IO.Class
(
liftIO
)
import
Control.Monad.IO.Class
(
liftIO
)
import
Data.Maybe
(
Maybe
(
..
))
import
Data.Maybe
(
Maybe
(
..
))
...
@@ -94,7 +94,7 @@ getGraph uId nId = do
...
@@ -94,7 +94,7 @@ getGraph uId nId = do
graph''
<-
computeGraph
cId
NgramsTerms
repo
graph''
<-
computeGraph
cId
NgramsTerms
repo
_
<-
updateHyperdata
nId
(
HyperdataGraph
$
Just
graph''
)
_
<-
updateHyperdata
nId
(
HyperdataGraph
$
Just
graph''
)
pure
graph''
pure
graph''
pure
$
trace
(
"salut"
<>
show
g
)
$
g
pure
{- $ trace (show g) $ -}
g
-- TODO use Database Monad only here ?
-- TODO use Database Monad only here ?
...
...
src/Gargantext/Viz/Graph/MaxClique.hs
View file @
380bff87
...
@@ -63,6 +63,25 @@ import Gargantext.Viz.Graph.FGL (Graph_Undirected, degree, neighbors, mkGraphUfr
...
@@ -63,6 +63,25 @@ import Gargantext.Viz.Graph.FGL (Graph_Undirected, degree, neighbors, mkGraphUfr
type
Graph
=
Graph_Undirected
type
Graph
=
Graph_Undirected
type
Neighbor
=
Node
type
Neighbor
=
Node
{-
-- prefiltre
-- Texte -> Ngrams
-- Map Terms
-- pré-filtre: spécifiques
-- soit conditionnelle, matrice spécifiques
-- combien de voisins maximum avant le calcul de cliques (les génériques)
-- calcul maxcliques
-- calcul de densité/inclusion si graph gros
--
-- FIS: ensemble de termes un niveau du document
-- maxclique: ensemble de termes au niveau de l'ensemble du document
type Density = Double
maxCliques' :: [[Text]] -> Map (Set Ngrams) Density
maxCliques' = undefined
-}
maxCliques
::
Graph
->
[[
Node
]]
maxCliques
::
Graph
->
[[
Node
]]
maxCliques
g
=
map
(
\
n
->
subMaxCliques
g
(
n
:
ns
))
ns
&
concat
&
takeMax
maxCliques
g
=
map
(
\
n
->
subMaxCliques
g
(
n
:
ns
))
ns
&
concat
&
takeMax
where
where
...
...
src/Gargantext/Viz/Graph/Tools.hs
View file @
380bff87
...
@@ -53,14 +53,14 @@ cooc2graph threshold myCooc = do
...
@@ -53,14 +53,14 @@ cooc2graph threshold myCooc = do
where
where
(
as
,
bs
)
=
List
.
unzip
$
Map
.
keys
distanceMap
(
as
,
bs
)
=
List
.
unzip
$
Map
.
keys
distanceMap
n'
=
Set
.
size
$
Set
.
fromList
$
as
<>
bs
n'
=
Set
.
size
$
Set
.
fromList
$
as
<>
bs
ClustersParams
rivers
level
=
trace
(
"nodesApprox: "
<>
show
nodesApprox
)
$
clustersParams
nodesApprox
ClustersParams
rivers
level
=
{-trace ("nodesApprox: " <> show nodesApprox) $-}
clustersParams
nodesApprox
partitions
<-
case
Map
.
size
distanceMap
>
0
of
partitions
<-
case
Map
.
size
distanceMap
>
0
of
True
->
trace
(
"level"
<>
show
level
)
$
cLouvain
level
distanceMap
True
->
trace
(
"level"
<>
show
level
)
$
cLouvain
level
distanceMap
False
->
panic
"Text.Flow: DistanceMap is empty"
False
->
panic
"Text.Flow: DistanceMap is empty"
let
bridgeness'
=
trace
(
"rivers: "
<>
show
rivers
)
$
bridgeness
rivers
partitions
distanceMap
let
bridgeness'
=
{-trace ("rivers: " <> show rivers) $-}
bridgeness
rivers
partitions
distanceMap
let
confluence'
=
confluence
(
Map
.
keys
bridgeness'
)
3
True
False
let
confluence'
=
confluence
(
Map
.
keys
bridgeness'
)
3
True
False
data2graph
(
Map
.
toList
ti
)
myCooc'
bridgeness'
confluence'
partitions
data2graph
(
Map
.
toList
ti
)
myCooc'
bridgeness'
confluence'
partitions
...
@@ -72,14 +72,14 @@ data ClustersParams = ClustersParams { bridgness :: Double
...
@@ -72,14 +72,14 @@ data ClustersParams = ClustersParams { bridgness :: Double
}
deriving
(
Show
)
}
deriving
(
Show
)
clustersParams
::
Int
->
ClustersParams
clustersParams
::
Int
->
ClustersParams
clustersParams
x
=
ClustersParams
(
fromIntegral
x
)
y
clustersParams
x
=
ClustersParams
(
fromIntegral
x
)
"0.00000001"
--
y
where
{-
where
y
|
x
<
100
=
"0.01"
y | x < 100 = "0.0
0000
1"
|
x
<
350
=
"0.01"
| x < 350 = "0.0
0000
1"
|
x
<
500
=
"0.01"
| x < 500 = "0.0
0000
1"
|
x
<
1000
=
"0.1"
| x < 1000 = "0.
00000
1"
| otherwise = "1"
| otherwise = "1"
-}
----------------------------------------------------------
----------------------------------------------------------
-- | From data to Graph
-- | From data to Graph
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment