#' Generate data
#'
#' Generate nodes and edges.
#'
#' @param n Number of nodes.
#' @param colors Color palette to use.
#' @param nodes Nodes, as generated by \code{sg_make_nodes}.
#' @param ... Any other argument to pass to \link[igraph]{sample_pa}.
#'
#' @section Functions:
#' \itemize{
#' \item{\code{sg_make_nodes} generate data.frame nodes.}
#' \item{\code{sg_make_edges} generate data.frame edges.}
#' \item{\code{sg_make_nodes_edges} generate list of nodes and edges.}
#' }
#'
#' @examples
#' nodes <- sg_make_nodes()
#' edges <- sg_make_edges(nodes)
#'
#' sigmajs() %>%
#' sg_nodes(nodes, id, label, size, color) %>%
#' sg_edges(edges, id, source, target) %>%
#' sg_settings(defaultNodeColor = "#0011ff")
#'
#' @return \code{tibble} of nodes or edges or a \code{list} of the latter.
#'
#' @importFrom grDevices colorRampPalette
#' @rdname generate
#' @export
sg_make_nodes <- function(n = 10, colors = c("#B1E2A3", "#98D3A5", "#328983", "#1C5C70", "#24C96B")) {
dplyr::tibble(
id = as.character(seq(1, n)),
label = sample(paste0(LETTERS, 1:100), n, replace = TRUE),
size = ceiling(runif(n, 1, 5)),
color = colorRampPalette(colors)(n)
)
}
#' @rdname generate
#' @export
sg_make_edges <- function(nodes, n = NULL) {
if (missing(nodes))
stop("mising nodes", call. = FALSE)
if (!is.null(n))
warning("Argument `n` is deprecated")
ids <- as.character(nodes$id)
dplyr::tibble(
id = as.character(seq(1, length(ids))),
source = ids,
target = sample(ids, length(ids), replace = TRUE)
)
}
#' @rdname generate
#' @export
sg_make_nodes_edges <- function(n, ...){
g <- igraph::sample_pa(n, ...)
g <- igraph::as_data_frame(g, what = 'both')
edges <- g$edges %>%
dplyr::mutate(
id = 1:n(),
from = as.character(from),
to = as.character(to)
) %>%
dplyr::select(
source = from,
target = to,
id)
nodes <- dplyr::tibble(
id = as.character(c(edges$source, edges$target))
) %>%
dplyr::group_by(id) %>%
dplyr::summarise(size = n()) %>%
dplyr::ungroup() %>%
dplyr::mutate(
label = id
) %>%
dplyr::select(
id,
label,
size
)
list(
nodes = nodes,
edges = edges
)
}
#' Kill or clear
#'
#' Kill the graph to ensure new data is redrawn, useful in Shiny
#' when graph is not updated by \code{\link{sigmajsProxy}}.
#'
#' @inheritParams sg_nodes
#'
#' @return A modified version of the \code{sg} object.
#'
#' @rdname clear-kill
#' @export
sg_kill <- function(sg){
.test_sg(sg)
sg$x$kill <- TRUE
sg
}
#' @rdname clear-kill
#' @export
sg_clear <- function(sg){
.test_sg(sg)
sg$x$clear <- TRUE
sg
}
#' Color
#'
#' Scale color by node size.
#'
#' @inheritParams sg_nodes
#' @param pal Vector of color.
#'
#' @examples
#' nodes <- sg_make_nodes()
#' edges <- sg_make_edges(nodes, 20)
#'
#' sigmajs() %>%
#' sg_nodes(nodes, id, size) %>%
#' sg_scale_color(pal = c("red", "blue"))
#'
#' @return A modified version of the \code{sg} object.
#'
#' @name color-scale
#' @export
sg_scale_color <- function(sg, pal){
size <- purrr::map(sg$x$data$nodes, "size") %>%
unlist() %>%
as.numeric()
if (!length(size))
stop("no node size passed", call. = FALSE)
color <- scales::col_numeric(pal, domain = range(size))(size)
sg$x$data$nodes <- purrr::map2(sg$x$data$nodes, color, function(x, y){
x$color <- y
return(x)
})
return(sg)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.