From b7591ee9de72d452f42eea7b85d51f7b60500064 Mon Sep 17 00:00:00 2001 From: olivroy Date: Thu, 16 Nov 2023 08:05:42 -0500 Subject: [PATCH] Remove tibble warnings in `render_graph()` --- NEWS.md | 2 +- R/render_graph.R | 669 +++++++++++++++-------------- man/render_graph.Rd | 77 ++-- tests/testthat/test-render_graph.R | 56 ++- 4 files changed, 444 insertions(+), 360 deletions(-) diff --git a/NEWS.md b/NEWS.md index 13bcfae65..0e842ffcb 100755 --- a/NEWS.md +++ b/NEWS.md @@ -2,7 +2,7 @@ * DiagrammeR nows uses testthat 3rd edition (@olivroy, #498) -* No longer use deprecated features from igraph and tidyselect (>= 1.2.0) (@olivroy, #497) +* No longer use deprecated features from tibble, igraph and tidyselect (>= 1.2.0) (@olivroy, #497, #507) * Error messages have been reviewed and now use cli (@olivroy, #499, #502) diff --git a/R/render_graph.R b/R/render_graph.R index 3dd6ee268..513d64a05 100644 --- a/R/render_graph.R +++ b/R/render_graph.R @@ -20,45 +20,52 @@ #' @examples #' if (interactive()) { #' -#' # Render a graph that's a -#' # balanced tree -#' create_graph() %>% -#' add_balanced_tree( -#' k = 2, h = 3) %>% -#' render_graph() +#' # Render a graph that's a +#' # balanced tree +#' create_graph() %>% +#' add_balanced_tree( +#' k = 2, h = 3 +#' ) %>% +#' render_graph() #' -#' # Use the `tree` layout for -#' # better node placement in this -#' # hierarchical graph -#' create_graph() %>% -#' add_balanced_tree( -#' k = 2, h = 3) %>% -#' render_graph(layout = "tree") +#' # Use the `tree` layout for +#' # better node placement in this +#' # hierarchical graph +#' create_graph() %>% +#' add_balanced_tree( +#' k = 2, h = 3 +#' ) %>% +#' render_graph(layout = "tree") #' -#' # Plot the same tree graph but -#' # don't show the node ID values -#' create_graph() %>% -#' add_balanced_tree( -#' k = 2, h = 3) %>% -#' set_node_attr_to_display() %>% -#' render_graph(layout = "tree") +#' # Plot the same tree graph but +#' # don't show the node ID values +#' create_graph() %>% +#' add_balanced_tree( +#' k = 2, h = 3 +#' ) %>% +#' set_node_attr_to_display() %>% +#' render_graph(layout = "tree") #' -#' # Create a circle graph -#' create_graph() %>% -#' add_gnm_graph( -#' n = 55, -#' m = 75, -#' set_seed = 23) %>% -#' render_graph( -#' layout = "circle") +#' # Create a circle graph +#' create_graph() %>% +#' add_gnm_graph( +#' n = 55, +#' m = 75, +#' set_seed = 23 +#' ) %>% +#' render_graph( +#' layout = "circle" +#' ) #' -#' # Render the graph using the -#' # `visNetwork` output option -#' create_graph() %>% -#' add_balanced_tree( -#' k = 2, h = 3) %>% -#' render_graph( -#' output = "visNetwork") +#' # Render the graph using the +#' # `visNetwork` output option +#' create_graph() %>% +#' add_balanced_tree( +#' k = 2, h = 3 +#' ) %>% +#' render_graph( +#' output = "visNetwork" +#' ) #' } #' #' @family Display and Save @@ -79,325 +86,343 @@ render_graph <- function( output <- output %||% "graph" - if (output == "graph") { + # Not allowing partial matching. + output <- rlang::arg_match0(output, c("graph", "visNetwork")) + # Check layout is a single string or NULL + check_string(layout, allow_null = TRUE) - if (!is.null(title)) { + if (!is.null(layout)) { + rlang::arg_match0(layout, c("circle", "tree", "kk", "fr", "nicely")) + } - graph <- add_global_graph_attrs(graph, "label", title, "graph") - graph <- add_global_graph_attrs(graph, "labelloc", "t", "graph") - graph <- add_global_graph_attrs(graph, "labeljust", "c", "graph") - graph <- add_global_graph_attrs(graph, "fontname", "Helvetica", "graph") - graph <- add_global_graph_attrs(graph, "fontcolor", "gray30", "graph") - } + # Return early if output is visNetwork. + if (output == "visNetwork") { + return(visnetwork(graph)) + } - # If no fillcolor provided, use default; if no default available, use white - if (nrow(graph$nodes_df) > 0) { - if (!("fillcolor" %in% colnames(graph$nodes_df))) { - if ("fillcolor" %in% graph$global_attrs$attr) { - - graph$nodes_df$fillcolor <- - graph$global_attrs %>% - dplyr::filter(attr == "fillcolor" & attr_type == "node") %>% - dplyr::select("value") %>% - purrr::flatten_chr() - } else { - graph$nodes_df$fillcolor <- "white" - } - } - } + # output = "graph" code with out = grViz - # If fillcolor is available and there are NA values, - # replace NAs with default color if available - if (nrow(graph$nodes_df) > 0) { - if ("fillcolor" %in% colnames(graph$nodes_df)) { - if ("fillcolor" %in% graph$global_attrs$attr) { + # Add title as attribute + if (!is.null(title)) { - graph$nodes_df$fillcolor[which(is.na(graph$nodes_df$fillcolor))] <- - graph$global_attrs[which(graph$global_attrs$attr == "fillcolor"), 2] - } - } - } + graph <- add_global_graph_attrs(graph, "label", title, "graph") + graph <- add_global_graph_attrs(graph, "labelloc", "t", "graph") + graph <- add_global_graph_attrs(graph, "labeljust", "c", "graph") + graph <- add_global_graph_attrs(graph, "fontname", "Helvetica", "graph") + graph <- add_global_graph_attrs(graph, "fontcolor", "gray30", "graph") + } - # Translate X11 colors to hexadecimal colors - if ("fillcolor" %in% colnames(graph$nodes_df)) { - - graph$nodes_df <- - graph$nodes_df %>% - dplyr::left_join( - x11_hex() %>% - dplyr::as_tibble() %>% - dplyr::mutate(hex = toupper(hex)), - by = c("fillcolor" = "x11_name")) %>% - dplyr::mutate( - fillcolor = dplyr::coalesce(hex, fillcolor), - .keep = "unused") - } + # If no fillcolor provided, use default; if no default available, use white + if (nrow(graph$nodes_df) > 0 && + !("fillcolor" %in% colnames(graph$nodes_df))) { - # Use adaptive font coloring for nodes that have a fill color - if (!("fontcolor" %in% colnames(graph$nodes_df)) & - "fillcolor" %in% colnames(graph$nodes_df)) { + if ("fillcolor" %in% graph$global_attrs$attr) { - graph$nodes_df$fontcolor <- - tibble::tibble(value = graph$nodes_df$fillcolor) %>% - dplyr::mutate(value_x = contrasting_text_color(background_color = value)) %>% - dplyr::pull(value_x) + graph$nodes_df$fillcolor <- + graph$global_attrs %>% + dplyr::filter(attr == "fillcolor", attr_type == "node") %>% + dplyr::pull("value") %>% + as.character() + } else { + graph$nodes_df$fillcolor <- "white" } + } - if (!is.null(layout)) { - if (layout %in% c("circle", "tree", "kk", "fr", "nicely")) { - - graph <- - graph %>% - add_global_graph_attrs( - attr = "layout", - value = "neato", - attr_type = "graph") - - if ("x" %in% colnames(graph$nodes_df)) { - graph$nodes_df <- - graph$nodes_df %>% - dplyr::select(-x) - } - - if ("y" %in% colnames(graph$nodes_df)) { - graph$nodes_df <- - graph$nodes_df %>% - dplyr::select(-y) - } - - if (layout == "circle") { - coords <- - graph %>% - to_igraph() %>% - igraph::layout_in_circle() %>% - dplyr::as_tibble(.name_repair = "unique") %>% - purrr::set_names(c("x", "y")) %>% - # created a test in test-render_graph to avoid tibble deprecation warning - # as_tibble.matrix must have name repair present. - # dplyr::rename(x = V1, y = V2) %>% - dplyr::mutate(x = x * (((count_nodes(graph) + (0.25 * count_nodes(graph)))) / count_nodes(graph))) %>% - dplyr::mutate(y = y * (((count_nodes(graph) + (0.25 * count_nodes(graph)))) / count_nodes(graph))) - } - - if (layout == "tree") { - coords <- - (graph %>% - to_igraph() %>% - igraph::layout_with_sugiyama())[[2]] %>% - dplyr::as_tibble(.name_repair = function(x) c("x", "y")) - } - - if (layout == "kk") { - coords <- - graph %>% - to_igraph() %>% - igraph::layout_with_kk() %>% - dplyr::as_tibble() %>% - dplyr::rename(x = V1, y = V2) - } - - if (layout == "fr") { - coords <- - graph %>% - to_igraph() %>% - igraph::layout_with_fr() %>% - dplyr::as_tibble() %>% - dplyr::rename(x = V1, y = V2) - } - - if (layout == "nicely") { - coords <- - graph %>% - to_igraph() %>% - igraph::layout_nicely() %>% - dplyr::as_tibble() %>% - dplyr::rename(x = V1, y = V2) - } - - # Bind (x, y) coordinates to the graph's - # internal NDF - graph$nodes_df <- - graph$nodes_df %>% - dplyr::bind_cols(coords) - } - } + # If fillcolor is available and there are NA values, + # replace NAs with default color if available + if (nrow(graph$nodes_df) > 0 && + rlang::has_name(graph$nodes_df, "fillcolor") && + "fillcolor" %in% graph$global_attrs$attr) { - if ("image" %in% colnames(graph %>% get_node_df()) || - "fa_icon" %in% colnames(graph %>% get_node_df()) || - as_svg) { - if (as_svg && !rlang::is_installed("DiagrammeRsvg")) { - rlang::inform("Use `as_svg = FALSE` if you don't want to install DiagrammeRsvg.") - } + graph$nodes_df$fillcolor[which(is.na(graph$nodes_df$fillcolor))] <- + graph$global_attrs[which(graph$global_attrs$attr == "fillcolor"), 2] + } - # Stop function if `DiagrammeRsvg` package is not available - rlang::check_installed("DiagrammeRsvg", "to render the graph to SVG.") + # Translate X11 colors to hexadecimal colors + if ("fillcolor" %in% colnames(graph$nodes_df)) { + + graph$nodes_df <- + graph$nodes_df %>% + dplyr::left_join( + x11_hex() %>% + dplyr::as_tibble() %>% + dplyr::mutate(hex = toupper(hex)), + by = c("fillcolor" = "x11_name") + ) %>% + dplyr::mutate( + fillcolor = dplyr::coalesce(hex, fillcolor), + .keep = "unused" + ) + } - # Generate DOT code - dot_code <- generate_dot(graph) + # Use adaptive font coloring for nodes that have a fill color + if ("fillcolor" %in% colnames(graph$nodes_df) && + !"fontcolor" %in% colnames(graph$nodes_df) + ) { - # Get a vector of SVG lines - svg_vec <- - strsplit(DiagrammeRsvg::export_svg( - grViz(diagram = dot_code)), "\n") %>% - unlist() + graph$nodes_df$fontcolor <- + tibble::tibble(value = graph$nodes_df$fillcolor) %>% + dplyr::mutate(value_x = contrasting_text_color(background_color = value)) %>% + dplyr::pull("value_x") + } - # create display to make return work when `as_svg = TRUE` #482 - display <- grViz(diagram = dot_code, width = width, height = height) + # Modify nodes df if a specific layout is requested. + # and is one of the accepted values ("circle", "tree", "kk", "fr", "nicely") + if (!is.null(layout)) { + + graph <- + add_global_graph_attrs( + graph, + attr = "layout", + value = "neato", + attr_type = "graph" + ) + + # Remove existing x and y columns in nodes_df + # to replace them with the layout coords + if ("x" %in% colnames(graph$nodes_df)) { + graph$nodes_df$x <- NULL + } - # Get a tibble of SVG data - svg_tbl <- get_svg_tbl(svg_vec) + if ("y" %in% colnames(graph$nodes_df)) { + graph$nodes_df$y <- NULL + } - svg_lines <- - "% + igraph::layout_with_sugiyama() + m_coords <- m_coords[["layout"]] - svg_line_no <- svg_tbl %>% - dplyr::filter(type == "svg") %>% - dplyr::pull("index") + # Safety + if (!is.matrix(m_coords) && nrow(m_coords) == 0) { - # Modify attrs - svg_vec[svg_line_no] <- svg_lines + cli::cli_abort("The tree coords should be a matrix", .internal = TRUE) + } - if ("image" %in% colnames(graph %>% get_node_df())) { + coords <- data.frame( + x = m_coords[, 1], + y = m_coords[, 2], + stringsAsFactors = FALSE + ) + } else { + # Simple cases using defaults for kk, fr, nicely, and circle. + fn_igraph <- switch(layout, + "kk" = igraph::layout_with_kk, + "fr" = igraph::layout_with_fr, + "nicely" = igraph::layout_nicely, + "circle" = igraph::layout_in_circle + ) + + m_coords <- graph %>% + to_igraph() %>% + fn_igraph() + + if (!is.matrix(m_coords)) { + cli::cli_abort("The {.val {layout}} coords should be a matrix", .internal = TRUE) + } - node_id_images <- - graph %>% - get_node_df() %>% - dplyr::select("id", "image") %>% - dplyr::filter(nzchar(image)) %>% - dplyr::pull("id") + coords <- data.frame( + x = m_coords[, 1], + y = m_coords[, 2], + stringsAsFactors = FALSE + ) + } - filter_lines <- - graph %>% - get_node_df() %>% - dplyr::select("id", "image") %>% - dplyr::filter(nzchar(image)) %>% - dplyr::mutate(filter_lines = as.character(glue::glue(""))) %>% - dplyr::pull("filter_lines") %>% - paste(collapse = "\n") + # Corrections for layout = "circle" + if (layout == "circle") { + n_nodes <- count_nodes(graph) + + if (n_nodes == 0) { + cli::cli_warn("No nodes exist? in the circle graph?") + coords$x <- NaN + coords$y <- NaN + } else { + # Previously as x * (count_nodes(graph) + (0.25 * count_nodes(graph))) / count_nodes(graph) + # which can be simplified to x * 1.25? if n_nodes > 0 + # coords$x <- coords$x * (n_nodes + 0.25 * n_nodes) / n_nodes + coords$x <- coords$x * 1.25 + coords$y <- coords$y * 1.25 + } - filter_shape_refs <- as.character(glue::glue(" filter=\"url(#{node_id_images})\" ")) + } + # Bind (x, y) coordinates to the graph's + # internal NDF + graph$nodes_df <- + dplyr::bind_cols(graph$nodes_df, coords) + } - svg_shape_nos <- - svg_tbl %>% - dplyr::filter(node_id %in% node_id_images) %>% - dplyr::filter(type == "node_block") %>% - dplyr::pull("index") + if (as_svg || any(c("image", "fa_icon") %in% colnames(get_node_df(graph)))) { - svg_shape_nos <- svg_shape_nos + 3 - svg_text_nos <- svg_shape_nos + 1 + if (as_svg && !rlang::is_installed("DiagrammeRsvg")) { + rlang::inform("Use `as_svg = FALSE` if you don't want to install DiagrammeRsvg.") + } - # Modify shape lines - for (i in seq(node_id_images)) { + # Stop function if `DiagrammeRsvg` package is not available + rlang::check_installed("DiagrammeRsvg", "to render the graph to SVG.") + + # Generate DOT code + dot_code <- generate_dot(graph) + + # create display to make return work when `as_svg = TRUE` #482 + display <- grViz(diagram = dot_code, width = width, height = height) + + # Get a vector of SVG lines + svg_vec <- + strsplit(DiagrammeRsvg::export_svg( + grViz(diagram = dot_code) + ), "\n") %>% + unlist() + + # Get a tibble of SVG data + svg_tbl <- get_svg_tbl(svg_vec) + + svg_lines <- + "% + dplyr::filter(type == "svg") %>% + dplyr::pull("index") + + # Modify attrs + svg_vec[svg_line_no] <- svg_lines + + if ("image" %in% colnames(graph %>% get_node_df())) { + node_id_images <- + graph %>% + get_node_df() %>% + dplyr::select("id", "image") %>% + dplyr::filter(nzchar(image)) %>% + dplyr::pull("id") + + filter_lines <- + graph %>% + get_node_df() %>% + dplyr::select("id", "image") %>% + dplyr::filter(nzchar(image)) %>% + dplyr::mutate(filter_lines = as.character(glue::glue(""))) %>% + dplyr::pull("filter_lines") %>% + paste(collapse = "\n") + + filter_shape_refs <- as.character(glue::glue(" filter=\"url(#{node_id_images})\" ")) + + svg_shape_nos <- + svg_tbl %>% + dplyr::filter(node_id %in% node_id_images) %>% + dplyr::filter(type == "node_block") %>% + dplyr::pull("index") - svg_vec[svg_shape_nos[i]] <- - sub(" ", paste0(filter_shape_refs[i]), svg_vec[svg_shape_nos[i]]) + svg_shape_nos <- svg_shape_nos + 3 + svg_text_nos <- svg_shape_nos + 1 - svg_vec[svg_text_nos[i]] <- "" - } + # Modify shape lines + for (i in seq(node_id_images)) { + svg_vec[svg_shape_nos[i]] <- + sub(" ", paste0(filter_shape_refs[i]), svg_vec[svg_shape_nos[i]]) - # Add in lines - svg_vec[svg_line_no + 1] <- - paste0(svg_vec[svg_line_no + 1], "\n\n", filter_lines, "\n") + svg_vec[svg_text_nos[i]] <- "" } - # # Get the name of the function - # fcn_name <- get_calling_fcn() - # if ("fa_icon" %in% colnames(graph %>% get_node_df())) { - # - # # Using a fontawesome icon requires the fontawesome package; - # # if it's not present, stop with a message - # if (requireNamespace("fontawesome", quietly = TRUE)) { - # - # node_id_fa <- - # graph %>% - # get_node_df() %>% - # dplyr::select(id, fa_icon) %>% - # dplyr::filter(fa_icon != "") %>% - # dplyr::filter(!is.na(fa_icon)) %>% - # dplyr::mutate(fa_uri = NA_character_) - # - # node_id_svg <- - # node_id_fa %>% - # dplyr::pull(id) - # - # for (i in seq(nrow(node_id_fa))) { - # - # random_name <- paste(sample(letters[1:10], 10), collapse = "") - # tmp_svg_file <- paste0(random_name, ".svg") - # - # fa_icon <- node_id_fa[i, ]$fa_icon - # id <- node_id_fa[i, ]$id - # - # writeLines(fontawesome::fa(fa_icon), tmp_svg_file) - # - # svg_uri <- get_image_uri(tmp_svg_file) - # - # file.remove(tmp_svg_file) - # - # node_id_fa[i, "fa_uri"] <- - # as.character(glue::glue("")) - # } - # - # filter_lines <- - # node_id_fa %>% - # dplyr::pull(fa_uri) %>% - # paste(collapse = "\n") - # - # filter_shape_refs <- as.character(glue::glue(" filter=\"url(#{node_id_svg})\" ")) - # - # svg_shape_nos <- - # svg_tbl %>% - # dplyr::filter(node_id %in% node_id_svg) %>% - # dplyr::filter(type == "node_block") %>% - # dplyr::pull(index) - # - # svg_shape_nos <- svg_shape_nos + 3 - # svg_text_nos <- svg_shape_nos + 1 - # - # # Modify shape lines - # for (i in seq_len(node_id_svg)) { - # - # svg_vec[svg_shape_nos[i]] <- - # sub(" ", paste0(filter_shape_refs[i]), svg_vec[svg_shape_nos[i]]) - # - # svg_vec[svg_text_nos[i]] <- "" - # } - # - # # Add in lines - # svg_vec[svg_line_no + 1] <- - # paste0(svg_vec[svg_line_no + 1], "\n\n", filter_lines, "\n") - # } - # - # svg_vec_1 <- paste(svg_vec, collapse = "\n") - # - # display <- htmltools::browsable(htmltools::HTML(svg_vec_1)) - # - # } else { - # - # cli::cli_abort( - # c( - # "Cannot currently render FontAwesome icons.", - # "please install the `fontawesome` package and retry", - # "pkg installed using `devtools::install_github('rstudio/fontawesome')`")) - # } - } else { - - # Generate DOT code - dot_code <- generate_dot(graph) - - # Generate a `grViz` object - grVizObject <- - grViz( - diagram = dot_code, - width = width, - height = height) - - display <- grVizObject + # Add in lines + svg_vec[svg_line_no + 1] <- + paste0(svg_vec[svg_line_no + 1], "\n\n", filter_lines, "\n") } - display - - } else if (output == "visNetwork") { - visnetwork(graph) + # # Get the name of the function + # if ("fa_icon" %in% colnames(graph %>% get_node_df())) { + # + # # Using a fontawesome icon requires the fontawesome package; + # # if it's not present, stop with a message + # if (requireNamespace("fontawesome", quietly = TRUE)) { + # + # node_id_fa <- + # graph %>% + # get_node_df() %>% + # dplyr::select(id, fa_icon) %>% + # dplyr::filter(fa_icon != "") %>% + # dplyr::filter(!is.na(fa_icon)) %>% + # dplyr::mutate(fa_uri = NA_character_) + # + # node_id_svg <- + # node_id_fa %>% + # dplyr::pull(id) + # + # for (i in seq(nrow(node_id_fa))) { + # + # random_name <- paste(sample(letters[1:10], 10), collapse = "") + # tmp_svg_file <- paste0(random_name, ".svg") + # + # fa_icon <- node_id_fa[i, ]$fa_icon + # id <- node_id_fa[i, ]$id + # + # writeLines(fontawesome::fa(fa_icon), tmp_svg_file) + # + # svg_uri <- get_image_uri(tmp_svg_file) + # + # file.remove(tmp_svg_file) + # + # node_id_fa[i, "fa_uri"] <- + # as.character(glue::glue("")) + # } + # + # filter_lines <- + # node_id_fa %>% + # dplyr::pull(fa_uri) %>% + # paste(collapse = "\n") + # + # filter_shape_refs <- as.character(glue::glue(" filter=\"url(#{node_id_svg})\" ")) + # + # svg_shape_nos <- + # svg_tbl %>% + # dplyr::filter(node_id %in% node_id_svg) %>% + # dplyr::filter(type == "node_block") %>% + # dplyr::pull(index) + # + # svg_shape_nos <- svg_shape_nos + 3 + # svg_text_nos <- svg_shape_nos + 1 + # + # # Modify shape lines + # for (i in seq_len(node_id_svg)) { + # + # svg_vec[svg_shape_nos[i]] <- + # sub(" ", paste0(filter_shape_refs[i]), svg_vec[svg_shape_nos[i]]) + # + # svg_vec[svg_text_nos[i]] <- "" + # } + # + # # Add in lines + # svg_vec[svg_line_no + 1] <- + # paste0(svg_vec[svg_line_no + 1], "\n\n", filter_lines, "\n") + # } + # + # svg_vec_1 <- paste(svg_vec, collapse = "\n") + # + # display <- htmltools::browsable(htmltools::HTML(svg_vec_1)) + # + # } else { + # + # cli::cli_abort( + # c( + # "Cannot currently render FontAwesome icons.", + # "please install the `fontawesome` package and retry", + # "pkg installed using `devtools::install_github('rstudio/fontawesome')`")) + # } + } else { + # Generate DOT code + dot_code <- generate_dot(graph) + + # Generate a `grViz` object + grVizObject <- + grViz( + diagram = dot_code, + width = width, + height = height + ) + + display <- grVizObject } + + display } diff --git a/man/render_graph.Rd b/man/render_graph.Rd index b92c98760..654026d37 100644 --- a/man/render_graph.Rd +++ b/man/render_graph.Rd @@ -41,45 +41,52 @@ Using a \code{dgr_graph} object, render the graph in the RStudio Viewer. \examples{ if (interactive()) { -# Render a graph that's a -# balanced tree -create_graph() \%>\% - add_balanced_tree( - k = 2, h = 3) \%>\% - render_graph() + # Render a graph that's a + # balanced tree + create_graph() \%>\% + add_balanced_tree( + k = 2, h = 3 + ) \%>\% + render_graph() -# Use the `tree` layout for -# better node placement in this -# hierarchical graph -create_graph() \%>\% - add_balanced_tree( - k = 2, h = 3) \%>\% - render_graph(layout = "tree") + # Use the `tree` layout for + # better node placement in this + # hierarchical graph + create_graph() \%>\% + add_balanced_tree( + k = 2, h = 3 + ) \%>\% + render_graph(layout = "tree") -# Plot the same tree graph but -# don't show the node ID values -create_graph() \%>\% - add_balanced_tree( - k = 2, h = 3) \%>\% - set_node_attr_to_display() \%>\% - render_graph(layout = "tree") + # Plot the same tree graph but + # don't show the node ID values + create_graph() \%>\% + add_balanced_tree( + k = 2, h = 3 + ) \%>\% + set_node_attr_to_display() \%>\% + render_graph(layout = "tree") -# Create a circle graph -create_graph() \%>\% - add_gnm_graph( - n = 55, - m = 75, - set_seed = 23) \%>\% - render_graph( - layout = "circle") + # Create a circle graph + create_graph() \%>\% + add_gnm_graph( + n = 55, + m = 75, + set_seed = 23 + ) \%>\% + render_graph( + layout = "circle" + ) -# Render the graph using the -# `visNetwork` output option -create_graph() \%>\% - add_balanced_tree( - k = 2, h = 3) \%>\% - render_graph( - output = "visNetwork") + # Render the graph using the + # `visNetwork` output option + create_graph() \%>\% + add_balanced_tree( + k = 2, h = 3 + ) \%>\% + render_graph( + output = "visNetwork" + ) } } diff --git a/tests/testthat/test-render_graph.R b/tests/testthat/test-render_graph.R index 08743fe24..a9db919c0 100644 --- a/tests/testthat/test-render_graph.R +++ b/tests/testthat/test-render_graph.R @@ -4,7 +4,59 @@ test_that("No warning is produced.", { # before changing render_graph circa line 177, there was a warn withr::local_seed(10) expect_no_warning(create_graph() %>% + add_balanced_tree( + k = 2, h = 3) %>% + render_graph(layout = "tree")) + + # example_graph from README + example_graph <- + create_graph() %>% + add_pa_graph( + n = 50, m = 1, + set_seed = 23 + ) %>% + add_gnp_graph( + n = 50, p = 1 / 100, + set_seed = 23 + ) %>% + join_node_attrs(df = get_betweenness(.)) %>% + join_node_attrs(df = get_degree_total(.)) %>% + colorize_node_attrs( + node_attr_from = total_degree, + node_attr_to = fillcolor, + palette = "Greens", + alpha = 90 + ) %>% + rescale_node_attrs( + node_attr_from = betweenness, + to_lower_bound = 0.5, + to_upper_bound = 1.0, + node_attr_to = height + ) %>% + select_nodes_by_id(nodes = get_articulation_points(.)) %>% + set_node_attrs_ws(node_attr = peripheries, value = 2) %>% + set_node_attrs_ws(node_attr = penwidth, value = 3) %>% + clear_selection() %>% + set_node_attr_to_display(attr = NULL) + + expect_no_warning(render_graph(example_graph, layout = "nicely")) + expect_no_warning(render_graph(example_graph, layout = "circle")) + expect_no_warning(render_graph(example_graph, layout = "kk")) + expect_no_warning(render_graph(example_graph, layout = "tree")) + + expect_no_warning(render_graph(example_graph, layout = "fr")) + +}) + +test_that("render_graph errors on incorrect graph and layout input", { + g <- create_graph() %>% add_balanced_tree( - k = 2, h = 3) %>% - render_graph(layout = "tree")) + k = 2, h = 3) + + expect_error( + render_graph(g, layout = "xx") + ) + expect_error( + render_graph(g, output = "xx") + ) })