Neighbor highlighting via mouseover and click at the same time
JohnCoene
| 1 |
#' Create from igraph
|
|
| 2 |
#'
|
|
| 3 |
#' Create a \code{sigmajs} from an \code{igraph} object.
|
|
| 4 |
#'
|
|
| 5 |
#' @param sg An object of class \code{sigmajs}as intatiated by \code{\link{sigmajs}}.
|
|
| 6 |
#' @param igraph An object of class \code{igraph}.
|
|
| 7 |
#' @param layout A matrix of coordinates.
|
|
| 8 |
#' @param sd A \link[crosstalk]{SharedData} of nodes.
|
|
| 9 |
#'
|
|
| 10 |
#' @examples
|
|
| 11 |
#' \dontrun{
|
|
| 12 |
#' data("lesmis_igraph")
|
|
| 13 |
#'
|
|
| 14 |
#' layout <- igraph::layout_with_fr(lesmis_igraph)
|
|
| 15 |
#'
|
|
| 16 |
#' sigmajs() %>%
|
|
| 17 |
#' sg_from_igraph(lesmis_igraph, layout) %>%
|
|
| 18 |
#' sg_settings(defaultNodeColor = "#000")
|
|
| 19 |
#' }
|
|
| 20 |
#'
|
|
| 21 |
#' @return A modified version of the \code{sg} object.
|
|
| 22 |
#'
|
|
| 23 |
#' @export
|
|
| 24 |
sg_from_igraph <- function(sg, igraph, layout = NULL, sd = NULL) { |
|
| 25 |
|
|
| 26 | 1 |
if (missing(sg)) |
| 27 | 1 |
stop("missing sg", call. = FALSE) |
| 28 |
|
|
| 29 | 1 |
.test_sg(sg) |
| 30 |
|
|
| 31 | 1 |
if (missing(igraph)) |
| 32 | 1 |
stop("must pass igraph", call. = FALSE) |
| 33 |
|
|
| 34 | 1 |
if (!inherits(igraph, "igraph")) |
| 35 | 1 |
stop("igraph is not of class igraph", call. = FALSE) |
| 36 |
|
|
| 37 |
# extract data frames
|
|
| 38 | 1 |
g <- igraph::as_data_frame(igraph, what = 'both') |
| 39 | 1 |
edges <- g$edges |
| 40 | 1 |
nodes <- g$vertices |
| 41 |
|
|
| 42 |
# rename and enforce character
|
|
| 43 | 1 |
n <- nrow(edges) |
| 44 | 1 |
edges <- dplyr::mutate( |
| 45 | 1 |
edges,
|
| 46 | 1 |
id = as.character(seq(1, n)), # start from 1 |
| 47 | 1 |
from = as.character(from), |
| 48 | 1 |
to = as.character(to) |
| 49 |
)
|
|
| 50 | 1 |
names(edges)[1:2] <- c("source", "target") |
| 51 |
|
|
| 52 |
# check if nodes exist
|
|
| 53 | 1 |
if (ncol(nodes) == 0) |
| 54 | 1 |
nodes <- dplyr::tibble(id = seq(1, nrow(nodes))) |
| 55 |
|
|
| 56 |
# enforce character
|
|
| 57 | 1 |
if ("id" %in% names(nodes)) |
| 58 | 1 |
nodes$id <- as.character(nodes$id) |
| 59 |
else
|
|
| 60 | 1 |
nodes$id <- nodes$name |
| 61 |
|
|
| 62 |
# add layout
|
|
| 63 | 1 |
if (is.null(layout)) |
| 64 | 1 |
layout <- igraph::layout_nicely(igraph) |
| 65 |
|
|
| 66 |
# add x and y (required by sigmajs)
|
|
| 67 | 1 |
layout <- as.data.frame(layout) |
| 68 | 1 |
names(layout) <- c("x", "y") |
| 69 |
|
|
| 70 |
# force layout character
|
|
| 71 | 1 |
layout$x <- as.character(layout$x) |
| 72 | 1 |
layout$y <- as.character(layout$y) |
| 73 |
|
|
| 74 | 1 |
nodes <- dplyr::bind_cols(nodes, layout) |
| 75 |
|
|
| 76 | 1 |
if(!"size" %in% names(nodes)) |
| 77 | 1 |
nodes$size <- 1 |
| 78 |
|
|
| 79 | 1 |
sg$x$data <- append(sg$x$data, list(nodes = .as_list(nodes), edges = .as_list(edges))) |
| 80 |
|
|
| 81 | 1 |
if(!is.null(sd)){ |
| 82 | 1 |
if (crosstalk::is.SharedData(sd)) { |
| 83 | 1 |
sg$x$crosstalk$crosstalk_key <- sd$key() |
| 84 | 1 |
sg$x$crosstalk$crosstalk_group <- sd$groupName() |
| 85 |
}
|
|
| 86 |
}
|
|
| 87 |
|
|
| 88 | 1 |
return(sg) |
| 89 |
}
|
Read our documentation on viewing source code .