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
->
(
Text
->
Text
)
->
Cmd
err
(
Map
Text
(
Double
,
Set
Text
))
getTficf
u
m
nt
f
=
do
u'
<-
getNodesByNgramsUser
u
nt
m'
<-
getNodesByNgramsMaster
u
m
u'
<-
Map
.
filter
(
\
s
->
Set
.
size
s
>
1
)
<$>
getNodesByNgramsUser
u
nt
m'
<-
Map
.
filter
(
\
s
->
Set
.
size
s
>
1
)
<$>
getNodesByNgramsMaster
u
m
pure
$
toTficfData
(
countNodesByNgramsWith
f
u'
)
(
countNodesByNgramsWith
f
m'
)
...
...
@@ -92,8 +92,7 @@ getTficfWith u m ls nt mtxt = do
Nothing -> x
Just x' -> maybe x identity x'
pure $ toTficfData (countNodesByNgramsWith f u')
(countNodesByNgramsWith f m')
pure $ toTficfData (countNodesByNgramsWith f u') (countNodesByNgramsWith f m')
-}
type
Context
=
(
Double
,
Map
Text
(
Double
,
Set
Text
))
...
...
@@ -183,7 +182,7 @@ getOccByNgramsOnlyFast' :: CorpusId
->
NgramsType
->
[
Text
]
->
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
where
...
...
src/Gargantext/Database/Action/Query.hs
View file @
fd80a797
...
...
@@ -86,5 +86,12 @@ mkNodeWithParent NodeAnnuaire (Just i) uId name =
where
hd
=
defaultAnnuaire
{-
mkNodeWithParent NodeList (Just i) uId name =
insertNodesWithParentR (Just i) [node NodeList name hd Nothing uId]
where
hd = defaultList
-}
mkNodeWithParent
_
_
_
_
=
nodeError
NotImplYet
src/Gargantext/Database/Action/Query/Node.hs
View file @
fd80a797
...
...
@@ -416,12 +416,21 @@ instance MkCorpus HyperdataAnnuaire
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
=
maybe
(
mkList'
pId
uId
)
(
pure
.
view
node_id
)
.
headMay
=<<
getListsWithParentId
pId
where
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
defaultList
::
HasNodeError
err
=>
CorpusId
->
Cmd
err
ListId
defaultList
cId
=
...
...
src/Gargantext/Database/Admin/Types/Node.hs
View file @
fd80a797
...
...
@@ -376,8 +376,9 @@ instance Arbitrary HyperdataCorpus where
------------------------------------------------------------------------
data
HyperdataList
=
HyperdataList
{
hd_list
::
!
(
Maybe
Text
)
}
deriving
(
Show
,
Generic
)
data
HyperdataList
=
HyperdataList
{
hd_list
::
!
(
Maybe
Text
)
}
deriving
(
Show
,
Generic
)
$
(
deriveJSON
(
unPrefix
"hd_"
)
''
H
yperdataList
)
instance
Hyperdata
HyperdataList
...
...
@@ -412,10 +413,11 @@ instance Arbitrary HyperdataList' where
-}
----
data
HyperdataListModel
=
HyperdataListModel
{
_hlm_params
::
!
(
Int
,
Int
)
,
_hlm_path
::
!
Text
,
_hlm_score
::
!
(
Maybe
Double
)
}
deriving
(
Show
,
Generic
)
data
HyperdataListModel
=
HyperdataListModel
{
_hlm_params
::
!
(
Int
,
Int
)
,
_hlm_path
::
!
Text
,
_hlm_score
::
!
(
Maybe
Double
)
}
deriving
(
Show
,
Generic
)
instance
Hyperdata
HyperdataListModel
instance
Arbitrary
HyperdataListModel
where
...
...
@@ -432,7 +434,6 @@ $(deriveJSON (unPrefix "hyperdataScore_") ''HyperdataScore)
instance
Hyperdata
HyperdataScore
------------------------------------------------------------------------
data
HyperdataResource
=
HyperdataResource
{
hyperdataResource_preferences
::
!
(
Maybe
Text
)
}
deriving
(
Show
,
Generic
)
$
(
deriveJSON
(
unPrefix
"hyperdataResource_"
)
''
H
yperdataResource
)
...
...
@@ -448,7 +449,6 @@ $(deriveJSON (unPrefix "hyperdataDashboard_") ''HyperdataDashboard)
instance
Hyperdata
HyperdataDashboard
------------------------------------------------------------------------
-- TODO add the Graph Structure here
data
HyperdataPhylo
=
HyperdataPhylo
{
hyperdataPhylo_preferences
::
!
(
Maybe
Text
)
,
hyperdataPhylo_data
::
!
(
Maybe
Phylo
)
...
...
@@ -475,8 +475,6 @@ $(deriveJSON (unPrefix "hd_") ''HyperData)
instance
Hyperdata
HyperData
------------------------------------------------------------------------
-- | Then a Node can be either a Folder or a Corpus or a Document
data
NodeType
=
NodeUser
...
...
src/Gargantext/Text/List.hs
View file @
fd80a797
...
...
@@ -17,20 +17,20 @@ Portability : POSIX
module
Gargantext.Text.List
where
import
Data.Either
(
partitionEithers
,
Either
(
..
))
--
import Data.Either (partitionEithers, Either(..))
import
Data.Map
(
Map
)
import
Data.Set
(
Set
)
import
Data.Text
(
Text
)
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.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.Admin.Utils
(
Cmd
)
import
Gargantext.Database.Schema.Ngrams
(
NgramsType
(
..
))
import
Gargantext.Prelude
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.List
as
List
import
qualified
Data.Map
as
Map
...
...
@@ -78,17 +78,20 @@ buildNgramsOthersList uCid groupIt nt = do
let
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'
candiTerms
=
List
.
drop
listSize
all'
pure
$
Map
.
unionsWith
(
<>
)
[
toElements
GraphTerm
graphTerms
,
toElements
CandidateTerm
candiTerms
]
,
toElements
CandidateTerm
candiTerms
]
where
toElements
nType
x
=
Map
.
fromList
[(
nt
,
[
mkNgramsElement
t
nType
Nothing
(
mSetFromList
[]
)
|
(
t
,
_ns
)
<-
x
]
)
]
toElements
nType
x
=
Map
.
fromList
[(
nt
,
[
mkNgramsElement
t
nType
Nothing
(
mSetFromList
[]
)
|
(
t
,
_ns
)
<-
x
]
)
]
{-
buildNgramsTermsList' :: UserCorpusId
...
...
@@ -121,9 +124,9 @@ buildNgramsTermsList' uCid groupIt stop gls is = do
let ngs' = List.concat
$ map toNgramsElement
$ map (\t -> (StopTerm, toList' t)) s
$ map (\t -> (StopTerm
, toList' t)) s
<> map (\t -> (CandidateTerm, toList' t)) c
<> map (\t -> (GraphTerm, toList' t)) m
<> map (\t -> (GraphTerm
, toList' t)) m
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