Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
H
haskell-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
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
Przemyslaw Kaminski
haskell-gargantext
Commits
6aebe7b8
Commit
6aebe7b8
authored
Nov 19, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[CLEAN] doc + refact
parent
01f6f79c
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 @
6aebe7b8
...
@@ -40,9 +40,8 @@ toGroupedText :: GroupedTextParams a b
...
@@ -40,9 +40,8 @@ toGroupedText :: GroupedTextParams a b
toGroupedText
groupParams
scores
=
toGroupedText
groupParams
scores
=
(
groupWithStem
groupParams
)
.
(
groupWithScores
scores
)
(
groupWithStem
groupParams
)
.
(
groupWithScores
scores
)
------------------------------------------------------------------------
------------------------------------------------------------------------
-- | WIP
-- | WIP
, put this in test folder
toGroupedText_test
::
Bool
-- Map Stem (GroupedText Int)
toGroupedText_test
::
Bool
-- Map Stem (GroupedText Int)
toGroupedText_test
=
toGroupedText_test
=
-- fromGroupedScores $ fromListScores from
-- fromGroupedScores $ fromListScores from
...
...
src/Gargantext/Core/Text/List/Group/WithScores.hs
View file @
6aebe7b8
...
@@ -23,6 +23,7 @@ import Data.Text (Text)
...
@@ -23,6 +23,7 @@ import Data.Text (Text)
import
Gargantext.Core.Types
(
ListType
(
..
))
-- (MasterCorpusId, UserCorpusId)
import
Gargantext.Core.Types
(
ListType
(
..
))
-- (MasterCorpusId, UserCorpusId)
import
Gargantext.Database.Admin.Types.Node
(
NodeId
)
import
Gargantext.Database.Admin.Types.Node
(
NodeId
)
-- import Gargantext.Core.Text.List.Learn (Model(..))
-- import Gargantext.Core.Text.List.Learn (Model(..))
import
Gargantext.Core.Text.List.Social.Prelude
import
Gargantext.Core.Text.List.Social.Scores
import
Gargantext.Core.Text.List.Social.Scores
import
Gargantext.Prelude
import
Gargantext.Prelude
import
qualified
Data.Set
as
Set
import
qualified
Data.Set
as
Set
...
@@ -38,9 +39,11 @@ makeLenses ''GroupedWithListScores
...
@@ -38,9 +39,11 @@ makeLenses ''GroupedWithListScores
instance
Semigroup
GroupedWithListScores
where
instance
Semigroup
GroupedWithListScores
where
(
<>
)
(
GroupedWithListScores
c1
l1
)
(
<>
)
(
GroupedWithListScores
c1
l1
)
(
GroupedWithListScores
c2
l2
)
=
(
GroupedWithListScores
c2
l2
)
=
GroupedWithListScores
(
c1
<>
c2
)
(
l1
<>
l2
)
GroupedWithListScores
(
c1
<>
c2
)
(
l1
<>
l2
)
------
------
-- To be removed
data
GroupedTextScores
score
=
data
GroupedTextScores
score
=
GroupedTextScores
{
_gts_listType
::
!
(
Maybe
ListType
)
GroupedTextScores
{
_gts_listType
::
!
(
Maybe
ListType
)
,
_gts_score
::
score
,
_gts_score
::
score
...
@@ -53,6 +56,7 @@ instance Semigroup a => Semigroup (GroupedTextScores a) where
...
@@ -53,6 +56,7 @@ instance Semigroup a => Semigroup (GroupedTextScores a) where
=
GroupedTextScores
(
l1
<>
l2
)
(
s1
<>
s2
)
(
c1
<>
c2
)
=
GroupedTextScores
(
l1
<>
l2
)
(
s1
<>
s2
)
(
c1
<>
c2
)
------
------
-- | Tree of GroupedTextScores
data
GroupedTextScores'
score
=
data
GroupedTextScores'
score
=
GroupedTextScores'
{
_gts'_listType
::
!
(
Maybe
ListType
)
GroupedTextScores'
{
_gts'_listType
::
!
(
Maybe
ListType
)
,
_gts'_score
::
score
,
_gts'_score
::
score
...
@@ -78,6 +82,7 @@ groupWithScores scores ms = orphans <> groups
...
@@ -78,6 +82,7 @@ groupWithScores scores ms = orphans <> groups
orphans
=
addIfNotExist
scores
ms
orphans
=
addIfNotExist
scores
ms
------------------------------------------------------------------------
addScore
::
Map
Text
(
Set
NodeId
)
addScore
::
Map
Text
(
Set
NodeId
)
->
Map
Text
(
GroupedTextScores
(
Set
NodeId
))
->
Map
Text
(
GroupedTextScores
(
Set
NodeId
))
->
Map
Text
(
GroupedTextScores
(
Set
NodeId
))
->
Map
Text
(
GroupedTextScores
(
Set
NodeId
))
...
@@ -102,8 +107,15 @@ addIfNotExist mapSocialScores mapScores =
...
@@ -102,8 +107,15 @@ addIfNotExist mapSocialScores mapScores =
_
->
m
_
->
m
add
ns'
Nothing
=
Just
$
GroupedTextScores
Nothing
ns'
Set
.
empty
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
fromGroupedScores
::
Map
Parent
GroupedWithListScores
...
...
src/Gargantext/Core/Text/List/Social.hs
View file @
6aebe7b8
...
@@ -20,6 +20,7 @@ import Gargantext.API.Ngrams.Tools -- (getListNgrams)
...
@@ -20,6 +20,7 @@ import Gargantext.API.Ngrams.Tools -- (getListNgrams)
import
Gargantext.API.Ngrams.Types
import
Gargantext.API.Ngrams.Types
import
Gargantext.Core.Text.List.Social.Find
import
Gargantext.Core.Text.List.Social.Find
import
Gargantext.Core.Text.List.Social.ListType
import
Gargantext.Core.Text.List.Social.ListType
import
Gargantext.Core.Text.List.Social.Prelude
import
Gargantext.Core.Text.List.Social.Scores
import
Gargantext.Core.Text.List.Social.Scores
import
Gargantext.Core.Types.Individu
import
Gargantext.Core.Types.Individu
import
Gargantext.Core.Types.Main
import
Gargantext.Core.Types.Main
...
...
src/Gargantext/Core/Text/List/Social/Prelude.hs
0 → 100644
View file @
6aebe7b8
{-|
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 @
6aebe7b8
...
@@ -26,48 +26,15 @@ import Data.Text (Text)
...
@@ -26,48 +26,15 @@ import Data.Text (Text)
import
GHC.Generics
(
Generic
)
import
GHC.Generics
(
Generic
)
import
Gargantext.API.Ngrams.Types
import
Gargantext.API.Ngrams.Types
import
Gargantext.Core.Types.Main
import
Gargantext.Core.Types.Main
import
Gargantext.Core.Text.List.Social.Prelude
import
Gargantext.Prelude
import
Gargantext.Prelude
import
qualified
Data.Map
as
Map
import
qualified
Data.Map
as
Map
import
qualified
Data.Set
as
Set
import
qualified
Data.Set
as
Set
------------------------------------------------------------------------
------------------------------------------------------------------------
-- | Tools to inherit groupings
-- | Datatype definition
------------------------------------------------------------------------
-- | 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
------------------------------------------------------------------------
data
FlowListScores
=
data
FlowListScores
=
FlowListScores
{
_fls_parents
::
Map
Parent
Int
FlowListScores
{
_fls_parents
::
Map
Parent
Int
,
_fls_listType
::
Map
ListType
Int
,
_fls_listType
::
Map
ListType
Int
-- You can add any score by incrementing this type
-- You can add any score by incrementing this type
-- , _flc_score :: Map Score Int
-- , _flc_score :: Map Score Int
...
@@ -76,29 +43,31 @@ data FlowListScores =
...
@@ -76,29 +43,31 @@ data FlowListScores =
makeLenses
''
F
lowListScores
makeLenses
''
F
lowListScores
-- | Rules to compose 2 datatype FlowListScores
-- Triangle de Pascal, nombre d'or ou pi ?
instance
Semigroup
FlowListScores
where
instance
Semigroup
FlowListScores
where
(
<>
)
(
FlowListScores
p1
l1
)
(
FlowListScores
p2
l2
)
=
(
<>
)
(
FlowListScores
p1
l1
)
FlowListScores
(
p1
<>
p2
)
(
l1
<>
l2
)
(
FlowListScores
p2
l2
)
=
FlowListScores
(
p1
<>
p2
)
(
l1
<>
l2
)
------------------------------------------------------------------------
------------------------------------------------------------------------
------------------------------------------------------------------------
------------------------------------------------------------------------
-- | toFlowListScores which generate Score from list of Map Text
-- | Generates Score from list of Map Text NgramsRepoElement
-- NgramsRepoElement
toFlowListScores
::
KeepAllParents
toFlowListScores
::
KeepAllParents
->
Set
Text
->
Set
Text
->
Map
Text
FlowListScores
->
Map
Text
FlowListScores
->
[
Map
Text
NgramsRepoElement
]
->
[
Map
Text
NgramsRepoElement
]
->
Map
Text
FlowListScores
->
Map
Text
FlowListScores
toFlowListScores
k
ts
=
foldl'
(
toFlowListScores'
k
ts
)
toFlowListScores
k
st
=
foldl'
(
toFlowListScores'
k
st
)
where
where
toFlowListScores'
::
KeepAllParents
toFlowListScores'
::
KeepAllParents
->
Set
Text
->
Set
Text
->
Map
Text
FlowListScores
->
Map
Text
FlowListScores
->
Map
Text
NgramsRepoElement
->
Map
Text
NgramsRepoElement
->
Map
Text
FlowListScores
->
Map
Text
FlowListScores
toFlowListScores'
k'
ts
'
to'
ngramsRepo
=
toFlowListScores'
k'
st
'
to'
ngramsRepo
=
Set
.
foldl'
(
toFlowListScores''
k'
ts'
ngramsRepo
)
to'
ts
'
Set
.
foldl'
(
toFlowListScores''
k'
st'
ngramsRepo
)
to'
st
'
toFlowListScores''
::
KeepAllParents
toFlowListScores''
::
KeepAllParents
->
Set
Text
->
Set
Text
...
@@ -106,10 +75,10 @@ toFlowListScores k ts = foldl' (toFlowListScores' k ts)
...
@@ -106,10 +75,10 @@ toFlowListScores k ts = foldl' (toFlowListScores' k ts)
->
Map
Text
FlowListScores
->
Map
Text
FlowListScores
->
Text
->
Text
->
Map
Text
FlowListScores
->
Map
Text
FlowListScores
toFlowListScores''
k''
s
s
ngramsRepo
to''
t
=
toFlowListScores''
k''
s
t''
ngramsRepo
to''
t
=
case
Map
.
lookup
t
ngramsRepo
of
case
Map
.
lookup
t
ngramsRepo
of
Nothing
->
to''
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''
$
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