{-| Module : Gargantext.Viz.Graph Description : Graph utils Copyright : (c) CNRS, 2017-Present License : AGPL + CECILL v3 Maintainer : team@gargantext.org Stability : experimental Portability : POSIX -} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DeriveGeneric #-} module Gargantext.Viz.Graph where ------------------------------------------------------------------------ import GHC.IO (FilePath) import GHC.Generics (Generic) import Data.Aeson.TH (deriveJSON) import qualified Data.Aeson as DA import Data.ByteString.Lazy as DBL (readFile, writeFile) import Data.Text (Text, pack) import qualified Text.Read as T import qualified Data.Text as T import Data.Map.Strict (Map) import qualified Data.Map.Strict as M import Data.Swagger (ToSchema) import Gargantext.Prelude import Gargantext.Core.Types (Label) import Gargantext.Core.Utils.Prefix (unPrefix) import Data.Graph.Clustering.Louvain.CplusPlus (LouvainNode(..)) import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary) import Test.QuickCheck (elements) ------------------------------------------------------------------------ data TypeNode = Terms | Unknown deriving (Show, Generic) $(deriveJSON (unPrefix "") ''TypeNode) data Attributes = Attributes { clust_default :: Int } deriving (Show, Generic) $(deriveJSON (unPrefix "") ''Attributes) data Node = Node { node_size :: Int , node_type :: TypeNode , node_id :: Text , node_label :: Text , node_attributes :: Attributes } deriving (Show, Generic) $(deriveJSON (unPrefix "node_") ''Node) data Edge = Edge { edge_source :: Text , edge_target :: Text , edge_weight :: Double , edge_id :: Text } deriving (Show, Generic) $(deriveJSON (unPrefix "edge_") ''Edge) data Graph = Graph { graph_nodes :: [Node] , graph_edges :: [Edge] } deriving (Show, Generic) $(deriveJSON (unPrefix "graph_") ''Graph) -- | Intances for Swagger documentation instance ToSchema Node instance ToSchema TypeNode instance ToSchema Attributes instance ToSchema Edge instance ToSchema Graph defaultGraph :: Graph defaultGraph = Graph {graph_nodes = [Node {node_size = 4, node_type = Terms, node_id = pack "0", node_label = pack "animal", node_attributes = Attributes {clust_default = 0}},Node {node_size = 3, node_type = Terms, node_id = pack "1", node_label = pack "bird", node_attributes = Attributes {clust_default = 0}},Node {node_size = 2, node_type = Terms, node_id = pack "2", node_label = pack "boy", node_attributes = Attributes {clust_default = 1}},Node {node_size = 2, node_type = Terms, node_id = pack "3", node_label = pack "dog", node_attributes = Attributes {clust_default = 0}},Node {node_size = 2, node_type = Terms, node_id = pack "4", node_label = pack "girl", node_attributes = Attributes {clust_default = 1}},Node {node_size = 4, node_type = Terms, node_id = pack "5", node_label = pack "human body", node_attributes = Attributes {clust_default = 1}},Node {node_size = 3, node_type = Terms, node_id = pack "6", node_label = pack "object", node_attributes = Attributes {clust_default = 2}},Node {node_size = 2, node_type = Terms, node_id = pack "7", node_label = pack "pen", node_attributes = Attributes {clust_default = 2}},Node {node_size = 2, node_type = Terms, node_id = pack "8", node_label = pack "table", node_attributes = Attributes {clust_default = 2}}], graph_edges = [Edge {edge_source = pack "0", edge_target = pack "0", edge_weight = 1.0, edge_id = pack "0"},Edge {edge_source = pack "1", edge_target = pack "0", edge_weight = 1.0, edge_id = pack "1"},Edge {edge_source = pack "1", edge_target = pack "1", edge_weight = 1.0, edge_id = pack "2"},Edge {edge_source = pack "2", edge_target = pack "2", edge_weight = 1.0, edge_id = pack "3"},Edge {edge_source = pack "2", edge_target = pack "5", edge_weight = 1.0, edge_id = pack "4"},Edge {edge_source = pack "3", edge_target = pack "0", edge_weight = 1.0, edge_id = pack "5"},Edge {edge_source = pack "3", edge_target = pack "1", edge_weight = 1.0, edge_id = pack "6"},Edge {edge_source = pack "3", edge_target = pack "3", edge_weight = 1.0, edge_id = pack "7"},Edge {edge_source = pack "4", edge_target = pack "4", edge_weight = 1.0, edge_id = pack "8"},Edge {edge_source = pack "4", edge_target = pack "5", edge_weight = 1.0, edge_id = pack "9"},Edge {edge_source = pack "5", edge_target = pack "5", edge_weight = 1.0, edge_id = pack "10"},Edge {edge_source = pack "6", edge_target = pack "6", edge_weight = 1.0, edge_id = pack "11"},Edge {edge_source = pack "7", edge_target = pack "6", edge_weight = 1.0, edge_id = pack "12"},Edge {edge_source = pack "7", edge_target = pack "7", edge_weight = 1.0, edge_id = pack "13"},Edge {edge_source = pack "8", edge_target = pack "6", edge_weight = 1.0, edge_id = pack "14"},Edge {edge_source = pack "8", edge_target = pack "7", edge_weight = 1.0, edge_id = pack "15"},Edge {edge_source = pack "8", edge_target = pack "8", edge_weight = 1.0, edge_id = pack "16"}]} -- | Intances for the mack instance Arbitrary Graph where arbitrary = elements $ [defaultGraph] ----------------------------------------------------------- -- 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) ---------------------------------------------------------- -- | From data to Graph -- FIXME: distance should not be a map since we just "toList" it (same as cLouvain) data2graph :: [(Label, Int)] -> Map (Int, Int) Int -> Map (Int, Int) Double -> [LouvainNode] -> Graph data2graph labels coocs distance partitions = Graph nodes edges where community_id_by_node_id = M.fromList [ (n, c) | LouvainNode n c <- partitions ] nodes = [ Node { node_size = maybe 0 identity (M.lookup (n,n) coocs) , node_type = Terms -- or Unknown , node_id = cs (show n) , node_label = T.unwords l , node_attributes = Attributes { clust_default = maybe 0 identity (M.lookup n community_id_by_node_id) } } | (l, n) <- labels ] edges = [ Edge { edge_source = cs (show s) , edge_target = cs (show t) , edge_weight = w , edge_id = cs (show i) } | (i, ((s,t), w)) <- zip ([0..]::[Integer]) (M.toList distance) ] ----------------------------------------------------------- ----------------------------------------------------------- graphV3ToGraph :: GraphV3 -> Graph graphV3ToGraph (GraphV3 links nodes) = Graph (map nodeV32node nodes) (zipWith linkV32edge [1..] links) where nodeV32node :: NodeV3 -> Node nodeV32node (NodeV3 no_id' (AttributesV3 cl') no_s' no_lb') = Node no_s' Terms (cs $ show no_id') no_lb' (Attributes cl') linkV32edge :: Int -> EdgeV3 -> Edge linkV32edge n (EdgeV3 eo_s' eo_t' eo_w') = Edge (cs $ show eo_s') (cs $ show eo_t') ((T.read $ T.unpack eo_w') :: Double) (cs $ show n) graphV3ToGraphWithFiles :: FilePath -> FilePath -> IO () graphV3ToGraphWithFiles g1 g2 = do -- GraphV3 <- IO Fichier graph <- DBL.readFile g1 let newGraph = case DA.decode graph :: Maybe GraphV3 of Nothing -> panic (T.pack "no graph") Just new -> new DBL.writeFile g2 (DA.encode $ graphV3ToGraph newGraph) readGraphFromJson :: FilePath -> IO (Maybe Graph) readGraphFromJson fp = do graph <- DBL.readFile fp pure $ DA.decode graph