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
175
Issues
175
List
Board
Labels
Milestones
Merge Requests
10
Merge Requests
10
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
...
@@ -21,9 +21,12 @@ Portability : POSIX
module
Gargantext.Core.Types.Main
where
module
Gargantext.Core.Types.Main
where
------------------------------------------------------------------------
------------------------------------------------------------------------
import
Prelude
(
Enum
,
Bounded
,
minBound
,
maxBound
)
import
Data.Aeson
(
FromJSON
,
ToJSON
,
toJSON
)
import
Data.Aeson
(
FromJSON
,
ToJSON
,
toJSON
)
import
Data.Aeson
as
A
import
Data.Aeson
as
A
import
Data.Aeson.TH
(
deriveJSON
)
import
Data.Aeson.TH
(
deriveJSON
)
import
Data.Map
(
fromList
,
lookup
)
import
Data.Eq
(
Eq
())
import
Data.Eq
(
Eq
())
import
Data.Monoid
((
<>
))
import
Data.Monoid
((
<>
))
import
Data.Text
(
Text
)
import
Data.Text
(
Text
)
...
@@ -80,7 +83,7 @@ corpusTree nId t = TreeN (NodeTree ("Corpus " <> t) NodeCorpus nId) ( [ leafT
...
@@ -80,7 +83,7 @@ corpusTree nId t = TreeN (NodeTree ("Corpus " <> t) NodeCorpus nId) ( [ leafT
-- TODO multiple ListType declaration, remove it
-- TODO multiple ListType declaration, remove it
data
ListType
=
Stop
|
Candidate
|
Map
data
ListType
=
Stop
|
Candidate
|
Map
deriving
(
Generic
,
Eq
,
Ord
,
Show
)
deriving
(
Generic
,
Eq
,
Ord
,
Show
,
Enum
,
Bounded
)
instance
ToJSON
ListType
instance
ToJSON
ListType
instance
FromJSON
ListType
instance
FromJSON
ListType
...
@@ -90,6 +93,9 @@ listId Stop = 0
...
@@ -90,6 +93,9 @@ listId Stop = 0
listId
Candidate
=
1
listId
Candidate
=
1
listId
Map
=
2
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
-- data Metrics = Occurrences | Cooccurrences | Specclusion | Genclusion | Cvalue
-- | TfidfCorpus | TfidfGlobal | TirankLocal | TirankGlobal
-- | TfidfCorpus | TfidfGlobal | TirankLocal | TirankGlobal
...
...
src/Gargantext/Database/Config.hs
View file @
452628e5
...
@@ -73,6 +73,6 @@ nodeTypeInv = map swap nodeTypes
...
@@ -73,6 +73,6 @@ nodeTypeInv = map swap nodeTypes
nodeTypes
::
[(
NodeType
,
NodeTypeId
)]
nodeTypes
::
[(
NodeType
,
NodeTypeId
)]
nodeTypes
=
[
(
n
,
nodeTypeId
n
)
|
n
<-
allNodeTypes
]
nodeTypes
=
[
(
n
,
nodeTypeId
n
)
|
n
<-
allNodeTypes
]
typeId2node
::
NodeTypeId
->
NodeType
fromNodeTypeId
::
NodeTypeId
->
NodeType
typeId2node
tId
=
fromMaybe
(
panic
$
pack
$
"Type Id "
<>
show
tId
<>
" does not exist"
)
fromNodeTypeId
tId
=
fromMaybe
(
panic
$
pack
$
"Type Id "
<>
show
tId
<>
" does not exist"
)
(
lookup
tId
nodeTypeInv
)
(
lookup
tId
nodeTypeInv
)
src/Gargantext/Database/Ngrams.hs
View file @
452628e5
...
@@ -24,6 +24,7 @@ Ngrams connection to the Database.
...
@@ -24,6 +24,7 @@ Ngrams connection to the Database.
module
Gargantext.Database.Ngrams
where
module
Gargantext.Database.Ngrams
where
-- import Opaleye
-- import Opaleye
import
Prelude
(
Enum
,
Bounded
,
minBound
,
maxBound
)
import
Control.Lens
(
makeLenses
)
import
Control.Lens
(
makeLenses
)
import
Data.ByteString.Internal
(
ByteString
)
import
Data.ByteString.Internal
(
ByteString
)
import
Data.Map
(
Map
,
fromList
,
lookup
)
import
Data.Map
(
Map
,
fromList
,
lookup
)
...
@@ -34,6 +35,7 @@ import Database.PostgreSQL.Simple.ToField (toField)
...
@@ -34,6 +35,7 @@ import Database.PostgreSQL.Simple.ToField (toField)
import
Database.PostgreSQL.Simple.ToRow
(
toRow
)
import
Database.PostgreSQL.Simple.ToRow
(
toRow
)
import
Database.PostgreSQL.Simple.Types
(
Values
(
..
),
QualifiedIdentifier
(
..
))
import
Database.PostgreSQL.Simple.Types
(
Values
(
..
),
QualifiedIdentifier
(
..
))
import
GHC.Generics
(
Generic
)
import
GHC.Generics
(
Generic
)
import
Gargantext.Core.Types
(
fromListTypeId
,
ListType
)
import
Gargantext.Database.Config
(
nodeTypeId
)
import
Gargantext.Database.Config
(
nodeTypeId
)
import
Gargantext.Database.Types.Node
(
NodeType
)
import
Gargantext.Database.Types.Node
(
NodeType
)
import
Gargantext.Database.Node
(
mkCmd
,
Cmd
(
..
))
import
Gargantext.Database.Node
(
mkCmd
,
Cmd
(
..
))
...
@@ -79,7 +81,7 @@ import qualified Database.PostgreSQL.Simple as DPS
...
@@ -79,7 +81,7 @@ import qualified Database.PostgreSQL.Simple as DPS
-- ngrams in authors field of document has Authors Type
-- ngrams in authors field of document has Authors Type
-- ngrams in text (title or abstract) of documents has Terms Type
-- ngrams in text (title or abstract) of documents has Terms Type
data
NgramsType
=
Authors
|
Institutes
|
Sources
|
Terms
data
NgramsType
=
Authors
|
Institutes
|
Sources
|
Terms
deriving
(
Eq
,
Show
,
Ord
)
deriving
(
Eq
,
Show
,
Ord
,
Enum
,
Bounded
)
ngramsTypeId
::
NgramsType
->
Int
ngramsTypeId
::
NgramsType
->
Int
ngramsTypeId
Authors
=
1
ngramsTypeId
Authors
=
1
...
@@ -87,6 +89,9 @@ ngramsTypeId Institutes = 2
...
@@ -87,6 +89,9 @@ ngramsTypeId Institutes = 2
ngramsTypeId
Sources
=
3
ngramsTypeId
Sources
=
3
ngramsTypeId
Terms
=
4
ngramsTypeId
Terms
=
4
fromNgramsTypeId
::
Int
->
Maybe
NgramsType
fromNgramsTypeId
id
=
lookup
id
$
fromList
[(
ngramsTypeId
nt
,
nt
)
|
nt
<-
[
minBound
..
maxBound
]
::
[
NgramsType
]]
type
NgramsTerms
=
Text
type
NgramsTerms
=
Text
type
NgramsId
=
Int
type
NgramsId
=
Int
type
Size
=
Int
type
Size
=
Int
...
@@ -187,13 +192,13 @@ type NgramsTableParamMaster = NgramsTableParam
...
@@ -187,13 +192,13 @@ type NgramsTableParamMaster = NgramsTableParam
data
NgramsTableData
=
NgramsTableData
{
_ntd_terms
::
Text
data
NgramsTableData
=
NgramsTableData
{
_ntd_terms
::
Text
,
_ntd_n
::
Int
,
_ntd_n
::
Int
,
_ntd_
ngramsType
::
Int
,
_ntd_
listType
::
Maybe
ListType
,
_ntd_weight
::
Double
,
_ntd_weight
::
Double
}
deriving
(
Show
)
}
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
)
=
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
where
nodeTId
=
nodeTypeId
nodeT
nodeTId
=
nodeTypeId
nodeT
ngrmTId
=
ngramsTypeId
ngrmT
ngrmTId
=
ngramsTypeId
ngrmT
...
@@ -233,7 +238,6 @@ querySelectTableNgrams = [sql|
...
@@ -233,7 +238,6 @@ querySelectTableNgrams = [sql|
type
ListIdUser
=
Int
type
ListIdUser
=
Int
type
ListIdMaster
=
Int
type
ListIdMaster
=
Int
getNgramsGroup
::
ListIdUser
->
ListIdMaster
->
Cmd
[(
Text
,
Text
)]
getNgramsGroup
::
ListIdUser
->
ListIdMaster
->
Cmd
[(
Text
,
Text
)]
getNgramsGroup
lu
lm
=
mkCmd
$
\
conn
->
DPS
.
query
conn
querySelectNgramsGroup
(
lu
,
lm
)
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
...
@@ -27,7 +27,7 @@ import Database.PostgreSQL.Simple.SqlQQ
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Gargantext.Core.Types.Main
(
NodeTree
(
..
),
Tree
(
..
))
import
Gargantext.Core.Types.Main
(
NodeTree
(
..
),
Tree
(
..
))
import
Gargantext.Database.Config
(
typeId2node
)
import
Gargantext.Database.Config
(
fromNodeTypeId
)
------------------------------------------------------------------------
------------------------------------------------------------------------
-- import Gargantext (connectGargandb)
-- import Gargantext (connectGargandb)
-- import Control.Monad ((>>=))
-- import Control.Monad ((>>=))
...
@@ -70,7 +70,7 @@ toTree' m n =
...
@@ -70,7 +70,7 @@ toTree' m n =
toNodeTree
::
DbTreeNode
->
NodeTree
toNodeTree
::
DbTreeNode
->
NodeTree
toNodeTree
(
DbTreeNode
nId
tId
_
n
)
=
NodeTree
n
nodeType
nId
toNodeTree
(
DbTreeNode
nId
tId
_
n
)
=
NodeTree
n
nodeType
nId
where
where
nodeType
=
typeId2node
tId
nodeType
=
fromNodeTypeId
tId
------------------------------------------------------------------------
------------------------------------------------------------------------
toTreeParent
::
[
DbTreeNode
]
->
Map
(
Maybe
ParentId
)
[
DbTreeNode
]
toTreeParent
::
[
DbTreeNode
]
->
Map
(
Maybe
ParentId
)
[
DbTreeNode
]
toTreeParent
=
fromListWith
(
<>
)
.
map
(
\
n
->
(
dt_parentId
n
,
[
n
]))
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