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
145
Issues
145
List
Board
Labels
Milestones
Merge Requests
6
Merge Requests
6
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
c2eef64c
Commit
c2eef64c
authored
Nov 26, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[CLEAN] smal refact, renaming, doc
parent
4ea0d7f8
Pipeline
#1249
failed with stage
Changes
2
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
19 additions
and
17 deletions
+19
-17
List.hs
src/Gargantext/Core/Text/List.hs
+14
-14
Group.hs
src/Gargantext/Core/Text/List/Group.hs
+5
-3
No files found.
src/Gargantext/Core/Text/List.hs
View file @
c2eef64c
...
...
@@ -17,7 +17,6 @@ module Gargantext.Core.Text.List
import
Control.Lens
hiding
(
both
)
-- ((^.), view, over, set, (_1), (_2))
import
Data.Map
(
Map
)
import
Data.Maybe
(
catMaybes
,
fromMaybe
)
import
Data.Monoid
(
mempty
)
import
Data.Ord
(
Down
(
..
))
import
Data.Set
(
Set
)
...
...
@@ -43,11 +42,9 @@ import Gargantext.Database.Query.Table.Node.Error (HasNodeError())
import
Gargantext.Database.Query.Tree.Error
(
HasTreeError
)
import
Gargantext.Database.Schema.Ngrams
(
NgramsType
(
..
))
import
Gargantext.Prelude
import
qualified
Data.Char
as
Char
import
qualified
Data.List
as
List
import
qualified
Data.Map
as
Map
import
qualified
Data.Set
as
Set
import
qualified
Data.Text
as
Text
{-
...
...
@@ -138,6 +135,8 @@ buildNgramsTermsList :: ( HasNodeError err
->
m
(
Map
NgramsType
[
NgramsElement
])
buildNgramsTermsList
user
uCid
mCid
groupParams
(
nt
,
mapListSize
)
=
do
-- | Filter 0 With Double
-- Computing global speGen score
allTerms
::
Map
Text
Double
<-
getTficf
uCid
mCid
nt
...
...
@@ -168,12 +167,15 @@ buildNgramsTermsList user uCid mCid groupParams (nt, mapListSize)= do
(
groupedMonoHead
,
groupedMonoTail
)
=
splitAt
monoSize
groupedMono
(
groupedMultHead
,
groupedMultTail
)
=
splitAt
multSize
groupedMult
-------------------------
-- Filter 1 With Set NodeId and SpeGen
selectedTerms
=
Set
.
toList
$
hasTerms
(
groupedMonoHead
<>
groupedMultHead
)
-- TO remove (and remove HasNodeError instance)
userListId
<-
defaultList
uCid
masterListId
<-
defaultList
mCid
mapTextDocIds
<-
getNodesByNgramsOnlyUser
uCid
[
userListId
,
masterListId
]
nt
...
...
@@ -232,27 +234,27 @@ buildNgramsTermsList user uCid mCid groupParams (nt, mapListSize)= do
exclSize
=
1
-
inclSize
splitAt'
n'
=
(
both
(
Map
.
fromList
))
.
(
List
.
splitAt
(
round
$
n'
*
listSizeLocal
))
sortOn
f
=
(
List
.
sortOn
(
Down
.
f
.
_gts'_score
.
snd
))
.
Map
.
toList
sortOn
f
=
(
List
.
sortOn
(
Down
.
(
view
(
gts'_score
.
f
))
.
snd
))
.
Map
.
toList
monoInc_size
=
monoSize
*
inclSize
/
2
(
monoScoredInclHead
,
monoScoredInclTail
)
=
splitAt'
monoInc_size
$
(
sortOn
_
scored_genInc
)
monoScoredIncl
(
monoScoredExclHead
,
monoScoredExclTail
)
=
splitAt'
monoInc_size
$
(
sortOn
_
scored_speExc
)
monoScoredExcl
monoInc_size
=
splitAt'
$
monoSize
*
inclSize
/
2
(
monoScoredInclHead
,
monoScoredInclTail
)
=
monoInc_size
$
(
sortOn
scored_genInc
)
monoScoredIncl
(
monoScoredExclHead
,
monoScoredExclTail
)
=
monoInc_size
$
(
sortOn
scored_speExc
)
monoScoredExcl
multExc_size
=
multSize
*
exclSize
/
2
(
multScoredInclHead
,
multScoredInclTail
)
=
splitAt'
multExc_size
$
(
sortOn
_
scored_genInc
)
multScoredIncl
(
multScoredExclHead
,
multScoredExclTail
)
=
splitAt'
multExc_size
$
(
sortOn
_
scored_speExc
)
multScoredExcl
multExc_size
=
splitAt'
$
multSize
*
exclSize
/
2
(
multScoredInclHead
,
multScoredInclTail
)
=
multExc_size
$
(
sortOn
scored_genInc
)
multScoredIncl
(
multScoredExclHead
,
multScoredExclTail
)
=
multExc_size
$
(
sortOn
scored_speExc
)
multScoredExcl
-- Final Step building the Typed list
termListHead
=
maps
<>
cands
where
maps
=
setListType
(
Just
MapTerm
)
$
monoScoredInclHead
$
monoScoredInclHead
<>
monoScoredExclHead
<>
multScoredInclHead
<>
multScoredExclHead
cands
=
setListType
(
Just
CandidateTerm
)
$
monoScoredInclTail
$
monoScoredInclTail
<>
monoScoredExclTail
<>
multScoredInclTail
<>
multScoredExclTail
...
...
@@ -267,5 +269,3 @@ buildNgramsTermsList user uCid mCid groupParams (nt, mapListSize)= do
]
pure
result
------------------------------------------------------------------------------
src/Gargantext/Core/Text/List/Group.hs
View file @
c2eef64c
...
...
@@ -52,9 +52,6 @@ toGroupedTree groupParams flc scores = {-view flc_scores-} flow2
True
->
flow1
False
->
groupWithStem'
groupParams
flow1
{-
DM.foldlWithKey :: (a -> k -> b -> a) -> a -> Map k b -> a
-}
setScoresWith
::
(
Ord
a
,
Ord
b
)
=>
(
Text
->
(
GroupedTreeScores
a
)
->
(
GroupedTreeScores
b
))
...
...
@@ -62,6 +59,11 @@ setScoresWith :: (Ord a, Ord b)
->
Map
Text
(
GroupedTreeScores
b
)
setScoresWith
=
Map
.
mapWithKey
{-
gts :: (Text -> b) -> Text -> GroupedTreeScores a -> GroupedTreeScores b
gts f t g = over gts'_children set gts'_score (f t) g
-}
{-
Map.foldlWithKey (\k v ->
{- over gts'_children (setScoresWith fun)
...
...
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