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
b19eb53a
Commit
b19eb53a
authored
Nov 19, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[CLEAN] doc + refact
parent
eb61dae3
Changes
5
Hide whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
89 additions
and
50 deletions
+89
-50
Group.hs
src/Gargantext/Core/Text/List/Group.hs
+1
-2
WithScores.hs
src/Gargantext/Core/Text/List/Group/WithScores.hs
+14
-2
Social.hs
src/Gargantext/Core/Text/List/Social.hs
+1
-0
Prelude.hs
src/Gargantext/Core/Text/List/Social/Prelude.hs
+58
-0
Scores.hs
src/Gargantext/Core/Text/List/Social/Scores.hs
+15
-46
No files found.
src/Gargantext/Core/Text/List/Group.hs
View file @
b19eb53a
...
...
@@ -40,9 +40,8 @@ toGroupedText :: GroupedTextParams a b
toGroupedText
groupParams
scores
=
(
groupWithStem
groupParams
)
.
(
groupWithScores
scores
)
------------------------------------------------------------------------
-- | WIP
-- | WIP
, put this in test folder
toGroupedText_test
::
Bool
-- Map Stem (GroupedText Int)
toGroupedText_test
=
-- fromGroupedScores $ fromListScores from
...
...
src/Gargantext/Core/Text/List/Group/WithScores.hs
View file @
b19eb53a
...
...
@@ -23,6 +23,7 @@ import Data.Text (Text)
import
Gargantext.Core.Types
(
ListType
(
..
))
-- (MasterCorpusId, UserCorpusId)
import
Gargantext.Database.Admin.Types.Node
(
NodeId
)
-- import Gargantext.Core.Text.List.Learn (Model(..))
import
Gargantext.Core.Text.List.Social.Prelude
import
Gargantext.Core.Text.List.Social.Scores
import
Gargantext.Prelude
import
qualified
Data.Set
as
Set
...
...
@@ -38,9 +39,11 @@ makeLenses ''GroupedWithListScores
instance
Semigroup
GroupedWithListScores
where
(
<>
)
(
GroupedWithListScores
c1
l1
)
(
GroupedWithListScores
c2
l2
)
=
GroupedWithListScores
(
c1
<>
c2
)
(
l1
<>
l2
)
GroupedWithListScores
(
c1
<>
c2
)
(
l1
<>
l2
)
------
-- To be removed
data
GroupedTextScores
score
=
GroupedTextScores
{
_gts_listType
::
!
(
Maybe
ListType
)
,
_gts_score
::
score
...
...
@@ -53,6 +56,7 @@ instance Semigroup a => Semigroup (GroupedTextScores a) where
=
GroupedTextScores
(
l1
<>
l2
)
(
s1
<>
s2
)
(
c1
<>
c2
)
------
-- | Tree of GroupedTextScores
data
GroupedTextScores'
score
=
GroupedTextScores'
{
_gts'_listType
::
!
(
Maybe
ListType
)
,
_gts'_score
::
score
...
...
@@ -78,6 +82,7 @@ groupWithScores scores ms = orphans <> groups
orphans
=
addIfNotExist
scores
ms
------------------------------------------------------------------------
addScore
::
Map
Text
(
Set
NodeId
)
->
Map
Text
(
GroupedTextScores
(
Set
NodeId
))
->
Map
Text
(
GroupedTextScores
(
Set
NodeId
))
...
...
@@ -102,8 +107,15 @@ addIfNotExist mapSocialScores mapScores =
_
->
m
add
ns'
Nothing
=
Just
$
GroupedTextScores
Nothing
ns'
Set
.
empty
add
_
_
=
Nothing
-- should not be present
add
_
_
=
Nothing
-- should not be present
------------------------------------------------------------------------
{-
toGroupedTextScores' :: Map Parent GroupedWithListScores
-> Map Text (Set NodeId)
-> Map Parent (GroupedTextScores' (Set NodeId))
toGroupedTextScores' par datas = undefined
-}
------------------------------------------------------------------------
fromGroupedScores
::
Map
Parent
GroupedWithListScores
...
...
src/Gargantext/Core/Text/List/Social.hs
View file @
b19eb53a
...
...
@@ -20,6 +20,7 @@ import Gargantext.API.Ngrams.Tools -- (getListNgrams)
import
Gargantext.API.Ngrams.Types
import
Gargantext.Core.Text.List.Social.Find
import
Gargantext.Core.Text.List.Social.ListType
import
Gargantext.Core.Text.List.Social.Prelude
import
Gargantext.Core.Text.List.Social.Scores
import
Gargantext.Core.Types.Individu
import
Gargantext.Core.Types.Main
...
...
src/Gargantext/Core/Text/List/Social/Prelude.hs
0 → 100644
View file @
b19eb53a
{-|
Module : Gargantext.Core.Text.List.Social.Prelude
Description :
Copyright : (c) CNRS, 2018-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeFamilies #-}
module
Gargantext.Core.Text.List.Social.Prelude
where
import
Data.Map
(
Map
)
import
Data.Text
(
Text
)
import
Gargantext.Prelude
import
qualified
Data.Map
as
Map
------------------------------------------------------------------------
-- | Tools to inherit groupings
------------------------------------------------------------------------
-- | Tools
parentUnionsMerge
::
(
Ord
a
,
Ord
b
,
Num
c
)
=>
[
Map
a
(
Map
b
c
)]
->
Map
a
(
Map
b
c
)
parentUnionsMerge
=
Map
.
unionsWith
(
Map
.
unionWith
(
+
))
-- This Parent union is specific
-- [Private, Shared, Public]
-- means the following preferences:
-- Private > Shared > Public
-- if data have not been tagged privately, then use others tags
-- This unions behavior takes first key only and ignore others
parentUnionsExcl
::
Ord
a
=>
[
Map
a
b
]
->
Map
a
b
parentUnionsExcl
=
Map
.
unions
------------------------------------------------------------------------
type
Parent
=
Text
hasParent
::
Text
->
Map
Text
(
Map
Parent
Int
)
->
Maybe
Parent
hasParent
t
m
=
case
Map
.
lookup
t
m
of
Nothing
->
Nothing
Just
m'
->
keyWithMaxValue
m'
------------------------------------------------------------------------
keyWithMaxValue
::
Map
a
b
->
Maybe
a
keyWithMaxValue
m
=
(
fst
.
fst
)
<$>
Map
.
maxViewWithKey
m
src/Gargantext/Core/Text/List/Social/Scores.hs
View file @
b19eb53a
...
...
@@ -26,48 +26,15 @@ import Data.Text (Text)
import
GHC.Generics
(
Generic
)
import
Gargantext.API.Ngrams.Types
import
Gargantext.Core.Types.Main
import
Gargantext.Core.Text.List.Social.Prelude
import
Gargantext.Prelude
import
qualified
Data.Map
as
Map
import
qualified
Data.Set
as
Set
------------------------------------------------------------------------
-- | Tools to inherit groupings
------------------------------------------------------------------------
-- | Tools
parentUnionsMerge
::
(
Ord
a
,
Ord
b
,
Num
c
)
=>
[
Map
a
(
Map
b
c
)]
->
Map
a
(
Map
b
c
)
parentUnionsMerge
=
Map
.
unionsWith
(
Map
.
unionWith
(
+
))
-- This Parent union is specific
-- [Private, Shared, Public]
-- means the following preferences:
-- Private > Shared > Public
-- if data have not been tagged privately, then use others tags
-- This unions behavior takes first key only and ignore others
parentUnionsExcl
::
Ord
a
=>
[
Map
a
b
]
->
Map
a
b
parentUnionsExcl
=
Map
.
unions
------------------------------------------------------------------------
type
Parent
=
Text
hasParent
::
Text
->
Map
Text
(
Map
Parent
Int
)
->
Maybe
Parent
hasParent
t
m
=
case
Map
.
lookup
t
m
of
Nothing
->
Nothing
Just
m'
->
keyWithMaxValue
m'
------------------------------------------------------------------------
keyWithMaxValue
::
Map
a
b
->
Maybe
a
keyWithMaxValue
m
=
(
fst
.
fst
)
<$>
Map
.
maxViewWithKey
m
------------------------------------------------------------------------
-- | Datatype definition
data
FlowListScores
=
FlowListScores
{
_fls_parents
::
Map
Parent
Int
FlowListScores
{
_fls_parents
::
Map
Parent
Int
,
_fls_listType
::
Map
ListType
Int
-- You can add any score by incrementing this type
-- , _flc_score :: Map Score Int
...
...
@@ -76,29 +43,31 @@ data FlowListScores =
makeLenses
''
F
lowListScores
-- | Rules to compose 2 datatype FlowListScores
-- Triangle de Pascal, nombre d'or ou pi ?
instance
Semigroup
FlowListScores
where
(
<>
)
(
FlowListScores
p1
l1
)
(
FlowListScores
p2
l2
)
=
FlowListScores
(
p1
<>
p2
)
(
l1
<>
l2
)
(
<>
)
(
FlowListScores
p1
l1
)
(
FlowListScores
p2
l2
)
=
FlowListScores
(
p1
<>
p2
)
(
l1
<>
l2
)
------------------------------------------------------------------------
------------------------------------------------------------------------
-- | toFlowListScores which generate Score from list of Map Text
-- NgramsRepoElement
-- | Generates Score from list of Map Text NgramsRepoElement
toFlowListScores
::
KeepAllParents
->
Set
Text
->
Map
Text
FlowListScores
->
[
Map
Text
NgramsRepoElement
]
->
Map
Text
FlowListScores
toFlowListScores
k
ts
=
foldl'
(
toFlowListScores'
k
ts
)
toFlowListScores
k
st
=
foldl'
(
toFlowListScores'
k
st
)
where
toFlowListScores'
::
KeepAllParents
->
Set
Text
->
Map
Text
FlowListScores
->
Map
Text
NgramsRepoElement
->
Map
Text
FlowListScores
toFlowListScores'
k'
ts
'
to'
ngramsRepo
=
Set
.
foldl'
(
toFlowListScores''
k'
ts'
ngramsRepo
)
to'
ts
'
toFlowListScores'
k'
st
'
to'
ngramsRepo
=
Set
.
foldl'
(
toFlowListScores''
k'
st'
ngramsRepo
)
to'
st
'
toFlowListScores''
::
KeepAllParents
->
Set
Text
...
...
@@ -106,10 +75,10 @@ toFlowListScores k ts = foldl' (toFlowListScores' k ts)
->
Map
Text
FlowListScores
->
Text
->
Map
Text
FlowListScores
toFlowListScores''
k''
s
s
ngramsRepo
to''
t
=
toFlowListScores''
k''
s
t''
ngramsRepo
to''
t
=
case
Map
.
lookup
t
ngramsRepo
of
Nothing
->
to''
Just
nre
->
Map
.
alter
(
addParent
k''
nre
s
s
)
t
Just
nre
->
Map
.
alter
(
addParent
k''
nre
s
t''
)
t
$
Map
.
alter
(
addList
$
_nre_list
nre
)
t
to''
------------------------------------------------------------------------
...
...
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