diff --git a/DESCRIPTION b/DESCRIPTION index 38f0d683..34de8c6d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: manynet Title: Many Ways to Make, Modify, Map, Mark, and Measure Myriad Networks -Version: 1.2.1 -Date: 2024-10-01 +Version: 1.2.2 +Date: 2024-10-04 Description: Many tools for making, modifying, mapping, marking, measuring, and motifs and memberships of many different types of networks. All functions operate with matrices, edge lists, and 'igraph', 'network', and 'tidygraph' objects, diff --git a/NAMESPACE b/NAMESPACE index 16f16531..f43d8a33 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -596,6 +596,7 @@ export(node_is_recovered) export(node_kernighanlin) export(node_leading_eigen) export(node_leiden) +export(node_leverage) export(node_louvain) export(node_mode) export(node_multidegree) @@ -616,6 +617,7 @@ export(node_regular_equivalence) export(node_richness) export(node_roulette) export(node_spinglass) +export(node_stress) export(node_strong_components) export(node_structural_equivalence) export(node_thresholds) @@ -712,6 +714,7 @@ export(to_blocks) export(to_components) export(to_correlation) export(to_directed) +export(to_dominating) export(to_ego) export(to_egos) export(to_eulerian) @@ -835,7 +838,6 @@ importFrom(igraph,delete_vertex_attr) importFrom(igraph,delete_vertices) importFrom(igraph,diameter) importFrom(igraph,distances) -importFrom(igraph,eccentricity) importFrom(igraph,edge_attr) importFrom(igraph,edge_attr_names) importFrom(igraph,edge_betweenness) diff --git a/NEWS.md b/NEWS.md index b19646d5..be9ecd62 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,27 @@ +# manynet 1.2.2 + +## Package + +- Updated all tutorials with different themes to make them more distinctive +- Updated centrality tutorial with gifs +- Updated visualisation tutorial with a few extras + +## Modifying + +- Added `to_dominating()` for extracting the dominating tree of a given network + +## Mapping + +- Reworked `graphr()` to make function more concise and consistent (thanks @henriquesposito) + - This allows new functionality and improves debugging moving forward + +## Measuring + +- Updated closeness centrality documentation +- Improved `node_eccentricity()` to allow normalisation, appear in closeness documentation +- Added `node_stress()` as a new betweenness-like centrality measure +- Added `node_leverage()` as a new degree-like centrality measure + # manynet 1.2.1 ## Making diff --git a/R/manip_reformed.R b/R/manip_reformed.R index 6052ab16..e53b9f68 100644 --- a/R/manip_reformed.R +++ b/R/manip_reformed.R @@ -449,6 +449,7 @@ to_blocks.tbl_graph <- function(.data, membership, FUN = mean){ #' - `to_eulerian()` returns only the Eulerian path within some network data. #' - `to_tree()` returns the spanning tree in some network data or, #' if the data is unconnected, a forest of spanning trees. +#' - `to_dominating()` returns the dominating tree of the network #' @details #' Not all functions have methods available for all object classes. #' Below are the currently implemented S3 methods: @@ -651,5 +652,17 @@ to_eulerian.tbl_graph <- function(.data){ #' @export to_tree <- function(.data) { .data <- as_igraph(.data) - igraph::subgraph.edges(.data, igraph::sample_spanning_tree(.data)) + out <- igraph::subgraph.edges(.data, igraph::sample_spanning_tree(.data)) + as_tidygraph(out) +} + +#' @rdname manip_paths +#' @param from The index or name of the node from which the path should be traced. +#' @param direction String, either "out" or "in". +#' @export +to_dominating <- function(.data, from, direction = c("out","in")) { + direction <- match.arg(direction) + .data <- as_igraph(.data) + out <- igraph::dominator_tree(.data, root = from, mode = direction)$domtree + as_tidygraph(out) } diff --git a/R/map_autograph.R b/R/map_autograph.R index 2fadaee7..cb1f05b4 100644 --- a/R/map_autograph.R +++ b/R/map_autograph.R @@ -96,13 +96,11 @@ #' size = ifelse(node_is_cutpoint(ison_adolescents), 6, 3)) %>% #' mutate_ties(ecolor = rep(c("friends", "acquaintances"), times = 5)) %>% #' graphr(node_color = "color", node_size = "size", -#' edge_size = 1.5, edge_color = "ecolor") -#' #graphr(ison_lotr, node_color = Race, -#' # node_size = node_degree(ison_lotr)*2, -#' # edge_color = "#66A61E", -#' # edge_size = tie_degree(ison_lotr)) -#' #graphr(ison_karateka, node_group = allegiance, -#' # edge_size = tie_closeness(ison_karateka)) +#' edge_size = 1.5, edge_color = "ecolor") +#' graphr(ison_lotr, node_color = Race, node_size = node_degree(ison_lotr)*2, +#' edge_color = "yellow", edge_size = tie_degree(ison_lotr)) +#' graphr(ison_karateka, node_group = allegiance, +#' edge_size = tie_closeness(ison_karateka)) #' @export graphr <- function(.data, layout, labels = TRUE, node_color, node_shape, node_size, node_group, @@ -130,8 +128,8 @@ graphr <- function(.data, layout, labels = TRUE, } if (missing(node_group)) node_group <- NULL else { node_group <- as.character(substitute(node_group)) - g <- activate(g, "nodes") %>% - mutate(node_group = reduce_categories(g, node_group)) + g <- tidygraph::activate(g, "nodes") %>% + tidygraph::mutate(node_group = reduce_categories(g, node_group)) } if (missing(edge_color) && missing(edge_colour)) { edge_color <- NULL @@ -149,10 +147,14 @@ graphr <- function(.data, layout, labels = TRUE, p <- .graph_edges(p, g, edge_color, edge_size, node_size) # Add nodes ---- p <- .graph_nodes(p, g, node_color, node_shape, node_size) + # Add labels ---- + if (isTRUE(labels) & is_labelled(g)) { + p <- .graph_labels(p, g, layout) + } p } -.graph_layout <- function(g, layout, labels, node_group, ...){ +.graph_layout <- function(g, layout, labels, node_group, ...) { name <- NULL dots <- list(...) if ("x" %in% names(dots) & "y" %in% names(dots)) { @@ -167,57 +169,6 @@ graphr <- function(.data, layout, labels = TRUE, } } p <- ggraph::ggraph(lo) + ggplot2::theme_void() - if (labels & is_labelled(g)) { - if (layout == "circle") { - # https://stackoverflow.com/questions/57000414/ggraph-node-labels-truncated?rq=1 - angles <- as.data.frame(cart2pol(as.matrix(lo[,1:2]))) - angles$degree <- angles$phi * 180/pi - angles <- dplyr::case_when(lo[,2] == 0 & lo[,1] == 0 ~ 0.1, - lo[,2] >= 0 & lo[,1] > 0 ~ angles$degree, - lo[,2] < 0 & lo[,1] > 0 ~ angles$degree, - lo[,1] == 1 ~ angles$degree, - TRUE ~ angles$degree - 180) - if (net_nodes(g) < 20) { - hj <- ifelse(lo[,1] >= 0, -0.4, 1.4) - vj <- ifelse(lo[,2] >= 0, -0.4, 1.4) - } else { - hj <- ifelse(lo[,1] >= 0, -0.2, 1.2) - vj <- ifelse(lo[,2] >= 0, -0.2, 1.2) - } - p <- p + ggraph::geom_node_text(ggplot2::aes(label = name), repel = TRUE, - size = 3, hjust = hj, angle = angles) + - ggplot2::coord_cartesian(xlim=c(-1.2,1.2), ylim=c(-1.2,1.2)) - } else if (layout == "concentric") { - if (net_nodes(g) < 20) { - hj <- ifelse(lo[,1] >= 0, -0.8, 1.8) - vj <- ifelse(lo[,2] >= 0, -0.8, 1.8) - } else if (net_nodes(g) > 20 & net_nodes(g) < 30) { - hj <- ifelse(lo[,1] >= 0, -0.4, 1.4) - vj <- ifelse(lo[,2] >= 0, -0.4, 1.4) - } else { - hj <- ifelse(lo[,1] >= 0, -0.2, 1.2) - vj <- ifelse(lo[,2] >= 0, -0.2, 1.2) - } - p <- p + ggraph::geom_node_text(ggplot2::aes(label = name), vjust = vj, - size = 3, hjust = hj, repel = TRUE) + - ggplot2::coord_cartesian(xlim=c(-1.2,1.2), ylim=c(-1.2,1.2)) - } else if (layout %in% c("bipartite", "railway") | layout == "hierarchy" & length(unique(lo[["y"]])) <= 2) { - p <- p + ggraph::geom_node_text(ggplot2::aes(label = name), angle = 90, - size = 3, hjust = "outward", repel = TRUE, - nudge_y = ifelse(lo[,2] == 1, 0.05, -0.05)) + - ggplot2::coord_cartesian(ylim=c(-0.2, 1.2)) - } else if (layout == "hierarchy" & length(unique(lo[["y"]])) > 2) { - p <- p + ggraph::geom_node_text(ggplot2::aes(label = name), - size = 3, hjust = "inward", repel = TRUE) - } else if (layout %in% c("alluvial", "lineage")) { - p <- p + ggraph::geom_node_label(ggplot2::aes(label = name), size = 3, - repel = TRUE, label.size = 0, - nudge_x = ifelse(lo[,1] == 1, 0.02, -0.02)) - } else { - p <- p + ggraph::geom_node_label(ggplot2::aes(label = name), label.size = 0, - repel = TRUE, seed = 1234, size = 3) - } - } if (!is.null(node_group)) { x <- y <- NULL thisRequires("ggforce") @@ -225,328 +176,188 @@ graphr <- function(.data, layout, labels = TRUE, ggforce::geom_mark_hull(ggplot2::aes(x, y, fill = node_group, label = node_group), data = lo) + ggplot2::scale_fill_manual(values = colorsafe_palette, - guide = ggplot2::guide_legend("Color")) + guide = ggplot2::guide_legend("Group")) } p } .graph_edges <- function(p, g, edge_color, edge_size, node_size) { - weight <- lsize <- NULL - esize <- .infer_esize(g, edge_size) - check_edge_variables(g, edge_color, edge_size) - # Begin plotting edges in various cases if (is_directed(g)) { - e_cap <- unlist(unname(.infer_end_cap(g, node_size))) - bend <- .infer_bend(g) - if (is_weighted(g)) { - if (!is.null(edge_color)) { - if (edge_color %in% names(tie_attribute(g))) { - p <- p + ggraph::geom_edge_arc(ggplot2::aes( - width = esize, colour = as.factor(tie_attribute(g, edge_color)), - end_cap = ggraph::circle(c(e_cap), 'mm')), - edge_alpha = 0.4, strength = bend, edge_linetype = "solid", - arrow = ggplot2::arrow(angle = 15, length = ggplot2::unit(2, 'mm'), - type = "closed")) + - ggraph::scale_edge_width_continuous(range = c(0.2, 2.5), guide = "Edge Size") + - ggraph::scale_edge_colour_manual(values = colorsafe_palette, - guide = ggplot2::guide_legend("Edge color")) - } else { - p <- p + ggraph::geom_edge_arc(ggplot2::aes(width = esize, - end_cap = ggraph::circle(c(e_cap), 'mm')), - colour = edge_color, - edge_alpha = 0.4, strength = bend, - edge_linetype = "solid", - arrow = ggplot2::arrow(angle = 15, - length = ggplot2::unit(2, 'mm'), - type = "closed")) + - ggraph::scale_edge_width_continuous(range = c(0.2, 2.5), guide = "Edge Size") - } - } else if (is_signed(g)) { - p <- p + ggraph::geom_edge_arc( - ggplot2::aes(width = esize, - end_cap = ggraph::circle(c(e_cap), 'mm'), - edge_colour = ifelse(igraph::E(g)$sign >= 0, "#d73027", "#4575b4"), - edge_linetype = ifelse(igraph::E(g)$sign >= 0, "solid", "dashed")), - edge_alpha = 0.4, strength = bend, show.legend = FALSE, - arrow = ggplot2::arrow(angle = 15, length = ggplot2::unit(2, 'mm'), type = "closed")) + - ggraph::scale_edge_width_continuous(range = c(0.2, 2.5), guide = "Edge Size") - } else { - p <- p + ggraph::geom_edge_arc(ggplot2::aes(width = esize, - end_cap = ggraph::circle(c(e_cap), 'mm')), - edge_colour = "black", - edge_alpha = 0.4, strength = bend, - edge_linetype = "solid", - arrow = ggplot2::arrow(angle = 15, - length = ggplot2::unit(2, 'mm'), - type = "closed")) + - ggraph::scale_edge_width_continuous(range = c(0.2, 2.5), guide = "Edge Size") - } - } else { - if (!is.null(edge_color)) { - if (edge_color %in% names(tie_attribute(g))) { - p <- p + ggraph::geom_edge_arc(ggplot2::aes( - colour = as.factor(tie_attribute(g, edge_color)), - end_cap = ggraph::circle(c(e_cap), 'mm'), width = esize), - edge_alpha = 0.4, strength = bend, edge_linetype = "solid", - arrow = ggplot2::arrow(angle = 15, length = ggplot2::unit(3, "mm"), - type = "closed")) + - ggraph::scale_edge_colour_manual(values = colorsafe_palette, - guide = ggplot2::guide_legend("Edge color")) + - ggraph::scale_edge_width_continuous(range = c(0.2, 2.5), guide = "Edge Size") - } else { - p <- p + ggraph::geom_edge_arc(ggplot2::aes(end_cap = ggraph::circle(c(e_cap), 'mm'), - width = esize), - colour = edge_color, edge_alpha = 0.4, - strength = bend, edge_linetype = "solid", - arrow = ggplot2::arrow(angle = 15, - length = ggplot2::unit(3, "mm"), - type = "closed")) + - ggraph::scale_edge_width_continuous(range = c(0.2, 2.5), guide = "Edge Size") - } - } else if (is_signed(g)) { - p <- p + ggraph::geom_edge_arc( - ggplot2::aes(end_cap = ggraph::circle(c(e_cap), 'mm'), width = esize, - edge_colour = ifelse(igraph::E(g)$sign >= 0, "#d73027", "#4575b4"), - edge_linetype = ifelse(igraph::E(g)$sign >= 0, "solid", "dashed")), - edge_alpha = 0.4, strength = bend, show.legend = FALSE, - arrow = ggplot2::arrow(angle = 15, length = ggplot2::unit(3, "mm"), - type = "closed")) + - ggraph::scale_edge_width_continuous(range = c(0.2, 2.5), guide = "Edge Size") - } else { - p <- p + ggraph::geom_edge_arc(ggplot2::aes(end_cap = ggraph::circle(c(e_cap), 'mm'), - width = esize), - edge_colour = "black", - edge_alpha = 0.4, strength = bend, - edge_linetype = "solid", - arrow = ggplot2::arrow(angle = 15, - length = ggplot2::unit(3, "mm"), - type = "closed")) + - ggraph::scale_edge_width_continuous(range = c(0.2, 2.5), guide = "Edge Size") - } - } + out <- .infer_directed_edge_mapping(g, edge_color, edge_size, node_size) + p <- map_directed_edges(p, g, out) } else { - if (is_weighted(g)) { # weighted and undirected - if (!is.null(edge_color)) { - if (edge_color %in% names(tie_attribute(g))) { - p <- p + ggraph::geom_edge_link0(ggplot2::aes( - width = weight, colour = as.factor(tie_attribute(g, edge_color))), - edge_alpha = 0.4, edge_linetype = "solid") + - ggraph::scale_edge_width_continuous(range = c(0.2, 1), guide = "none") + - ggraph::scale_edge_colour_manual(values = colorsafe_palette, - guide = ggplot2::guide_legend("Edge color")) - } else { - p <- p + ggraph::geom_edge_link0(ggplot2::aes(width = weight), - colour = edge_color, - edge_alpha = 0.4, - edge_linetype = "solid") + - ggraph::scale_edge_width_continuous(range = c(0.2, 1), guide = "none") - } - } else if (is_signed(g)) { - p <- p + ggraph::geom_edge_link0( - ggplot2::aes(width = weight, - edge_colour = ifelse(igraph::E(g)$sign >= 0, "#d73027", "#4575b4"), - edge_linetype = ifelse(igraph::E(g)$sign >= 0, "solid", "dashed")), - edge_alpha = 0.4, show.legend = FALSE) + - ggraph::scale_edge_width_continuous(range = c(0.2, 1), guide = "none") - } else { - p <- p + ggraph::geom_edge_link0(ggplot2::aes(width = weight), - edge_colour = "black", - edge_linetype = "solid", - edge_alpha = 0.4) + - ggraph::scale_edge_width_continuous(range = c(0.2, 1), guide = "none") - } - } else { # unweighted and undirected - if (!is.null(edge_color)) { - if (edge_color %in% names(tie_attribute(g))) { - p <- p + ggraph::geom_edge_link0(ggplot2::aes( - colour = as.factor(tie_attribute(g, edge_color)), width = esize), - edge_linetype = "solid", - edge_alpha = 0.4) + - ggraph::scale_edge_colour_manual(values = colorsafe_palette, - guide = ggplot2::guide_legend("Edge color")) + - ggraph::scale_edge_width_continuous(range = c(0.2, 2.5), guide = "Edge Size") - } else { - p <- p + ggraph::geom_edge_link0(ggplot2::aes(width = esize), - colour = edge_color, - edge_linetype = "solid", - edge_alpha = 0.4) + - ggraph::scale_edge_width_continuous(range = c(0.2, 2.5), guide = "Edge Size") - } - } else if (is_signed(g)) { - p <- p + ggraph::geom_edge_link0( - ggplot2::aes(edge_colour = ifelse(igraph::E(g)$sign >= 0, "#d73027", "#4575b4"), - edge_linetype = ifelse(igraph::E(g)$sign >= 0, "solid", "dashed"), - width = esize), - edge_alpha = 0.4, show.legend = FALSE) + - ggraph::scale_edge_width_continuous(range = c(0.2, 2.5), guide = "Edge Size") - } else { - p <- p + ggraph::geom_edge_link0(ggplot2::aes(width = esize), - edge_colour = "black", edge_alpha = 0.4, - edge_linetype = "solid") + - ggraph::scale_edge_width_continuous(range = c(0.2, 2.5), guide = "Edge Size") - } - } + out <- .infer_edge_mapping(g, edge_color, edge_size) + p <- map_edges(p, g, out) } if (is_complex(g)) { - p <- p + ggraph::geom_edge_loop0(edge_alpha = 0.4) + p <- p + ggraph::geom_edge_loop0(edge_alpha = 0.4) } - if (length(unique(esize)) == 1) { + # Check legends + if (length(unique(out[["esize"]])) == 1) { p <- p + ggplot2::guides(edge_width = "none") - } else p <- p + ggplot2::guides(edge_width = ggplot2::guide_legend(title = "Edge size")) + } else p <- p + ggraph::scale_edge_width_continuous(range = c(0.3, 3), + guide = ggplot2::guide_legend( + ifelse(is.null(edge_size) & + is_weighted(g), + "Edge Weight", "Edge Size"))) + if (length(unique(out[["ecolor"]])) == 1) { + p <- p + ggplot2::guides(edge_colour = "none") + } else p <- p + ggraph::scale_edge_colour_manual(values = colorsafe_palette, + guide = ggplot2::guide_legend( + ifelse(is.null(edge_color) & + is_signed(g), + "Edge Sign", "Edge Color"))) p } -.graph_nodes <- function(p, g, node_color, node_shape, node_size){ - nshape <- .infer_shape(g, node_shape) - nsize <- .infer_nsize(g, node_size) - check_node_variables(g, node_color, node_size) +.graph_nodes <- function(p, g, node_color, node_shape, node_size) { + out <- .infer_node_mapping(g, node_color, node_size, node_shape) if (is.null(node_color) & "Infected" %in% names(node_attribute(g))) { - node_color <- as.factor(ifelse(node_attribute(g, "Exposed"), "Exposed", - ifelse(node_attribute(g, "Infected"),"Infected", - ifelse(node_attribute(g, "Recovered"), "Recovered", - "Susceptible")))) - p <- p + ggraph::geom_node_point(ggplot2::aes(color = node_color), - size = nsize, shape = nshape) + - ggplot2::scale_color_manual(name = NULL, guide = ggplot2::guide_legend(""), - values = c("Infected" = "#d73027", - "Susceptible" = "#4575b4", - "Exposed" = "#E6AB02", - "Recovered" = "#66A61E")) + p <- map_infected_nodes(p, g, out) } else if (is.null(node_color) & any("diff_model" %in% names(attributes(g)))) { - node_adopts <- node_adoption_time(attr(g,"diff_model")) - nshape <- ifelse(node_adopts == min(node_adopts), "Seed(s)", - ifelse(node_adopts == Inf, "Non-Adopter", "Adopter")) - node_color <- ifelse(is.infinite(node_adopts), - max(node_adopts[!is.infinite(node_adopts)]) + 1, - node_adopts) - p <- p + ggraph::geom_node_point(ggplot2::aes(shape = nshape, - color = node_color), - size = nsize) + - ggplot2::scale_color_gradient(low = "#d73027", high = "#4575b4", - breaks=c(min(node_color)+1, - ifelse(any(nshape=="Non-Adopter"), - max(node_color)-1, - max(node_color))), - labels=c("Early\nadoption", "Late\nadoption"), - name = "Time of\nAdoption\n") + - ggplot2::scale_shape_manual(name = "", - breaks = c("Seed(s)", "Adopter", "Non-Adopter"), - values = c("Seed(s)" = "triangle", - "Adopter" = "circle", - "Non-Adopter" = "square")) + - ggplot2::guides(color = ggplot2::guide_colorbar(order = 1, reverse = TRUE), - shape = ggplot2::guide_legend(order = 2)) + p <- map_diff_model_nodes(p, g, out) } else { - if (is_twomode(g)) { - if (!is.null(node_color)) { - if (node_color %in% names(node_attribute(g))) { - if (.is_mark_attrib(node_attribute(g, node_color))) { - node_color <- factor(node_attribute(g, node_color), - levels = c("TRUE", "FALSE")) - } else node_color <- factor(node_attribute(g, node_color)) - p <- p + ggraph::geom_node_point(ggplot2::aes(color = node_color), - size = nsize, shape = nshape) + - ggplot2::scale_colour_manual(values = colorsafe_palette, - guide = ggplot2::guide_legend("Color")) - } else { - p <- p + ggraph::geom_node_point(color = node_color, - size = nsize, shape = nshape) - } - } else { - p <- p + ggraph::geom_node_point(size = nsize, shape = nshape) - } - } else { - if (!is.null(node_color)) { - if (node_color %in% names(node_attribute(g))) { - if (.is_mark_attrib(node_attribute(g, node_color))) { - node_color <- factor(node_attribute(g, node_color), - levels = c("TRUE", "FALSE")) - } else node_color <- factor(node_attribute(g, node_color)) - p <- p + ggraph::geom_node_point(aes(color = node_color, - size = nsize, shape = nshape)) + - ggplot2::scale_colour_manual(values = colorsafe_palette, - guide = ggplot2::guide_legend("Color")) - } else { - p <- p + ggraph::geom_node_point(color = node_color, - size = nsize, - shape = nshape) - } - } else { - p <- p + ggraph::geom_node_point(size = nsize, shape = nshape) - } - } + p <- map_nodes(p, out) + # Check legends + if (length(unique(out[["nsize"]])) > 1) + p <- p + ggplot2::guides(size = ggplot2::guide_legend(title = "Node Size")) + if (length(unique(out[["nshape"]])) > 1) + p <- p + ggplot2::guides(shape = ggplot2::guide_legend( + title = ifelse(is_twomode(g) & is.null(node_shape), "Node Mode", "Node Shape"))) + if (length(unique(out[["ncolor"]])) > 1) + p <- p + ggplot2::scale_colour_manual(values = colorsafe_palette, + guide = ggplot2::guide_legend("Node Color")) } - # Drop legends for elements that don't vary - if(length(unique(nsize)) == 1) { - p <- p + ggplot2::guides(size = "none") - } else p <- p + ggplot2::guides(size = ggplot2::guide_legend(title = "Size")) - if (length(unique(nshape)) == 1) { - p <- p + ggplot2::guides(shape = "none") - } else p <- p + ggplot2::guides(shape = ggplot2::guide_legend(title = "Shape")) # Consider rescaling nodes p <- p + ggplot2::scale_size(range = c(1/net_nodes(g)*50, 1/net_nodes(g)*100)) p } -.infer_bend <- function(g) { - if (length(igraph::E(g)) > 100) { - out <- 0 +.graph_labels <- function(p, g, layout) { + if (layout == "circle" | layout == "concentric") { + angles <- as.data.frame(cart2pol(as.matrix(p[["data"]][,1:2]))) + angles$degree <- angles$phi * 180/pi + angles <- dplyr::case_when(p[["data"]][,2] == 0 & p[["data"]][,1] == 0 ~ 0.1, + p[["data"]][,2] >= 0 & p[["data"]][,1] > 0 ~ angles$degree, + p[["data"]][,2] < 0 & p[["data"]][,1] > 0 ~ angles$degree, + p[["data"]][,1] == 1 ~ angles$degree, + TRUE ~ angles$degree - 180) + if (net_nodes(g) < 10) { + hj <- ifelse(p[["data"]][,1] >= 0, -0.8, 1.8) + } else if (net_nodes(g) < 20) { + hj <- ifelse(p[["data"]][,1] >= 0, -0.4, 1.4) + } else { + hj <- ifelse(p[["data"]][,1] >= 0, -0.2, 1.2) + } + p <- p + ggraph::geom_node_text(ggplot2::aes(label = name), repel = TRUE, + size = 3, hjust = hj, angle = angles) + + ggplot2::coord_cartesian(xlim=c(-1.2,1.2), ylim=c(-1.2,1.2)) + } else if (layout %in% c("bipartite", "railway") | layout == "hierarchy" & + length(unique(p[["data"]][["y"]])) <= 2) { + p <- p + ggraph::geom_node_text(ggplot2::aes(label = name), angle = 90, + size = 3, hjust = "outward", repel = TRUE, + nudge_y = ifelse(p[["data"]][,2] == 1, + 0.05, -0.05)) + + ggplot2::coord_cartesian(ylim=c(-0.2, 1.2)) + } else if (layout == "hierarchy" & length(unique(p[["data"]][["y"]])) > 2) { + p <- p + ggraph::geom_node_text(ggplot2::aes(label = name), + size = 3, hjust = "inward", repel = TRUE) + } else if (layout %in% c("alluvial", "lineage")) { + p <- p + ggraph::geom_node_label(ggplot2::aes(label = name), size = 3, + repel = TRUE, nudge_x = ifelse(p[["data"]][,1] == 1, + 0.02, -0.02)) } else { - out <- ifelse(igraph::which_mutual(g), 0.2, 0) + p <- p + ggraph::geom_node_label(ggplot2::aes(label = name), + repel = TRUE, seed = 1234, size = 3) } - out } -.infer_nsize <- function(g, node_size){ - if (!is.null(node_size)) { - if (is.character(node_size)) { - out <- node_attribute(g, node_size) - } else if (is.numeric(node_size)) { - out <- node_size +# `graphr()` helper functions +reduce_categories <- function(g, node_group) { + limit <- toCondense <- NULL + if (sum(table(node_attribute(g, node_group)) <= 2) > 2 & + length(unique(node_attribute(g, node_group))) > 2) { + toCondense <- names(which(table(node_attribute(g, node_group)) <= 2)) + out <- ifelse(node_attribute(g, node_group) %in% toCondense, + "Other", node_attribute(g, node_group)) + message("The number of groups was reduced since there were groups with less than 2 nodes.") + } else if (sum(table(node_attribute(g, node_group)) <= 2) == 2 & + length(unique(node_attribute(g, node_group))) > 2) { + limit <- stats::reorder(node_attribute(g, node_group), + node_attribute(g, node_group), + FUN = length, decreasing = TRUE) + if (sum(utils::tail(attr(limit, "scores"), 2))) { + toCondense <- utils::tail(levels(limit), 3) } else { - out <- node_size(g) + toCondense <- utils::tail(levels(limit), 2) } - if(length(node_size > 1) & all(out <= 1 & out >= 0)) out <- out*10 - } else { - out <- min(20, (250 / net_nodes(g)) / 2) - } + out <- ifelse(node_attribute(g, node_group) %in% toCondense, "Other", + node_attribute(g, node_group)) + message("The number of groups was reduced since there were groups with less than 2 nodes.") + } else if (sum(table(node_attribute(g, node_group)) <= 2) == 1 & + length(unique(node_attribute(g, node_group))) > 2) { + limit <- stats::reorder(node_attribute(g, node_group), + node_attribute(g, node_group), + FUN = length, decreasing = TRUE) + toCondense <- utils::tail(levels(limit), 2) + out <- ifelse(node_attribute(g, node_group) %in% toCondense, "Other", + node_attribute(g, node_group)) + message("The number of groups was reduced since there were groups with less than 2 nodes.") + } else if (sum(table(node_attribute(g, node_group)) <= 2) == 1 & + length(unique(node_attribute(g, node_group))) == 2) { + out <- as.factor(node_attribute(g, node_group)) + message("Node groups with 2 nodes or less can be cause issues for plotting ...") + } else out <- as.factor(node_attribute(g, node_group)) out } -.infer_end_cap <- function(g, node_size) { - nsize <- NULL - g %>% - tidygraph::activate("edges") %>% - data.frame() %>% - left_join(data.frame(node_id = 1:length(node_names(g)), - nsize = .infer_nsize(g, node_size)/2), - by = c("to" = "node_id")) %>% - dplyr::select(nsize) +.infer_directed_edge_mapping <- function(g, edge_color, edge_size, node_size) { + check_edge_variables(g, edge_color, edge_size) + list("ecolor" = .infer_ecolor(g, edge_color), + "esize" = .infer_esize(g, edge_size), + "line_type" = .infer_line_type(g), + "end_cap" = .infer_end_cap(g, node_size)) } -.infer_shape <- function(g, node_shape) { - if (!is.null(node_shape)) { - if (node_shape %in% names(node_attribute(g))) { - out <- as.factor(node_attribute(g, node_shape)) - } else if (length(node_shape) == 1) { - out <- rep(node_shape, net_nodes(g)) +.infer_edge_mapping <- function(g, edge_color, edge_size) { + check_edge_variables(g, edge_color, edge_size) + list("ecolor" = .infer_ecolor(g, edge_color), + "esize" = .infer_esize(g, edge_size), + "line_type" = .infer_line_type(g)) +} + +.infer_ecolor <- function(g, edge_color){ + if (!is.null(edge_color)) { + if (edge_color %in% names(tie_attribute(g))) { + if ("tie_mark" %in% class(tie_attribute(g, edge_color))) { + out <- factor(as.character(tie_attribute(g, edge_color)), + levels = c("FALSE", "TRUE")) + } else out <- as.factor(as.character(tie_attribute(g, edge_color))) + if (length(unique(out)) == 1) { + out <- rep("black", net_ties(g)) + message("Please indicate a variable with more than one value or level when mapping edge colors.") + } + } else { + out <- edge_color + } + } else if (is.null(edge_color) & is_signed(g)) { + out <- as.factor(ifelse(igraph::E(g)$sign >= 0, "Positive", "Negative")) + if (length(unique(out)) == 1) { + out <- "black" } - } else if (is_twomode(g)) { - out <- ifelse(igraph::V(g)$type, "square", "circle") } else { - out <- "circle" + out <- "black" } out } -.infer_esize <- function(g, edge_size) { +.infer_esize <- function(g, edge_size){ if (!is.null(edge_size)) { - if (is.character(edge_size)) { + if (any(edge_size %in% names(tie_attribute(g)))) { out <- tie_attribute(g, edge_size) } else { out <- edge_size } - if (length(out > 1) & all(out <= 1 & out >= 0)) out <- out*10 } else if (is.null(edge_size) & is_weighted(g)) { out <- tie_attribute(g, "weight") } else { @@ -555,39 +366,31 @@ graphr <- function(.data, layout, labels = TRUE, out } -.check_color <- function(v) { - color <- grDevices::colors() - color <- color[!color %in% "black"] - v <- ifelse(is.na(v), "black", v) - if (!any(grepl(paste(color, collapse = "|"), v)) | any(grepl("^#", v))) { - for(i in unique(v)) { - if (i != "black") { - v[v == i] <- sample(color, 1) - } - } +.infer_end_cap <- function(g, node_size) { + nsize <- .infer_nsize(g, node_size)/2 + # Accounts for rescaling + if (length(unique(nsize)) == 1) { + out <- rep(unique(nsize), net_ties(g)) + } else { + out <- g %>% + tidygraph::activate("edges") %>% + data.frame() %>% + dplyr::left_join(data.frame(node_id = 1:length(node_names(g)), + nsize = nsize), + by = c("to" = "node_id")) + out <- out$nsize + out <- ((out - min(out)) / (max(out) - min(out))) * + ((1 / net_nodes(g) * 100) - (1 / net_nodes(g)*50)) + (1 / net_nodes(g) * 50) } - v + out } -# .collapse_guides <- function(plist) { -# glist <- list() -# for (i in seq_len(length(plist))) { -# glist[[i]] <- names(which(apply(plist[[i]]$data[c("Infected", -# "Exposed", -# "Recovered")], -# 2, function(x) length(unique(x)) > 1))) -# } -# if (any(lengths(glist) > 0)) { -# kl <- which.max(unlist(lapply(glist, length))) -# for (i in setdiff(seq_len(length(plist)), kl)) { -# plist[[i]]["guides"] <- NULL -# } -# } -# plist -# } - -.is_mark_attrib <- function(x) { - if ("node_mark" %in% class(x)) TRUE else FALSE +.infer_line_type <- function(g) { + if (is_signed(g)) { + out <- ifelse(as.numeric(tie_attribute(g, "sign")) >= 0, + "solid", "dashed") + ifelse(length(unique(out)) == 1, unique(out), out) + } else "solid" } check_edge_variables <- function(g, edge_color, edge_size) { @@ -604,6 +407,113 @@ check_edge_variables <- function(g, edge_color, edge_size) { } } +map_directed_edges <- function(p, g, out) { + if (length(out[["ecolor"]]) == 1 & length(out[["esize"]]) == 1) { + p <- p + ggraph::geom_edge_arc(ggplot2::aes(end_cap = ggraph::circle(c(out[["end_cap"]]), 'mm')), + edge_colour = out[["ecolor"]], edge_width = out[["esize"]], + edge_linetype = out[["line_type"]], + edge_alpha = 0.4, strength = ifelse(igraph::which_mutual(g), 0.2, 0), + arrow = ggplot2::arrow(angle = 15, type = "closed", + length = ggplot2::unit(2, 'mm'))) + } else if (length(out[["ecolor"]]) > 1 & length(out[["esize"]]) == 1) { + p <- p + ggraph::geom_edge_arc(ggplot2::aes(edge_colour = out[["ecolor"]], + end_cap = ggraph::circle(c(out[["end_cap"]]), 'mm')), + edge_width = out[["esize"]], edge_linetype = out[["line_type"]], + edge_alpha = 0.4, strength = ifelse(igraph::which_mutual(g), 0.2, 0), + arrow = ggplot2::arrow(angle = 15, type = "closed", + length = ggplot2::unit(2, 'mm'))) + } else if (length(out[["ecolor"]]) == 1 & length(out[["esize"]]) > 1) { + p <- p + ggraph::geom_edge_arc(ggplot2::aes(edge_width = out[["esize"]], + end_cap = ggraph::circle(c(out[["end_cap"]]), 'mm')), + edge_colour = out[["ecolor"]], edge_linetype = out[["line_type"]], + edge_alpha = 0.4, strength = ifelse(igraph::which_mutual(g), 0.2, 0), + arrow = ggplot2::arrow(angle = 15, type = "closed", + length = ggplot2::unit(2, 'mm'))) + } else { + p <- p + ggraph::geom_edge_arc(ggplot2::aes(edge_colour = out[["ecolor"]], + edge_width = out[["esize"]], + end_cap = ggraph::circle(c(out[["end_cap"]]), 'mm')), + edge_linetype = out[["line_type"]], + edge_alpha = 0.4, strength = ifelse(igraph::which_mutual(g), 0.2, 0), + arrow = ggplot2::arrow(angle = 15, type = "closed", + length = ggplot2::unit(2, 'mm'))) + } + p +} + +map_edges <- function(p, g, out) { + if (length(out[["ecolor"]]) == 1 & length(out[["esize"]]) == 1) { + p <- p + ggraph::geom_edge_link0(edge_width = out[["esize"]], + edge_colour = out[["ecolor"]], + edge_alpha = 0.4, + edge_linetype = out[["line_type"]]) + } else if (length(out[["ecolor"]]) > 1 & length(out[["esize"]]) == 1) { + p <- p + ggraph::geom_edge_link0(ggplot2::aes(edge_colour = out[["ecolor"]]), + edge_width = out[["esize"]], + edge_alpha = 0.4, + edge_linetype = out[["line_type"]]) + } else if (length(out[["ecolor"]]) == 1 & length(out[["esize"]]) > 1) { + p <- p + ggraph::geom_edge_link0(ggplot2::aes(edge_width = out[["esize"]]), + edge_colour = out[["ecolor"]], + edge_alpha = 0.4, + edge_linetype = out[["line_type"]]) + } else { + p <- p + ggraph::geom_edge_link0(ggplot2::aes(edge_width = out[["esize"]], + edge_colour = out[["ecolor"]]), + edge_alpha = 0.4, edge_linetype = out[["line_type"]]) + } +} + +.infer_node_mapping <- function(g, node_color, node_size, node_shape) { + check_node_variables(g, node_color, node_size) + list("nshape" = .infer_nshape(g, node_shape), + "nsize" = .infer_nsize(g, node_size), + "ncolor" = .infer_ncolor(g, node_color)) +} + +.infer_nsize <- function(g, node_size) { + if (!is.null(node_size)) { + if (is.character(node_size)) { + out <- node_attribute(g, node_size) + } else out <- node_size + if (length(node_size > 1) & all(out <= 1 & out >= 0)) out <- out * 10 + } else { + out <- min(20, (250 / net_nodes(g)) / 2) + } + as.numeric(out) +} + +.infer_nshape <- function(g, node_shape) { + if (!is.null(node_shape)) { + if (node_shape %in% names(node_attribute(g))) { + out <- as.factor(as.character(node_attribute(g, node_shape))) + } else out <- node_shape + } else if (is_twomode(g) & is.null(node_shape)) { + out <- ifelse(igraph::V(g)$type, "One", "Two") + } else { + out <- "circle" + } + out +} + +.infer_ncolor <- function(g, node_color) { + if (!is.null(node_color)) { + if (node_color %in% names(node_attribute(g))) { + if ("node_mark" %in% class(node_attribute(g, node_color))) { + out <- factor(as.character(node_attribute(g, node_color)), + levels = c("FALSE", "TRUE")) + } else out <- as.factor(as.character(node_attribute(g, node_color))) + if (length(unique(out)) == 1) { + out <- rep("black", net_nodes(g)) + message("Please indicate a variable with more than one value or level when mapping node colors.") + } + } else out <- node_color + } else { + out <- "black" + } + out +} + check_node_variables <- function(g, node_color, node_size) { if (!is.null(node_color)) { if (any(!tolower(node_color) %in% tolower(igraph::vertex_attr_names(g))) & @@ -618,6 +528,139 @@ check_node_variables <- function(g, node_color, node_size) { } } +map_infected_nodes<- function(p, g, out) { + node_color <- as.factor(ifelse(node_attribute(g, "Exposed"), "Exposed", + ifelse(node_attribute(g, "Infected"),"Infected", + ifelse(node_attribute(g, "Recovered"), "Recovered", + "Susceptible")))) + p + ggraph::geom_node_point(ggplot2::aes(color = node_color), + size = out[["nsize"]], shape = out[["nshape"]]) + + ggplot2::scale_color_manual(name = NULL, guide = ggplot2::guide_legend(""), + values = c("Infected" = "#d73027", + "Susceptible" = "#4575b4", + "Exposed" = "#E6AB02", + "Recovered" = "#66A61E")) +} + +map_diff_model_nodes <- function(p, g, out) { + node_adopts <- node_adoption_time(attr(g,"diff_model")) + nshape <- ifelse(node_adopts == min(node_adopts), "Seed(s)", + ifelse(node_adopts == Inf, "Non-Adopter", "Adopter")) + node_color <- ifelse(is.infinite(node_adopts), + max(node_adopts[!is.infinite(node_adopts)]) + 1, + node_adopts) + p + ggraph::geom_node_point(ggplot2::aes(shape = nshape, color = node_color), + size = out[["nsize"]]) + + ggplot2::scale_color_gradient(low = "#d73027", high = "#4575b4", + breaks=c(min(node_color)+1, + ifelse(any(nshape=="Non-Adopter"), + max(node_color)-1, + max(node_color))), + labels=c("Early\nadoption", "Late\nadoption"), + name = "Time of\nAdoption\n") + + ggplot2::scale_shape_manual(name = "", + breaks = c("Seed(s)", "Adopter", "Non-Adopter"), + values = c("Seed(s)" = "triangle", + "Adopter" = "circle", + "Non-Adopter" = "square")) + + ggplot2::guides(color = ggplot2::guide_colorbar(order = 1, reverse = TRUE), + shape = ggplot2::guide_legend(order = 2)) +} + +map_nodes <- function(p, out) { + if (length(out[["ncolor"]]) == 1 & length(out[["nsize"]]) == 1 & length(out[["nshape"]]) == 1) { + p <- p + ggraph::geom_node_point(colour = out[["ncolor"]], size = out[["nsize"]], + shape = out[["nshape"]]) + } else if (length(out[["ncolor"]]) > 1 & length(out[["nsize"]]) == 1 & length(out[["nshape"]]) == 1) { + p <- p + ggraph::geom_node_point(ggplot2::aes(colour = out[["ncolor"]]), + size = out[["nsize"]], shape = out[["nshape"]]) + } else if (length(out[["ncolor"]]) == 1 & length(out[["nsize"]]) > 1 & length(out[["nshape"]]) == 1) { + p <- p + ggraph::geom_node_point(ggplot2::aes(size = out[["nsize"]]), + colour = out[["ncolor"]], shape = out[["nshape"]]) + } else if (length(out[["ncolor"]]) == 1 & length(out[["nsize"]]) == 1 & length(out[["nshape"]]) > 1) { + p <- p + ggraph::geom_node_point(ggplot2::aes(shape = out[["nshape"]]), + colour = out[["ncolor"]], size = out[["nsize"]]) + } else if (length(out[["ncolor"]]) > 1 & length(out[["nsize"]]) > 1 & length(out[["nshape"]]) == 1) { + p <- p + ggraph::geom_node_point(ggplot2::aes(colour = out[["ncolor"]], size = out[["nsize"]]), + shape = out[["nshape"]]) + } else if (length(out[["ncolor"]]) > 1 & length(out[["nsize"]]) == 1 & length(out[["nshape"]]) > 1) { + p <- p + ggraph::geom_node_point(ggplot2::aes(colour = out[["ncolor"]], shape = out[["nshape"]]), + size = out[["nsize"]]) + } else if (length(out[["ncolor"]]) == 1 & length(out[["nsize"]]) > 1 & length(out[["nshape"]]) > 1) { + p <- p + ggraph::geom_node_point(ggplot2::aes(size = out[["nsize"]], shape = out[["nshape"]]), + colour = out[["ncolor"]]) + } else { + p <- p + ggraph::geom_node_point(ggplot2::aes(colour = out[["ncolor"]], + shape = out[["nshape"]], + size = out[["nsize"]])) + } + p +} + + +cart2pol <- function(xyz){ + stopifnot(is.numeric(xyz)) + if (is.vector(xyz) && (length(xyz) == 2 || length(xyz) == + 3)) { + x <- xyz[1] + y <- xyz[2] + m <- 1 + n <- length(xyz) + } + else if (is.matrix(xyz) && (ncol(xyz) == 2 || ncol(xyz) == + 3)) { + x <- xyz[, 1] + y <- xyz[, 2] + m <- nrow(xyz) + n <- ncol(xyz) + } + else cli::cli_abort("Input must be a vector of length 3 or a matrix with 3 columns.") + phi <- atan2(y, x) + r <- hypot(x, y) + if (n == 2) { + if (m == 1) + prz <- c(phi, r) + else prz <- cbind(phi, r) + } + else { + if (m == 1) { + z <- xyz[3] + prz <- c(phi, r, z) + } + else { + z <- xyz[, 3] + prz <- cbind(phi, r, z) + } + } + return(prz) +} + +hypot <- function (x, y) { + if ((length(x) == 0 && is.numeric(y) && length(y) <= 1) || + (length(y) == 0 && is.numeric(x) && length(x) <= 1)) + return(vector()) + if (!is.numeric(x) && !is.complex(x) || !is.numeric(y) && + !is.complex(y)) + cli::cli_abort("Arguments 'x' and 'y' must be numeric or complex.") + if (length(x) == 1 && length(y) > 1) { + x <- rep(x, length(y)) + dim(x) <- dim(y) + } + else if (length(x) > 1 && length(y) == 1) { + y <- rep(y, length(x)) + dim(y) <- dim(x) + } + if ((is.vector(x) && is.vector(y) && length(x) != length(y)) || + (is.matrix(x) && is.matrix(y) && dim(x) != dim(y)) || + (is.vector(x) && is.matrix(y)) || is.matrix(x) && is.vector(y)) + cli::cli_abort("Arguments 'x' and 'y' must be of the same size.") + x <- abs(x) + y <- abs(y) + m <- pmin(x, y) + M <- pmax(x, y) + ifelse(M == 0, 0, M * sqrt(1 + (m/M)^2)) +} + # Longitudinal or comparative networks #### #' Easily graph a set of networks with sensible defaults @@ -714,6 +757,7 @@ graphs <- function(netlist, waves, do.call(patchwork::wrap_plots, c(gs, list(guides = "collect"))) } +# `graphs()` helper functions is_ego_network <- function(nlist) { if (all(unique(names(nlist)) != "")) { length(names(nlist)) == length(unique(unlist(unname(lapply(nlist, node_names))))) & @@ -969,107 +1013,19 @@ map_dynamic <- function(edges_out, nodes_out, edge_color, node_shape, p } -# Helpers #### - -reduce_categories <- function(g, node_group) { - limit <- toCondense <- NULL - if (sum(table(node_attribute(g, node_group)) <= 2) > 2 & - length(unique(node_attribute(g, node_group))) > 2) { - toCondense <- names(which(table(node_attribute(g, node_group)) <= 2)) - out <- ifelse(node_attribute(g, node_group) %in% toCondense, - "Other", node_attribute(g, node_group)) - message("The number of groups was reduced since there were groups with less than 2 nodes.") - } else if (sum(table(node_attribute(g, node_group)) <= 2) == 2 & - length(unique(node_attribute(g, node_group))) > 2) { - limit <- stats::reorder(node_attribute(g, node_group), - node_attribute(g, node_group), - FUN = length, decreasing = TRUE) - if (sum(utils::tail(attr(limit, "scores"), 2))) { - toCondense <- utils::tail(levels(limit), 3) - } else { - toCondense <- utils::tail(levels(limit), 2) - } - out <- ifelse(node_attribute(g, node_group) %in% toCondense, "Other", - node_attribute(g, node_group)) - message("The number of groups was reduced since there were groups with less than 2 nodes.") - } else if (sum(table(node_attribute(g, node_group)) <= 2) == 1 & - length(unique(node_attribute(g, node_group))) > 2) { - limit <- stats::reorder(node_attribute(g, node_group), - node_attribute(g, node_group), - FUN = length, decreasing = TRUE) - toCondense <- utils::tail(levels(limit), 2) - out <- ifelse(node_attribute(g, node_group) %in% toCondense, "Other", - node_attribute(g, node_group)) - message("The number of groups was reduced since there were groups with less than 2 nodes.") - } else if (sum(table(node_attribute(g, node_group)) <= 2) == 1 & - length(unique(node_attribute(g, node_group))) == 2) { - out <- as.factor(node_attribute(g, node_group)) - message("Node groups with 2 nodes or less can be cause issues for plotting ...") - } else out <- as.factor(node_attribute(g, node_group)) - out -} - -cart2pol <- function(xyz){ - stopifnot(is.numeric(xyz)) - if (is.vector(xyz) && (length(xyz) == 2 || length(xyz) == - 3)) { - x <- xyz[1] - y <- xyz[2] - m <- 1 - n <- length(xyz) - } - else if (is.matrix(xyz) && (ncol(xyz) == 2 || ncol(xyz) == - 3)) { - x <- xyz[, 1] - y <- xyz[, 2] - m <- nrow(xyz) - n <- ncol(xyz) - } - else cli::cli_abort("Input must be a vector of length 3 or a matrix with 3 columns.") - phi <- atan2(y, x) - r <- hypot(x, y) - if (n == 2) { - if (m == 1) - prz <- c(phi, r) - else prz <- cbind(phi, r) - } - else { - if (m == 1) { - z <- xyz[3] - prz <- c(phi, r, z) - } - else { - z <- xyz[, 3] - prz <- cbind(phi, r, z) +# `graphd()` helper functions +.check_color <- function(v) { + color <- grDevices::colors() + color <- color[!color %in% "black"] + v <- ifelse(is.na(v), "black", v) + if (!any(grepl(paste(color, collapse = "|"), v)) | any(grepl("^#", v))) { + for(i in unique(v)) { + if (i != "black") { + v[v == i] <- sample(color, 1) + } } } - return(prz) -} - -hypot <- function (x, y) { - if ((length(x) == 0 && is.numeric(y) && length(y) <= 1) || - (length(y) == 0 && is.numeric(x) && length(x) <= 1)) - return(vector()) - if (!is.numeric(x) && !is.complex(x) || !is.numeric(y) && - !is.complex(y)) - cli::cli_abort("Arguments 'x' and 'y' must be numeric or complex.") - if (length(x) == 1 && length(y) > 1) { - x <- rep(x, length(y)) - dim(x) <- dim(y) - } - else if (length(x) > 1 && length(y) == 1) { - y <- rep(y, length(x)) - dim(y) <- dim(x) - } - if ((is.vector(x) && is.vector(y) && length(x) != length(y)) || - (is.matrix(x) && is.matrix(y) && dim(x) != dim(y)) || - (is.vector(x) && is.matrix(y)) || is.matrix(x) && is.vector(y)) - cli::cli_abort("Arguments 'x' and 'y' must be of the same size.") - x <- abs(x) - y <- abs(y) - m <- pmin(x, y) - M <- pmax(x, y) - ifelse(M == 0, 0, M * sqrt(1 + (m/M)^2)) + v } time_edges_lst <- function(tlist, edges_lst, nodes_lst, edge_color) { diff --git a/R/mark_ties.R b/R/mark_ties.R index 18b6aa26..d95f2597 100644 --- a/R/mark_ties.R +++ b/R/mark_ties.R @@ -79,14 +79,15 @@ tie_is_bridge <- function(.data){ } #' @rdname mark_ties -#' @param from The index or name of the node from which the path should be traced. +#' @inheritParams manip_paths #' @param to The index or name of the node to which the path should be traced. #' @param all_paths Whether to return a list of paths or sample just one. #' By default FALSE, sampling just a single path. #' @importFrom igraph all_shortest_paths #' @examples -#' ison_adolescents %>% mutate_ties(route = tie_is_path(from = "Jane", to = 7)) %>% -#' graphr(edge_colour = "route") +#' ison_adolescents %>% +#' mutate_ties(route = tie_is_path(from = "Jane", to = 7)) %>% +#' graphr(edge_colour = "route") #' @export tie_is_path <- function(.data, from, to, all_paths = FALSE){ if(missing(.data)) {expect_edges(); .data <- .G()} diff --git a/R/measure_centrality.R b/R/measure_centrality.R index 8fd34954..85a6c5c7 100644 --- a/R/measure_centrality.R +++ b/R/measure_centrality.R @@ -13,6 +13,7 @@ #' - `node_outdegree()` returns the `direction = 'out'` results. #' - `node_multidegree()` measures the ratio between types of ties in a multiplex network. #' - `node_posneg()` measures the PN (positive-negative) centrality of a signed network. +#' - `node_leverage()` measures the leverage centrality of nodes in a network. #' - `tie_degree()` measures the degree centrality of ties in a network #' - `net_degree()` measures a network's degree centralization; #' there are several related shortcut functions: @@ -187,6 +188,25 @@ node_posneg <- function(.data){ make_node_measure(out, .data) } +#' @rdname measure_central_degree +#' @section Leverage centrality: +#' Leverage centrality concerns the degree of a node compared with that of its +#' neighbours, \eqn{J}: +#' \deqn{C_L(i) = \frac{1}{deg(i)} \sum_{j \in J(i)} \frac{deg(i) - deg(j)}{deg(i) + deg(j)}} +#' @references +#' ## On leverage centrality +#' Joyce, Karen E., Paul J. Laurienti, Jonathan H. Burdette, and Satoru Hayasaka. 2010. +#' "A New Measure of Centrality for Brain Networks". +#' _PLoS ONE_ 5(8): e12200. +#' \doi{10.1371/journal.pone.0012200} +#' @export +node_leverage <- function(.data){ + if(missing(.data)) {expect_nodes(); .data <- .G()} + out <- (node_deg(.data) - node_neighbours_degree(.data))/ + (node_deg(.data) + node_neighbours_degree(.data)) + make_node_measure(out, .data) +} + #' @rdname measure_central_degree #' @examples #' tie_degree(ison_adolescents) @@ -263,6 +283,7 @@ net_indegree <- function(.data, normalized = TRUE){ #' - `node_flow()` measures the flow betweenness centralities of nodes in a network, #' which uses an electrical current model for information spreading #' in contrast to the shortest paths model used by normal betweenness centrality. +#' - `node_stress()` measures the stress centrality of nodes in a network. #' - `tie_betweenness()` measures the number of shortest paths going through a tie. #' - `net_betweenness()` measures the betweenness centralization for a network. #' @@ -281,6 +302,16 @@ net_indegree <- function(.data, normalized = TRUE){ NULL #' @rdname measure_central_between +#' @section Betweenness centrality: +#' Betweenness centrality is based on the number of shortest paths between +#' other nodes that a node lies upon: +#' \deqn{C_B(i) = \sum_{j,k:j \neq k, j \neq i, k \neq i} \frac{g_{jik}}{g_{jk}}} +#' @references +#' ## On betweenness centrality +#' Freeman, Linton. 1977. +#' "A set of measures of centrality based on betweenness". +#' _Sociometry_, 40(1): 35–41. +#' \doi{10.2307/3033543} #' @examples #' node_betweenness(ison_southern_women) #' @return A numeric vector giving the betweenness centrality measure of each node. @@ -319,14 +350,18 @@ node_betweenness <- function(.data, normalized = TRUE, } #' @rdname measure_central_between -#' @examples -#' node_induced(ison_adolescents) +#' @section Induced centrality: +#' Induced centrality or vitality centrality concerns the change in +#' total betweenness centrality between networks with and without a given node: +#' \deqn{C_I(i) = C_B(G) - C_B(G\ i)} #' @references #' ## On induced centrality #' Everett, Martin and Steve Borgatti. 2010. #' "Induced, endogenous and exogenous centrality" #' _Social Networks_, 32: 339-344. #' \doi{10.1016/j.socnet.2010.06.004} +#' @examples +#' node_induced(ison_adolescents) #' @export node_induced <- function(.data, normalized = TRUE, cutoff = NULL){ @@ -342,19 +377,58 @@ node_induced <- function(.data, normalized = TRUE, make_node_measure(out, .data) } - #' @rdname measure_central_between +#' @section Flow betweenness centrality: +#' Flow betweenness centrality concerns the total maximum flow, \eqn{f}, +#' between other nodes \eqn{j,k} in a network \eqn{G} that a given node mediates: +#' \deqn{C_F(i) = \sum_{j,k:j\neq k, j\neq i, k\neq i} f(j,k,G) - f(j,k,G\ i)} +#' When normalized (by default) this sum of differences is divided by the +#' sum of flows \eqn{f(i,j,G)}. +#' @references +#' ## On flow centrality +#' Freeman, Lin, Stephen Borgatti, and Douglas White. 1991. +#' "Centrality in Valued Graphs: A Measure of Betweenness Based on Network Flow". +#' _Social Networks_, 13(2), 141-154. +#' +#' Koschutzki, D., K.A. Lehmann, L. Peeters, S. Richter, D. Tenfelde-Podehl, and O. Zlotowski. 2005. +#' "Centrality Indices". +#' In U. Brandes and T. Erlebach (eds.), _Network Analysis: Methodological Foundations_. +#' Berlin: Springer. #' @export node_flow <- function(.data, normalized = TRUE){ if(missing(.data)) {expect_nodes(); .data <- .G()} thisRequires("sna") - out <- sna::flowbet(manynet::as_network(.data), - gmode = ifelse(manynet::is_directed(.data), "digraph", "graph"), - diag = manynet::is_complex(.data), + out <- sna::flowbet(as_network(.data), + gmode = ifelse(is_directed(.data), "digraph", "graph"), + diag = is_complex(.data), cmode = ifelse(normalized, "normflow", "rawflow")) make_node_measure(out, .data) } +#' @rdname measure_central_between +#' @section Stress centrality: +#' Stress centrality is the number of all shortest paths or geodesics, \eqn{g}, +#' between other nodes that a given node mediates: +#' \deqn{C_S(i) = \sum_{j,k:j \neq k, j \neq i, k \neq i} g_{jik}} +#' High stress nodes lie on a large number of shortest paths between other +#' nodes, and thus associated with bridging or spanning boundaries. +#' @references +#' ## On stress centrality +#' Shimbel, A. 1953. +#' "Structural Parameters of Communication Networks". +#' _Bulletin of Mathematical Biophysics_, 15:501-507. +#' \doi{10.1007/BF02476438} +#' @export +node_stress <- function(.data, normalized = TRUE){ + if(missing(.data)) {expect_nodes(); .data <- .G()} + thisRequires("sna") + out <- sna::stresscent(as_network(.data), + gmode = ifelse(is_directed(.data), "digraph", "graph"), + diag = is_complex(.data), + rescale = normalized) + make_node_measure(out, .data) +} + #' @rdname measure_central_between #' @importFrom igraph edge_betweenness #' @examples @@ -435,17 +509,24 @@ net_betweenness <- function(.data, normalized = TRUE, #' Measures of closeness-like centrality and centralisation #' @description -#' These functions calculate common closeness-related centrality measures for one- and two-mode networks: +#' These functions calculate common closeness-related centrality measures +#' that rely on path-length for one- and two-mode networks: #' -#' - `node_closeness()` measures the closeness centrality of nodes in a network. +#' - `node_closeness()` measures the closeness centrality of nodes in a +#' network. #' - `node_reach()` measures nodes' reach centrality, #' or how many nodes they can reach within _k_ steps. -#' - `node_harmonic()` measures nodes' harmonic centrality or valued centrality, -#' which is thought to behave better than reach centrality for disconnected networks. +#' - `node_harmonic()` measures nodes' harmonic centrality or valued +#' centrality, which is thought to behave better than reach centrality +#' for disconnected networks. #' - `node_information()` measures nodes' information centrality or #' current-flow closeness centrality. -#' - `node_distance()` measures nodes' geodesic distance from or to a given node. -#' - `tie_closeness()` measures the closeness of each tie to other ties in the network. +#' - `node_eccentricity()` measures nodes' eccentricity or maximum distance +#' from another node in the network. +#' - `node_distance()` measures nodes' geodesic distance from or to a +#' given node. +#' - `tie_closeness()` measures the closeness of each tie to other ties +#' in the network. #' - `net_closeness()` measures a network's closeness centralization. #' - `net_reach()` measures a network's reach centralization. #' - `net_harmonic()` measures a network's harmonic centralization. @@ -464,6 +545,23 @@ NULL #' @rdname measure_central_close #' @param cutoff Maximum path length to use during calculations. +#' @section Closeness centrality: +#' Closeness centrality or status centrality is defined as the reciprocal of +#' the farness or distance, \eqn{d}, +#' from a node to all other nodes in the network: +#' \deqn{C_C(i) = \frac{1}{\sum_j d(i,j)}} +#' When (more commonly) normalised, the numerator is instead \eqn{N-1}. +#' @references +#' ## On closeness centrality +#' Bavelas, Alex. 1950. +#' "Communication Patterns in Task‐Oriented Groups". +#' _The Journal of the Acoustical Society of America_, 22(6): 725–730. +#' \doi{10.1121/1.1906679} +#' +#' Harary, Frank. 1959. +#' "Status and Contrastatus". +#' _Sociometry_, 22(1): 23–43. +#' \doi{10.2307/2785610} #' @examples #' node_closeness(ison_southern_women) #' @export @@ -492,53 +590,149 @@ node_closeness <- function(.data, normalized = TRUE, } #' @rdname measure_central_close -#' @param k Integer of steps out to calculate reach. -#' @examples -#' node_reach(ison_adolescents) -#' @export -node_reach <- function(.data, normalized = TRUE, k = 2){ - if(missing(.data)) {expect_nodes(); .data <- .G()} - if(manynet::is_weighted(.data)){ - tore <- manynet::as_matrix(.data)/mean(manynet::as_matrix(.data)) - out <- 1/tore - } else out <- igraph::distances(manynet::as_igraph(.data)) - diag(out) <- 0 - out <- rowSums(out<=k) - if(normalized) out <- out/(manynet::net_nodes(.data)-1) - out <- make_node_measure(out, .data) - out -} - -#' @rdname measure_central_close +#' @section Harmonic centrality: +#' Harmonic centrality or valued centrality reverses the sum and reciprocal +#' operations compared to closeness centrality: +#' \deqn{C_H(i) = \sum_{i, i \neq j} \frac{1}{d(i,j)}} +#' where \eqn{\frac{1}{d(i,j)} = 0} where there is no path between \eqn{i} and +#' \eqn{j}. Normalization is by \eqn{N-1}. +#' Since the harmonic mean performs better than the arithmetic mean on +#' unconnected networks, i.e. networks with infinite distances, +#' harmonic centrality is to be preferred in these cases. #' @references #' ## On harmonic centrality -#' Marchiori, M, and V Latora. 2000. +#' Marchiori, Massimo, and Vito Latora. 2000. #' "Harmony in the small-world". #' _Physica A_ 285: 539-546. +#' \doi{10.1016/S0378-4371(00)00311-3} #' #' Dekker, Anthony. 2005. #' "Conceptual distance in social network analysis". #' _Journal of Social Structure_ 6(3). #' @export -node_harmonic <- function(.data, normalized = TRUE, k = -1){ +node_harmonic <- function(.data, normalized = TRUE, cutoff = -1){ if(missing(.data)) {expect_nodes(); .data <- .G()} out <- igraph::harmonic_centrality(as_igraph(.data), # weighted if present - normalized = normalized, cutoff = k) + normalized = normalized, cutoff = cutoff) out <- make_node_measure(out, .data) out } #' @rdname measure_central_close +#' @section Reach centrality: +#' In some cases, longer path lengths are irrelevant and 'closeness' should +#' be defined as how many others are in a local neighbourhood. +#' How many steps out this neighbourhood should be defined as is given by +#' the 'cutoff' parameter. +#' This is usually termed \eqn{k} or \eqn{m} in equations, +#' which is why this is sometimes called (\eqn{m}- or) +#' \eqn{k}-step reach centrality: +#' \deqn{C_R(i) = \sum_j d(i,j) \leq k} +#' The maximum reach score is \eqn{N-1}, achieved when the node can reach all +#' other nodes in the network in \eqn{k} steps or less, +#' but the normalised version, \eqn{\frac{C_R}{N-1}}, is more common. +#' Note that if \eqn{k = 1} (i.e. cutoff = 1), then this returns the node's degree. +#' At higher cutoff reach centrality returns the size of the node's component. +#' @references +#' ## On reach centrality +#' Borgatti, Stephen P., Martin G. Everett, and J.C. Johnson. 2013. +#' _Analyzing social networks_. +#' London: SAGE Publications Limited. +#' @examples +#' node_reach(ison_adolescents) +#' @export +node_reach <- function(.data, normalized = TRUE, cutoff = 2){ + if(missing(.data)) {expect_nodes(); .data <- .G()} + if(is_weighted(.data)){ + tore <- as_matrix(.data)/mean(as_matrix(.data)) + out <- 1/tore + } else out <- igraph::distances(as_igraph(.data)) + diag(out) <- 0 + out <- rowSums(out <= cutoff) + if(normalized) out <- out/(net_nodes(.data)-1) + out <- make_node_measure(out, .data) + out +} + +#' @rdname measure_central_close +#' @section Information centrality: +#' Information centrality, also known as current-flow centrality, +#' is a hybrid measure relating to both path-length and walk-based measures. +#' The information centrality of a node is the harmonic average of the +#' “bandwidth” or inverse path-length for all paths originating from the node. +#' +#' As described in the `{sna}` package, +#' information centrality works on an undirected but potentially weighted +#' network excluding isolates (which take scores of zero). +#' It is defined as: +#' \deqn{C_I = \frac{1}{T + \frac{\sum T - 2 \sum C_1}{|N|}}} +#' where \eqn{C = B^-1} with \eqn{B} is a pseudo-adjacency matrix replacing +#' the diagonal of \eqn{1-A} with \eqn{1+k}, +#' and \eqn{T} is the trace of \eqn{C} and \eqn{S_R} an arbitrary row sum +#' (all rows in \eqn{C} have the same sum). +#' +#' Nodes with higher information centrality have a large number of short paths +#' to many others in the network, and are thus considered to have greater +#' control of the flow of information. +#' @references +#' ## On information centrality +#' Stephenson, Karen, and Marvin Zelen. 1989. +#' "Rethinking centrality: Methods and examples". +#' _Social Networks_ 11(1):1-37. +#' \doi{10.1016/0378-8733(89)90016-6} +#' +#' Brandes, Ulrik, and Daniel Fleischer. 2005. +#' "Centrality Measures Based on Current Flow". +#' _Proc. 22nd Symp. Theoretical Aspects of Computer Science_ LNCS 3404: 533-544. +#' \doi{10.1007/978-3-540-31856-9_44} #' @export node_information <- function(.data, normalized = TRUE){ if(missing(.data)) {expect_nodes(); .data <- .G()} thisRequires("sna") out <- sna::infocent(manynet::as_network(.data), gmode = ifelse(manynet::is_directed(.data), "digraph", "graph"), - diag = manynet::is_complex(.data)) + diag = manynet::is_complex(.data), + rescale = normalized) make_node_measure(out, .data) } +#' @rdname measure_central_close +#' @section Eccentricity centrality: +#' Eccentricity centrality, graph centrality, or the Koenig number, +#' is the (if normalized, inverse of) the distance to the furthest node: +#' \deqn{C_E(i) = \frac{1}{max_{j \in N} d(i,j)}} +#' where the distance from \eqn{i} to \eqn{j} is \eqn{\infty} if unconnected. +#' As such it is only well defined for connected networks. +#' @references +#' ## On eccentricity centrality +#' Hage, Per, and Frank Harary. 1995. +#' "Eccentricity and centrality in networks". +#' _Social Networks_, 17(1): 57-63. +#' \doi{10.1016/0378-8733(94)00248-9} +#' @export +node_eccentricity <- function(.data, normalized = TRUE){ + if(missing(.data)) {expect_nodes(); .data <- .G()} + if(!is_connected(.data)) + mnet_unavailable("Eccentricity centrality is only available for connected networks.") + disties <- igraph::distances(as_igraph(.data)) + out <- apply(disties, 1, max) + if(normalized) out <- 1/out + make_node_measure(out, .data) +} + +# - `node_eccentricity()` measures nodes' eccentricity or Koenig number, +# a measure of farness based on number of links needed to reach +# most distant node in the network. +# #' @rdname measure_holes +# #' @importFrom igraph eccentricity +# #' @export +# cnode_eccentricity <- function(.data){ +# if(missing(.data)) {expect_nodes(); .data <- .G()} +# out <- igraph::eccentricity(manynet::as_igraph(.data), +# mode = "out") +# make_node_measure(out, .data) +# } + #' @rdname measure_central_close #' @param from,to Index or name of a node to calculate distances from or to. #' @export @@ -634,9 +828,9 @@ net_closeness <- function(.data, normalized = TRUE, #' @rdname measure_central_close #' @export -net_reach <- function(.data, normalized = TRUE, k = 2){ +net_reach <- function(.data, normalized = TRUE, cutoff = 2){ if(missing(.data)) {expect_nodes(); .data <- .G()} - reaches <- node_reach(.data, normalized = FALSE, k = k) + reaches <- node_reach(.data, normalized = FALSE, cutoff = cutoff) out <- sum(max(reaches) - reaches) if(normalized) out <- out / sum(manynet::net_nodes(.data) - reaches) make_network_measure(out, .data) @@ -644,9 +838,9 @@ net_reach <- function(.data, normalized = TRUE, k = 2){ #' @rdname measure_central_close #' @export -net_harmonic <- function(.data, normalized = TRUE, k = 2){ +net_harmonic <- function(.data, normalized = TRUE, cutoff = 2){ if(missing(.data)) {expect_nodes(); .data <- .G()} - harm <- node_harmonic(.data, normalized = FALSE, k = k) + harm <- node_harmonic(.data, normalized = FALSE, cutoff = cutoff) out <- sum(max(harm) - harm) if(normalized) out <- out / sum(manynet::net_nodes(.data) - harm) make_network_measure(out, .data) @@ -656,23 +850,31 @@ net_harmonic <- function(.data, normalized = TRUE, k = 2){ #' Measures of eigenvector-like centrality and centralisation #' @description -#' These functions calculate common eigenvector-related centrality measures for one- and two-mode networks: +#' These functions calculate common eigenvector-related centrality +#' measures, or walk-based eigenmeasures, for one- and two-mode networks: #' -#' - `node_eigenvector()` measures the eigenvector centrality of nodes in a network. -#' - `node_power()` measures the Bonacich, beta, or power centrality of nodes in a network. -#' - `node_alpha()` measures the alpha or Katz centrality of nodes in a network. +#' - `node_eigenvector()` measures the eigenvector centrality of nodes +#' in a network. +#' - `node_power()` measures the Bonacich, beta, or power centrality of +#' nodes in a network. +#' - `node_alpha()` measures the alpha or Katz centrality of nodes in a +#' network. #' - `node_pagerank()` measures the pagerank centrality of nodes in a network. -#' - `node_hub()` measures how well nodes in a network serve as hubs pointing to many authorities. -#' - `node_authority()` measures how well nodes in a network serve as authorities from many hubs. -#' - `tie_eigenvector()` measures the eigenvector centrality of ties in a network. -#' - `net_eigenvector()` measures the eigenvector centralization for a network. +#' - `node_hub()` measures how well nodes in a network serve as hubs pointing +#' to many authorities. +#' - `node_authority()` measures how well nodes in a network serve as +#' authorities from many hubs. +#' - `tie_eigenvector()` measures the eigenvector centrality of ties in a +#' network. +#' - `net_eigenvector()` measures the eigenvector centralization for a +#' network. #' #' All measures attempt to use as much information as they are offered, #' including whether the networks are directed, weighted, or multimodal. #' If this would produce unintended results, #' first transform the salient properties using e.g. [to_undirected()] functions. -#' All centrality and centralization measures return normalized measures by default, -#' including for two-mode networks. +#' All centrality and centralization measures return normalized measures +#' by default, including for two-mode networks. #' @name measure_central_eigen #' @family centrality #' @family measures diff --git a/R/measure_holes.R b/R/measure_holes.R index 479cf27d..95867a0b 100644 --- a/R/measure_holes.R +++ b/R/measure_holes.R @@ -13,9 +13,6 @@ #' according to Burt (1992) and for two-mode networks according to Hollway et al (2020). #' - `node_hierarchy()` measures nodes' exposure to hierarchy, #' where only one or two contacts are the source of closure. -#' - `node_eccentricity()` measures nodes' eccentricity or Koenig number, -#' a measure of farness based on number of links needed to reach -#' most distant node in the network. #' - `node_neighbours_degree()` measures nodes' average nearest neighbors degree, #' or \eqn{knn}, a measure of the type of local environment a node finds itself in #' - `tie_cohesion()` measures the ratio between common neighbors to ties' @@ -218,16 +215,6 @@ node_hierarchy <- function(.data){ make_node_measure(out, .data) } -#' @rdname measure_holes -#' @importFrom igraph eccentricity -#' @export -node_eccentricity <- function(.data){ - if(missing(.data)) {expect_nodes(); .data <- .G()} - out <- igraph::eccentricity(manynet::as_igraph(.data), - mode = "out") - make_node_measure(out, .data) -} - #' @rdname measure_holes #' @importFrom igraph knn #' @references diff --git a/R/zzz.R b/R/zzz.R index 9a048c47..6b19fb17 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -21,7 +21,7 @@ greet_startup_cli <- function() { tips <- c( "i" = "There are lots of ways to contribute to {.pkg manynet} at {.url https://github.com/stocnet/manynet/}.", - "i" = "Please let us know any issues or features requests at {.url https://github.com/stocnet/manynet/issues}. It's really helpful!", + "i" = "Please let us know any bugs, issues, or feature requests at {.url https://github.com/stocnet/manynet/issues}. It's really helpful!", "i" = "To eliminate package startup messages, use: `suppressPackageStartupMessages(library({.pkg manynet}))`.", # "i" = "Changing the theme of all your graphs is straightforward with `set_manynet_theme()`", "i" = "If there are too many messages in the console, run `options(manynet_verbosity = 'quiet')`", diff --git a/inst/tutorials/tutorial0/tutorial0.Rmd b/inst/tutorials/tutorial0/tutorial0.Rmd index d8d02cbf..375997ee 100644 --- a/inst/tutorials/tutorial0/tutorial0.Rmd +++ b/inst/tutorials/tutorial0/tutorial0.Rmd @@ -3,7 +3,7 @@ title: "Intro to R" author: "by James Hollway" output: learnr::tutorial: - theme: journal + theme: bootstrap runtime: shiny_prerendered description: > The aim of this tutorial is to offer a very, very short introduction to R diff --git a/inst/tutorials/tutorial1/data.Rmd b/inst/tutorials/tutorial1/data.Rmd index a8973e0a..1582e537 100644 --- a/inst/tutorials/tutorial1/data.Rmd +++ b/inst/tutorials/tutorial1/data.Rmd @@ -3,7 +3,7 @@ title: "Data" author: "by James Hollway" output: learnr::tutorial: - theme: journal + theme: flatly runtime: shiny_prerendered description: > This tutorial covers several ways to make and modify network data, diff --git a/inst/tutorials/tutorial1/data.html b/inst/tutorials/tutorial1/data.html index f1e9419d..0a2569ef 100644 --- a/inst/tutorials/tutorial1/data.html +++ b/inst/tutorials/tutorial1/data.html @@ -1056,19 +1056,19 @@
The Kamada-Kawai method inserts a spring between all pairs -of vertices that is the length of the graph distance between them. This -means that edges with a large weight will be longer. KK offers a good -layout for lattice-like networks, because it will try to space the +
The Kamada-Kawai (KK) method inserts a spring between all +pairs of vertices that is the length of the graph distance between them. +This means that edges with a large weight will be longer. KK offers a +good layout for lattice-like networks, because it will try to space the network out evenly.
-The Fruchterman-Reingold method uses an attractive force -between directly connected vertices, and a repulsive force between all -vertex pairs. The attractive force is proportional to the edge’s weight, -thus edges with a large weight will be shorter. FR offers a good +
The Fruchterman-Reingold (FR) method uses an attractive +force between directly connected vertices, and a repulsive force between +all vertex pairs. The attractive force is proportional to the edge’s +weight, thus edges with a large weight will be shorter. FR offers a good baseline for most types of networks.
-The Stress Minimisation method is related to the KK +
The Stress Minimisation (stress) method is related to the KK
algorithm, but offers better runtime, quality, and stability and so is
generally preferred. Indeed, {manynet}
uses it as the
default for most networks. It has the advantage of returning the same
@@ -494,18 +494,25 @@
graphr(ison_southern_women, layout = "mds") + ggtitle("Multidimensional Scaling")
-graphr(ison_southern_women, layout = "mds") + ggtitle("Multidimensional Scaling")
+graphr(ison_southern_women, layout = "mds") + ggtitle("Multidimensional Scaling")
Other such layouts include:
"pmds"
Grid layouts arrange nodes based on some cartesion coordinates. These +
Grid layouts arrange nodes based on some Cartesian coordinates. These can be useful for making sure all nodes’ labels are visible, but horizontal and vertical lines can overlap, making it difficult to distinguish whether some nodes are tied or not.
@@ -550,7 +557,8 @@Other times color may not be desired. Some publications require
grayscale images. To use a grayscale color palette, replace
-_hue
from above with _grey
:
_hue
from above with _grey
(note the ‘e’
+spelling):
Note that grayscale is more effective for continuous variables or +very few discrete variables than the number used here.
For this exercise, we’ll use the ison_brandes
dataset in
@@ -181,6 +182,7 @@
Let’s start with calculating degree. Remember that degree centrality is just the number of incident edges/ties to each node. It is therefore easy to calculate yourself. Just sum the rows or columns of the @@ -233,6 +235,7 @@
Often we are interested in the distribution of (degree) centrality in
a network. {manynet}
offers a way to get a pretty good
first look at this distribution, though there are more elaborate ways to
@@ -486,13 +489,21 @@
Choose another dataset included in {manynet}
. Name a
+plausible research question you could ask of the dataset relating to
each of the four main centrality measures (degree, betweenness,
-closeness, eigenvector) You may want to add these as titles or subtitles
-to each plot.
+closeness, eigenvector). Plot the network with nodes sized by each
+centrality measure, using titles or subtitles to record the question
+and/or centralization measure.
@@ -679,23 +690,23 @@