Commit 452628e5 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[NGRAMS] Table queries ready (qualitative tests, needs more tests)

parent 0b956a2e
Pipeline #10 canceled with stage
......@@ -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
......
......@@ -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)
......@@ -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)
......
......@@ -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]))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment