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
175
Issues
175
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
eb88099c
Commit
eb88099c
authored
Jul 09, 2019
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[MISC] fixes.
parent
208176cb
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
11 additions
and
11 deletions
+11
-11
Main.hs
bin/gargantext-import/Main.hs
+4
-4
List.hs
src/Gargantext/Text/List.hs
+5
-5
Terms.hs
src/Gargantext/Text/Terms.hs
+1
-1
API.hs
src/Gargantext/Viz/Phylo/API.hs
+1
-1
No files found.
bin/gargantext-import/Main.hs
View file @
eb88099c
...
@@ -24,7 +24,7 @@ import Control.Exception (finally)
...
@@ -24,7 +24,7 @@ import Control.Exception (finally)
import
Servant
(
ServantErr
)
import
Servant
(
ServantErr
)
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Gargantext.Database.Flow
(
FlowCmdM
,
flowCorpusFile
)
import
Gargantext.Database.Flow
(
FlowCmdM
,
flowCorpusFile
)
import
Gargantext.Text.Corpus.Parsers
(
FileFormat
(
CsvHalFormat
))
import
Gargantext.Text.Corpus.Parsers
(
FileFormat
(
..
))
import
Gargantext.Database.Utils
(
Cmd
,
)
import
Gargantext.Database.Utils
(
Cmd
,
)
import
Gargantext.Database.Types.Node
(
CorpusId
,
toHyperdataDocument
)
import
Gargantext.Database.Types.Node
(
CorpusId
,
toHyperdataDocument
)
import
Gargantext.Database.Schema.User
(
insertUsersDemo
)
import
Gargantext.Database.Schema.User
(
insertUsersDemo
)
...
@@ -46,10 +46,10 @@ main = do
...
@@ -46,10 +46,10 @@ main = do
createUsers
=
insertUsersDemo
createUsers
=
insertUsersDemo
let
let
--tt = (Unsupervised EN
5 1
Nothing)
--tt = (Unsupervised EN
6 0
Nothing)
tt
=
(
M
ono
EN
)
tt
=
(
M
ulti
EN
)
cmd
::
forall
m
.
FlowCmdM
DevEnv
ServantErr
m
=>
m
CorpusId
cmd
::
forall
m
.
FlowCmdM
DevEnv
ServantErr
m
=>
m
CorpusId
cmd
=
flowCorpusFile
(
cs
user
)
(
cs
name
)
(
read
limit
::
Int
)
tt
Csv
HalFormat
corpusPath
cmd
=
flowCorpusFile
(
cs
user
)
(
cs
name
)
(
read
limit
::
Int
)
tt
Csv
GargV3
corpusPath
{-
{-
let debatCorpus :: forall m. FlowCmdM DevEnv ServantErr m => m CorpusId
let debatCorpus :: forall m. FlowCmdM DevEnv ServantErr m => m CorpusId
debatCorpus = do
debatCorpus = do
...
...
src/Gargantext/Text/List.hs
View file @
eb88099c
...
@@ -59,9 +59,9 @@ data StopSize = StopSize {unStopSize :: Int}
...
@@ -59,9 +59,9 @@ data StopSize = StopSize {unStopSize :: Int}
-- | TODO improve grouping functions of Authors, Sources, Institutes..
-- | TODO improve grouping functions of Authors, Sources, Institutes..
buildNgramsLists
::
Lang
->
Int
->
Int
->
StopSize
->
UserCorpusId
->
MasterCorpusId
buildNgramsLists
::
Lang
->
Int
->
Int
->
StopSize
->
UserCorpusId
->
MasterCorpusId
->
Cmd
err
(
Map
NgramsType
[
NgramsElement
])
->
Cmd
err
(
Map
NgramsType
[
NgramsElement
])
buildNgramsLists
l
n
m
s
uCid
_
mCid
=
do
buildNgramsLists
l
n
m
s
uCid
mCid
=
do
--
ngTerms <- buildNgramsTermsList l n m s uCid mCid
ngTerms
<-
buildNgramsTermsList
l
n
m
s
uCid
mCid
ngTerms
<-
buildNgramsTermsList'
uCid
(
ngramsGroup
l
n
m
)
(
isStopTerm
s
.
fst
)
500
50
--
ngTerms <- buildNgramsTermsList' uCid (ngramsGroup l n m) (isStopTerm s . fst) 500 50
othersTerms
<-
mapM
(
buildNgramsOthersList
uCid
identity
)
[
Authors
,
Sources
,
Institutes
]
othersTerms
<-
mapM
(
buildNgramsOthersList
uCid
identity
)
[
Authors
,
Sources
,
Institutes
]
pure
$
Map
.
unions
$
othersTerms
<>
[
ngTerms
]
pure
$
Map
.
unions
$
othersTerms
<>
[
ngTerms
]
...
@@ -123,8 +123,8 @@ buildNgramsTermsList l n m s uCid mCid = do
...
@@ -123,8 +123,8 @@ buildNgramsTermsList l n m s uCid mCid = do
candidates
<-
sortTficf
<$>
getTficf'
uCid
mCid
NgramsTerms
(
ngramsGroup
l
n
m
)
candidates
<-
sortTficf
<$>
getTficf'
uCid
mCid
NgramsTerms
(
ngramsGroup
l
n
m
)
let
let
candidatesSize
=
2000
candidatesSize
=
2000
a
=
50
0
a
=
1
0
b
=
50
0
b
=
1
0
candidatesHead
=
List
.
take
candidatesSize
candidates
candidatesHead
=
List
.
take
candidatesSize
candidates
candidatesTail
=
List
.
drop
candidatesSize
candidates
candidatesTail
=
List
.
drop
candidatesSize
candidates
termList
=
(
toTermList
a
b
((
isStopTerm
s
)
.
fst
)
candidatesHead
)
termList
=
(
toTermList
a
b
((
isStopTerm
s
)
.
fst
)
candidatesHead
)
...
...
src/Gargantext/Text/Terms.hs
View file @
eb88099c
...
@@ -120,7 +120,7 @@ termsUnsupervised (Unsupervised l n s m) =
...
@@ -120,7 +120,7 @@ termsUnsupervised (Unsupervised l n s m) =
pure
pure
.
map
(
text2term
l
)
.
map
(
text2term
l
)
.
List
.
nub
.
List
.
nub
.
(
List
.
filter
(
\
l'
->
List
.
length
l'
>
s
))
.
(
List
.
filter
(
\
l'
->
List
.
length
l'
>
=
s
))
.
List
.
concat
.
List
.
concat
.
mainEleveWith
(
maybe
(
panic
"no model"
)
identity
m
)
n
.
mainEleveWith
(
maybe
(
panic
"no model"
)
identity
m
)
n
.
uniText
.
uniText
...
...
src/Gargantext/Viz/Phylo/API.hs
View file @
eb88099c
...
@@ -104,7 +104,7 @@ getPhylo :: PhyloId -> GargServer GetPhylo
...
@@ -104,7 +104,7 @@ getPhylo :: PhyloId -> GargServer GetPhylo
getPhylo
phId
_lId
l
msb
=
do
getPhylo
phId
_lId
l
msb
=
do
phNode
<-
getNodePhylo
phId
phNode
<-
getNodePhylo
phId
let
let
level
=
maybe
1
identity
l
level
=
maybe
2
identity
l
branc
=
maybe
2
identity
msb
branc
=
maybe
2
identity
msb
maybePhylo
=
hyperdataPhylo_data
$
_node_hyperdata
phNode
maybePhylo
=
hyperdataPhylo_data
$
_node_hyperdata
phNode
...
...
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