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
842c6a90
Unverified
Commit
842c6a90
authored
Nov 15, 2018
by
Nicolas Pouillard
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[NGRAMS] fixes
parent
78505cd6
Changes
3
Show whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
36 additions
and
15 deletions
+36
-15
package.yaml
package.yaml
+1
-0
Ngrams.hs
src/Gargantext/API/Ngrams.hs
+34
-14
Flow.hs
src/Gargantext/Database/Flow.hs
+1
-1
No files found.
package.yaml
View file @
842c6a90
...
@@ -103,6 +103,7 @@ library:
...
@@ -103,6 +103,7 @@ library:
-
hxt
-
hxt
-
hlcm
-
hlcm
-
ini
-
ini
-
insert-ordered-containers
-
jose-jwt
-
jose-jwt
# - kmeans-vector
# - kmeans-vector
-
KMP
-
KMP
...
...
src/Gargantext/API/Ngrams.hs
View file @
842c6a90
...
@@ -23,48 +23,49 @@ add get
...
@@ -23,48 +23,49 @@ add get
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# OPTIONS -fno-warn-orphans #-}
module
Gargantext.API.Ngrams
module
Gargantext.API.Ngrams
where
where
-- import Gargantext.Database.User (UserId)
-- import Gargantext.Database.User (UserId)
import
Data.Patch.Class
(
Replace
(
..
)
,
replace
)
import
Data.Patch.Class
(
Replace
,
replace
)
import
qualified
Data.Map.Strict.Patch
as
PM
--
import qualified Data.Map.Strict.Patch as PM
import
Data.Monoid
import
Data.Monoid
import
Data.Semigroup
--
import Data.Semigroup
import
Data.Set
(
Set
)
import
Data.Set
(
Set
)
import
qualified
Data.Set
as
Set
import
qualified
Data.Set
as
Set
--import Data.Maybe (catMaybes)
--import Data.Maybe (catMaybes)
--import qualified Data.Map.Strict as DM
--import qualified Data.Map.Strict as DM
--import qualified Data.Set as Set
--import qualified Data.Set as Set
import
Control.Lens
(
view
)
import
Control.Lens
(
view
,
(
.~
)
)
import
Data.Aeson
(
FromJSON
,
ToJSON
)
import
Data.Aeson
import
Data.Aeson.TH
(
deriveJSON
)
import
Data.Aeson.TH
(
deriveJSON
)
import
Data.Either
(
Either
(
Left
))
import
Data.Either
(
Either
(
Left
))
import
Data.List
(
concat
)
import
Data.List
(
concat
)
import
Data.Set
(
Set
)
import
qualified
Data.HashMap.Strict.InsOrd
as
InsOrdHashMap
import
Data.Swagger
(
ToSchema
,
ToParamSchema
)
import
Data.Swagger
import
Data.Text
(
Text
)
import
Data.Text
(
Text
)
import
Database.PostgreSQL.Simple
(
Connection
)
import
Database.PostgreSQL.Simple
(
Connection
)
import
GHC.Generics
(
Generic
)
import
GHC.Generics
(
Generic
)
import
Gargantext.Core.Types
(
node_id
)
import
Gargantext.Core.Types
(
node_id
)
import
Gargantext.Core.Types.Main
(
Tree
(
..
))
--
import Gargantext.Core.Types.Main (Tree(..))
import
Gargantext.Core.Utils.Prefix
(
unPrefix
)
import
Gargantext.Core.Utils.Prefix
(
unPrefix
)
import
Gargantext.Database.Ngrams
(
NgramsId
)
import
Gargantext.Database.Ngrams
(
NgramsId
)
import
Gargantext.Database.Node
(
getListsWithParentId
)
import
Gargantext.Database.Node
(
getListsWithParentId
)
-- import Gargantext.Database.NodeNgram -- (NodeNgram(..), NodeNgram, updateNodeNgrams, NodeNgramPoly)
-- import Gargantext.Database.NodeNgram -- (NodeNgram(..), NodeNgram, updateNodeNgrams, NodeNgramPoly)
import
Gargantext.Database.NodeNgramsNgrams
-- (NodeNgramsNgramsPoly(NodeNgramsNgrams))
import
Gargantext.Database.NodeNgramsNgrams
-- (NodeNgramsNgramsPoly(NodeNgramsNgrams))
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Gargantext.Text.List.Types
(
ListType
(
..
),
ListId
,
ListTypeId
)
--,listTypeId )
import
Gargantext.Text.List.Types
(
ListType
(
..
),
ListId
,
ListTypeId
)
--
,listTypeId )
import
Prelude
(
Enum
,
Bounded
,
minBound
,
maxBound
)
import
Prelude
(
Enum
,
Bounded
,
minBound
,
maxBound
)
import
Servant
hiding
(
Patch
)
import
Servant
hiding
(
Patch
)
import
Test.QuickCheck
(
elements
)
import
Test.QuickCheck
(
elements
)
import
Test.QuickCheck.Arbitrary
(
Arbitrary
,
arbitrary
)
import
Test.QuickCheck.Arbitrary
(
Arbitrary
,
arbitrary
)
-- import qualified Data.Set as Set
------------------------------------------------------------------------
------------------------------------------------------------------------
--data FacetFormat = Table | Chart
--data FacetFormat = Table | Chart
...
@@ -145,9 +146,26 @@ data PatchSet a = PatchSet
...
@@ -145,9 +146,26 @@ data PatchSet a = PatchSet
instance
(
Ord
a
,
Arbitrary
a
)
=>
Arbitrary
(
PatchSet
a
)
where
instance
(
Ord
a
,
Arbitrary
a
)
=>
Arbitrary
(
PatchSet
a
)
where
arbitrary
=
PatchSet
<$>
arbitrary
<*>
arbitrary
arbitrary
=
PatchSet
<$>
arbitrary
<*>
arbitrary
instance
ToJSON
a
=>
ToJSON
(
PatchSet
a
)
where
toJSON
=
genericToJSON
$
unPrefix
"_"
toEncoding
=
genericToEncoding
$
unPrefix
"_"
instance
(
Ord
a
,
FromJSON
a
)
=>
FromJSON
(
PatchSet
a
)
where
parseJSON
=
genericParseJSON
$
unPrefix
"_"
instance
ToSchema
a
=>
ToSchema
(
PatchSet
a
)
instance
ToSchema
a
=>
ToSchema
(
PatchSet
a
)
instance
ToSchema
a
=>
ToSchema
(
Replace
a
)
instance
ToSchema
a
=>
ToSchema
(
Replace
a
)
where
declareNamedSchema
(
_
::
proxy
(
Replace
a
))
=
do
aSchema
<-
declareSchemaRef
(
Proxy
::
Proxy
a
)
return
$
NamedSchema
(
Just
"Replace"
)
$
mempty
&
type_
.~
SwaggerObject
&
properties
.~
InsOrdHashMap
.
fromList
[
(
"old"
,
aSchema
)
,
(
"new"
,
aSchema
)
]
&
required
.~
[
"old"
,
"new"
]
data
NgramsPatch
=
data
NgramsPatch
=
NgramsPatch
{
_patch_children
::
PatchSet
NgramsElement
NgramsPatch
{
_patch_children
::
PatchSet
NgramsElement
...
@@ -156,7 +174,7 @@ data NgramsPatch =
...
@@ -156,7 +174,7 @@ data NgramsPatch =
deriving
(
Ord
,
Eq
,
Show
,
Generic
)
deriving
(
Ord
,
Eq
,
Show
,
Generic
)
$
(
deriveJSON
(
unPrefix
"_"
)
''
N
gramsPatch
)
$
(
deriveJSON
(
unPrefix
"_"
)
''
N
gramsPatch
)
instance
Semigroup
NgramsPatch
where
--
instance Semigroup NgramsPatch where
instance
ToSchema
NgramsPatch
instance
ToSchema
NgramsPatch
...
@@ -239,10 +257,12 @@ defaultList c cId = view node_id <$> maybe (panic noListFound) identity
...
@@ -239,10 +257,12 @@ defaultList c cId = view node_id <$> maybe (panic noListFound) identity
where
where
noListFound
=
"Gargantext.API.Ngrams.defaultList: no list found"
noListFound
=
"Gargantext.API.Ngrams.defaultList: no list found"
{-
toLists
::
ListId
->
NgramsIdPatchs
->
[(
ListId
,
NgramsId
,
ListTypeId
)]
toLists
::
ListId
->
NgramsIdPatchs
->
[(
ListId
,
NgramsId
,
ListTypeId
)]
toLists
=
undefined
{-
toLists lId np =
toLists lId np =
[ (lId,ngId,listTypeId lt) | map (toList lId) (_nip_ngramsIdPatchs np) ]
[ (lId,ngId,listTypeId lt) | map (toList lId) (_nip_ngramsIdPatchs np) ]
-}
toList
::
ListId
->
NgramsIdPatch
->
(
ListId
,
NgramsId
,
ListTypeId
)
toList
::
ListId
->
NgramsIdPatch
->
(
ListId
,
NgramsId
,
ListTypeId
)
toList
=
undefined
toList
=
undefined
...
@@ -252,7 +272,7 @@ toGroups lId addOrRem ps = concat $ map (toGroup lId addOrRem) $ _nip_ngramsIdPa
...
@@ -252,7 +272,7 @@ toGroups lId addOrRem ps = concat $ map (toGroup lId addOrRem) $ _nip_ngramsIdPa
toGroup
::
ListId
->
(
NgramsPatch
->
Set
NgramsId
)
->
NgramsIdPatch
->
[
NodeNgramsNgrams
]
toGroup
::
ListId
->
(
NgramsPatch
->
Set
NgramsId
)
->
NgramsIdPatch
->
[
NodeNgramsNgrams
]
toGroup
=
undefined
toGroup
=
undefined
-}
{-
{-
toGroup lId addOrRem (NgramsIdPatch ngId patch) =
toGroup lId addOrRem (NgramsIdPatch ngId patch) =
map (\ng -> (NodeNgramsNgrams lId ngId ng (Just 1))) (Set.toList $ addOrRem patch)
map (\ng -> (NodeNgramsNgrams lId ngId ng (Just 1))) (Set.toList $ addOrRem patch)
...
...
src/Gargantext/Database/Flow.hs
View file @
842c6a90
...
@@ -211,7 +211,7 @@ insertGroups lId ngrs =
...
@@ -211,7 +211,7 @@ insertGroups lId ngrs =
------------------------------------------------------------------------
------------------------------------------------------------------------
-- TODO: verify NgramsT lost here
-- TODO: verify NgramsT lost here
ngrams2list
::
Map
(
NgramsT
NgramsIndexed
)
(
Map
NodeId
Int
)
->
Map
ListType
NgramsIndexed
ngrams2list
::
Map
(
NgramsT
NgramsIndexed
)
(
Map
NodeId
Int
)
->
Map
ListType
NgramsIndexed
ngrams2list
=
DM
.
fromList
.
zip
(
repeat
Candidate
)
.
map
(
\
(
NgramsT
t
ng
)
->
ng
)
.
DM
.
keys
ngrams2list
=
DM
.
fromList
.
zip
(
repeat
Candidate
)
.
map
(
\
(
NgramsT
_lost_
t
ng
)
->
ng
)
.
DM
.
keys
-- | TODO: weight of the list could be a probability
-- | TODO: weight of the list could be a probability
insertLists
::
ListId
->
Map
ListType
NgramsIndexed
->
Cmd
Int
insertLists
::
ListId
->
Map
ListType
NgramsIndexed
->
Cmd
Int
...
...
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