# Using graph actions") test_that("actions can be added to a graph object", { # Create an empty graph object graph <- create_graph() # Add a graph action that sets a node # attr column with a function; the # main function `set_node_attr_w_fcn()` # uses the `get_betweenness()` function # to provide betweenness values in the # `btwns` column graph <- graph %>% add_graph_action( fcn = "set_node_attr_w_fcn", node_attr_fcn = "get_betweenness", column_name = "btwns", action_name = "get_btwns") # Expect a `data.frame` object with in # `graph$graph_actions` expect_s3_class( graph$graph_actions, "data.frame") # Extract `graph$graph_actions` to a # separate object graph_actions <- graph$graph_actions # Expect a single row in the data frame expect_equal( nrow(graph_actions), 1) # Expect three columns in the data frame expect_equal( ncol(graph_actions), 3) # Expect certain column names in the # data frame object expect_equal( colnames(graph_actions), c("action_index", "action_name", "expression")) # Expect the `action_index` to be 1 expect_equal( graph_actions$action_index, 1) # Expect the `action_name` to be `get_btwns` expect_equal( graph_actions$action_name, "get_btwns") # Expect the action in the data frame to # be correctly generated expect_equal( graph_actions$expression, "set_node_attr_w_fcn(graph = graph, node_attr_fcn = 'get_betweenness', column_name = 'btwns')") }) test_that("actions can be deleted from a graph object", { # Create an empty graph object graph <- create_graph() # Expect an error when trying to # delete graph actions and none exist expect_error( graph %>% delete_graph_actions( actions = 1)) # Add three graph actions to the # graph graph <- graph %>% add_graph_action( fcn = "set_node_attr_w_fcn", node_attr_fcn = "get_pagerank", column_name = "pagerank", action_name = "get_pagerank") %>% add_graph_action( fcn = "rescale_node_attrs", node_attr_from = "pagerank", node_attr_to = "width", action_name = "pagerank_to_width") %>% add_graph_action( fcn = "colorize_node_attrs", node_attr_from = "width", node_attr_to = "fillcolor", action_name = "pagerank_fillcolor") n_graph_actions_before_deletion <- nrow(graph$graph_actions) # Delete two of the graph actions graph_delete_2 <- graph %>% delete_graph_actions( actions = c(2, 3)) # Expect that one graph action remains # Expect a single row in the data frame expect_equal( nrow(graph_delete_2$graph_actions), n_graph_actions_before_deletion - 2) # Expect that the first graph action # remains in the graph # Expect the `action_index` to be 1 expect_equal( graph_delete_2$graph_actions$action_index, 1) # Expect the `action_name` to be `get_btwns` expect_equal( graph_delete_2$graph_actions$action_name, "get_pagerank") # Expect the action in the data frame to # be correctly generated expect_equal( graph_delete_2$graph_actions$expression, "set_node_attr_w_fcn(graph = graph, node_attr_fcn = 'get_pagerank', column_name = 'pagerank')") # Delete two of the graph actions by # their `action_name` values graph_delete_2_by_name <- graph %>% delete_graph_actions( actions = c("pagerank_to_width", "pagerank_fillcolor")) # Expect that one graph action remains # Expect a single row in the data frame expect_equal( nrow(graph_delete_2_by_name$graph_actions), n_graph_actions_before_deletion - 2) # Expect that the first graph action # remains in the graph # Expect the `action_index` to be 1 expect_equal( graph_delete_2_by_name$graph_actions$action_index, 1) # Expect the `action_name` to be `get_btwns` expect_equal( graph_delete_2_by_name$graph_actions$action_name, "get_pagerank") # Expect the action in the data frame to # be correctly generated expect_equal( graph_delete_2_by_name$graph_actions$expression, "set_node_attr_w_fcn(graph = graph, node_attr_fcn = 'get_pagerank', column_name = 'pagerank')") }) test_that("actions within a graph object can be reordered", { # Create an empty graph object graph <- create_graph() # Add three graph actions to the # graph graph <- graph %>% add_graph_action( fcn = "set_node_attr_w_fcn", node_attr_fcn = "get_pagerank", column_name = "pagerank", action_name = "get_pagerank") %>% add_graph_action( fcn = "rescale_node_attrs", node_attr_from = "pagerank", node_attr_to = "width", action_name = "pagerank_to_width") %>% add_graph_action( fcn = "colorize_node_attrs", node_attr_from = "width", node_attr_to = "fillcolor", action_name = "pagerank_fillcolor") # Get the names of the graph actions # before the reordering occurs names_of_graph_actions_before_reordering <- graph$graph_actions$action_name # Reorder the graph actions so that `2`, # precedes `3`, which precedes `1` graph <- graph %>% reorder_graph_actions( indices = c(2, 3, 1)) # Expect three graph actions in the # graph object expect_equal( nrow(graph$graph_actions), 3) # Get the names of the graph actions # before the reordering occurs names_of_graph_actions_after_reordering <- graph$graph_actions$action_name # Expect that the graph action names # appear in the order according to the # vector provided as `indices` expect_equal( names_of_graph_actions_after_reordering, names_of_graph_actions_before_reordering[c(2, 3, 1)]) }) test_that("graph actions can be triggered to modify the graph", { # Create a random graph graph <- create_graph() %>% add_gnm_graph( n = 5, m = 10, set_seed = 23) # Add three graph actions to: # - add PageRank values # - rescale PageRank values # - create a `fillcolor` attr # ...then, manually trigger the # actions to perform evaluation graph <- graph %>% add_graph_action( fcn = "set_node_attr_w_fcn", node_attr_fcn = "get_pagerank", column_name = "pagerank", action_name = "get_pagerank") %>% add_graph_action( fcn = "rescale_node_attrs", node_attr_from = "pagerank", node_attr_to = "width", action_name = "pgrnk_to_width") %>% add_graph_action( fcn = "colorize_node_attrs", node_attr_from = "width", node_attr_to = "fillcolor", action_name = "pgrnk_fillcolor") %>% trigger_graph_actions() # Expect certain columns to be available # in the graph's internal node data frame expect_named( graph$nodes_df, c("id", "type", "label", "pagerank", "width", "fillcolor")) # Expect the `pagerank` column to have # numeric values less than 1 expect_type( graph$nodes_df$pagerank, "double") expect_true( all(graph$nodes_df$pagerank <= 1)) # Expect the `width` column to have # numeric values less than 1 expect_type( graph$nodes_df$width, "double") expect_true( all(graph$nodes_df$width <= 1)) # Expect the `fillcolor` column to have # character values with color codes expect_type( graph$nodes_df$fillcolor, "character") expect_match( graph$nodes_df$fillcolor, "#[A-F0-9]*" ) # Expect a warning if using the # `trigger_graph_actions()` function # when there are no graph actions expect_message( create_graph() %>% trigger_graph_actions()) })