Skip to content

haskell-gargantext
haskell-gargantext
Verified Commit ed2c6313 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski
Browse files
Options

[graph] some refactoring of Core.Viz.Graph

parent ce1cc37a
Hide whitespace changes
Inline Side-by-side
Showing with 318 additions and 274 deletions
gargantext.cabal
View file @ ed2c6313
cabal-version: 1.12
-- This file has been generated from package.yaml by hpack version 0.35.1.
-- This file has been generated from package.yaml by hpack version 0.34.7.
--
-- see: https://github.com/sol/hpack
name: gargantext
version: 0.0.6.9.1
version: 0.0.6.9.1
synopsis: Search, map, share
description: Please see README.md
category: Data
......@@ -232,6 +232,7 @@ library
Gargantext.Core.Viz.Graph.FGL
Gargantext.Core.Viz.Graph.GEXF
Gargantext.Core.Viz.Graph.Legend
Gargantext.Core.Viz.Graph.PatriciaTreeTypes
Gargantext.Core.Viz.Graph.Tools.Infomap
Gargantext.Core.Viz.Graph.Types
Gargantext.Core.Viz.Graph.Utils
......
src/Gargantext/API/GraphQL/Context.hs
View file @ ed2c6313
......@@ -184,7 +184,7 @@ toHyperdataRowDocumentGQL hyperdata =
, hrd_uniqId = _hr_uniqId
, hrd_uniqIdBdd = _hr_uniqIdBdd
}
HyperdataRowContact _ _ _ -> Nothing
HyperdataRowContact { } -> Nothing
updateNodeContextCategory :: (HasConnectionPool env, HasConfig env, HasMail env, HasSettings env) =>
NodeContextCategoryMArgs -> GqlM' e env [Int]
......
src/Gargantext/API/Node/Update.hs
View file @ ed2c6313
......@@ -29,9 +29,9 @@ import Gargantext.API.Ngrams.List (reIndexWith)
import Gargantext.API.Prelude (GargM, GargError, simuLogs)
import Gargantext.Core.Methods.Similarities (GraphMetric(..))
import Gargantext.Core.Types.Main (ListType(..))
import Gargantext.Core.Viz.Graph (Strength)
import Gargantext.Core.Viz.Graph.API (recomputeGraph)
import Gargantext.Core.Viz.Graph.Tools (PartitionMethod(..), BridgenessMethod(..))
import Gargantext.Core.Viz.Graph.Types (Strength)
import Gargantext.Core.Viz.Phylo (PhyloSubConfig(..), subConfig2config)
import Gargantext.Core.Viz.Phylo.API.Tools (flowPhyloAPI)
import Gargantext.Database.Action.Flow.Pairing (pairing)
......
src/Gargantext/Core/Viz.hs
View file @ ed2c6313
......@@ -14,4 +14,3 @@ Vizualisation of text stats
module Gargantext.Core.Viz
where
src/Gargantext/Core/Viz/Graph.hs
View file @ ed2c6313
......@@ -9,7 +9,6 @@ Portability : POSIX
-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE TemplateHaskell #-}
module Gargantext.Core.Viz.Graph
......@@ -17,244 +16,16 @@ module Gargantext.Core.Viz.Graph
import Data.ByteString.Lazy as DBL (readFile, writeFile)
import Data.HashMap.Strict (HashMap, lookup)
import Data.HashSet (HashSet)
import Data.Text (pack)
import GHC.IO (FilePath)
import Gargantext.API.Ngrams.Types (NgramsTerm(..), NgramsRepoElement(..), mSetToList)
import Gargantext.Core.Methods.Similarities (GraphMetric)
import Gargantext.Core.Types (ListId)
import Gargantext.Core.Viz.Graph.Types
import Gargantext.Database.Admin.Types.Hyperdata.Prelude
import Gargantext.Database.Admin.Types.Node (NodeId)
import Gargantext.Database.Schema.Ngrams (NgramsType(..))
import Gargantext.Prelude
import qualified Data.Aeson as DA
import qualified Data.HashSet as HashSet
import qualified Data.Text as Text
import qualified Text.Read as Text
data TypeNode = Terms | Unknown
deriving (Show, Generic)
instance ToJSON TypeNode
instance FromJSON TypeNode
instance ToSchema TypeNode
data Attributes = Attributes { clust_default :: Int }
deriving (Show, Generic)
$(deriveJSON (unPrefix "") ''Attributes)
instance ToSchema Attributes
data Node = Node { node_size :: Int
, node_type :: NgramsType -- TypeNode -- TODO NgramsType | Person
, node_id :: Text -- TODO NgramId
, node_label :: Text
, node_x_coord :: Double
, node_y_coord :: Double
, node_attributes :: Attributes
, node_children :: [Text]
}
deriving (Show, Generic)
$(deriveJSON (unPrefix "node_") ''Node)
instance ToSchema Node where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "node_")
data Edge = Edge { edge_source :: Text
, edge_target :: Text
, edge_weight :: Double
, edge_confluence :: Double
, edge_id :: Text
}
deriving (Show, Generic)
$(deriveJSON (unPrefix "edge_") ''Edge)
instance ToSchema Edge where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "edge_")
---------------------------------------------------------------
data LegendField = LegendField { _lf_id :: Int
, _lf_color :: Text
, _lf_label :: Text
}
deriving (Show, Generic)
$(deriveJSON (unPrefix "_lf_") ''LegendField)
instance ToSchema LegendField where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_lf_")
makeLenses ''LegendField
---------------------------------------------------------------
data Partite = Partite { _partite_nodes :: HashSet NgramsTerm
, _partite_type :: NgramsType
}
deriving (Show, Generic)
$(deriveJSON (unPrefix "_partite_") ''Partite)
instance ToSchema Partite where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_partite_")
makeLenses ''Partite
data MultiPartite = MultiPartite { _multipartite_data1 :: Partite
, _multipartite_data2 :: Partite
}
deriving (Show, Generic)
$(deriveJSON (unPrefix "_multipartite_") ''MultiPartite)
instance ToSchema MultiPartite where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_multipartite_")
makeLenses ''MultiPartite
defaultMultipartite :: MultiPartite
defaultMultipartite = MultiPartite a a
where
a = Partite HashSet.empty NgramsTerms
---------------------------------------------------------------
type Version = Int
data ListForGraph =
ListForGraph { _lfg_listId :: ListId
, _lfg_version :: Version
} deriving (Show, Generic)
$(deriveJSON (unPrefix "_lfg_") ''ListForGraph)
instance ToSchema ListForGraph where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_lfg_")
makeLenses ''ListForGraph
data Strength = Strong | Weak
deriving (Generic, Eq, Ord, Enum, Bounded, Show)
$(deriveJSON (unPrefix "") ''Strength)
instance ToSchema Strength where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
instance Arbitrary Strength where
arbitrary = elements $ [Strong, Weak]
data GraphMetadata =
GraphMetadata { _gm_title :: Text -- title of the graph
, _gm_metric :: GraphMetric
, _gm_edgesStrength :: Maybe Strength
, _gm_corpusId :: [NodeId] -- we can map with different corpus
, _gm_legend :: [LegendField] -- legend of the Graph
, _gm_list :: ListForGraph
, _gm_startForceAtlas :: Bool
-- , _gm_nodesTypes :: Maybe (NgramsType, NgramsType)
-- , _gm_version :: Int
}
deriving (Show, Generic)
$(deriveJSON (unPrefix "_gm_") ''GraphMetadata)
instance ToSchema GraphMetadata where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_gm_")
makeLenses ''GraphMetadata
data Graph = Graph { _graph_nodes :: [Node]
, _graph_edges :: [Edge]
, _graph_metadata :: Maybe GraphMetadata
}
deriving (Show, Generic)
$(deriveJSON (unPrefix "_graph_") ''Graph)
makeLenses ''Graph
instance ToSchema Graph where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_graph_")
-- | Intances for the mock
instance Arbitrary Graph where
arbitrary = elements $ [defaultGraph]
defaultGraph :: Graph
defaultGraph = Graph {_graph_nodes = [Node {node_x_coord=0, node_y_coord=0, node_size = 4, node_type = NgramsTerms, node_id = pack "0", node_label = pack "animal", node_attributes = Attributes {clust_default = 0}, node_children = []},Node {node_x_coord=0, node_y_coord=0, node_size = 3, node_type = NgramsTerms, node_id = pack "1", node_label = pack "bird", node_attributes = Attributes {clust_default = 0}, node_children = []},Node {node_x_coord=0, node_y_coord=0, node_size = 2, node_type = NgramsTerms, node_id = pack "2", node_label = pack "boy", node_attributes = Attributes {clust_default = 1}, node_children = []},Node {node_x_coord=0, node_y_coord=0, node_size = 2, node_type = NgramsTerms, node_id = pack "3", node_label = pack "dog", node_attributes = Attributes {clust_default = 0}, node_children = []},Node {node_x_coord=0, node_y_coord=0, node_size = 2, node_type = NgramsTerms, node_id = pack "4", node_label = pack "girl", node_attributes = Attributes {clust_default = 1}, node_children = []},Node {node_x_coord=0, node_y_coord=0, node_size = 4, node_type = NgramsTerms, node_id = pack "5", node_label = pack "human body", node_attributes = Attributes {clust_default = 1}, node_children = []},Node {node_x_coord=0, node_y_coord=0, node_size = 3, node_type = NgramsTerms, node_id = pack "6", node_label = pack "object", node_attributes = Attributes {clust_default = 2}, node_children = []},Node {node_x_coord=0, node_y_coord=0, node_size = 2, node_type = NgramsTerms, node_id = pack "7", node_label = pack "pen", node_attributes = Attributes {clust_default = 2}, node_children = []},Node {node_x_coord=0, node_y_coord=0, node_size = 2, node_type = NgramsTerms, node_id = pack "8", node_label = pack "table", node_attributes = Attributes {clust_default = 2}, node_children = []}], _graph_edges = [Edge {edge_source = pack "0", edge_target = pack "0", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "0"},Edge {edge_source = pack "1", edge_target = pack "0", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "1"},Edge {edge_source = pack "1", edge_target = pack "1", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "2"},Edge {edge_source = pack "2", edge_target = pack "2", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "3"},Edge {edge_source = pack "2", edge_target = pack "5", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "4"},Edge {edge_source = pack "3", edge_target = pack "0", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "5"},Edge {edge_source = pack "3", edge_target = pack "1", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "6"},Edge {edge_source = pack "3", edge_target = pack "3", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "7"},Edge {edge_source = pack "4", edge_target = pack "4", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "8"},Edge {edge_source = pack "4", edge_target = pack "5", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "9"},Edge {edge_source = pack "5", edge_target = pack "5", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "10"},Edge {edge_source = pack "6", edge_target = pack "6", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "11"},Edge {edge_source = pack "7", edge_target = pack "6", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "12"},Edge {edge_source = pack "7", edge_target = pack "7", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "13"},Edge {edge_source = pack "8", edge_target = pack "6", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "14"},Edge {edge_source = pack "8", edge_target = pack "7", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "15"},Edge {edge_source = pack "8", edge_target = pack "8", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "16"}], _graph_metadata = Nothing}
-----------------------------------------------------------
-- V3 Gargantext Version
data AttributesV3 = AttributesV3 { cl :: Int }
deriving (Show, Generic)
$(deriveJSON (unPrefix "") ''AttributesV3)
data NodeV3 = NodeV3 { no_id :: Int
, no_at :: AttributesV3
, no_s :: Int
, no_lb :: Text
}
deriving (Show, Generic)
$(deriveJSON (unPrefix "no_") ''NodeV3)
data EdgeV3 = EdgeV3 { eo_s :: Int
, eo_t :: Int
, eo_w :: Text
}
deriving (Show, Generic)
$(deriveJSON (unPrefix "eo_") ''EdgeV3)
data GraphV3 = GraphV3 { go_links :: [EdgeV3]
, go_nodes :: [NodeV3]
}
deriving (Show, Generic)
$(deriveJSON (unPrefix "go_") ''GraphV3)
-----------------------------------------------------------
data Camera = Camera { _camera_angle :: Double
, _camera_ratio :: Double
, _camera_x :: Double
, _camera_y :: Double }
deriving (Show, Generic)
$(deriveJSON (unPrefix "_camera_") ''Camera)
makeLenses ''Camera
instance ToSchema Camera where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_camera_")
-----------------------------------------------------------
data HyperdataGraph =
HyperdataGraph { _hyperdataGraph :: !(Maybe Graph)
, _hyperdataCamera :: !(Maybe Camera)
} deriving (Show, Generic)
$(deriveJSON (unPrefix "_") ''HyperdataGraph)
instance ToSchema HyperdataGraph where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_")
defaultHyperdataGraph :: HyperdataGraph
defaultHyperdataGraph = HyperdataGraph Nothing Nothing
instance Hyperdata HyperdataGraph
makeLenses ''HyperdataGraph
instance FromField HyperdataGraph
where
fromField = fromField'
instance DefaultFromField SqlJsonb HyperdataGraph
where
defaultFromField = fromPGSFromField
-----------------------------------------------------------
-- This type is used to return graph via API
-- hyperdataGraphAPI field is not a Maybe anymore – graph is always computed
data HyperdataGraphAPI =
HyperdataGraphAPI { _hyperdataAPIGraph :: Graph
, _hyperdataAPICamera :: !(Maybe Camera)
} deriving (Show, Generic)
$(deriveJSON (unPrefix "_hyperdataAPI") ''HyperdataGraphAPI)
instance ToSchema HyperdataGraphAPI where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_hyperdataAPI")
makeLenses ''HyperdataGraphAPI
instance FromField HyperdataGraphAPI
where
fromField = fromField'
-----------------------------------------------------------
graphV3ToGraph :: GraphV3 -> Graph
graphV3ToGraph (GraphV3 links nodes) = Graph { _graph_nodes = map nodeV32node nodes
......@@ -276,6 +47,7 @@ graphV3ToGraph (GraphV3 links nodes) = Graph { _graph_nodes = map nodeV32node no
linkV32edge :: Int -> EdgeV3 -> Edge
linkV32edge n (EdgeV3 eo_s' eo_t' eo_w') =
Edge { edge_source = cs $ show eo_s'
, edge_hidden = Just False
, edge_target = cs $ show eo_t'
, edge_weight = (Text.read $ Text.unpack eo_w') :: Double
, edge_confluence = 0.5
......
src/Gargantext/Core/Viz/Graph/API.hs
View file @ ed2c6313
......@@ -30,9 +30,9 @@ import Gargantext.API.Prelude
import Gargantext.Core.Methods.Similarities (Similarity(..), GraphMetric(..), withMetric)
import Gargantext.Core.NodeStory
import Gargantext.Core.Types.Main
import Gargantext.Core.Viz.Graph
import Gargantext.Core.Viz.Graph.GEXF ()
import Gargantext.Core.Viz.Graph.Tools -- (cooc2graph)
import Gargantext.Core.Viz.Graph.Types
import Gargantext.Database.Action.Metrics.NgramsByContext (getContextsByNgramsOnlyUser)
import Gargantext.Database.Action.Flow.Types (FlowCmdM)
import Gargantext.Database.Action.Node (mkNodeWithParent)
......
src/Gargantext/Core/Viz/Graph/GEXF.hs
View file @ ed2c6313
......@@ -19,18 +19,17 @@ module Gargantext.Core.Viz.Graph.GEXF
where
import Gargantext.Prelude
import Gargantext.Core.Viz.Graph
import qualified Data.HashMap.Lazy as HashMap
import qualified Gargantext.Prelude as P
import qualified Gargantext.Core.Viz.Graph as G
import qualified Gargantext.Core.Viz.Graph.Types as G
import qualified Xmlbf as Xmlbf
import Prelude (error)
-- Converts to GEXF format
-- See https://gephi.org/gexf/format/
instance Xmlbf.ToXml Graph where
toXml (Graph { _graph_nodes = graphNodes
, _graph_edges = graphEdges }) = root graphNodes graphEdges
instance Xmlbf.ToXml G.Graph where
toXml (G.Graph { _graph_nodes = graphNodes
, _graph_edges = graphEdges }) = root graphNodes graphEdges
where
root :: [G.Node] -> [G.Edge] -> [Xmlbf.Node]
root gn ge =
......@@ -77,5 +76,5 @@ instance Xmlbf.ToXml Graph where
-- just to be able to derive a client for the entire gargantext API,
-- we however want to avoid sollicitating this instance
instance Xmlbf.FromXml Graph where
instance Xmlbf.FromXml G.Graph where
fromXml = error "FromXml Graph: not defined, just a placeholder"
src/Gargantext/Core/Viz/Graph/PatriciaTreeTypes.hs 0 → 100644
View file @ ed2c6313
{-| Module : Gargantext.Core.Viz.Graph.PatriciaTreeTypes
Description :
Copyright : (c) CNRS, Alexandre Delanoë
License : AGPL + CECILL v3
Maintainer : contact@gargantext.org
Stability : experimental
Portability : POSIX
-}
module Gargantext.Core.Viz.Graph.PatriciaTreeTypes where
import qualified Data.Graph.Inductive.PatriciaTree as DGIP
-- import Data.IntMap (IntMap)
-- import qualified Eigen.Matrix as DenseMatrix
-- import Eigen.SparseMatrix (SparseMatrix)
--import qualified Data.Matrix.Sparse.Static as Sparse
-- import qualified Data.Vector.Unboxed as VU
-- import qualified Numeric.LinearAlgebra.Static as Dense
import Protolude hiding (sum, natVal)
-- | Main Types use in this libray
type Dict = IntMap
-- | Use the optimized version of Graph
type Graph a b = DGIP.Gr a b
-- | Type for Matrix computation optimizations (with Eigen)
-- type MatrixD n = Dense.L n n
-- type MatrixS n = Sparse.Matrix n n Double
src/Gargantext/Core/Viz/Graph/Tools.hs
View file @ ed2c6313
......@@ -25,11 +25,11 @@ import Gargantext.API.Ngrams.Types (NgramsTerm(..))
import Gargantext.Core.Methods.Similarities (Similarity(..), measure)
import Gargantext.Core.Methods.Similarities.Conditional (conditional)
import Gargantext.Core.Statistics
import Gargantext.Core.Viz.Graph
import Gargantext.Core.Viz.Graph.Bridgeness (bridgeness, Bridgeness(..), Partitions, nodeId2comId)
import Gargantext.Core.Viz.Graph.Index (createIndices, toIndex, map2mat, mat2map, Index, MatrixShape(..))
import Gargantext.Core.Viz.Graph.Tools.IGraph (mkGraphUfromEdges, spinglass)
import Gargantext.Core.Viz.Graph.Tools.Infomap (infomap)
import Gargantext.Core.Viz.Graph.Types (Attributes(..), Edge(..), Graph(..), MultiPartite(..), Node(..), Partite(..), Strength(..))
import Gargantext.Database.Schema.Ngrams (NgramsType(..))
import Gargantext.Core.Viz.Graph.Utils (edgesFilter, nodesFilter)
import Gargantext.Prelude
......@@ -242,6 +242,7 @@ data2graph multi labels' occurences bridge conf partitions =
(bridge', toKeep) = nodesFilter (\v -> v > 1) bridge
edges = [ Edge { edge_source = cs (show s)
, edge_hidden = Nothing
, edge_target = cs (show t)
, edge_weight = weight
, edge_confluence = maybe 0 identity $ Map.lookup (s,t) conf
......@@ -340,7 +341,7 @@ cooc2graph'' distance threshold myCooc = neighbourMap
-- Quentin
filterByNeighbours :: Double -> Map (Index, Index) Double -> Map (Index, Index) Double
filterByNeighbours threshold distanceMap = filteredMap
where
where
indexes :: [Index]
indexes = List.nub $ List.concat $ map (\(idx,idx') -> [idx,idx'] ) $ Map.keys distanceMap
filteredMap :: Map (Index, Index) Double
......@@ -354,4 +355,3 @@ filterByNeighbours threshold distanceMap = filteredMap
$ Map.filterWithKey (\(from,_) _ -> idx == from) distanceMap
in List.take (round threshold) selected
) indexes
src/Gargantext/Core/Viz/Graph/Types.hs
View file @ ed2c6313
{-| Module : Graph.Types
Description :
Copyright : (c) CNRS, Alexandre Delanoë
{-|
Module : Gargantext.Core.Viz.Graph.Types
Description : Graph utils
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : contact@gargantext.org
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
module Gargantext.Core.Viz.Graph.Types where
{-# LANGUAGE TemplateHaskell #-}
import qualified Data.Graph.Inductive.PatriciaTree as DGIP
-- import Data.IntMap (IntMap)
-- import qualified Eigen.Matrix as DenseMatrix
-- import Eigen.SparseMatrix (SparseMatrix)
module Gargantext.Core.Viz.Graph.Types
where
--import qualified Data.Matrix.Sparse.Static as Sparse
-- import qualified Data.Vector.Unboxed as VU
-- import qualified Numeric.LinearAlgebra.Static as Dense
import Protolude hiding (sum, natVal)
import Control.Lens (makeLenses)
import Database.PostgreSQL.Simple.FromField (FromField(..))
import Data.Aeson (FromJSON, ToJSON)
import Data.Aeson.TH (deriveJSON)
import Data.HashSet (HashSet)
import qualified Data.HashSet as HashSet
import Data.Swagger (ToSchema(..), genericDeclareNamedSchema)
import Data.Text (Text, pack)
import Gargantext.API.Ngrams.Types (NgramsTerm)
import Gargantext.Core.Methods.Similarities (GraphMetric)
import Gargantext.Core.Types (ListId)
import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
import Gargantext.Database.Admin.Types.Hyperdata.Prelude (Hyperdata)
import Gargantext.Database.Admin.Types.Node (NodeId)
import Gargantext.Database.Prelude (fromField')
import Gargantext.Database.Schema.Ngrams (NgramsType(..))
import Gargantext.Prelude
import GHC.Generics (Generic)
import Opaleye (DefaultFromField(..), SqlJsonb, fromPGSFromField)
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
-- | Main Types use in this libray
type Dict = IntMap
data TypeNode = Terms | Unknown
deriving (Show, Generic)
-- | Use the optimized version of Graph
type Graph a b = DGIP.Gr a b
instance ToJSON TypeNode
instance FromJSON TypeNode
instance ToSchema TypeNode
-- | Type for Matrix computation optimizations (with Eigen)
-- type MatrixD n = Dense.L n n
-- type MatrixS n = Sparse.Matrix n n Double
data Attributes = Attributes { clust_default :: Int }
deriving (Show, Generic)
$(deriveJSON (unPrefix "") ''Attributes)
instance ToSchema Attributes
data Node = Node { node_size :: Int
, node_type :: NgramsType -- TypeNode -- TODO NgramsType | Person
, node_id :: Text -- TODO NgramId
, node_label :: Text
, node_x_coord :: Double
, node_y_coord :: Double
, node_attributes :: Attributes
, node_children :: [Text]
}
deriving (Show, Generic)
$(deriveJSON (unPrefix "node_") ''Node)
instance ToSchema Node where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "node_")
data Edge = Edge { edge_confluence :: Double
, edge_hidden :: Maybe Bool
, edge_id :: Text
, edge_source :: Text
, edge_target :: Text
, edge_weight :: Double
}
deriving (Show, Generic)
$(deriveJSON (unPrefix "edge_") ''Edge)
instance ToSchema Edge where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "edge_")
---------------------------------------------------------------
data LegendField = LegendField { _lf_id :: Int
, _lf_color :: Text
, _lf_label :: Text
}
deriving (Show, Generic)
$(deriveJSON (unPrefix "_lf_") ''LegendField)
instance ToSchema LegendField where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_lf_")
makeLenses ''LegendField
---------------------------------------------------------------
data Partite = Partite { _partite_nodes :: HashSet NgramsTerm
, _partite_type :: NgramsType
}
deriving (Show, Generic)
$(deriveJSON (unPrefix "_partite_") ''Partite)
instance ToSchema Partite where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_partite_")
makeLenses ''Partite
data MultiPartite = MultiPartite { _multipartite_data1 :: Partite
, _multipartite_data2 :: Partite
}
deriving (Show, Generic)
$(deriveJSON (unPrefix "_multipartite_") ''MultiPartite)
instance ToSchema MultiPartite where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_multipartite_")
makeLenses ''MultiPartite
---------------------------------------------------------------
type Version = Int
data ListForGraph =
ListForGraph { _lfg_listId :: ListId
, _lfg_version :: Version
} deriving (Show, Generic)
$(deriveJSON (unPrefix "_lfg_") ''ListForGraph)
instance ToSchema ListForGraph where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_lfg_")
makeLenses ''ListForGraph
data Strength = Strong | Weak
deriving (Generic, Eq, Ord, Enum, Bounded, Show)
$(deriveJSON (unPrefix "") ''Strength)
instance ToSchema Strength where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
data GraphMetadata =
GraphMetadata { _gm_title :: Text -- title of the graph
, _gm_metric :: GraphMetric
, _gm_edgesStrength :: Maybe Strength
, _gm_corpusId :: [NodeId] -- we can map with different corpus
, _gm_legend :: [LegendField] -- legend of the Graph
, _gm_list :: ListForGraph
, _gm_startForceAtlas :: Bool
-- , _gm_nodesTypes :: Maybe (NgramsType, NgramsType)
-- , _gm_version :: Int
}
deriving (Show, Generic)
$(deriveJSON (unPrefix "_gm_") ''GraphMetadata)
instance ToSchema GraphMetadata where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_gm_")
makeLenses ''GraphMetadata
data Graph = Graph { _graph_nodes :: [Node]
, _graph_edges :: [Edge]
, _graph_metadata :: Maybe GraphMetadata
}
deriving (Show, Generic)
$(deriveJSON (unPrefix "_graph_") ''Graph)
makeLenses ''Graph
instance ToSchema Graph where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_graph_")
-----------------------------------------------------------
-- V3 Gargantext Version
data AttributesV3 = AttributesV3 { cl :: Int }
deriving (Show, Generic)
$(deriveJSON (unPrefix "") ''AttributesV3)
data NodeV3 = NodeV3 { no_id :: Int
, no_at :: AttributesV3
, no_s :: Int
, no_lb :: Text
}
deriving (Show, Generic)
$(deriveJSON (unPrefix "no_") ''NodeV3)
data EdgeV3 = EdgeV3 { eo_s :: Int
, eo_t :: Int
, eo_w :: Text
}
deriving (Show, Generic)
$(deriveJSON (unPrefix "eo_") ''EdgeV3)
data GraphV3 = GraphV3 { go_links :: [EdgeV3]
, go_nodes :: [NodeV3]
}
deriving (Show, Generic)
$(deriveJSON (unPrefix "go_") ''GraphV3)
-----------------------------------------------------------
data Camera = Camera { _camera_angle :: Double
, _camera_ratio :: Double
, _camera_x :: Double
, _camera_y :: Double }
deriving (Show, Generic)
$(deriveJSON (unPrefix "_camera_") ''Camera)
makeLenses ''Camera
instance ToSchema Camera where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_camera_")
-----------------------------------------------------------
data HyperdataGraph =
HyperdataGraph { _hyperdataGraph :: !(Maybe Graph)
, _hyperdataCamera :: !(Maybe Camera)
} deriving (Show, Generic)
$(deriveJSON (unPrefix "_") ''HyperdataGraph)
instance ToSchema HyperdataGraph where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_")
instance Hyperdata HyperdataGraph
makeLenses ''HyperdataGraph
instance FromField HyperdataGraph
where
fromField = fromField'
instance DefaultFromField SqlJsonb HyperdataGraph
where
defaultFromField = fromPGSFromField
-----------------------------------------------------------
-- This type is used to return graph via API
-- hyperdataGraphAPI field is not a Maybe anymore – graph is always computed
data HyperdataGraphAPI =
HyperdataGraphAPI { _hyperdataAPIGraph :: Graph
, _hyperdataAPICamera :: !(Maybe Camera)
} deriving (Show, Generic)
$(deriveJSON (unPrefix "_hyperdataAPI") ''HyperdataGraphAPI)
instance ToSchema HyperdataGraphAPI where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_hyperdataAPI")
makeLenses ''HyperdataGraphAPI
instance FromField HyperdataGraphAPI
where
fromField = fromField'
---------------------- defaults
defaultMultipartite :: MultiPartite
defaultMultipartite = MultiPartite a a
where
a = Partite HashSet.empty NgramsTerms
defaultGraph :: Graph
defaultGraph = Graph {_graph_nodes = [Node {node_x_coord=0, node_y_coord=0, node_size = 4, node_type = NgramsTerms, node_id = pack "0", node_label = pack "animal", node_attributes = Attributes {clust_default = 0}, node_children = []},Node {node_x_coord=0, node_y_coord=0, node_size = 3, node_type = NgramsTerms, node_id = pack "1", node_label = pack "bird", node_attributes = Attributes {clust_default = 0}, node_children = []},Node {node_x_coord=0, node_y_coord=0, node_size = 2, node_type = NgramsTerms, node_id = pack "2", node_label = pack "boy", node_attributes = Attributes {clust_default = 1}, node_children = []},Node {node_x_coord=0, node_y_coord=0, node_size = 2, node_type = NgramsTerms, node_id = pack "3", node_label = pack "dog", node_attributes = Attributes {clust_default = 0}, node_children = []},Node {node_x_coord=0, node_y_coord=0, node_size = 2, node_type = NgramsTerms, node_id = pack "4", node_label = pack "girl", node_attributes = Attributes {clust_default = 1}, node_children = []},Node {node_x_coord=0, node_y_coord=0, node_size = 4, node_type = NgramsTerms, node_id = pack "5", node_label = pack "human body", node_attributes = Attributes {clust_default = 1}, node_children = []},Node {node_x_coord=0, node_y_coord=0, node_size = 3, node_type = NgramsTerms, node_id = pack "6", node_label = pack "object", node_attributes = Attributes {clust_default = 2}, node_children = []},Node {node_x_coord=0, node_y_coord=0, node_size = 2, node_type = NgramsTerms, node_id = pack "7", node_label = pack "pen", node_attributes = Attributes {clust_default = 2}, node_children = []},Node {node_x_coord=0, node_y_coord=0, node_size = 2, node_type = NgramsTerms, node_id = pack "8", node_label = pack "table", node_attributes = Attributes {clust_default = 2}, node_children = []}], _graph_edges = [Edge {edge_source = pack "0", edge_target = pack "0", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "0", ..},Edge {edge_source = pack "1", edge_target = pack "0", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "1", ..},Edge {edge_source = pack "1", edge_target = pack "1", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "2", ..},Edge {edge_source = pack "2", edge_target = pack "2", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "3", ..},Edge {edge_source = pack "2", edge_target = pack "5", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "4", ..},Edge {edge_source = pack "3", edge_target = pack "0", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "5", ..},Edge {edge_source = pack "3", edge_target = pack "1", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "6", ..},Edge {edge_source = pack "3", edge_target = pack "3", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "7", ..},Edge {edge_source = pack "4", edge_target = pack "4", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "8", ..},Edge {edge_source = pack "4", edge_target = pack "5", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "9", ..},Edge {edge_source = pack "5", edge_target = pack "5", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "10", ..},Edge {edge_source = pack "6", edge_target = pack "6", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "11", ..},Edge {edge_source = pack "7", edge_target = pack "6", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "12", ..},Edge {edge_source = pack "7", edge_target = pack "7", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "13", ..},Edge {edge_source = pack "8", edge_target = pack "6", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "14", ..},Edge {edge_source = pack "8", edge_target = pack "7", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "15", ..},Edge {edge_source = pack "8", edge_target = pack "8", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "16", ..}], _graph_metadata = Nothing}
where
edge_hidden = Just False
defaultHyperdataGraph :: HyperdataGraph
defaultHyperdataGraph = HyperdataGraph Nothing Nothing
-- | Intances for the mock
instance Arbitrary Strength where
arbitrary = elements $ [Strong, Weak]
instance Arbitrary Graph where
arbitrary = elements $ [defaultGraph]
src/Gargantext/Database/Admin/Types/Hyperdata.hs
View file @ ed2c6313
......@@ -10,6 +10,7 @@ Portability : POSIX
-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module Gargantext.Database.Admin.Types.Hyperdata
( module Gargantext.Database.Admin.Types.Hyperdata.Any
......@@ -26,7 +27,7 @@ module Gargantext.Database.Admin.Types.Hyperdata
, module Gargantext.Database.Admin.Types.Hyperdata.Texts
, module Gargantext.Database.Admin.Types.Hyperdata.Phylo
, module Gargantext.Database.Admin.Types.Hyperdata.User
, module Gargantext.Core.Viz.Graph
, module Gargantext.Core.Viz.Graph.Types
)
where
......@@ -44,4 +45,4 @@ import Gargantext.Database.Admin.Types.Hyperdata.Prelude (Hyperdata)
import Gargantext.Database.Admin.Types.Hyperdata.Texts
import Gargantext.Database.Admin.Types.Hyperdata.Phylo
import Gargantext.Database.Admin.Types.Hyperdata.User
import Gargantext.Core.Viz.Graph (HyperdataGraph(..), defaultHyperdataGraph)
import Gargantext.Core.Viz.Graph.Types (HyperdataGraph(..), defaultHyperdataGraph)
src/Gargantext/Database/Admin/Types/Hyperdata/Default.hs
View file @ ed2c6313
......@@ -27,7 +27,7 @@ import Gargantext.Database.Admin.Types.Hyperdata.Prelude
data DefaultHyperdata =
DefaultUser HyperdataUser
DefaultUser HyperdataUser
| DefaultContact HyperdataContact
| DefaultCorpus HyperdataCorpus
......
src/Gargantext/Database/Admin/Types/Hyperdata/Prelude.hs
View file @ ed2c6313
......@@ -11,7 +11,7 @@ Portability : POSIX
module Gargantext.Database.Admin.Types.Hyperdata.Prelude
( module Control.Lens
( module Control.Lens
, module Data.Aeson
, module Data.Aeson.TH
, module Data.Aeson.Types
......@@ -66,8 +66,3 @@ data Chart =
instance ToJSON Chart
instance FromJSON Chart
instance ToSchema Chart
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