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
147
Issues
147
List
Board
Labels
Milestones
Merge Requests
6
Merge Requests
6
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
452628e5
Commit
452628e5
authored
Nov 22, 2018
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[NGRAMS] Table queries ready (qualitative tests, needs more tests)
parent
0b956a2e
Pipeline
#10
canceled with stage
Changes
4
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
20 additions
and
10 deletions
+20
-10
Main.hs
src/Gargantext/Core/Types/Main.hs
+7
-1
Config.hs
src/Gargantext/Database/Config.hs
+2
-2
Ngrams.hs
src/Gargantext/Database/Ngrams.hs
+9
-5
Tree.hs
src/Gargantext/Database/Tree.hs
+2
-2
No files found.
src/Gargantext/Core/Types/Main.hs
View file @
452628e5
...
...
@@ -21,9 +21,12 @@ Portability : POSIX
module
Gargantext.Core.Types.Main
where
------------------------------------------------------------------------
import
Prelude
(
Enum
,
Bounded
,
minBound
,
maxBound
)
import
Data.Aeson
(
FromJSON
,
ToJSON
,
toJSON
)
import
Data.Aeson
as
A
import
Data.Aeson.TH
(
deriveJSON
)
import
Data.Map
(
fromList
,
lookup
)
import
Data.Eq
(
Eq
())
import
Data.Monoid
((
<>
))
import
Data.Text
(
Text
)
...
...
@@ -80,7 +83,7 @@ corpusTree nId t = TreeN (NodeTree ("Corpus " <> t) NodeCorpus nId) ( [ leafT
-- TODO multiple ListType declaration, remove it
data
ListType
=
Stop
|
Candidate
|
Map
deriving
(
Generic
,
Eq
,
Ord
,
Show
)
deriving
(
Generic
,
Eq
,
Ord
,
Show
,
Enum
,
Bounded
)
instance
ToJSON
ListType
instance
FromJSON
ListType
...
...
@@ -90,6 +93,9 @@ listId Stop = 0
listId
Candidate
=
1
listId
Map
=
2
fromListTypeId
::
Int
->
Maybe
ListType
fromListTypeId
i
=
lookup
i
$
fromList
[
(
listId
l
,
l
)
|
l
<-
[
minBound
..
maxBound
]]
-- data Metrics = Occurrences | Cooccurrences | Specclusion | Genclusion | Cvalue
-- | TfidfCorpus | TfidfGlobal | TirankLocal | TirankGlobal
...
...
src/Gargantext/Database/Config.hs
View file @
452628e5
...
...
@@ -73,6 +73,6 @@ nodeTypeInv = map swap nodeTypes
nodeTypes
::
[(
NodeType
,
NodeTypeId
)]
nodeTypes
=
[
(
n
,
nodeTypeId
n
)
|
n
<-
allNodeTypes
]
typeId2node
::
NodeTypeId
->
NodeType
typeId2node
tId
=
fromMaybe
(
panic
$
pack
$
"Type Id "
<>
show
tId
<>
" does not exist"
)
fromNodeTypeId
::
NodeTypeId
->
NodeType
fromNodeTypeId
tId
=
fromMaybe
(
panic
$
pack
$
"Type Id "
<>
show
tId
<>
" does not exist"
)
(
lookup
tId
nodeTypeInv
)
src/Gargantext/Database/Ngrams.hs
View file @
452628e5
...
...
@@ -24,6 +24,7 @@ Ngrams connection to the Database.
module
Gargantext.Database.Ngrams
where
-- import Opaleye
import
Prelude
(
Enum
,
Bounded
,
minBound
,
maxBound
)
import
Control.Lens
(
makeLenses
)
import
Data.ByteString.Internal
(
ByteString
)
import
Data.Map
(
Map
,
fromList
,
lookup
)
...
...
@@ -34,6 +35,7 @@ import Database.PostgreSQL.Simple.ToField (toField)
import
Database.PostgreSQL.Simple.ToRow
(
toRow
)
import
Database.PostgreSQL.Simple.Types
(
Values
(
..
),
QualifiedIdentifier
(
..
))
import
GHC.Generics
(
Generic
)
import
Gargantext.Core.Types
(
fromListTypeId
,
ListType
)
import
Gargantext.Database.Config
(
nodeTypeId
)
import
Gargantext.Database.Types.Node
(
NodeType
)
import
Gargantext.Database.Node
(
mkCmd
,
Cmd
(
..
))
...
...
@@ -79,7 +81,7 @@ import qualified Database.PostgreSQL.Simple as DPS
-- ngrams in authors field of document has Authors Type
-- ngrams in text (title or abstract) of documents has Terms Type
data
NgramsType
=
Authors
|
Institutes
|
Sources
|
Terms
deriving
(
Eq
,
Show
,
Ord
)
deriving
(
Eq
,
Show
,
Ord
,
Enum
,
Bounded
)
ngramsTypeId
::
NgramsType
->
Int
ngramsTypeId
Authors
=
1
...
...
@@ -87,6 +89,9 @@ ngramsTypeId Institutes = 2
ngramsTypeId
Sources
=
3
ngramsTypeId
Terms
=
4
fromNgramsTypeId
::
Int
->
Maybe
NgramsType
fromNgramsTypeId
id
=
lookup
id
$
fromList
[(
ngramsTypeId
nt
,
nt
)
|
nt
<-
[
minBound
..
maxBound
]
::
[
NgramsType
]]
type
NgramsTerms
=
Text
type
NgramsId
=
Int
type
Size
=
Int
...
...
@@ -187,13 +192,13 @@ type NgramsTableParamMaster = NgramsTableParam
data
NgramsTableData
=
NgramsTableData
{
_ntd_terms
::
Text
,
_ntd_n
::
Int
,
_ntd_
ngramsType
::
Int
,
_ntd_
listType
::
Maybe
ListType
,
_ntd_weight
::
Double
}
deriving
(
Show
)
getTableNgrams
::
NodeType
->
NgramsType
->
NgramsTableParamUser
->
NgramsTableParamMaster
->
Cmd
[
(
Text
,
Int
,
Int
,
Double
)
]
getTableNgrams
::
NodeType
->
NgramsType
->
NgramsTableParamUser
->
NgramsTableParamMaster
->
Cmd
[
NgramsTableData
]
getTableNgrams
nodeT
ngrmT
(
NgramsTableParam
ul
uc
)
(
NgramsTableParam
ml
mc
)
=
mkCmd
$
\
conn
->
DPS
.
query
conn
querySelectTableNgrams
(
ul
,
uc
,
nodeTId
,
ngrmTId
,
ml
,
mc
,
nodeTId
,
ngrmTId
)
mkCmd
$
\
conn
->
map
(
\
(
t
,
n
,
nt
,
w
)
->
NgramsTableData
t
n
(
fromListTypeId
nt
)
w
)
<$>
DPS
.
query
conn
querySelectTableNgrams
(
ul
,
uc
,
nodeTId
,
ngrmTId
,
ml
,
mc
,
nodeTId
,
ngrmTId
)
where
nodeTId
=
nodeTypeId
nodeT
ngrmTId
=
ngramsTypeId
ngrmT
...
...
@@ -233,7 +238,6 @@ querySelectTableNgrams = [sql|
type
ListIdUser
=
Int
type
ListIdMaster
=
Int
getNgramsGroup
::
ListIdUser
->
ListIdMaster
->
Cmd
[(
Text
,
Text
)]
getNgramsGroup
lu
lm
=
mkCmd
$
\
conn
->
DPS
.
query
conn
querySelectNgramsGroup
(
lu
,
lm
)
...
...
src/Gargantext/Database/Tree.hs
View file @
452628e5
...
...
@@ -27,7 +27,7 @@ import Database.PostgreSQL.Simple.SqlQQ
import
Gargantext.Prelude
import
Gargantext.Core.Types.Main
(
NodeTree
(
..
),
Tree
(
..
))
import
Gargantext.Database.Config
(
typeId2node
)
import
Gargantext.Database.Config
(
fromNodeTypeId
)
------------------------------------------------------------------------
-- import Gargantext (connectGargandb)
-- import Control.Monad ((>>=))
...
...
@@ -70,7 +70,7 @@ toTree' m n =
toNodeTree
::
DbTreeNode
->
NodeTree
toNodeTree
(
DbTreeNode
nId
tId
_
n
)
=
NodeTree
n
nodeType
nId
where
nodeType
=
typeId2node
tId
nodeType
=
fromNodeTypeId
tId
------------------------------------------------------------------------
toTreeParent
::
[
DbTreeNode
]
->
Map
(
Maybe
ParentId
)
[
DbTreeNode
]
toTreeParent
=
fromListWith
(
<>
)
.
map
(
\
n
->
(
dt_parentId
n
,
[
n
]))
...
...
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