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
fd80a797
Commit
fd80a797
authored
Apr 22, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[FIX] Metrics adding filtering.
parent
8804c4e7
Changes
5
Hide whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
45 additions
and
29 deletions
+45
-29
NgramsByNode.hs
src/Gargantext/Database/Action/Metrics/NgramsByNode.hs
+4
-5
Query.hs
src/Gargantext/Database/Action/Query.hs
+7
-0
Node.hs
src/Gargantext/Database/Action/Query/Node.hs
+10
-1
Node.hs
src/Gargantext/Database/Admin/Types/Node.hs
+8
-10
List.hs
src/Gargantext/Text/List.hs
+16
-13
No files found.
src/Gargantext/Database/Action/Metrics/NgramsByNode.hs
View file @
fd80a797
...
@@ -71,8 +71,8 @@ getTficf :: UserCorpusId
...
@@ -71,8 +71,8 @@ getTficf :: UserCorpusId
->
(
Text
->
Text
)
->
(
Text
->
Text
)
->
Cmd
err
(
Map
Text
(
Double
,
Set
Text
))
->
Cmd
err
(
Map
Text
(
Double
,
Set
Text
))
getTficf
u
m
nt
f
=
do
getTficf
u
m
nt
f
=
do
u'
<-
getNodesByNgramsUser
u
nt
u'
<-
Map
.
filter
(
\
s
->
Set
.
size
s
>
1
)
<$>
getNodesByNgramsUser
u
nt
m'
<-
getNodesByNgramsMaster
u
m
m'
<-
Map
.
filter
(
\
s
->
Set
.
size
s
>
1
)
<$>
getNodesByNgramsMaster
u
m
pure
$
toTficfData
(
countNodesByNgramsWith
f
u'
)
pure
$
toTficfData
(
countNodesByNgramsWith
f
u'
)
(
countNodesByNgramsWith
f
m'
)
(
countNodesByNgramsWith
f
m'
)
...
@@ -92,8 +92,7 @@ getTficfWith u m ls nt mtxt = do
...
@@ -92,8 +92,7 @@ getTficfWith u m ls nt mtxt = do
Nothing -> x
Nothing -> x
Just x' -> maybe x identity x'
Just x' -> maybe x identity x'
pure $ toTficfData (countNodesByNgramsWith f u')
pure $ toTficfData (countNodesByNgramsWith f u') (countNodesByNgramsWith f m')
(countNodesByNgramsWith f m')
-}
-}
type
Context
=
(
Double
,
Map
Text
(
Double
,
Set
Text
))
type
Context
=
(
Double
,
Map
Text
(
Double
,
Set
Text
))
...
@@ -183,7 +182,7 @@ getOccByNgramsOnlyFast' :: CorpusId
...
@@ -183,7 +182,7 @@ getOccByNgramsOnlyFast' :: CorpusId
->
NgramsType
->
NgramsType
->
[
Text
]
->
[
Text
]
->
Cmd
err
(
Map
Text
Int
)
->
Cmd
err
(
Map
Text
Int
)
getOccByNgramsOnlyFast'
cId
lId
nt
tms
=
trace
(
show
(
cId
,
lId
))
$
getOccByNgramsOnlyFast'
cId
lId
nt
tms
=
trace
(
show
(
cId
,
lId
))
$
fromListWith
(
+
)
<$>
map
(
second
round
)
<$>
run
cId
lId
nt
tms
fromListWith
(
+
)
<$>
map
(
second
round
)
<$>
run
cId
lId
nt
tms
where
where
...
...
src/Gargantext/Database/Action/Query.hs
View file @
fd80a797
...
@@ -86,5 +86,12 @@ mkNodeWithParent NodeAnnuaire (Just i) uId name =
...
@@ -86,5 +86,12 @@ mkNodeWithParent NodeAnnuaire (Just i) uId name =
where
where
hd
=
defaultAnnuaire
hd
=
defaultAnnuaire
{-
mkNodeWithParent NodeList (Just i) uId name =
insertNodesWithParentR (Just i) [node NodeList name hd Nothing uId]
where
hd = defaultList
-}
mkNodeWithParent
_
_
_
_
=
nodeError
NotImplYet
mkNodeWithParent
_
_
_
_
=
nodeError
NotImplYet
src/Gargantext/Database/Action/Query/Node.hs
View file @
fd80a797
...
@@ -416,12 +416,21 @@ instance MkCorpus HyperdataAnnuaire
...
@@ -416,12 +416,21 @@ instance MkCorpus HyperdataAnnuaire
mk
n
h
p
u
=
insertNodesR
[
nodeAnnuaireW
n
h
p
u
]
mk
n
h
p
u
=
insertNodesR
[
nodeAnnuaireW
n
h
p
u
]
getOrMkList
::
HasNodeError
err
=>
ParentId
->
UserId
->
Cmd
err
ListId
getOrMkList
::
HasNodeError
err
=>
ParentId
->
UserId
->
Cmd
err
ListId
getOrMkList
pId
uId
=
getOrMkList
pId
uId
=
maybe
(
mkList'
pId
uId
)
(
pure
.
view
node_id
)
.
headMay
=<<
getListsWithParentId
pId
maybe
(
mkList'
pId
uId
)
(
pure
.
view
node_id
)
.
headMay
=<<
getListsWithParentId
pId
where
where
mkList'
pId
uId
=
maybe
(
nodeError
MkNode
)
pure
.
headMay
=<<
mkNode
NodeList
pId
uId
mkList'
pId
uId
=
maybe
(
nodeError
MkNode
)
pure
.
headMay
=<<
mkNode
NodeList
pId
uId
mkList
::
HasNodeError
err
=>
ParentId
->
UserId
->
Cmd
err
[
ListId
]
mkList
pId
uId
=
mkNode
NodeList
pId
uId
-- | TODO remove defaultList
-- | TODO remove defaultList
defaultList
::
HasNodeError
err
=>
CorpusId
->
Cmd
err
ListId
defaultList
::
HasNodeError
err
=>
CorpusId
->
Cmd
err
ListId
defaultList
cId
=
defaultList
cId
=
...
...
src/Gargantext/Database/Admin/Types/Node.hs
View file @
fd80a797
...
@@ -376,8 +376,9 @@ instance Arbitrary HyperdataCorpus where
...
@@ -376,8 +376,9 @@ instance Arbitrary HyperdataCorpus where
------------------------------------------------------------------------
------------------------------------------------------------------------
data
HyperdataList
=
HyperdataList
{
hd_list
::
!
(
Maybe
Text
)
data
HyperdataList
=
}
deriving
(
Show
,
Generic
)
HyperdataList
{
hd_list
::
!
(
Maybe
Text
)
}
deriving
(
Show
,
Generic
)
$
(
deriveJSON
(
unPrefix
"hd_"
)
''
H
yperdataList
)
$
(
deriveJSON
(
unPrefix
"hd_"
)
''
H
yperdataList
)
instance
Hyperdata
HyperdataList
instance
Hyperdata
HyperdataList
...
@@ -412,10 +413,11 @@ instance Arbitrary HyperdataList' where
...
@@ -412,10 +413,11 @@ instance Arbitrary HyperdataList' where
-}
-}
----
----
data
HyperdataListModel
=
HyperdataListModel
{
_hlm_params
::
!
(
Int
,
Int
)
data
HyperdataListModel
=
,
_hlm_path
::
!
Text
HyperdataListModel
{
_hlm_params
::
!
(
Int
,
Int
)
,
_hlm_score
::
!
(
Maybe
Double
)
,
_hlm_path
::
!
Text
}
deriving
(
Show
,
Generic
)
,
_hlm_score
::
!
(
Maybe
Double
)
}
deriving
(
Show
,
Generic
)
instance
Hyperdata
HyperdataListModel
instance
Hyperdata
HyperdataListModel
instance
Arbitrary
HyperdataListModel
where
instance
Arbitrary
HyperdataListModel
where
...
@@ -432,7 +434,6 @@ $(deriveJSON (unPrefix "hyperdataScore_") ''HyperdataScore)
...
@@ -432,7 +434,6 @@ $(deriveJSON (unPrefix "hyperdataScore_") ''HyperdataScore)
instance
Hyperdata
HyperdataScore
instance
Hyperdata
HyperdataScore
------------------------------------------------------------------------
------------------------------------------------------------------------
data
HyperdataResource
=
HyperdataResource
{
hyperdataResource_preferences
::
!
(
Maybe
Text
)
data
HyperdataResource
=
HyperdataResource
{
hyperdataResource_preferences
::
!
(
Maybe
Text
)
}
deriving
(
Show
,
Generic
)
}
deriving
(
Show
,
Generic
)
$
(
deriveJSON
(
unPrefix
"hyperdataResource_"
)
''
H
yperdataResource
)
$
(
deriveJSON
(
unPrefix
"hyperdataResource_"
)
''
H
yperdataResource
)
...
@@ -448,7 +449,6 @@ $(deriveJSON (unPrefix "hyperdataDashboard_") ''HyperdataDashboard)
...
@@ -448,7 +449,6 @@ $(deriveJSON (unPrefix "hyperdataDashboard_") ''HyperdataDashboard)
instance
Hyperdata
HyperdataDashboard
instance
Hyperdata
HyperdataDashboard
------------------------------------------------------------------------
------------------------------------------------------------------------
-- TODO add the Graph Structure here
-- TODO add the Graph Structure here
data
HyperdataPhylo
=
HyperdataPhylo
{
hyperdataPhylo_preferences
::
!
(
Maybe
Text
)
data
HyperdataPhylo
=
HyperdataPhylo
{
hyperdataPhylo_preferences
::
!
(
Maybe
Text
)
,
hyperdataPhylo_data
::
!
(
Maybe
Phylo
)
,
hyperdataPhylo_data
::
!
(
Maybe
Phylo
)
...
@@ -475,8 +475,6 @@ $(deriveJSON (unPrefix "hd_") ''HyperData)
...
@@ -475,8 +475,6 @@ $(deriveJSON (unPrefix "hd_") ''HyperData)
instance
Hyperdata
HyperData
instance
Hyperdata
HyperData
------------------------------------------------------------------------
------------------------------------------------------------------------
-- | Then a Node can be either a Folder or a Corpus or a Document
-- | Then a Node can be either a Folder or a Corpus or a Document
data
NodeType
=
NodeUser
data
NodeType
=
NodeUser
...
...
src/Gargantext/Text/List.hs
View file @
fd80a797
...
@@ -17,20 +17,20 @@ Portability : POSIX
...
@@ -17,20 +17,20 @@ Portability : POSIX
module
Gargantext.Text.List
module
Gargantext.Text.List
where
where
import
Data.Either
(
partitionEithers
,
Either
(
..
))
--
import Data.Either (partitionEithers, Either(..))
import
Data.Map
(
Map
)
import
Data.Map
(
Map
)
import
Data.Set
(
Set
)
import
Data.Set
(
Set
)
import
Data.Text
(
Text
)
import
Data.Text
(
Text
)
import
Gargantext.API.Ngrams
(
NgramsElement
,
mkNgramsElement
,
RootParent
(
..
),
mSetFromList
)
import
Gargantext.API.Ngrams
(
NgramsElement
,
mkNgramsElement
,
RootParent
(
..
),
mSetFromList
)
import
Gargantext.API.Ngrams.Tools
(
getCoocByNgrams'
,
Diagonal
(
..
))
--
import Gargantext.API.Ngrams.Tools (getCoocByNgrams', Diagonal(..))
import
Gargantext.Core
(
Lang
(
..
))
import
Gargantext.Core
(
Lang
(
..
))
import
Gargantext.Core.Types
(
ListType
(
..
),
MasterCorpusId
,
UserCorpusId
,
NodeId
)
import
Gargantext.Core.Types
(
ListType
(
..
),
MasterCorpusId
,
UserCorpusId
)
import
Gargantext.Database.Action.Metrics.NgramsByNode
(
getTficf
,
sortTficf
,
ngramsGroup
,
getNodesByNgramsUser
,
groupNodesByNgramsWith
)
import
Gargantext.Database.Action.Metrics.NgramsByNode
(
getTficf
,
sortTficf
,
ngramsGroup
,
getNodesByNgramsUser
,
groupNodesByNgramsWith
)
import
Gargantext.Database.Admin.Utils
(
Cmd
)
import
Gargantext.Database.Admin.Utils
(
Cmd
)
import
Gargantext.Database.Schema.Ngrams
(
NgramsType
(
..
))
import
Gargantext.Database.Schema.Ngrams
(
NgramsType
(
..
))
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Gargantext.Text.List.Learn
(
Model
(
..
))
import
Gargantext.Text.List.Learn
(
Model
(
..
))
import
Gargantext.Text.Metrics
(
takeScored
)
--
import Gargantext.Text.Metrics (takeScored)
import
qualified
Data.Char
as
Char
import
qualified
Data.Char
as
Char
import
qualified
Data.List
as
List
import
qualified
Data.List
as
List
import
qualified
Data.Map
as
Map
import
qualified
Data.Map
as
Map
...
@@ -78,17 +78,20 @@ buildNgramsOthersList uCid groupIt nt = do
...
@@ -78,17 +78,20 @@ buildNgramsOthersList uCid groupIt nt = do
let
let
listSize
=
9
listSize
=
9
all'
=
List
.
reverse
$
List
.
sortOn
(
Set
.
size
.
snd
.
snd
)
$
Map
.
toList
ngs
all'
=
List
.
reverse
$
List
.
sortOn
(
Set
.
size
.
snd
.
snd
)
$
Map
.
toList
ngs
graphTerms
=
List
.
take
listSize
all'
graphTerms
=
List
.
take
listSize
all'
candiTerms
=
List
.
drop
listSize
all'
candiTerms
=
List
.
drop
listSize
all'
pure
$
Map
.
unionsWith
(
<>
)
[
toElements
GraphTerm
graphTerms
pure
$
Map
.
unionsWith
(
<>
)
[
toElements
GraphTerm
graphTerms
,
toElements
CandidateTerm
candiTerms
]
,
toElements
CandidateTerm
candiTerms
]
where
where
toElements
nType
x
=
Map
.
fromList
[(
nt
,
[
mkNgramsElement
t
nType
Nothing
(
mSetFromList
[]
)
toElements
nType
x
=
|
(
t
,
_ns
)
<-
x
Map
.
fromList
[(
nt
,
[
mkNgramsElement
t
nType
Nothing
(
mSetFromList
[]
)
]
|
(
t
,
_ns
)
<-
x
)
]
]
)
]
{-
{-
buildNgramsTermsList' :: UserCorpusId
buildNgramsTermsList' :: UserCorpusId
...
@@ -121,9 +124,9 @@ buildNgramsTermsList' uCid groupIt stop gls is = do
...
@@ -121,9 +124,9 @@ buildNgramsTermsList' uCid groupIt stop gls is = do
let ngs' = List.concat
let ngs' = List.concat
$ map toNgramsElement
$ map toNgramsElement
$ map (\t -> (StopTerm, toList' t)) s
$ map (\t -> (StopTerm
, toList' t)) s
<> map (\t -> (CandidateTerm, toList' t)) c
<> map (\t -> (CandidateTerm, toList' t)) c
<> map (\t -> (GraphTerm, toList' t)) m
<> map (\t -> (GraphTerm
, toList' t)) m
pure $ Map.fromList [(NgramsTerms, ngs')]
pure $ Map.fromList [(NgramsTerms, ngs')]
-}
-}
...
...
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