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
12
Merge Requests
12
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
4a5fdbd6
Commit
4a5fdbd6
authored
Jun 26, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[FIX name] GraphTerm -> MapTerm
parent
ccd84a0f
Pipeline
#908
failed with stage
Changes
13
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
13 changed files
with
30 additions
and
30 deletions
+30
-30
Main.hs
bin/gargantext-adaptative-phylo/Main.hs
+2
-2
Main.hs
bin/gargantext-cli/Main.hs
+2
-2
Main.hs
bin/gargantext-phylo/Main.hs
+2
-2
Metrics.hs
src/Gargantext/API/Metrics.hs
+1
-1
Ngrams.hs
src/Gargantext/API/Ngrams.hs
+9
-9
Tools.hs
src/Gargantext/API/Ngrams/Tools.hs
+2
-2
Export.hs
src/Gargantext/API/Node/Corpus/Export.hs
+1
-1
Main.hs
src/Gargantext/Core/Types/Main.hs
+2
-2
Metrics.hs
src/Gargantext/Database/Action/Metrics.hs
+1
-1
List.hs
src/Gargantext/Text/List.hs
+4
-4
CSV.hs
src/Gargantext/Text/List/CSV.hs
+2
-2
API.hs
src/Gargantext/Viz/Graph/API.hs
+1
-1
Main.hs
src/Gargantext/Viz/Phylo/Main.hs
+1
-1
No files found.
bin/gargantext-adaptative-phylo/Main.hs
View file @
4a5fdbd6
...
...
@@ -28,7 +28,7 @@ import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument(..))
import
Gargantext.Text.Context
(
TermList
)
import
Gargantext.Text.Corpus.Parsers.CSV
(
csv_title
,
csv_abstract
,
csv_publication_year
)
import
Gargantext.Text.Corpus.Parsers
(
FileFormat
(
..
),
parseFile
)
import
Gargantext.Text.List.CSV
(
csv
Graph
TermList
)
import
Gargantext.Text.List.CSV
(
csv
Map
TermList
)
import
Gargantext.Text.Terms.WithList
(
Patterns
,
buildPatterns
,
extractTermsWithList
)
import
Gargantext.Viz.AdaptativePhylo
import
Gargantext.Viz.Phylo.PhyloMaker
(
toPhylo
)
...
...
@@ -144,7 +144,7 @@ main = do
Right
config
->
do
printIOMsg
"Parse the corpus"
mapList
<-
csv
Graph
TermList
(
listPath
config
)
mapList
<-
csv
Map
TermList
(
listPath
config
)
corpus
<-
fileToDocs
(
corpusParser
config
)
(
corpusPath
config
)
mapList
printIOComment
(
show
(
length
corpus
)
<>
" parsed docs from the corpus"
)
...
...
bin/gargantext-cli/Main.hs
View file @
4a5fdbd6
...
...
@@ -53,7 +53,7 @@ import Gargantext.Text.Terms
import
Gargantext.Text.Context
import
Gargantext.Text.Terms.WithList
import
Gargantext.Text.Corpus.Parsers.CSV
(
readFile
,
csv_title
,
csv_abstract
,
csv_publication_year
)
import
Gargantext.Text.List.CSV
(
csv
Graph
TermList
)
import
Gargantext.Text.List.CSV
(
csv
Map
TermList
)
import
Gargantext.Text.Terms
(
terms
)
import
Gargantext.Text.Metrics.Count
(
coocOnContexts
,
Coocs
)
...
...
@@ -103,7 +103,7 @@ main = do
<$>
readFile
corpusFile
-- termListMap :: [Text]
termList
<-
csv
Graph
TermList
termListFile
termList
<-
csv
Map
TermList
termListFile
putStrLn
$
show
$
length
termList
...
...
bin/gargantext-phylo/Main.hs
View file @
4a5fdbd6
...
...
@@ -31,7 +31,7 @@ import Gargantext.Prelude
import
Gargantext.Text.Context
(
TermList
)
import
Gargantext.Text.Corpus.Parsers
(
FileFormat
(
..
),
parseFile
)
import
Gargantext.Text.Corpus.Parsers.CSV
(
csv_title
,
csv_abstract
,
csv_publication_year
)
import
Gargantext.Text.List.CSV
(
csv
Graph
TermList
)
import
Gargantext.Text.List.CSV
(
csv
Map
TermList
)
import
Gargantext.Text.Terms.WithList
import
Gargantext.Viz.Phylo
import
Gargantext.Viz.Phylo.LevelMaker
...
...
@@ -191,7 +191,7 @@ main = do
P
.
Left
err
->
putStrLn
err
P
.
Right
conf
->
do
termList
<-
csv
Graph
TermList
(
listPath
conf
)
termList
<-
csv
Map
TermList
(
listPath
conf
)
corpus
<-
parse
(
corpusType
conf
)
(
limit
conf
)
(
corpusPath
conf
)
termList
...
...
src/Gargantext/API/Metrics.hs
View file @
4a5fdbd6
...
...
@@ -235,7 +235,7 @@ updatePie' cId maybeListId tabType _maybeLimit = do
,
hd_scatter
=
hds
,
hd_tree
=
hdt
})
=
node
^.
node_hyperdata
p
<-
pieData
cId
(
ngramsTypeFromTabType
tabType
)
Graph
Term
p
<-
pieData
cId
(
ngramsTypeFromTabType
tabType
)
Map
Term
_
<-
updateHyperdata
listId
$
HyperdataList
hdc
hdl
(
Just
$
ChartMetrics
p
)
hds
hdt
pure
$
ChartMetrics
p
...
...
src/Gargantext/API/Ngrams.hs
View file @
4a5fdbd6
...
...
@@ -260,7 +260,7 @@ mkNgramsElement ngrams list rp children =
newNgramsElement
::
Maybe
ListType
->
NgramsTerm
->
NgramsElement
newNgramsElement
mayList
ngrams
=
mkNgramsElement
ngrams
(
fromMaybe
Graph
Term
mayList
)
Nothing
mempty
mkNgramsElement
ngrams
(
fromMaybe
Map
Term
mayList
)
Nothing
mempty
instance
ToSchema
NgramsElement
where
declareNamedSchema
=
genericDeclareNamedSchema
(
unPrefixSwagger
"_ne_"
)
...
...
@@ -348,16 +348,16 @@ toNgramsElement ns = map toNgramsElement' ns
mockTable
::
NgramsTable
mockTable
=
NgramsTable
[
mkNgramsElement
"animal"
Graph
Term
Nothing
(
mSetFromList
[
"dog"
,
"cat"
])
,
mkNgramsElement
"cat"
Graph
Term
(
rp
"animal"
)
mempty
[
mkNgramsElement
"animal"
Map
Term
Nothing
(
mSetFromList
[
"dog"
,
"cat"
])
,
mkNgramsElement
"cat"
Map
Term
(
rp
"animal"
)
mempty
,
mkNgramsElement
"cats"
StopTerm
Nothing
mempty
,
mkNgramsElement
"dog"
Graph
Term
(
rp
"animal"
)
(
mSetFromList
[
"dogs"
])
,
mkNgramsElement
"dog"
Map
Term
(
rp
"animal"
)
(
mSetFromList
[
"dogs"
])
,
mkNgramsElement
"dogs"
StopTerm
(
rp
"dog"
)
mempty
,
mkNgramsElement
"fox"
Graph
Term
Nothing
mempty
,
mkNgramsElement
"fox"
Map
Term
Nothing
mempty
,
mkNgramsElement
"object"
CandidateTerm
Nothing
mempty
,
mkNgramsElement
"nothing"
StopTerm
Nothing
mempty
,
mkNgramsElement
"organic"
Graph
Term
Nothing
(
mSetFromList
[
"flower"
])
,
mkNgramsElement
"flower"
Graph
Term
(
rp
"organic"
)
mempty
,
mkNgramsElement
"organic"
Map
Term
Nothing
(
mSetFromList
[
"flower"
])
,
mkNgramsElement
"flower"
Map
Term
(
rp
"organic"
)
mempty
,
mkNgramsElement
"moon"
CandidateTerm
Nothing
mempty
,
mkNgramsElement
"sky"
StopTerm
Nothing
mempty
]
...
...
@@ -695,8 +695,8 @@ ngramsIdPatch = fromList $ catMaybes $ reverse [ replace (1::NgramsId) (Just $ n
{-
-- TODO: Replace.old is ignored which means that if the current list
-- `
Graph
Term` and that the patch is `Replace CandidateTerm StopTerm` then
-- the list is going to be `StopTerm` while it should keep `
Graph
Term`.
-- `
Map
Term` and that the patch is `Replace CandidateTerm StopTerm` then
-- the list is going to be `StopTerm` while it should keep `
Map
Term`.
-- However this should not happen in non conflicting situations.
mkListsUpdate :: NgramsType -> NgramsTablePatch -> [(NgramsTypeId, NgramsTerm, ListTypeId)]
mkListsUpdate nt patches =
...
...
src/Gargantext/API/Ngrams/Tools.hs
View file @
4a5fdbd6
...
...
@@ -79,9 +79,9 @@ filterListWithRoot :: ListType -> Map Text (ListType, Maybe Text)
->
Map
Text
(
Maybe
RootTerm
)
filterListWithRoot
lt
m
=
Map
.
fromList
$
map
(
\
(
t
,(
_
,
r
))
->
(
t
,
r
))
$
filter
is
Graph
Term
(
Map
.
toList
m
)
$
filter
is
Map
Term
(
Map
.
toList
m
)
where
is
Graph
Term
(
_t
,(
l
,
maybeRoot
))
=
case
maybeRoot
of
is
Map
Term
(
_t
,(
l
,
maybeRoot
))
=
case
maybeRoot
of
Nothing
->
l
==
lt
Just
r
->
case
Map
.
lookup
r
m
of
Nothing
->
panic
$
"Garg.API.Ngrams.Tools: filterWithRoot, unknown key: "
<>
r
...
...
src/Gargantext/API/Node/Corpus/Export.hs
View file @
4a5fdbd6
...
...
@@ -137,7 +137,7 @@ getNodeNgrams cId lId' nt repo = do
Just
l
->
pure
l
lIds
<-
selectNodesWithUsername
NodeList
userMaster
let
ngs
=
filterListWithRoot
Graph
Term
$
mapTermListRoot
[
lId
]
nt
repo
let
ngs
=
filterListWithRoot
Map
Term
$
mapTermListRoot
[
lId
]
nt
repo
r
<-
getNgramsByNodeOnlyUser
cId
(
lIds
<>
[
lId
])
nt
(
Map
.
keys
ngs
)
pure
r
...
...
src/Gargantext/Core/Types/Main.hs
View file @
4a5fdbd6
...
...
@@ -53,7 +53,7 @@ type HashId = Text
type
TypeId
=
Int
-- TODO multiple ListType declaration, remove it
data
ListType
=
StopTerm
|
CandidateTerm
|
Graph
Term
data
ListType
=
StopTerm
|
CandidateTerm
|
Map
Term
deriving
(
Generic
,
Eq
,
Ord
,
Show
,
Read
,
Enum
,
Bounded
)
instance
ToJSON
ListType
...
...
@@ -71,7 +71,7 @@ type ListTypeId = Int
listTypeId
::
ListType
->
ListTypeId
listTypeId
StopTerm
=
0
listTypeId
CandidateTerm
=
1
listTypeId
Graph
Term
=
2
listTypeId
Map
Term
=
2
fromListTypeId
::
ListTypeId
->
Maybe
ListType
fromListTypeId
i
=
lookup
i
$
fromList
[
(
listTypeId
l
,
l
)
|
l
<-
[
minBound
..
maxBound
]]
...
...
src/Gargantext/Database/Action/Metrics.hs
View file @
4a5fdbd6
...
...
@@ -73,6 +73,6 @@ getNgrams cId maybeListId tabType = do
lists
<-
mapTermListRoot
[
lId
]
(
ngramsTypeFromTabType
tabType
)
<$>
getRepo
let
maybeSyn
=
Map
.
unions
$
map
(
\
t
->
filterListWithRoot
t
lists
)
[
Graph
Term
,
StopTerm
,
CandidateTerm
]
[
Map
Term
,
StopTerm
,
CandidateTerm
]
pure
(
lists
,
maybeSyn
)
src/Gargantext/Text/List.hs
View file @
4a5fdbd6
...
...
@@ -79,7 +79,7 @@ buildNgramsOthersList uCid groupIt nt = do
graphTerms
=
List
.
take
listSize
all'
candiTerms
=
List
.
drop
listSize
all'
pure
$
Map
.
unionsWith
(
<>
)
[
toElements
Graph
Term
graphTerms
pure
$
Map
.
unionsWith
(
<>
)
[
toElements
Map
Term
graphTerms
,
toElements
CandidateTerm
candiTerms
]
where
...
...
@@ -122,7 +122,7 @@ buildNgramsTermsList' uCid groupIt stop gls is = do
$ map toNgramsElement
$ map (\t -> (StopTerm , toList' t)) s
<> map (\t -> (CandidateTerm, toList' t)) c
<> map (\t -> (
Graph
Term , toList' t)) m
<> map (\t -> (
Map
Term , toList' t)) m
pure $ Map.fromList [(NgramsTerms, ngs')]
-}
...
...
@@ -151,7 +151,7 @@ buildNgramsTermsList l n m s uCid mCid = do
termList
=
-- (toTermList a b ((isStopTerm s) . fst) candidatesHead)
(
map
(
toGargList
((
isStopTerm
s
)
.
fst
)
Graph
Term
)
candidatesHead
)
(
map
(
toGargList
((
isStopTerm
s
)
.
fst
)
Map
Term
)
candidatesHead
)
<>
(
map
(
toGargList
((
isStopTerm
s
)
.
fst
)
CandidateTerm
)
candidatesTail
)
ngs
=
List
.
concat
$
map
toNgramsElement
termList
...
...
@@ -167,7 +167,7 @@ toTermList :: Int
toTermList
_
_
_
[]
=
[]
toTermList
a
b
stop
ns
=
-- trace ("computing toTermList") $
map
(
toGargList
stop
CandidateTerm
)
xs
<>
map
(
toGargList
stop
Graph
Term
)
ys
<>
map
(
toGargList
stop
Map
Term
)
ys
<>
toTermList
a
b
stop
zs
where
xs
=
take
a
ns
...
...
src/Gargantext/Text/List/CSV.hs
View file @
4a5fdbd6
...
...
@@ -35,8 +35,8 @@ import Gargantext.Text.Context
------------------------------------------------------------------------
csv
Graph
TermList
::
FilePath
->
IO
TermList
csv
Graph
TermList
fp
=
csv2list
CsvMap
<$>
snd
<$>
fromCsvListFile
fp
csv
Map
TermList
::
FilePath
->
IO
TermList
csv
Map
TermList
fp
=
csv2list
CsvMap
<$>
snd
<$>
fromCsvListFile
fp
csv2list
::
CsvListType
->
Vector
CsvList
->
TermList
csv2list
lt
vs
=
V
.
toList
$
V
.
map
(
\
(
CsvList
_
label
forms
)
...
...
src/Gargantext/Viz/Graph/API.hs
View file @
4a5fdbd6
...
...
@@ -148,7 +148,7 @@ computeGraph cId d nt repo = do
-- (map (\n -> LegendField n "#FFFFFF" (pack $ show n)) [1..10])
lIds
<-
selectNodesWithUsername
NodeList
userMaster
let
ngs
=
filterListWithRoot
Graph
Term
$
mapTermListRoot
[
lId
]
nt
repo
let
ngs
=
filterListWithRoot
Map
Term
$
mapTermListRoot
[
lId
]
nt
repo
myCooc
<-
Map
.
filter
(
>
1
)
<$>
getCoocByNgrams
(
Diagonal
True
)
...
...
src/Gargantext/Viz/Phylo/Main.hs
View file @
4a5fdbd6
...
...
@@ -49,7 +49,7 @@ flowPhylo :: FlowCmdM env err m
flowPhylo
cId
=
do
list
<-
defaultList
cId
termList
<-
Map
.
toList
<$>
getTermsWith
Text
.
words
[
list
]
NgramsTerms
Graph
Term
termList
<-
Map
.
toList
<$>
getTermsWith
Text
.
words
[
list
]
NgramsTerms
Map
Term
docs'
<-
catMaybes
<$>
map
(
\
h
->
(,)
<$>
_hyperdataDocument_publication_year
h
...
...
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