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
158
Issues
158
List
Board
Labels
Milestones
Merge Requests
11
Merge Requests
11
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
4ae94de2
Commit
4ae94de2
authored
Nov 23, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[Type] Instance FlowLists
parent
0ce0a194
Changes
4
Show whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
44 additions
and
63 deletions
+44
-63
List.hs
src/Gargantext/Core/Text/List.hs
+8
-4
Group.hs
src/Gargantext/Core/Text/List/Group.hs
+0
-51
Prelude.hs
src/Gargantext/Core/Text/List/Group/Prelude.hs
+34
-5
WithScores.hs
src/Gargantext/Core/Text/List/Group/WithScores.hs
+2
-3
No files found.
src/Gargantext/Core/Text/List.hs
View file @
4ae94de2
...
...
@@ -89,22 +89,26 @@ buildNgramsOthersList user uCid groupIt (nt, MapListSize mapListSize) = do
<-
flowSocialList'
MySelfFirst
user
nt
(
FlowCont
Map
.
empty
$
Set
.
fromList
$
Map
.
keys
ngs'
)
-- PrivateFirst for first developments since Public NodeMode is not implemented yet
{-
printDebug "flowSocialList'"
$ Map.filter (not . ((==) Map.empty) . view fls_parents)
$ view flc_scores socialLists'
-}
let
groupParams
=
GroupedTextParams
groupIt
(
Set
.
size
.
snd
)
fst
snd
{-(size . fst)-}
groupedWithList
=
toGroupedText
groupParams
(
view
flc_scores
socialLists'
)
ngs'
{-
printDebug "groupedWithList"
$ Map.map (\v -> (view gt_label v, view gt_children v))
$ Map.filter (\v -> (Set.size $ view gt_children v) > 0)
$ groupedWithList
-}
let
(
stopTerms
,
tailTerms
)
=
Map
.
partition
(
\
t
->
t
^.
gt_listType
==
Just
StopTerm
)
groupedWithList
(
mapTerms
,
tailTerms'
)
=
Map
.
partition
(
\
t
->
t
^.
gt_listType
==
Just
MapTerm
)
tailTerms
(
stopTerms
,
tailTerms
)
=
Map
.
partition
(
(
==
Just
StopTerm
)
.
viewListType
)
groupedWithList
(
mapTerms
,
tailTerms'
)
=
Map
.
partition
(
(
==
Just
MapTerm
)
.
viewListType
)
tailTerms
listSize
=
mapListSize
-
(
List
.
length
mapTerms
)
(
mapTerms'
,
candiTerms
)
=
List
.
splitAt
listSize
...
...
@@ -114,9 +118,9 @@ buildNgramsOthersList user uCid groupIt (nt, MapListSize mapListSize) = do
pure
$
Map
.
fromList
[(
nt
,
(
List
.
concat
$
map
toNgramsElement
stopTerms
)
<>
(
List
.
concat
$
map
toNgramsElement
mapTerms
)
<>
(
List
.
concat
$
map
toNgramsElement
$
map
(
set
gt_l
istType
(
Just
MapTerm
))
mapTerms'
)
$
map
(
set
L
istType
(
Just
MapTerm
))
mapTerms'
)
<>
(
List
.
concat
$
map
toNgramsElement
$
map
(
set
gt_l
istType
(
Just
CandidateTerm
))
candiTerms
)
$
map
(
set
L
istType
(
Just
CandidateTerm
))
candiTerms
)
)]
...
...
src/Gargantext/Core/Text/List/Group.hs
View file @
4ae94de2
...
...
@@ -42,57 +42,6 @@ toGroupedText groupParams scores =
(
groupWithStem
groupParams
)
.
(
groupWithScores
scores
)
------------------------------------------------------------------------
-- | TODO put in test folder
toGroupedText_test
::
Bool
-- Map Stem (GroupedText Int)
toGroupedText_test
=
-- fromGroupedScores $ fromListScores from
toGroupedText
params
from
datas
==
result
where
params
=
GroupedTextParams
identity
(
Set
.
size
.
snd
)
fst
snd
from
::
Map
Text
FlowListScores
from
=
Map
.
fromList
[(
"A. Rahmani"
,
FlowListScores
{
_fls_parents
=
Map
.
fromList
[(
"T. Reposeur"
,
1
)]
,
_fls_listType
=
Map
.
fromList
[(
MapTerm
,
2
)]})
,(
"B. Tamain"
,
FlowListScores
{
_fls_parents
=
Map
.
fromList
[(
"T. Reposeur"
,
1
)]
,
_fls_listType
=
Map
.
fromList
[(
MapTerm
,
2
)]})
]
datas
::
Map
Text
(
Set
NodeId
)
datas
=
Map
.
fromList
[(
"A. Rahmani"
,
Set
.
fromList
[
1
,
2
])
,(
"T. Reposeur"
,
Set
.
fromList
[
3
,
4
])
,(
"B. Tamain"
,
Set
.
fromList
[
5
,
6
])
]
result
::
Map
Stem
(
GroupedText
Int
)
result
=
Map
.
fromList
[(
"A. Rahmani"
,
GroupedText
{
_gt_listType
=
Nothing
,
_gt_label
=
"A. Rahmani"
,
_gt_score
=
2
,
_gt_children
=
Set
.
empty
,
_gt_size
=
2
,
_gt_stem
=
"A. Rahmani"
,
_gt_nodes
=
Set
.
fromList
[
1
,
2
]
}
)
,(
"B. Tamain"
,
GroupedText
{
_gt_listType
=
Nothing
,
_gt_label
=
"B. Tamain"
,
_gt_score
=
2
,
_gt_children
=
Set
.
empty
,
_gt_size
=
2
,
_gt_stem
=
"B. Tamain"
,
_gt_nodes
=
Set
.
fromList
[
5
,
6
]
}
)
,(
"T. Reposeur"
,
GroupedText
{
_gt_listType
=
Nothing
,
_gt_label
=
"T. Reposeur"
,
_gt_score
=
2
,
_gt_children
=
Set
.
fromList
[
"A. Rahmani"
,
"B. Tamain"
]
,
_gt_size
=
2
,
_gt_stem
=
"T. Reposeur"
,
_gt_nodes
=
Set
.
fromList
[
1
..
6
]
}
)
]
------------------------------------------------------------------------
-- | TODO To be removed
addListType
::
Map
Text
ListType
->
GroupedText
a
->
GroupedText
a
...
...
src/Gargantext/Core/Text/List/Group/Prelude.hs
View file @
4ae94de2
...
...
@@ -14,7 +14,7 @@ Portability : POSIX
module
Gargantext.Core.Text.List.Group.Prelude
where
import
Control.Lens
(
makeLenses
)
import
Control.Lens
(
makeLenses
,
view
,
set
)
import
Data.Monoid
import
Data.Semigroup
import
Data.Set
(
Set
)
...
...
@@ -50,6 +50,28 @@ instance (Ord score, Monoid score)
makeLenses
'G
r
oupedTreeScores
---------------------------------------------
class
ViewListType
a
where
viewListType
::
a
->
Maybe
ListType
class
SetListType
a
where
setListType
::
Maybe
ListType
->
a
->
a
class
ViewScore
a
b
where
viewScore
::
a
->
b
instance
ViewListType
(
GroupedTreeScores
a
)
where
viewListType
=
view
gts'_listType
instance
SetListType
(
GroupedTreeScores
a
)
where
setListType
=
set
gts'_listType
{-
instance ViewScore (GroupedTreeScores a) b where
viewScore = view gts'_score
-}
-- 8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--
-- TODO to remove below
...
...
@@ -70,8 +92,6 @@ instance Monoid GroupedWithListScores where
makeLenses
''
G
roupedWithListScores
-- 8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--
------------------------------------------------------------------------
------------------------------------------------------------------------
-- | Group With Stem Main Types
...
...
@@ -85,6 +105,16 @@ data GroupedText score =
,
_gt_stem
::
!
Stem
-- needed ?
,
_gt_nodes
::
!
(
Set
NodeId
)
}
deriving
(
Show
,
Eq
)
--}
-- | Lenses Instances
makeLenses
'G
r
oupedText
instance
ViewListType
(
GroupedText
a
)
where
viewListType
=
view
gt_listType
instance
SetListType
(
GroupedText
a
)
where
setListType
=
set
gt_listType
{-
instance Show score => Show (GroupedText score) where
show (GroupedText lt l s _ _ _ _) = show l <> " : " <> show lt <> " : " <> show s
...
...
@@ -110,6 +140,5 @@ instance Ord a => Semigroup (GroupedText a) where
gr
=
Set
.
union
group1
group2
nodes
=
Set
.
union
nodes1
nodes2
-- | Lenses Instances
makeLenses
'G
r
oupedText
src/Gargantext/Core/Text/List/Group/WithScores.hs
View file @
4ae94de2
...
...
@@ -86,7 +86,6 @@ toGroupedTree' m notEmpty
--8<-- -8<-- -8<-- -8<-- -8<-- -8<-- -8<-- -8<-- -8<-- -8<-- -8<-- -8<--
-- TODO TO BE REMOVED
data
GroupedTextScores
score
=
...
...
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