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
141
Issues
141
List
Board
Labels
Milestones
Merge Requests
5
Merge Requests
5
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
acad4d47
Commit
acad4d47
authored
Nov 23, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[Type] Instance FlowLists
parent
4b2f54ab
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
43 additions
and
63 deletions
+43
-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
+33
-5
WithScores.hs
src/Gargantext/Core/Text/List/Group/WithScores.hs
+2
-3
No files found.
src/Gargantext/Core/Text/List.hs
View file @
acad4d47
...
...
@@ -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 @
acad4d47
...
...
@@ -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 @
acad4d47
...
...
@@ -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,5 +140,3 @@ 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 @
acad4d47
...
...
@@ -48,8 +48,8 @@ groupWithScores' flc scores = FlowCont groups orphans
------------------------------------------------------------------------
toMapMaybeParent
::
(
Text
->
Set
NodeId
)
->
Map
Text
FlowListScores
->
Map
(
Maybe
Parent
)
(
Map
Text
(
GroupedTreeScores
(
Set
NodeId
)))
->
Map
Text
FlowListScores
->
Map
(
Maybe
Parent
)
(
Map
Text
(
GroupedTreeScores
(
Set
NodeId
)))
toMapMaybeParent
f
=
Map
.
fromListWith
(
<>
)
.
(
map
(
fromScores''
f
))
.
Map
.
toList
fromScores''
::
(
Text
->
Set
NodeId
)
...
...
@@ -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