Commit 80ffec62 authored by Alexandre Delanoë's avatar Alexandre Delanoë

Merge remote-tracking branch 'origin/adinapoli/fix-phylo-types' into dev-merge

parents 8e353331 69fa22f7
......@@ -26,6 +26,8 @@ data-files:
ekg-assets/chart_line_add.png
ekg-assets/cross.png
test-data/ngrams/GarganText_NgramsTerms-QuantumComputing.json
test-data/phylo/bpa_phylo_test.json
test-data/phylo/open_science.json
library
exposed-modules:
......@@ -81,6 +83,7 @@ library
Gargantext.Core.Types.Individu
Gargantext.Core.Types.Main
Gargantext.Core.Types.Query
Gargantext.Core.Types.Phylo
Gargantext.Core.Utils
Gargantext.Core.Utils.Prefix
Gargantext.Core.Viz.Graph
......@@ -235,7 +238,6 @@ library
Gargantext.Core.Text.Terms.Multi.PosTagging
Gargantext.Core.Text.Terms.Multi.PosTagging.Types
Gargantext.Core.Text.Upload
Gargantext.Core.Types.Phylo
Gargantext.Core.Types.Search
Gargantext.Core.Utils.DateUtils
Gargantext.Core.Viz
......
......@@ -45,6 +45,8 @@ data-files:
- ekg-assets/chart_line_add.png
- ekg-assets/cross.png
- test-data/ngrams/GarganText_NgramsTerms-QuantumComputing.json
- test-data/phylo/bpa_phylo_test.json
- test-data/phylo/open_science.json
library:
source-dirs: src
ghc-options:
......@@ -109,6 +111,7 @@ library:
- Gargantext.Core.Types.Individu
- Gargantext.Core.Types.Main
- Gargantext.Core.Types.Query
- Gargantext.Core.Types.Phylo
- Gargantext.Core.Utils
- Gargantext.Core.Utils.Prefix
- Gargantext.Core.Viz.Graph
......
......@@ -9,16 +9,21 @@ import Data.Aeson
import Data.Either
import Gargantext.API.Node.Corpus.New
import Gargantext.API.Node.Corpus.Types
import Gargantext.Core.Types.Phylo
import Gargantext.Core.Viz.Phylo.API
import Prelude
import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.QuickCheck
import Text.RawString.QQ
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy.Char8 as C8
import Paths_gargantext
jsonRoundtrip :: (Show a, FromJSON a, ToJSON a, Eq a) => a -> Property
jsonRoundtrip a = eitherDecode (encode a) === Right a
jsonRoundtrip a =
counterexample ("Parsed JSON: " <> C8.unpack (encode a)) $ eitherDecode (encode a) === Right a
tests :: TestTree
tests = testGroup "JSON" [
......@@ -26,7 +31,14 @@ tests = testGroup "JSON" [
, testProperty "WithQuery roundtrips" (jsonRoundtrip @WithQuery)
, testCase "WithQuery frontend compliance" testWithQueryFrontend
, testGroup "Phylo" [
testProperty "PhyloData" (jsonRoundtrip @PhyloData)
testProperty "PeriodToNode" (jsonRoundtrip @PeriodToNodeData)
, testProperty "GraphData" (jsonRoundtrip @GraphData)
, testProperty "GraphDataData" (jsonRoundtrip @GraphDataData)
, testProperty "ObjectData" (jsonRoundtrip @ObjectData)
, testProperty "PhyloData" (jsonRoundtrip @PhyloData)
, testProperty "LayerData" (jsonRoundtrip @LayerData)
, testCase "can parse bpa_phylo_test.json" testParseBpaPhylo
, testCase "can parse open_science.json" testOpenSciencePhylo
]
]
......@@ -40,3 +52,19 @@ testWithQueryFrontend = do
-- instances, this test would fail, and we will be notified.
cannedWithQueryPayload :: String
cannedWithQueryPayload = [r| {"query":"Haskell","node_id":138,"lang":"EN","flowListWith":{"type":"MyListsFirst"},"datafield":"External Arxiv","databases":"Arxiv"} |]
testParseBpaPhylo :: Assertion
testParseBpaPhylo = do
pth <- getDataFileName "test-data/phylo/bpa_phylo_test.json"
jsonBlob <- B.readFile pth
case eitherDecodeStrict' @GraphData jsonBlob of
Left err -> error err
Right _ -> pure ()
testOpenSciencePhylo :: Assertion
testOpenSciencePhylo = do
pth <- getDataFileName "test-data/phylo/open_science.json"
jsonBlob <- B.readFile pth
case eitherDecodeStrict' @PhyloData jsonBlob of
Left err -> error err
Right _ -> pure ()
......@@ -28,9 +28,12 @@ module Gargantext.Core.Types.Phylo where
import Control.Monad.Fail (fail)
import Control.Lens (makeLenses)
import Control.Applicative ((<|>))
import Data.Aeson
import Data.Aeson.Types
import Data.Aeson.TH (deriveJSON)
import Data.Maybe
import Data.Monoid
import Data.Swagger
import Data.Text (Text)
......@@ -38,6 +41,7 @@ import Data.Time.Clock.POSIX (POSIXTime)
import qualified Data.Text as T
import Test.QuickCheck
import Test.QuickCheck.Instances.Text()
import Prelude (Either(..))
import GHC.Generics (Generic)
......@@ -114,12 +118,319 @@ data GraphData =
, _gd_edges :: [EdgeData]
, _gd_objects :: [ObjectData]
, _gd_strict :: Bool
, _gd_data :: GraphDataData
} deriving (Show, Eq, Generic)
data GraphDataData =
GraphDataData {
_gdd_bb :: Text
, _gdd_color :: Text
, _gdd_fontsize :: Text
, _gdd_label :: Text
, _gdd_labelloc :: Text
, _gdd_lheight :: Text
, _gdd_lp :: Text
, _gdd_lwidth :: Text
, _gdd_name :: Text
, _gdd_nodesep :: Text
, _gdd_overlap :: Text
, _gdd_phyloBranches :: Text
, _gdd_phyloDocs :: Text
, _gdd_phyloFoundations :: Text
, _gdd_phyloGroups :: Text
, _gdd_phyloPeriods :: Text
, _gdd_phyloSources :: Text
, _gdd_phyloTerms :: Text
, _gdd_phyloTimeScale :: Text
, _gdd_rank :: Text
, _gdd_ranksep :: Text
, _gdd_ratio :: Text
, _gdd_splines :: Text
, _gdd_style :: Text
} deriving (Show, Eq, Generic)
instance ToJSON GraphDataData where
toJSON GraphDataData{..} = object [
"bb" .= _gdd_bb
, "color" .= _gdd_color
, "fontsize" .= _gdd_fontsize
, "label" .= _gdd_label
, "labelloc" .= _gdd_labelloc
, "lheight" .= _gdd_lheight
, "lp" .= _gdd_lp
, "lwidth" .= _gdd_lwidth
, "name" .= _gdd_name
, "nodesep" .= _gdd_nodesep
, "overlap" .= _gdd_overlap
, "phyloBranches" .= _gdd_phyloBranches
, "phyloDocs" .= _gdd_phyloDocs
, "phyloFoundations" .= _gdd_phyloFoundations
, "phyloGroups" .= _gdd_phyloGroups
, "phyloPeriods" .= _gdd_phyloPeriods
, "phyloSources" .= _gdd_phyloSources
, "phyloTerms" .= _gdd_phyloTerms
, "phyloTimeScale" .= _gdd_phyloTimeScale
, "rank" .= _gdd_rank
, "ranksep" .= _gdd_ranksep
, "ratio" .= _gdd_ratio
, "splines" .= _gdd_splines
, "style" .= _gdd_style
]
instance FromJSON GraphDataData where
parseJSON = withObject "GraphDataData" $ \o -> do
_gdd_bb <- o .: "bb"
_gdd_color <- o .: "color"
_gdd_fontsize <- o .: "fontsize"
_gdd_label <- o .: "label"
_gdd_labelloc <- o .: "labelloc"
_gdd_lheight <- o .: "lheight"
_gdd_lp <- o .: "lp"
_gdd_lwidth <- o .: "lwidth"
_gdd_name <- o .: "name"
_gdd_nodesep <- o .: "nodesep"
_gdd_overlap <- o .: "overlap"
_gdd_phyloBranches <- o .: "phyloBranches"
_gdd_phyloDocs <- o .: "phyloDocs"
_gdd_phyloFoundations <- o .: "phyloFoundations"
_gdd_phyloGroups <- o .: "phyloGroups"
_gdd_phyloPeriods <- o .: "phyloPeriods"
_gdd_phyloSources <- o .: "phyloSources"
_gdd_phyloTerms <- o .: "phyloTerms"
_gdd_phyloTimeScale <- o .: "phyloTimeScale"
_gdd_rank <- o .: "rank"
_gdd_ranksep <- o .: "ranksep"
_gdd_ratio <- o .: "ratio"
_gdd_splines <- o .: "splines"
_gdd_style <- o .: "style"
pure $ GraphDataData{..}
-- temp placeholder.
newtype ObjectData = ObjectData { _ObjectData :: Value }
deriving stock (Show, Eq, Generic)
deriving newtype (FromJSON, ToJSON)
data ObjectData =
GroupToNode !GvId !NodeCommonData !GroupToNodeData
| BranchToNode !GvId !NodeCommonData !BranchToNodeData
| PeriodToNode !GvId !NodeCommonData !PeriodToNodeData
| Layer !GvId !GraphDataData !LayerData
deriving (Show, Eq, Generic)
instance ToJSON ObjectData where
toJSON = \case
GroupToNode gvid commonData nodeTypeData
-> mkObject gvid (Left commonData) nodeTypeData
BranchToNode gvid commonData nodeTypeData
-> mkObject gvid (Left commonData) nodeTypeData
PeriodToNode gvid commonData nodeTypeData
-> mkObject gvid (Left commonData) nodeTypeData
Layer gvid graphData nodeTypeData
-> mkObject gvid (Right graphData) nodeTypeData
instance FromJSON ObjectData where
parseJSON = withObject "ObjectData" $ \o -> do
_gvid <- o .: "_gvid"
-- try to parse the graph data first. If we succeed, then we are dealing with
-- the 'Layer', otherwise we the rest, but for the rest we can avoid re-parsing
-- the 'NodeCommonData' every time.
case parseMaybe @_ @GraphDataData parseJSON (Object o) of
Nothing
-> do commonData <- parseJSON (Object o)
((GroupToNode <$> pure _gvid <*> pure commonData <*> parseJSON (Object o)) <|>
(BranchToNode <$> pure _gvid <*> pure commonData <*> parseJSON (Object o)) <|>
(PeriodToNode <$> pure _gvid <*> pure commonData <*> parseJSON (Object o)))
Just gd
-> Layer <$> pure _gvid <*> pure gd <*> parseJSON (Object o)
mkObject :: ToJSON a => GvId -> Either NodeCommonData GraphDataData -> a -> Value
mkObject gvid commonData objectTypeData =
let commonDataJSON = either toJSON toJSON commonData
objectTypeDataJSON = toJSON objectTypeData
header = object $ [ "_gvid" .= toJSON gvid ]
in case (commonDataJSON, objectTypeDataJSON, header) of
(Object hdr, Object cdJSON, Object etDataJSON)
-> Object $ hdr <> cdJSON <> etDataJSON
_ -> panic "[Gargantext.Core.Types.Phylo.mkObject] impossible: commonData, header or objectTypeDataJSON didn't convert back to JSON Object."
data GroupToNodeData
= GroupToNodeData
{ _gtn_bId :: Text
, _gtn_branchId :: Text
, _gtn_fontname :: Text
, _gtn_foundation :: Text
, _gtn_frequence :: Text
, _gtn_from :: Text
, _gtn_lbl :: Text
, _gtn_penwidth :: Text
, _gtn_role :: Text
, _gtn_seaLvl :: Maybe Text
, _gtn_source :: Text
, _gtn_strFrom :: Maybe Text
, _gtn_strTo :: Maybe Text
, _gtn_support :: Text
, _gtn_to :: Text
, _gtn_weight :: Text
} deriving (Show, Eq, Generic)
instance ToJSON GroupToNodeData where
toJSON GroupToNodeData{..} = object [
"bId" .= _gtn_bId
, "branchId" .= _gtn_branchId
, "fontname" .= _gtn_fontname
, "foundation" .= _gtn_foundation
, "frequence" .= _gtn_frequence
, "from" .= _gtn_from
, "lbl" .= _gtn_lbl
, "penwidth" .= _gtn_penwidth
, "role" .= _gtn_role
, "seaLvl" .= _gtn_seaLvl
, "source" .= _gtn_source
, "strFrom" .= _gtn_strFrom
, "strTo" .= _gtn_strTo
, "support" .= _gtn_support
, "to" .= _gtn_to
, "weight" .= _gtn_weight
]
instance FromJSON GroupToNodeData where
parseJSON = withObject "GroupToNodeData" $ \o -> do
_gtn_bId <- o .: "bId"
_gtn_branchId <- o .: "branchId"
_gtn_fontname <- o .: "fontname"
_gtn_foundation <- o .: "foundation"
_gtn_frequence <- o .: "frequence"
_gtn_from <- o .: "from"
_gtn_lbl <- o .: "lbl"
_gtn_penwidth <- o .: "penwidth"
_gtn_role <- o .: "role"
_gtn_seaLvl <- o .:? "seaLvl"
_gtn_source <- o .: "source"
_gtn_strFrom <- o .:? "strFrom"
_gtn_strTo <- o .:? "strTo"
_gtn_support <- o .: "support"
_gtn_to <- o .: "to"
_gtn_weight <- o .: "weight"
pure $ GroupToNodeData{..}
data BranchToNodeData
= BranchToNodeData
{ _btn_age :: Text
, _btn_bId :: Text
, _btn_birth :: Text
, _btn_branchId :: Text
, _btn_branch_x :: Text
, _btn_branch_y :: Text
, _btn_fillcolor :: Text
, _btn_fontname :: Text
, _btn_fontsize :: Text
, _btn_size :: Text
, _btn_style :: Text
} deriving (Show, Eq, Generic)
instance ToJSON BranchToNodeData where
toJSON BranchToNodeData{..} = object [
"age" .= _btn_age
, "bId" .= _btn_bId
, "birth" .= _btn_birth
, "branchId" .= _btn_branchId
, "branch_x" .= _btn_branch_x
, "branch_y" .= _btn_branch_y
, "fillcolor" .= _btn_fillcolor
, "fontname" .= _btn_fontname
, "fontsize" .= _btn_fontsize
, "size" .= _btn_size
, "style" .= _btn_style
]
instance FromJSON BranchToNodeData where
parseJSON = withObject "BranchToNodeData" $ \o -> do
_btn_age <- o .: "age"
_btn_bId <- o .: "bId"
_btn_birth <- o .: "birth"
_btn_branchId <- o .: "branchId"
_btn_branch_x <- o .: "branch_x"
_btn_branch_y <- o .: "branch_y"
_btn_fillcolor <- o .: "fillcolor"
_btn_fontname <- o .: "fontname"
_btn_fontsize <- o .: "fontsize"
_btn_size <- o .: "size"
_btn_style <- o .: "style"
pure $ BranchToNodeData{..}
data PeriodToNodeData
= PeriodToNodeData
{ _ptn_fontsize :: Text
, _ptn_from :: Text
, _ptn_strFrom :: Maybe Text
, _ptn_strTo :: Maybe Text
, _ptn_to :: Text
} deriving (Show, Eq, Generic)
instance ToJSON PeriodToNodeData where
toJSON PeriodToNodeData{..} = object [
"fontsize" .= _ptn_fontsize
, "from" .= _ptn_from
, "strFrom" .= _ptn_strFrom
, "strTo" .= _ptn_strTo
, "to" .= _ptn_to
]
instance FromJSON PeriodToNodeData where
parseJSON = withObject "PeriodToNodeData" $ \o -> do
_ptn_fontsize <- o .: "fontsize"
_ptn_from <- o .: "from"
_ptn_strFrom <- o .:? "strFrom"
_ptn_strTo <- o .:? "strTo"
_ptn_to <- o .: "to"
pure $ PeriodToNodeData{..}
data LayerData
= LayerData {
_ld_nodes :: [Int]
} deriving (Show, Eq, Generic)
instance ToJSON LayerData where
toJSON LayerData{..} = object [
"nodes" .= toJSON _ld_nodes
]
instance FromJSON LayerData where
parseJSON = withObject "LayerData" $ \o -> do
_ld_nodes <- fromMaybe mempty <$> (o .:? "nodes")
pure $ LayerData{..}
data NodeCommonData =
NodeCommonData {
_nd_height :: !Text
, _nd_label :: !Text
, _nd_name :: !Text
, _nd_nodeType :: !Text
, _nd_pos :: !Text
, _nd_shape :: !Text
, _nd_width :: !Text
} deriving (Show, Eq, Generic)
instance ToJSON NodeCommonData where
toJSON NodeCommonData{..} = object [
"height" .= _nd_height
, "label" .= _nd_label
, "name" .= _nd_name
, "nodeType" .= _nd_nodeType
, "pos" .= _nd_pos
, "shape" .= _nd_shape
, "width" .= _nd_width
]
instance FromJSON NodeCommonData where
parseJSON = withObject "NodeCommonData" $ \o -> do
_nd_height <- o .: "height"
_nd_label <- o .: "label"
_nd_name <- o .: "name"
_nd_nodeType <- o .: "nodeType"
_nd_pos <- o .: "pos"
_nd_shape <- o .: "shape"
_nd_width <- o .: "width"
pure $ NodeCommonData{..}
data EdgeCommonData =
EdgeCommonData {
......@@ -137,6 +448,7 @@ data EdgeData
= GroupToAncestor !GvId !EdgeCommonData !GroupToAncestorData
| GroupToGroup !GvId !EdgeCommonData !GroupToGroupData
| BranchToGroup !GvId !EdgeCommonData !BranchToGroupData
| PeriodToPeriod !GvId !EdgeCommonData
deriving (Show, Eq, Generic)
data GroupToAncestorData
......@@ -173,13 +485,20 @@ $(deriveJSON (unPrefix "_phylo_Level" ) ''PhyloLevel )
$(deriveJSON (unPrefix "_phylo_Group" ) ''PhyloGroup )
instance ToJSON GraphData where
toJSON GraphData{..} = object
[ "_subgraph_cnt" .= _gd__subgraph_cnt
, "directed" .= _gd_directed
, "edges" .= _gd_edges
, "objects" .= _gd_objects
, "strict" .= _gd_strict
]
toJSON = mkGraphData
mkGraphData :: GraphData -> Value
mkGraphData GraphData{..} =
let hdrJSON = object [ "_subgraph_cnt" .= _gd__subgraph_cnt
, "directed" .= _gd_directed
, "edges" .= _gd_edges
, "objects" .= _gd_objects
, "strict" .= _gd_strict
]
datJSON = toJSON _gd_data
in case (hdrJSON, datJSON) of
(Object a, Object b) -> Object $ a <> b
_ -> panic "[Gargantext.Core.Types.Phylo.mkGraphData] impossible: header or data didn't convert back to JSON Object."
instance FromJSON GraphData where
parseJSON = withObject "GraphData" $ \o -> do
......@@ -188,6 +507,7 @@ instance FromJSON GraphData where
_gd_edges <- o .: "edges"
_gd_objects <- o .: "objects"
_gd_strict <- o .: "strict"
_gd_data <- parseJSON (Object o)
pure GraphData{..}
instance ToJSON GvId where
......@@ -198,14 +518,16 @@ instance FromJSON GvId where
instance ToJSON EdgeData where
toJSON = \case
GroupToAncestor gvid commonData edgeTypeData
-> mkNode "ancestorLink" gvid commonData edgeTypeData
-> mkEdge (Just "ancestorLink") gvid commonData edgeTypeData
GroupToGroup gvid commonData edgeTypeData
-> mkNode "link" gvid commonData edgeTypeData
-> mkEdge (Just "link") gvid commonData edgeTypeData
BranchToGroup gvid commonData edgeTypeData
-> mkNode "branchLink" gvid commonData edgeTypeData
-> mkEdge (Just "branchLink") gvid commonData edgeTypeData
PeriodToPeriod gvid commonData
-> mkEdge Nothing gvid commonData (Object mempty)
mkNode :: ToJSON a => Text -> GvId -> EdgeCommonData -> a -> Value
mkNode edgeType gvid commonData edgeTypeData =
mkEdge :: ToJSON a => Maybe Text -> GvId -> EdgeCommonData -> a -> Value
mkEdge edgeType gvid commonData edgeTypeData =
let commonDataJSON = toJSON commonData
edgeTypeDataJSON = toJSON edgeTypeData
header = object $ [ "edgeType" .= toJSON edgeType
......@@ -214,23 +536,24 @@ mkNode edgeType gvid commonData edgeTypeData =
in case (commonDataJSON, edgeTypeDataJSON, header) of
(Object hdr, Object cdJSON, Object etDataJSON)
-> Object $ hdr <> cdJSON <> etDataJSON
_ -> panic "[Gargantext.Core.Types.Phylo.mkNode] impossible: commonData, header or edgeTypeDataJSON didn't convert back to JSON Object."
_ -> panic "[Gargantext.Core.Types.Phylo.mkEdge] impossible: commonData, header or edgeTypeDataJSON didn't convert back to JSON Object."
instance FromJSON EdgeData where
parseJSON = withObject "EdgeData" $ \o -> do
edgeType <- o .: "edgeType"
edgeType <- o .:? "edgeType"
gvid <- o .: "_gvid"
_ed_color <- o .: "color"
_ed_head <- o .: "head"
_ed_pos <- o .: "pos"
_ed_tail <- o .: "tail"
_ed_width <- o .: "width"
case (edgeType :: Text) of
"ancestorLink" -> GroupToAncestor <$> pure gvid <*> pure EdgeCommonData{..} <*> parseJSON (Object o)
"link" -> GroupToGroup <$> pure gvid <*> pure EdgeCommonData{..} <*> parseJSON (Object o)
"branchLink" -> BranchToGroup <$> pure gvid <*> pure EdgeCommonData{..} <*> parseJSON (Object o)
_ -> fail $ "EdgeData: unrecognised edgeType for Phylo graph: " <> T.unpack edgeType
case (edgeType :: Maybe Text) of
Just "ancestorLink" -> GroupToAncestor <$> pure gvid <*> pure EdgeCommonData{..} <*> parseJSON (Object o)
Just "link" -> GroupToGroup <$> pure gvid <*> pure EdgeCommonData{..} <*> parseJSON (Object o)
Just "branchLink" -> BranchToGroup <$> pure gvid <*> pure EdgeCommonData{..} <*> parseJSON (Object o)
Just unknownEdgeType -> fail $ "EdgeData: unrecognised edgeType for Phylo graph: " <> T.unpack unknownEdgeType
Nothing -> pure $ PeriodToPeriod gvid EdgeCommonData{..}
instance ToJSON EdgeCommonData where
toJSON EdgeCommonData{..} = object
......@@ -307,10 +630,57 @@ instance ToSchema GvId where
declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
instance ToSchema EdgeData where
declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
instance ToSchema GraphDataData where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_gdd_")
instance ToSchema GraphData where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_gd_")
-- | Arbitrary instances
instance Arbitrary LayerData where
arbitrary = LayerData <$> arbitrary
instance Arbitrary NodeCommonData where
arbitrary = NodeCommonData <$> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
instance Arbitrary GroupToNodeData where
arbitrary = GroupToNodeData <$> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
instance Arbitrary BranchToNodeData where
arbitrary = BranchToNodeData <$> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
instance Arbitrary PeriodToNodeData where
arbitrary = PeriodToNodeData <$> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
instance Arbitrary BranchToGroupData where
arbitrary = BranchToGroupData <$> arbitrary <*> arbitrary
instance Arbitrary GroupToGroupData where
......@@ -329,7 +699,11 @@ instance Arbitrary EdgeCommonData where
<*> arbitrary
<*> arbitrary
instance Arbitrary ObjectData where
arbitrary = ObjectData <$> (String <$> arbitrary) -- temporary, it doesn't matter.
arbitrary = oneof [ GroupToNode <$> arbitrary <*> arbitrary <*> arbitrary
, BranchToNode <$> arbitrary <*> arbitrary <*> arbitrary
, PeriodToNode <$> arbitrary <*> arbitrary <*> arbitrary
, Layer <$> arbitrary <*> arbitrary <*> arbitrary
]
instance Arbitrary GvId where
arbitrary = GvId <$> arbitrary
instance Arbitrary EdgeData where
......@@ -338,8 +712,12 @@ instance Arbitrary EdgeData where
, BranchToGroup <$> arbitrary <*> arbitrary <*> arbitrary
]
instance Arbitrary GraphData where
arbitrary = GraphData <$> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
arbitrary = GraphData <$> arbitrary <*> arbitrary <*> vectorOf 10 arbitrary <*> vectorOf 10 arbitrary
<*> arbitrary <*> arbitrary
instance Arbitrary GraphDataData where
arbitrary = GraphDataData <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
<*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
<*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
<*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
<*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
<*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
This source diff could not be displayed because it is too large. You can view the blob instead.
{
"pd_data": {
"phyloSources": "[]",
"directed": true,
"phyloTimeScale": "year",
"color": "white",
"strict": false,
"lheight": "0.46",
"fontsize": "30",
"phyloGroups": "0",
"objects": [
{
"phyloSources": "[]",
"phyloTimeScale": "year",
"color": "white",
"lheight": "0.46",
"fontsize": "30",
"phyloGroups": "0",
"labelloc": "t",
"ratio": "fill",
"phyloTerms": "0",
"name": "Branches peaks",
"lwidth": "2.51",
"PhyloScale": "0.2",
"phyloFoundations": "346",
"_gvid": 0,
"label": "Phylo Name",
"rank": "same",
"lp": "142,2918.5",
"style": "filled",
"phyloQuality": "0.2253686608796909",
"bb": "0,0,284,2939",
"overlap": "scale",
"splines": "spline",
"nodesep": "1",
"phyloDocs": "313.0",
"phyloPeriods": "22",
"ranksep": "1",
"phyloBranches": "0",
"phyloSeaRiseStart": "0.1",
"phyloSeaRiseSteps": "0.1"
},
{
"phyloSources": "[]",
"phyloTimeScale": "year",
"color": "white",
"lheight": "0.46",
"fontsize": "30",
"phyloGroups": "0",
"labelloc": "t",
"ratio": "fill",
"phyloTerms": "0",
"name": "Period20002002",
"lwidth": "2.51",
"PhyloScale": "0.2",
"phyloFoundations": "346",
"_gvid": 1,
"nodes": [
23
],
"label": "Phylo Name",
"rank": "same",
"lp": "142,2918.5",
"style": "filled",
"phyloQuality": "0.2253686608796909",
"bb": "0,0,284,2939",
"overlap": "scale",
"splines": "spline",
"nodesep": "1",
"phyloDocs": "313.0",
"phyloPeriods": "22",
"ranksep": "1",
"phyloBranches": "0",
"phyloSeaRiseStart": "0.1",
"phyloSeaRiseSteps": "0.1"
},
{
"phyloSources": "[]",
"phyloTimeScale": "year",
"color": "white",
"lheight": "0.46",
"fontsize": "30",
"phyloGroups": "0",
"labelloc": "t",
"ratio": "fill",
"phyloTerms": "0",
"name": "Period20012003",
"lwidth": "2.51",
"PhyloScale": "0.2",
"phyloFoundations": "346",
"_gvid": 2,
"nodes": [
24
],
"label": "Phylo Name",
"rank": "same",
"lp": "142,2918.5",
"style": "filled",
"phyloQuality": "0.2253686608796909",
"bb": "0,0,284,2939",
"overlap": "scale",
"splines": "spline",
"nodesep": "1",
"phyloDocs": "313.0",
"phyloPeriods": "22",
"ranksep": "1",
"phyloBranches": "0",
"phyloSeaRiseStart": "0.1",
"phyloSeaRiseSteps": "0.1"
},
{
"phyloSources": "[]",
"phyloTimeScale": "year",
"color": "white",
"lheight": "0.46",
"fontsize": "30",
"phyloGroups": "0",
"labelloc": "t",
"ratio": "fill",
"phyloTerms": "0",
"name": "Period20022004",
"lwidth": "2.51",
"PhyloScale": "0.2",
"phyloFoundations": "346",
"_gvid": 3,
"nodes": [
25
],
"label": "Phylo Name",
"rank": "same",
"lp": "142,2918.5",
"style": "filled",
"phyloQuality": "0.2253686608796909",
"bb": "0,0,284,2939",
"overlap": "scale",
"splines": "spline",
"nodesep": "1",
"phyloDocs": "313.0",
"phyloPeriods": "22",
"ranksep": "1",
"phyloBranches": "0",
"phyloSeaRiseStart": "0.1",
"phyloSeaRiseSteps": "0.1"
},
{
"phyloSources": "[]",
"phyloTimeScale": "year",
"color": "white",
"lheight": "0.46",
"fontsize": "30",
"phyloGroups": "0",
"labelloc": "t",
"ratio": "fill",
"phyloTerms": "0",
"name": "Period20032005",
"lwidth": "2.51",
"PhyloScale": "0.2",
"phyloFoundations": "346",
"_gvid": 4,
"nodes": [
26
],
"label": "Phylo Name",
"rank": "same",
"lp": "142,2918.5",
"style": "filled",
"phyloQuality": "0.2253686608796909",
"bb": "0,0,284,2939",
"overlap": "scale",
"splines": "spline",
"nodesep": "1",
"phyloDocs": "313.0",
"phyloPeriods": "22",
"ranksep": "1",
"phyloBranches": "0",
"phyloSeaRiseStart": "0.1",
"phyloSeaRiseSteps": "0.1"
},
{
"phyloSources": "[]",
"phyloTimeScale": "year",
"color": "white",
"lheight": "0.46",
"fontsize": "30",
"phyloGroups": "0",
"labelloc": "t",
"ratio": "fill",
"phyloTerms": "0",
"name": "Period20042006",
"lwidth": "2.51",
"PhyloScale": "0.2",
"phyloFoundations": "346",
"_gvid": 5,
"nodes": [
27
],
"label": "Phylo Name",
"rank": "same",
"lp": "142,2918.5",
"style": "filled",
"phyloQuality": "0.2253686608796909",
"bb": "0,0,284,2939",
"overlap": "scale",
"splines": "spline",
"nodesep": "1",
"phyloDocs": "313.0",
"phyloPeriods": "22",
"ranksep": "1",
"phyloBranches": "0",
"phyloSeaRiseStart": "0.1",
"phyloSeaRiseSteps": "0.1"
},
{
"phyloSources": "[]",
"phyloTimeScale": "year",
"color": "white",
"lheight": "0.46",
"fontsize": "30",
"phyloGroups": "0",
"labelloc": "t",
"ratio": "fill",
"phyloTerms": "0",
"name": "Period20052007",
"lwidth": "2.51",
"PhyloScale": "0.2",
"phyloFoundations": "346",
"_gvid": 6,
"nodes": [
28
],
"label": "Phylo Name",
"rank": "same",
"lp": "142,2918.5",
"style": "filled",
"phyloQuality": "0.2253686608796909",
"bb": "0,0,284,2939",
"overlap": "scale",
"splines": "spline",
"nodesep": "1",
"phyloDocs": "313.0",
"phyloPeriods": "22",
"ranksep": "1",
"phyloBranches": "0",
"phyloSeaRiseStart": "0.1",
"phyloSeaRiseSteps": "0.1"
},
{
"phyloSources": "[]",
"phyloTimeScale": "year",
"color": "white",
"lheight": "0.46",
"fontsize": "30",
"phyloGroups": "0",
"labelloc": "t",
"ratio": "fill",
"phyloTerms": "0",
"name": "Period20062008",
"lwidth": "2.51",
"PhyloScale": "0.2",
"phyloFoundations": "346",
"_gvid": 7,
"nodes": [
29
],
"label": "Phylo Name",
"rank": "same",
"lp": "142,2918.5",
"style": "filled",
"phyloQuality": "0.2253686608796909",
"bb": "0,0,284,2939",
"overlap": "scale",
"splines": "spline",
"nodesep": "1",
"phyloDocs": "313.0",
"phyloPeriods": "22",
"ranksep": "1",
"phyloBranches": "0",
"phyloSeaRiseStart": "0.1",
"phyloSeaRiseSteps": "0.1"
},
{
"phyloSources": "[]",
"phyloTimeScale": "year",
"color": "white",
"lheight": "0.46",
"fontsize": "30",
"phyloGroups": "0",
"labelloc": "t",
"ratio": "fill",
"phyloTerms": "0",
"name": "Period20072009",
"lwidth": "2.51",
"PhyloScale": "0.2",
"phyloFoundations": "346",
"_gvid": 8,
"nodes": [
30
],
"label": "Phylo Name",
"rank": "same",
"lp": "142,2918.5",
"style": "filled",
"phyloQuality": "0.2253686608796909",
"bb": "0,0,284,2939",
"overlap": "scale",
"splines": "spline",
"nodesep": "1",
"phyloDocs": "313.0",
"phyloPeriods": "22",
"ranksep": "1",
"phyloBranches": "0",
"phyloSeaRiseStart": "0.1",
"phyloSeaRiseSteps": "0.1"
},
{
"phyloSources": "[]",
"phyloTimeScale": "year",
"color": "white",
"lheight": "0.46",
"fontsize": "30",
"phyloGroups": "0",
"labelloc": "t",
"ratio": "fill",
"phyloTerms": "0",
"name": "Period20082010",
"lwidth": "2.51",
"PhyloScale": "0.2",
"phyloFoundations": "346",
"_gvid": 9,
"nodes": [
31
],
"label": "Phylo Name",
"rank": "same",
"lp": "142,2918.5",
"style": "filled",
"phyloQuality": "0.2253686608796909",
"bb": "0,0,284,2939",
"overlap": "scale",
"splines": "spline",
"nodesep": "1",
"phyloDocs": "313.0",
"phyloPeriods": "22",
"ranksep": "1",
"phyloBranches": "0",
"phyloSeaRiseStart": "0.1",
"phyloSeaRiseSteps": "0.1"
},
{
"phyloSources": "[]",
"phyloTimeScale": "year",
"color": "white",
"lheight": "0.46",
"fontsize": "30",
"phyloGroups": "0",
"labelloc": "t",
"ratio": "fill",
"phyloTerms": "0",
"name": "Period20092011",
"lwidth": "2.51",
"PhyloScale": "0.2",
"phyloFoundations": "346",
"_gvid": 10,
"nodes": [
32
],
"label": "Phylo Name",
"rank": "same",
"lp": "142,2918.5",
"style": "filled",
"phyloQuality": "0.2253686608796909",
"bb": "0,0,284,2939",
"overlap": "scale",
"splines": "spline",
"nodesep": "1",
"phyloDocs": "313.0",
"phyloPeriods": "22",
"ranksep": "1",
"phyloBranches": "0",
"phyloSeaRiseStart": "0.1",
"phyloSeaRiseSteps": "0.1"
},
{
"phyloSources": "[]",
"phyloTimeScale": "year",
"color": "white",
"lheight": "0.46",
"fontsize": "30",
"phyloGroups": "0",
"labelloc": "t",
"ratio": "fill",
"phyloTerms": "0",
"name": "Period20102012",
"lwidth": "2.51",
"PhyloScale": "0.2",
"phyloFoundations": "346",
"_gvid": 11,
"nodes": [
33
],
"label": "Phylo Name",
"rank": "same",
"lp": "142,2918.5",
"style": "filled",
"phyloQuality": "0.2253686608796909",
"bb": "0,0,284,2939",
"overlap": "scale",
"splines": "spline",
"nodesep": "1",
"phyloDocs": "313.0",
"phyloPeriods": "22",
"ranksep": "1",
"phyloBranches": "0",
"phyloSeaRiseStart": "0.1",
"phyloSeaRiseSteps": "0.1"
},
{
"phyloSources": "[]",
"phyloTimeScale": "year",
"color": "white",
"lheight": "0.46",
"fontsize": "30",
"phyloGroups": "0",
"labelloc": "t",
"ratio": "fill",
"phyloTerms": "0",
"name": "Period20112013",
"lwidth": "2.51",
"PhyloScale": "0.2",
"phyloFoundations": "346",
"_gvid": 12,
"nodes": [
34
],
"label": "Phylo Name",
"rank": "same",
"lp": "142,2918.5",
"style": "filled",
"phyloQuality": "0.2253686608796909",
"bb": "0,0,284,2939",
"overlap": "scale",
"splines": "spline",
"nodesep": "1",
"phyloDocs": "313.0",
"phyloPeriods": "22",
"ranksep": "1",
"phyloBranches": "0",
"phyloSeaRiseStart": "0.1",
"phyloSeaRiseSteps": "0.1"
},
{
"phyloSources": "[]",
"phyloTimeScale": "year",
"color": "white",
"lheight": "0.46",
"fontsize": "30",
"phyloGroups": "0",
"labelloc": "t",
"ratio": "fill",
"phyloTerms": "0",
"name": "Period20122014",
"lwidth": "2.51",
"PhyloScale": "0.2",
"phyloFoundations": "346",
"_gvid": 13,
"nodes": [
35
],
"label": "Phylo Name",
"rank": "same",
"lp": "142,2918.5",
"style": "filled",
"phyloQuality": "0.2253686608796909",
"bb": "0,0,284,2939",
"overlap": "scale",
"splines": "spline",
"nodesep": "1",
"phyloDocs": "313.0",
"phyloPeriods": "22",
"ranksep": "1",
"phyloBranches": "0",
"phyloSeaRiseStart": "0.1",
"phyloSeaRiseSteps": "0.1"
},
{
"phyloSources": "[]",
"phyloTimeScale": "year",
"color": "white",
"lheight": "0.46",
"fontsize": "30",
"phyloGroups": "0",
"labelloc": "t",
"ratio": "fill",
"phyloTerms": "0",
"name": "Period20132015",
"lwidth": "2.51",
"PhyloScale": "0.2",
"phyloFoundations": "346",
"_gvid": 14,
"nodes": [
36
],
"label": "Phylo Name",
"rank": "same",
"lp": "142,2918.5",
"style": "filled",
"phyloQuality": "0.2253686608796909",
"bb": "0,0,284,2939",
"overlap": "scale",
"splines": "spline",
"nodesep": "1",
"phyloDocs": "313.0",
"phyloPeriods": "22",
"ranksep": "1",
"phyloBranches": "0",
"phyloSeaRiseStart": "0.1",
"phyloSeaRiseSteps": "0.1"
},
{
"phyloSources": "[]",
"phyloTimeScale": "year",
"color": "white",
"lheight": "0.46",
"fontsize": "30",
"phyloGroups": "0",
"labelloc": "t",
"ratio": "fill",
"phyloTerms": "0",
"name": "Period20142016",
"lwidth": "2.51",
"PhyloScale": "0.2",
"phyloFoundations": "346",
"_gvid": 15,
"nodes": [
37
],
"label": "Phylo Name",
"rank": "same",
"lp": "142,2918.5",
"style": "filled",
"phyloQuality": "0.2253686608796909",
"bb": "0,0,284,2939",
"overlap": "scale",
"splines": "spline",
"nodesep": "1",
"phyloDocs": "313.0",
"phyloPeriods": "22",
"ranksep": "1",
"phyloBranches": "0",
"phyloSeaRiseStart": "0.1",
"phyloSeaRiseSteps": "0.1"
},
{
"phyloSources": "[]",
"phyloTimeScale": "year",
"color": "white",
"lheight": "0.46",
"fontsize": "30",
"phyloGroups": "0",
"labelloc": "t",
"ratio": "fill",
"phyloTerms": "0",
"name": "Period20152017",
"lwidth": "2.51",
"PhyloScale": "0.2",
"phyloFoundations": "346",
"_gvid": 16,
"nodes": [
38
],
"label": "Phylo Name",
"rank": "same",
"lp": "142,2918.5",
"style": "filled",
"phyloQuality": "0.2253686608796909",
"bb": "0,0,284,2939",
"overlap": "scale",
"splines": "spline",
"nodesep": "1",
"phyloDocs": "313.0",
"phyloPeriods": "22",
"ranksep": "1",
"phyloBranches": "0",
"phyloSeaRiseStart": "0.1",
"phyloSeaRiseSteps": "0.1"
},
{
"phyloSources": "[]",
"phyloTimeScale": "year",
"color": "white",
"lheight": "0.46",
"fontsize": "30",
"phyloGroups": "0",
"labelloc": "t",
"ratio": "fill",
"phyloTerms": "0",
"name": "Period20162018",
"lwidth": "2.51",
"PhyloScale": "0.2",
"phyloFoundations": "346",
"_gvid": 17,
"nodes": [
39
],
"label": "Phylo Name",
"rank": "same",
"lp": "142,2918.5",
"style": "filled",
"phyloQuality": "0.2253686608796909",
"bb": "0,0,284,2939",
"overlap": "scale",
"splines": "spline",
"nodesep": "1",
"phyloDocs": "313.0",
"phyloPeriods": "22",
"ranksep": "1",
"phyloBranches": "0",
"phyloSeaRiseStart": "0.1",
"phyloSeaRiseSteps": "0.1"
},
{
"phyloSources": "[]",
"phyloTimeScale": "year",
"color": "white",
"lheight": "0.46",
"fontsize": "30",
"phyloGroups": "0",
"labelloc": "t",
"ratio": "fill",
"phyloTerms": "0",
"name": "Period20172019",
"lwidth": "2.51",
"PhyloScale": "0.2",
"phyloFoundations": "346",
"_gvid": 18,
"nodes": [
40
],
"label": "Phylo Name",
"rank": "same",
"lp": "142,2918.5",
"style": "filled",
"phyloQuality": "0.2253686608796909",
"bb": "0,0,284,2939",
"overlap": "scale",
"splines": "spline",
"nodesep": "1",
"phyloDocs": "313.0",
"phyloPeriods": "22",
"ranksep": "1",
"phyloBranches": "0",
"phyloSeaRiseStart": "0.1",
"phyloSeaRiseSteps": "0.1"
},
{
"phyloSources": "[]",
"phyloTimeScale": "year",
"color": "white",
"lheight": "0.46",
"fontsize": "30",
"phyloGroups": "0",
"labelloc": "t",
"ratio": "fill",
"phyloTerms": "0",
"name": "Period20182020",
"lwidth": "2.51",
"PhyloScale": "0.2",
"phyloFoundations": "346",
"_gvid": 19,
"nodes": [
41
],
"label": "Phylo Name",
"rank": "same",
"lp": "142,2918.5",
"style": "filled",
"phyloQuality": "0.2253686608796909",
"bb": "0,0,284,2939",
"overlap": "scale",
"splines": "spline",
"nodesep": "1",
"phyloDocs": "313.0",
"phyloPeriods": "22",
"ranksep": "1",
"phyloBranches": "0",
"phyloSeaRiseStart": "0.1",
"phyloSeaRiseSteps": "0.1"
},
{
"phyloSources": "[]",
"phyloTimeScale": "year",
"color": "white",
"lheight": "0.46",
"fontsize": "30",
"phyloGroups": "0",
"labelloc": "t",
"ratio": "fill",
"phyloTerms": "0",
"name": "Period20192021",
"lwidth": "2.51",
"PhyloScale": "0.2",
"phyloFoundations": "346",
"_gvid": 20,
"nodes": [
42
],
"label": "Phylo Name",
"rank": "same",
"lp": "142,2918.5",
"style": "filled",
"phyloQuality": "0.2253686608796909",
"bb": "0,0,284,2939",
"overlap": "scale",
"splines": "spline",
"nodesep": "1",
"phyloDocs": "313.0",
"phyloPeriods": "22",
"ranksep": "1",
"phyloBranches": "0",
"phyloSeaRiseStart": "0.1",
"phyloSeaRiseSteps": "0.1"
},
{
"phyloSources": "[]",
"phyloTimeScale": "year",
"color": "white",
"lheight": "0.46",
"fontsize": "30",
"phyloGroups": "0",
"labelloc": "t",
"ratio": "fill",
"phyloTerms": "0",
"name": "Period20202022",
"lwidth": "2.51",
"PhyloScale": "0.2",
"phyloFoundations": "346",
"_gvid": 21,
"nodes": [
43
],
"label": "Phylo Name",
"rank": "same",
"lp": "142,2918.5",
"style": "filled",
"phyloQuality": "0.2253686608796909",
"bb": "0,0,284,2939",
"overlap": "scale",
"splines": "spline",
"nodesep": "1",
"phyloDocs": "313.0",
"phyloPeriods": "22",
"ranksep": "1",
"phyloBranches": "0",
"phyloSeaRiseStart": "0.1",
"phyloSeaRiseSteps": "0.1"
},
{
"phyloSources": "[]",
"phyloTimeScale": "year",
"color": "white",
"lheight": "0.46",
"fontsize": "30",
"phyloGroups": "0",
"labelloc": "t",
"ratio": "fill",
"phyloTerms": "0",
"name": "Period20212023",
"lwidth": "2.51",
"PhyloScale": "0.2",
"phyloFoundations": "346",
"_gvid": 22,
"nodes": [
44
],
"label": "Phylo Name",
"rank": "same",
"lp": "142,2918.5",
"style": "filled",
"phyloQuality": "0.2253686608796909",
"bb": "0,0,284,2939",
"overlap": "scale",
"splines": "spline",
"nodesep": "1",
"phyloDocs": "313.0",
"phyloPeriods": "22",
"ranksep": "1",
"phyloBranches": "0",
"phyloSeaRiseStart": "0.1",
"phyloSeaRiseSteps": "0.1"
},
{
"height": "0.875",
"fontsize": "50",
"strTo": "\"2002-01-01\"",
"pos": "142,2866.5",
"name": "period20002002",
"nodeType": "period",
"_gvid": 23,
"label": "2000 2002",
"to": "2002",
"strFrom": "\"2000-01-01\"",
"from": "2000",
"width": "3.9444",
"shape": "box"
},
{
"height": "0.875",
"fontsize": "50",
"strTo": "\"2003-01-01\"",
"pos": "142,2731.5",
"name": "period20012003",
"nodeType": "period",
"_gvid": 24,
"label": "2001 2003",
"to": "2003",
"strFrom": "\"2003-01-01\"",
"from": "2001",
"width": "3.9444",
"shape": "box"
},
{
"height": "0.875",
"fontsize": "50",
"strTo": "\"2004-01-01\"",
"pos": "142,2596.5",
"name": "period20022004",
"nodeType": "period",
"_gvid": 25,
"label": "2002 2004",
"to": "2004",
"strFrom": "\"2004-01-01\"",
"from": "2002",
"width": "3.9444",
"shape": "box"
},
{
"height": "0.875",
"fontsize": "50",
"strTo": "\"2005-01-01\"",
"pos": "142,2461.5",
"name": "period20032005",
"nodeType": "period",
"_gvid": 26,
"label": "2003 2005",
"to": "2005",
"strFrom": "\"2005-01-01\"",
"from": "2003",
"width": "3.9444",
"shape": "box"
},
{
"height": "0.875",
"fontsize": "50",
"strTo": "\"2006-01-01\"",
"pos": "142,2326.5",
"name": "period20042006",
"nodeType": "period",
"_gvid": 27,
"label": "2004 2006",
"to": "2006",
"strFrom": "\"2006-01-01\"",
"from": "2004",
"width": "3.9444",
"shape": "box"
},
{
"height": "0.875",
"fontsize": "50",
"strTo": "\"\"",
"pos": "142,2191.5",
"name": "period20052007",
"nodeType": "period",
"_gvid": 28,
"label": "2005 2007",
"to": "2007",
"strFrom": "\"\"",
"from": "2005",
"width": "3.9444",
"shape": "box"
},
{
"height": "0.875",
"fontsize": "50",
"strTo": "\"2008-01-01\"",
"pos": "142,2056.5",
"name": "period20062008",
"nodeType": "period",
"_gvid": 29,
"label": "2006 2008",
"to": "2008",
"strFrom": "\"2008-01-01\"",
"from": "2006",
"width": "3.9444",
"shape": "box"
},
{
"height": "0.875",
"fontsize": "50",
"strTo": "\"2009-01-01\"",
"pos": "142,1921.5",
"name": "period20072009",
"nodeType": "period",
"_gvid": 30,
"label": "2007 2009",
"to": "2009",
"strFrom": "\"2009-01-01\"",
"from": "2007",
"width": "3.9444",
"shape": "box"
},
{
"height": "0.875",
"fontsize": "50",
"strTo": "\"2010-01-01\"",
"pos": "142,1786.5",
"name": "period20082010",
"nodeType": "period",
"_gvid": 31,
"label": "2008 2010",
"to": "2010",
"strFrom": "\"2010-01-01\"",
"from": "2008",
"width": "3.9444",
"shape": "box"
},
{
"height": "0.875",
"fontsize": "50",
"strTo": "\"2011-01-01\"",
"pos": "142,1651.5",
"name": "period20092011",
"nodeType": "period",
"_gvid": 32,
"label": "2009 2011",
"to": "2011",
"strFrom": "\"2011-01-01\"",
"from": "2009",
"width": "3.9444",
"shape": "box"
},
{
"height": "0.875",
"fontsize": "50",
"strTo": "\"2012-01-01\"",
"pos": "142,1516.5",
"name": "period20102012",
"nodeType": "period",
"_gvid": 33,
"label": "2010 2012",
"to": "2012",
"strFrom": "\"2012-01-01\"",
"from": "2010",
"width": "3.9444",
"shape": "box"
},
{
"height": "0.875",
"fontsize": "50",
"strTo": "\"2013-01-01\"",
"pos": "142,1381.5",
"name": "period20112013",
"nodeType": "period",
"_gvid": 34,
"label": "2011 2013",
"to": "2013",
"strFrom": "\"2013-01-01\"",
"from": "2011",
"width": "3.9444",
"shape": "box"
},
{
"height": "0.875",
"fontsize": "50",
"strTo": "\"2014-01-01\"",
"pos": "142,1246.5",
"name": "period20122014",
"nodeType": "period",
"_gvid": 35,
"label": "2012 2014",
"to": "2014",
"strFrom": "\"2014-01-01\"",
"from": "2012",
"width": "3.9444",
"shape": "box"
},
{
"height": "0.875",
"fontsize": "50",
"strTo": "\"2015-01-01\"",
"pos": "142,1111.5",
"name": "period20132015",
"nodeType": "period",
"_gvid": 36,
"label": "2013 2015",
"to": "2015",
"strFrom": "\"2015-01-01\"",
"from": "2013",
"width": "3.9444",
"shape": "box"
},
{
"height": "0.875",
"fontsize": "50",
"strTo": "\"2016-01-01\"",
"pos": "142,976.5",
"name": "period20142016",
"nodeType": "period",
"_gvid": 37,
"label": "2014 2016",
"to": "2016",
"strFrom": "\"2016-01-01\"",
"from": "2014",
"width": "3.9444",
"shape": "box"
},
{
"height": "0.875",
"fontsize": "50",
"strTo": "\"2017-01-01\"",
"pos": "142,841.5",
"name": "period20152017",
"nodeType": "period",
"_gvid": 38,
"label": "2015 2017",
"to": "2017",
"strFrom": "\"2017-01-01\"",
"from": "2015",
"width": "3.9444",
"shape": "box"
},
{
"height": "0.875",
"fontsize": "50",
"strTo": "\"2018-01-01\"",
"pos": "142,706.5",
"name": "period20162018",
"nodeType": "period",
"_gvid": 39,
"label": "2016 2018",
"to": "2018",
"strFrom": "\"2018-01-01\"",
"from": "2016",
"width": "3.9444",
"shape": "box"
},
{
"height": "0.875",
"fontsize": "50",
"strTo": "\"2019-01-01\"",
"pos": "142,571.5",
"name": "period20172019",
"nodeType": "period",
"_gvid": 40,
"label": "2017 2019",
"to": "2019",
"strFrom": "\"2019-01-01\"",
"from": "2017",
"width": "3.9444",
"shape": "box"
},
{
"height": "0.875",
"fontsize": "50",
"strTo": "\"2020-01-01\"",
"pos": "142,436.5",
"name": "period20182020",
"nodeType": "period",
"_gvid": 41,
"label": "2018 2020",
"to": "2020",
"strFrom": "\"2020-01-01\"",
"from": "2018",
"width": "3.9444",
"shape": "box"
},
{
"height": "0.875",
"fontsize": "50",
"strTo": "\"2021-01-01\"",
"pos": "142,301.5",
"name": "period20192021",
"nodeType": "period",
"_gvid": 42,
"label": "2019 2021",
"to": "2021",
"strFrom": "\"2021-01-01\"",
"from": "2019",
"width": "3.9444",
"shape": "box"
},
{
"height": "0.875",
"fontsize": "50",
"strTo": "\"2022-01-01\"",
"pos": "142,166.5",
"name": "period20202022",
"nodeType": "period",
"_gvid": 43,
"label": "2020 2022",
"to": "2022",
"strFrom": "\"2022-01-01\"",
"from": "2020",
"width": "3.9444",
"shape": "box"
},
{
"height": "0.875",
"fontsize": "50",
"strTo": "\"2023-01-01\"",
"pos": "142,31.5",
"name": "period20212023",
"nodeType": "period",
"_gvid": 44,
"label": "2021 2023",
"to": "2023",
"strFrom": "\"2023-01-01\"",
"from": "2021",
"width": "3.9444",
"shape": "box"
}
],
"labelloc": "t",
"ratio": "fill",
"phyloTerms": "0",
"name": "Phylo Name",
"lwidth": "2.51",
"PhyloScale": "0.2",
"phyloFoundations": "346",
"label": "Phylo Name",
"rank": "same",
"lp": "142,2918.5",
"style": "filled",
"phyloQuality": "0.2253686608796909",
"bb": "0,0,284,2939",
"overlap": "scale",
"splines": "spline",
"nodesep": "1",
"_subgraph_cnt": 23,
"phyloDocs": "313.0",
"phyloPeriods": "22",
"ranksep": "1",
"phyloBranches": "0",
"edges": [
{
"color": "black",
"head": 24,
"pos": "e,142,2763.3 142,2835 142,2816.7 142,2793.2 142,2773.3",
"tail": 23,
"_gvid": 0,
"width": "5"
},
{
"color": "black",
"head": 25,
"pos": "e,142,2628.3 142,2700 142,2681.7 142,2658.2 142,2638.3",
"tail": 24,
"_gvid": 1,
"width": "5"
},
{
"color": "black",
"head": 26,
"pos": "e,142,2493.3 142,2565 142,2546.7 142,2523.2 142,2503.3",
"tail": 25,
"_gvid": 2,
"width": "5"
},
{
"color": "black",
"head": 27,
"pos": "e,142,2358.3 142,2430 142,2411.7 142,2388.2 142,2368.3",
"tail": 26,
"_gvid": 3,
"width": "5"
},
{
"color": "black",
"head": 28,
"pos": "e,142,2223.3 142,2295 142,2276.7 142,2253.2 142,2233.3",
"tail": 27,
"_gvid": 4,
"width": "5"
},
{
"color": "black",
"head": 29,
"pos": "e,142,2088.3 142,2160 142,2141.7 142,2118.2 142,2098.3",
"tail": 28,
"_gvid": 5,
"width": "5"
},
{
"color": "black",
"head": 30,
"pos": "e,142,1953.3 142,2025 142,2006.7 142,1983.2 142,1963.3",
"tail": 29,
"_gvid": 6,
"width": "5"
},
{
"color": "black",
"head": 31,
"pos": "e,142,1818.3 142,1890 142,1871.7 142,1848.2 142,1828.3",
"tail": 30,
"_gvid": 7,
"width": "5"
},
{
"color": "black",
"head": 32,
"pos": "e,142,1683.3 142,1755 142,1736.7 142,1713.2 142,1693.3",
"tail": 31,
"_gvid": 8,
"width": "5"
},
{
"color": "black",
"head": 33,
"pos": "e,142,1548.3 142,1620 142,1601.7 142,1578.2 142,1558.3",
"tail": 32,
"_gvid": 9,
"width": "5"
},
{
"color": "black",
"head": 34,
"pos": "e,142,1413.3 142,1485 142,1466.7 142,1443.2 142,1423.3",
"tail": 33,
"_gvid": 10,
"width": "5"
},
{
"color": "black",
"head": 35,
"pos": "e,142,1278.3 142,1350 142,1331.7 142,1308.2 142,1288.3",
"tail": 34,
"_gvid": 11,
"width": "5"
},
{
"color": "black",
"head": 36,
"pos": "e,142,1143.3 142,1215 142,1196.7 142,1173.2 142,1153.3",
"tail": 35,
"_gvid": 12,
"width": "5"
},
{
"color": "black",
"head": 37,
"pos": "e,142,1008.3 142,1080 142,1061.7 142,1038.2 142,1018.3",
"tail": 36,
"_gvid": 13,
"width": "5"
},
{
"color": "black",
"head": 38,
"pos": "e,142,873.33 142,944.99 142,926.7 142,903.22 142,883.35",
"tail": 37,
"_gvid": 14,
"width": "5"
},
{
"color": "black",
"head": 39,
"pos": "e,142,738.33 142,809.99 142,791.7 142,768.22 142,748.35",
"tail": 38,
"_gvid": 15,
"width": "5"
},
{
"color": "black",
"head": 40,
"pos": "e,142,603.33 142,674.99 142,656.7 142,633.22 142,613.35",
"tail": 39,
"_gvid": 16,
"width": "5"
},
{
"color": "black",
"head": 41,
"pos": "e,142,468.33 142,539.99 142,521.7 142,498.22 142,478.35",
"tail": 40,
"_gvid": 17,
"width": "5"
},
{
"color": "black",
"head": 42,
"pos": "e,142,333.33 142,404.99 142,386.7 142,363.22 142,343.35",
"tail": 41,
"_gvid": 18,
"width": "5"
},
{
"color": "black",
"head": 43,
"pos": "e,142,198.33 142,269.99 142,251.7 142,228.22 142,208.35",
"tail": 42,
"_gvid": 19,
"width": "5"
},
{
"color": "black",
"head": 44,
"pos": "e,142,63.331 142,134.99 142,116.7 142,93.22 142,73.348",
"tail": 43,
"_gvid": 20,
"width": "5"
}
],
"phyloSeaRiseStart": "0.1",
"phyloSeaRiseSteps": "0.1"
},
"pd_listId": 185785,
"pd_corpusId": 185783
}
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