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 @@

Adding/deleting attributes

@@ -1087,22 +1087,22 @@

Adding/deleting attributes

@@ -1238,22 +1238,22 @@

Adding/deleting attributes

@@ -1273,23 +1273,23 @@

Adding/deleting attributes

@@ -1468,20 +1468,20 @@

Adding/deleting attributes

@@ -1623,17 +1623,17 @@

Adding/deleting attributes

@@ -1770,25 +1770,25 @@

Adding/deleting attributes

@@ -1897,27 +1897,27 @@

Adding/deleting attributes

@@ -2134,12 +2134,12 @@

Adding/deleting attributes

diff --git a/inst/tutorials/tutorial2/visualisation.Rmd b/inst/tutorials/tutorial2/visualisation.Rmd index d0eeb2b4..b27e4967 100644 --- a/inst/tutorials/tutorial2/visualisation.Rmd +++ b/inst/tutorials/tutorial2/visualisation.Rmd @@ -3,7 +3,7 @@ title: "Visualisation" author: "by James Hollway" output: learnr::tutorial: - theme: journal + theme: lumen runtime: shiny_prerendered description: > This tutorial aims to give an overview of how to use manynet and other @@ -247,19 +247,19 @@ These might include attractive and repulsive forces. graphr(ison_southern_women, layout = "stress") + ggtitle("Stress Minimisation")) ``` -The _Kamada-Kawai_ method inserts a spring between all pairs of vertices +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, +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 algorithm, +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 layout each time it is run on the same network. @@ -270,7 +270,7 @@ question("Can we interpret the distance between nodes in force-directed layouts correct = TRUE, message = "That's right, they are illustrative and not to be used for hard conclusions."), answer("Yes"), - allow_retry = FALSE + allow_retry = TRUE ) ``` @@ -345,16 +345,25 @@ in a two-dimensional (or more) space. ```{r mds, exercise=TRUE, fig.align='center'} graphr(ison_southern_women, layout = "mds") + ggtitle("Multidimensional Scaling") -graphr(ison_southern_women, layout = "mds") + ggtitle("Multidimensional Scaling") ``` Other such layouts include: - Pivot multidimensional scaling: `"pmds"` +```{r spectralinterp-Q, echo=FALSE, purl = FALSE} +question("Can we interpret the distance between nodes in spectral layouts?", + answer("No"), + answer("Yes", + correct = TRUE, + message = "That's right, though it is not always easy to do so..."), + allow_retry = TRUE +) +``` + ### Grid layouts -Grid layouts arrange nodes based on some cartesion coordinates. +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. @@ -391,12 +400,13 @@ graphr(ison_lotr, ggplot2::scale_colour_hue() ``` + ### Grayscale Other times color may not be desired. Some publications require grayscale images. To use a grayscale color palette, -replace `_hue` from above with `_grey`: +replace `_hue` from above with `_grey` (note the 'e' spelling): ```{r greyscale, exercise=TRUE} graphr(ison_lotr, @@ -404,6 +414,9 @@ graphr(ison_lotr, ggplot2::scale_colour_grey() ``` +As you can see, grayscale is more effective for continuous variables +or very few discrete variables than the number used here. + ### Manual override Or we may want to choose particular colors for each category. diff --git a/inst/tutorials/tutorial2/visualisation.html b/inst/tutorials/tutorial2/visualisation.html index 09b9e1f6..b91539e0 100644 --- a/inst/tutorials/tutorial2/visualisation.html +++ b/inst/tutorials/tutorial2/visualisation.html @@ -390,17 +390,17 @@

Force-directed layouts

graphr(ison_southern_women, layout = "stress") + ggtitle("Stress Minimisation")) -

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 @@

Spectral layouts

-
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:

+
+
+
+
+
+ +
+

Grid layouts

-

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 @@

Who’s hue?

Grayscale

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):

@@ -559,6 +567,8 @@

Grayscale

ggplot2::scale_colour_grey()
+

Note that grayscale is more effective for continuous variables or +very few discrete variables than the number used here.

Manual override

@@ -1127,11 +1137,11 @@

Exporting plots to PDF

@@ -1320,7 +1330,7 @@

Exporting plots to PDF

"library(manynet)", "library(migraph)", "library(patchwork)", "knitr::opts_chunk$set(echo = FALSE)"), chunk_opts = list(label = "setup", include = FALSE)), setup = NULL, chunks = list(list(label = "mds", - code = "graphr(ison_southern_women, layout = \"mds\") + ggtitle(\"Multidimensional Scaling\")\ngraphr(ison_southern_women, layout = \"mds\") + ggtitle(\"Multidimensional Scaling\")", + code = "graphr(ison_southern_women, layout = \"mds\") + ggtitle(\"Multidimensional Scaling\")", opts = list(label = "\"mds\"", exercise = "TRUE", fig.align = "\"center\""), engine = "r")), code_check = NULL, error_check = NULL, check = NULL, solution = NULL, tests = NULL, options = list(eval = FALSE, @@ -1339,22 +1349,44 @@

Exporting plots to PDF

aniopts = "controls,loop", warning = TRUE, error = FALSE, message = TRUE, render = NULL, ref.label = NULL, child = NULL, engine = "r", split = FALSE, include = TRUE, purl = TRUE, - max.print = 1000, label = "mds", exercise = TRUE, code = c("graphr(ison_southern_women, layout = \"mds\") + ggtitle(\"Multidimensional Scaling\")", - "graphr(ison_southern_women, layout = \"mds\") + ggtitle(\"Multidimensional Scaling\")" - ), out.width.px = 624, out.height.px = 384, params.src = "mds, exercise=TRUE, fig.align='center'", + max.print = 1000, label = "mds", exercise = TRUE, code = "graphr(ison_southern_women, layout = \"mds\") + ggtitle(\"Multidimensional Scaling\")", + out.width.px = 624, out.height.px = 384, params.src = "mds, exercise=TRUE, fig.align='center'", fig.num = 0, exercise.df_print = "paged", exercise.checker = "NULL"), engine = "r", version = "4"), class = c("r", "tutorial_exercise" ))) + + - + + - - + - + + - - + - + + - - + - + + - - + - + + - - + - + +
diff --git a/inst/tutorials/tutorial3/centrality.Rmd b/inst/tutorials/tutorial3/centrality.Rmd index 58366a98..4f65c7b4 100644 --- a/inst/tutorials/tutorial3/centrality.Rmd +++ b/inst/tutorials/tutorial3/centrality.Rmd @@ -24,6 +24,8 @@ The aim of this tutorial is to show how we can measure and map degree, betweenness, closeness, eigenvector, and other types of centrality, explore their distributions and calculate the corresponding centralisation. + + ### Setting up For this exercise, we'll use the `ison_brandes` dataset in `{manynet}`. @@ -58,7 +60,7 @@ graphr(ison_brandes2, layout = "bipartite") ``` The network is anonymous, but I think it would be nice to add some names, -even if it's just pretend. +even if it's just pretend. Luckily, `{manynet}` has a function for this: `to_named()`. This makes plotting the network just a wee bit more accessible and interpretable: @@ -82,6 +84,8 @@ as they are assigned randomly from a pool of (American) first names. ## Degree centrality + + 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. @@ -138,6 +142,8 @@ question("In what ways are higher degree nodes more 'central'?", ## Degree distributions + + 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 do this in base and grid graphics. @@ -271,19 +277,19 @@ we can highlight which node or nodes hold the maximum score in red. ```{r ggid-solution} # plot the network, highlighting the node with the highest centrality score with a different colour ison_brandes %>% - add_node_attribute("color", node_is_max(node_degree(ison_brandes))) %>% + mutate_nodes(color = node_is_max(node_degree())) %>% graphr(node_color = "color") ison_brandes %>% - add_node_attribute("color", node_is_max(node_betweenness(ison_brandes))) %>% + mutate_nodes(color = node_is_max(node_betweenness())) %>% graphr(node_color = "color") ison_brandes %>% - add_node_attribute("color", node_is_max(node_closeness(ison_brandes))) %>% + mutate_nodes(color = node_is_max(node_closeness())) %>% graphr(node_color = "color") ison_brandes %>% - add_node_attribute("color", node_is_max(node_eigenvector(ison_brandes))) %>% + mutate_nodes(color = node_is_max(node_eigenvector())) %>% graphr(node_color = "color") ``` @@ -406,9 +412,17 @@ question("What is the difference between centrality and centralisation according ) ``` -## Tasks +## Free play + + + +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). +Plot the network with nodes sized by each centrality measure, +using titles or subtitles to record the question and/or centralization measure. + +```{r freeplayend, exercise=TRUE, purl=FALSE, fig.width=9} + +``` -1. Name a plausible research question you could ask of this data -for each of the four main centrality measures -(degree, betweenness, closeness, eigenvector) -You may want to add these as titles or subtitles to each plot. diff --git a/inst/tutorials/tutorial3/centrality.html b/inst/tutorials/tutorial3/centrality.html index be176a05..94216f8d 100644 --- a/inst/tutorials/tutorial3/centrality.html +++ b/inst/tutorials/tutorial3/centrality.html @@ -116,6 +116,7 @@

Today’s target

degree, betweenness, closeness, eigenvector, and other types of centrality, explore their distributions and calculate the corresponding centralisation.

+

Setting up

For this exercise, we’ll use the ison_brandes dataset in @@ -181,6 +182,7 @@

Setting up

Degree centrality

+

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 @@

Degree centrality

Degree distributions

+

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 @@

Centralization

-
-

Tasks

-
    -
  1. Name a plausible research question you could ask of this data for +
    +

    Free play

    +

    +

    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 @@

    Tasks

    @@ -761,17 +772,17 @@

    Tasks

    @@ -836,24 +847,24 @@

    Tasks

    @@ -1055,16 +1066,16 @@

    Tasks

    @@ -1187,19 +1198,19 @@

    Tasks

    @@ -1220,22 +1231,22 @@

    Tasks

    -
  2. -
+ + + + + +

diff --git a/inst/tutorials/tutorial4/community.Rmd b/inst/tutorials/tutorial4/community.Rmd index 876c3a51..5d55db3e 100644 --- a/inst/tutorials/tutorial4/community.Rmd +++ b/inst/tutorials/tutorial4/community.Rmd @@ -3,7 +3,7 @@ title: "Cohesion and Community" author: "by James Hollway" output: learnr::tutorial: - theme: journal + theme: spacelab runtime: shiny_prerendered description: > This tutorial aims to teach you how to calculate various cohesion measures, diff --git a/inst/tutorials/tutorial4/community.html b/inst/tutorials/tutorial4/community.html index 812935f1..65156ab7 100644 --- a/inst/tutorials/tutorial4/community.html +++ b/inst/tutorials/tutorial4/community.html @@ -1067,15 +1067,15 @@

Task/Unit Test

@@ -1187,11 +1187,11 @@

Task/Unit Test

@@ -1347,29 +1347,29 @@

Task/Unit Test

@@ -1463,19 +1463,19 @@

Task/Unit Test

@@ -1544,20 +1544,20 @@

Task/Unit Test

@@ -1881,16 +1881,16 @@

Task/Unit Test

@@ -2151,12 +2151,12 @@

Task/Unit Test

diff --git a/inst/tutorials/tutorial5/position.Rmd b/inst/tutorials/tutorial5/position.Rmd index 808fbfd6..cef5f349 100644 --- a/inst/tutorials/tutorial5/position.Rmd +++ b/inst/tutorials/tutorial5/position.Rmd @@ -3,7 +3,7 @@ title: "Position and Equivalence" author: "by James Hollway" output: learnr::tutorial: - theme: journal + theme: united runtime: shiny_prerendered description: > This tutorial aims to teach you how to measure structural holes and diff --git a/inst/tutorials/tutorial5/position.html b/inst/tutorials/tutorial5/position.html index 1d33ced7..53dfb3ba 100644 --- a/inst/tutorials/tutorial5/position.html +++ b/inst/tutorials/tutorial5/position.html @@ -826,22 +826,22 @@

Reduced graphs

@@ -859,28 +859,28 @@

Reduced graphs

@@ -1025,17 +1025,17 @@

Reduced graphs

@@ -1240,11 +1240,11 @@

Reduced graphs

@@ -1605,12 +1605,12 @@

Reduced graphs

diff --git a/inst/tutorials/tutorial6/topology.Rmd b/inst/tutorials/tutorial6/topology.Rmd index c13fb6f6..74e5f09b 100644 --- a/inst/tutorials/tutorial6/topology.Rmd +++ b/inst/tutorials/tutorial6/topology.Rmd @@ -3,7 +3,7 @@ title: "Topology and Resilience" author: "by James Hollway" output: learnr::tutorial: - theme: journal + theme: cosmo runtime: shiny_prerendered description: > This tutorial aims to teach you how to create deterministic networks, diff --git a/inst/tutorials/tutorial6/topology.html b/inst/tutorials/tutorial6/topology.html index 7f8de64a..6fb1e563 100644 --- a/inst/tutorials/tutorial6/topology.html +++ b/inst/tutorials/tutorial6/topology.html @@ -945,27 +945,27 @@

Identifying bridges

@@ -1454,11 +1454,11 @@

Identifying bridges

@@ -1718,30 +1718,30 @@

Identifying bridges

@@ -1825,26 +1825,26 @@

Identifying bridges

@@ -1922,13 +1922,13 @@

Identifying bridges

@@ -1945,18 +1945,18 @@

Identifying bridges

@@ -2034,18 +2034,18 @@

Identifying bridges

@@ -2120,19 +2120,19 @@

Identifying bridges

@@ -2408,12 +2408,12 @@

Identifying bridges

diff --git a/inst/tutorials/tutorial7/diffusion.Rmd b/inst/tutorials/tutorial7/diffusion.Rmd index 2fea6eeb..7d60ae19 100644 --- a/inst/tutorials/tutorial7/diffusion.Rmd +++ b/inst/tutorials/tutorial7/diffusion.Rmd @@ -3,7 +3,7 @@ title: "Diffusion and Learning" author: "by James Hollway" output: learnr::tutorial: - theme: readable + theme: simplex runtime: shiny_prerendered description: > In this tutorial you will learn how to simulate and investigate simple and complex diff --git a/inst/tutorials/tutorial7/diffusion.html b/inst/tutorials/tutorial7/diffusion.html index e9d8b968..96ea8f3e 100644 --- a/inst/tutorials/tutorial7/diffusion.html +++ b/inst/tutorials/tutorial7/diffusion.html @@ -1517,11 +1517,11 @@

Free play: Networkers

@@ -1623,19 +1623,19 @@

Free play: Networkers

@@ -1693,10 +1693,10 @@

Free play: Networkers

@@ -1757,10 +1757,10 @@

Free play: Networkers

@@ -1989,10 +1989,10 @@

Free play: Networkers

@@ -2095,10 +2095,10 @@

Free play: Networkers

@@ -2164,10 +2164,10 @@

Free play: Networkers

@@ -2275,22 +2275,22 @@

Free play: Networkers

@@ -2568,10 +2568,10 @@

Free play: Networkers

@@ -2634,16 +2634,16 @@

Free play: Networkers

@@ -2754,16 +2754,16 @@

Free play: Networkers

@@ -2783,17 +2783,17 @@

Free play: Networkers

@@ -2987,10 +2987,10 @@

Free play: Networkers

@@ -3010,20 +3010,20 @@

Free play: Networkers

@@ -3085,27 +3085,27 @@

Free play: Networkers

@@ -3164,12 +3164,12 @@

Free play: Networkers

diff --git a/man/manip_paths.Rd b/man/manip_paths.Rd index e829dfa6..8c47be1c 100644 --- a/man/manip_paths.Rd +++ b/man/manip_paths.Rd @@ -6,6 +6,7 @@ \alias{to_mentoring} \alias{to_eulerian} \alias{to_tree} +\alias{to_dominating} \title{Modifying networks paths} \usage{ to_matching(.data, mark = "type") @@ -15,6 +16,8 @@ to_mentoring(.data, elites = 0.1) to_eulerian(.data) to_tree(.data) + +to_dominating(.data, from, direction = c("out", "in")) } \arguments{ \item{.data}{An object of a manynet-consistent class: @@ -42,6 +45,10 @@ for example because they are an isolate, a tie to themselves (a loop) will be created instead. Note that this is a different default behaviour than that described in Valente and Davis (1999).} + +\item{from}{The index or name of the node from which the path should be traced.} + +\item{direction}{String, either "out" or "in".} } \value{ All \code{to_} functions return an object of the same class as that provided. @@ -57,6 +64,7 @@ These functions return tidygraphs containing only special sets of ties: \item \code{to_eulerian()} returns only the Eulerian path within some network data. \item \code{to_tree()} returns the spanning tree in some network data or, if the data is unconnected, a forest of spanning trees. +\item \code{to_dominating()} returns the dominating tree of the network } } \details{ diff --git a/man/map_graphr.Rd b/man/map_graphr.Rd index 18bf97c9..fbe001ca 100644 --- a/man/map_graphr.Rd +++ b/man/map_graphr.Rd @@ -123,13 +123,11 @@ ison_adolescents \%>\% 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)) } \seealso{ Other mapping: diff --git a/man/mark_ties.Rd b/man/mark_ties.Rd index 46287c00..8979a1aa 100644 --- a/man/mark_ties.Rd +++ b/man/mark_ties.Rd @@ -60,8 +60,9 @@ tie_is_loop(ison_marvel_relationships) tie_is_reciprocated(ison_algebra) tie_is_feedback(ison_algebra) tie_is_bridge(ison_brandes) -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") } \seealso{ Other marks: diff --git a/man/measure_central_between.Rd b/man/measure_central_between.Rd index 2a12601a..b50e1b57 100644 --- a/man/measure_central_between.Rd +++ b/man/measure_central_between.Rd @@ -5,6 +5,7 @@ \alias{node_betweenness} \alias{node_induced} \alias{node_flow} +\alias{node_stress} \alias{tie_betweenness} \alias{net_betweenness} \title{Measures of betweenness-like centrality and centralisation} @@ -15,6 +16,8 @@ node_induced(.data, normalized = TRUE, cutoff = NULL) node_flow(.data, normalized = TRUE) +node_stress(.data, normalized = TRUE) + tie_betweenness(.data, normalized = TRUE) net_betweenness(.data, normalized = TRUE, direction = c("all", "out", "in")) @@ -56,6 +59,7 @@ These functions calculate common betweenness-related centrality measures for one \item \code{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. +\item \code{node_stress()} measures the stress centrality of nodes in a network. \item \code{tie_betweenness()} measures the number of shortest paths going through a tie. \item \code{net_betweenness()} measures the betweenness centralization for a network. } @@ -67,6 +71,38 @@ first transform the salient properties using e.g. \code{\link[=to_undirected]{to All centrality and centralization measures return normalized measures by default, including for two-mode networks. } +\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}}} +} + +\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)} +} + +\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)}. +} + +\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. +} + \examples{ node_betweenness(ison_southern_women) node_induced(ison_adolescents) @@ -77,6 +113,14 @@ ison_adolescents \%>\% mutate_ties(weight = tb) \%>\% net_betweenness(ison_southern_women, direction = "in") } \references{ +\subsection{On betweenness centrality}{ + +Freeman, Linton. 1977. +"A set of measures of centrality based on betweenness". +\emph{Sociometry}, 40(1): 35–41. +\doi{10.2307/3033543} +} + \subsection{On induced centrality}{ Everett, Martin and Steve Borgatti. 2010. @@ -84,6 +128,26 @@ Everett, Martin and Steve Borgatti. 2010. \emph{Social Networks}, 32: 339-344. \doi{10.1016/j.socnet.2010.06.004} } + +\subsection{On flow centrality}{ + +Freeman, Lin, Stephen Borgatti, and Douglas White. 1991. +"Centrality in Valued Graphs: A Measure of Betweenness Based on Network Flow". +\emph{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.), \emph{Network Analysis: Methodological Foundations}. +Berlin: Springer. +} + +\subsection{On stress centrality}{ + +Shimbel, A. 1953. +"Structural Parameters of Communication Networks". +\emph{Bulletin of Mathematical Biophysics}, 15:501-507. +\doi{10.1007/BF02476438} +} } \seealso{ Other centrality: diff --git a/man/measure_central_close.Rd b/man/measure_central_close.Rd index bfe83d23..8c1af71e 100644 --- a/man/measure_central_close.Rd +++ b/man/measure_central_close.Rd @@ -3,9 +3,10 @@ \name{measure_central_close} \alias{measure_central_close} \alias{node_closeness} -\alias{node_reach} \alias{node_harmonic} +\alias{node_reach} \alias{node_information} +\alias{node_eccentricity} \alias{node_distance} \alias{tie_closeness} \alias{net_closeness} @@ -15,21 +16,23 @@ \usage{ node_closeness(.data, normalized = TRUE, direction = "out", cutoff = NULL) -node_reach(.data, normalized = TRUE, k = 2) +node_harmonic(.data, normalized = TRUE, cutoff = -1) -node_harmonic(.data, normalized = TRUE, k = -1) +node_reach(.data, normalized = TRUE, cutoff = 2) node_information(.data, normalized = TRUE) +node_eccentricity(.data, normalized = TRUE) + node_distance(.data, from, to, normalized = TRUE) tie_closeness(.data, normalized = TRUE) net_closeness(.data, normalized = TRUE, direction = c("all", "out", "in")) -net_reach(.data, normalized = TRUE, k = 2) +net_reach(.data, normalized = TRUE, cutoff = 2) -net_harmonic(.data, normalized = TRUE, k = 2) +net_harmonic(.data, normalized = TRUE, cutoff = 2) } \arguments{ \item{.data}{An object of a manynet-consistent class: @@ -56,22 +59,27 @@ against only the centrality scores of the other nodes in that mode.} \item{cutoff}{Maximum path length to use during calculations.} -\item{k}{Integer of steps out to calculate reach.} - \item{from, to}{Index or name of a node to calculate distances from or to.} } \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: \itemize{ -\item \code{node_closeness()} measures the closeness centrality of nodes in a network. +\item \code{node_closeness()} measures the closeness centrality of nodes in a +network. \item \code{node_reach()} measures nodes' reach centrality, or how many nodes they can reach within \emph{k} steps. -\item \code{node_harmonic()} measures nodes' harmonic centrality or valued centrality, -which is thought to behave better than reach centrality for disconnected networks. +\item \code{node_harmonic()} measures nodes' harmonic centrality or valued +centrality, which is thought to behave better than reach centrality +for disconnected networks. \item \code{node_information()} measures nodes' information centrality or current-flow closeness centrality. -\item \code{node_distance()} measures nodes' geodesic distance from or to a given node. -\item \code{tie_closeness()} measures the closeness of each tie to other ties in the network. +\item \code{node_eccentricity()} measures nodes' eccentricity or maximum distance +from another node in the network. +\item \code{node_distance()} measures nodes' geodesic distance from or to a +given node. +\item \code{tie_closeness()} measures the closeness of each tie to other ties +in the network. \item \code{net_closeness()} measures a network's closeness centralization. \item \code{net_reach()} measures a network's reach centralization. \item \code{net_harmonic()} measures a network's harmonic centralization. @@ -84,6 +92,75 @@ first transform the salient properties using e.g. \code{\link[=to_undirected]{to All centrality and centralization measures return normalized measures by default, including for two-mode networks. } +\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}. +} + +\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. +} + +\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. +} + +\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 \code{{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. +} + +\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. +} + \examples{ node_closeness(ison_southern_women) node_reach(ison_adolescents) @@ -94,16 +171,58 @@ ison_adolescents \%>\% mutate_ties(weight = ec) \%>\% net_closeness(ison_southern_women, direction = "in") } \references{ +\subsection{On closeness centrality}{ + +Bavelas, Alex. 1950. +"Communication Patterns in Task‐Oriented Groups". +\emph{The Journal of the Acoustical Society of America}, 22(6): 725–730. +\doi{10.1121/1.1906679} + +Harary, Frank. 1959. +"Status and Contrastatus". +\emph{Sociometry}, 22(1): 23–43. +\doi{10.2307/2785610} +} + \subsection{On harmonic centrality}{ -Marchiori, M, and V Latora. 2000. +Marchiori, Massimo, and Vito Latora. 2000. "Harmony in the small-world". \emph{Physica A} 285: 539-546. +\doi{10.1016/S0378-4371(00)00311-3} Dekker, Anthony. 2005. "Conceptual distance in social network analysis". \emph{Journal of Social Structure} 6(3). } + +\subsection{On reach centrality}{ + +Borgatti, Stephen P., Martin G. Everett, and J.C. Johnson. 2013. +\emph{Analyzing social networks}. +London: SAGE Publications Limited. +} + +\subsection{On information centrality}{ + +Stephenson, Karen, and Marvin Zelen. 1989. +"Rethinking centrality: Methods and examples". +\emph{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". +\emph{Proc. 22nd Symp. Theoretical Aspects of Computer Science} LNCS 3404: 533-544. +\doi{10.1007/978-3-540-31856-9_44} +} + +\subsection{On eccentricity centrality}{ + +Hage, Per, and Frank Harary. 1995. +"Eccentricity and centrality in networks". +\emph{Social Networks}, 17(1): 57-63. +\doi{10.1016/0378-8733(94)00248-9} +} } \seealso{ Other centrality: diff --git a/man/measure_central_degree.Rd b/man/measure_central_degree.Rd index a1da152c..038eae50 100644 --- a/man/measure_central_degree.Rd +++ b/man/measure_central_degree.Rd @@ -8,6 +8,7 @@ \alias{node_indegree} \alias{node_multidegree} \alias{node_posneg} +\alias{node_leverage} \alias{tie_degree} \alias{net_degree} \alias{net_outdegree} @@ -31,6 +32,8 @@ node_multidegree(.data, tie1, tie2) node_posneg(.data) +node_leverage(.data) + tie_degree(.data, normalized = TRUE) net_degree(.data, normalized = TRUE, direction = c("all", "out", "in")) @@ -99,6 +102,7 @@ there are several related shortcut functions: } \item \code{node_multidegree()} measures the ratio between types of ties in a multiplex network. \item \code{node_posneg()} measures the PN (positive-negative) centrality of a signed network. +\item \code{node_leverage()} measures the leverage centrality of nodes in a network. \item \code{tie_degree()} measures the degree centrality of ties in a network \item \code{net_degree()} measures a network's degree centralization; there are several related shortcut functions: @@ -115,6 +119,13 @@ first transform the salient properties using e.g. \code{\link[=to_undirected]{to All centrality and centralization measures return normalized measures by default, including for two-mode networks. } +\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)}} +} + \examples{ node_degree(ison_southern_women) tie_degree(ison_adolescents) @@ -156,6 +167,14 @@ Everett, Martin G., and Stephen P. Borgatti. 2014. \emph{Social Networks} 38:111–20. \doi{10.1016/j.socnet.2014.03.005} } + +\subsection{On leverage centrality}{ + +Joyce, Karen E., Paul J. Laurienti, Jonathan H. Burdette, and Satoru Hayasaka. 2010. +"A New Measure of Centrality for Brain Networks". +\emph{PLoS ONE} 5(8): e12200. +\doi{10.1371/journal.pone.0012200} +} } \seealso{ \code{\link[=to_undirected]{to_undirected()}} for removing edge directions diff --git a/man/measure_central_eigen.Rd b/man/measure_central_eigen.Rd index 33fe96cb..31e836dc 100644 --- a/man/measure_central_eigen.Rd +++ b/man/measure_central_eigen.Rd @@ -59,24 +59,32 @@ A numeric vector giving the eigenvector centrality measure of each node. A numeric vector giving each node's power centrality measure. } \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: \itemize{ -\item \code{node_eigenvector()} measures the eigenvector centrality of nodes in a network. -\item \code{node_power()} measures the Bonacich, beta, or power centrality of nodes in a network. -\item \code{node_alpha()} measures the alpha or Katz centrality of nodes in a network. +\item \code{node_eigenvector()} measures the eigenvector centrality of nodes +in a network. +\item \code{node_power()} measures the Bonacich, beta, or power centrality of +nodes in a network. +\item \code{node_alpha()} measures the alpha or Katz centrality of nodes in a +network. \item \code{node_pagerank()} measures the pagerank centrality of nodes in a network. -\item \code{node_hub()} measures how well nodes in a network serve as hubs pointing to many authorities. -\item \code{node_authority()} measures how well nodes in a network serve as authorities from many hubs. -\item \code{tie_eigenvector()} measures the eigenvector centrality of ties in a network. -\item \code{net_eigenvector()} measures the eigenvector centralization for a network. +\item \code{node_hub()} measures how well nodes in a network serve as hubs pointing +to many authorities. +\item \code{node_authority()} measures how well nodes in a network serve as +authorities from many hubs. +\item \code{tie_eigenvector()} measures the eigenvector centrality of ties in a +network. +\item \code{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. \code{\link[=to_undirected]{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. } \details{ We use \code{{igraph}} routines behind the scenes here for consistency and because they are often faster. diff --git a/man/measure_holes.Rd b/man/measure_holes.Rd index f937c904..1e19d2f0 100644 --- a/man/measure_holes.Rd +++ b/man/measure_holes.Rd @@ -8,7 +8,6 @@ \alias{node_efficiency} \alias{node_constraint} \alias{node_hierarchy} -\alias{node_eccentricity} \alias{node_neighbours_degree} \alias{tie_cohesion} \title{Measures of structural holes} @@ -25,8 +24,6 @@ node_constraint(.data) node_hierarchy(.data) -node_eccentricity(.data) - node_neighbours_degree(.data) tie_cohesion(.data) @@ -54,9 +51,6 @@ is adjacent. according to Burt (1992) and for two-mode networks according to Hollway et al (2020). \item \code{node_hierarchy()} measures nodes' exposure to hierarchy, where only one or two contacts are the source of closure. -\item \code{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. \item \code{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 \item \code{tie_cohesion()} measures the ratio between common neighbors to ties' diff --git a/tests/testthat/test-map_autographr.R b/tests/testthat/test-map_autographr.R index a606d304..02a8f793 100644 --- a/tests/testthat/test-map_autographr.R +++ b/tests/testthat/test-map_autographr.R @@ -9,8 +9,8 @@ test_that("unweighted, unsigned, undirected networks graph correctly", { expect_equal(test_brandes[["layers"]][[1]][["aes_params"]][["edge_alpha"]], 0.4) expect_equal(test_brandes[["layers"]][[1]][["aes_params"]][["edge_linetype"]], "solid") # Node parameters - #expect_equal(round(test_brandes[["layers"]][[2]][["aes_params"]][["size"]]), 5) - #expect_equal(as.character(test_brandes[["layers"]][[2]][["aes_params"]][["shape"]]), "circle") + expect_equal(round(test_brandes[["layers"]][[2]][["aes_params"]][["size"]]), 11) + expect_equal(as.character(test_brandes[["layers"]][[2]][["aes_params"]][["shape"]]), "circle") }) test_that("unweighted, signed, undirected networks graph correctly", { @@ -23,7 +23,7 @@ test_that("unweighted, signed, undirected networks graph correctly", { # Edge parameters expect_equal(test_marvel[["layers"]][[2]][["aes_params"]][["edge_alpha"]], 0.4) # Node parameters - #expect_equal(test_marvel[["layers"]][[4]][["aes_params"]][["size"]], 1) + expect_equal(test_marvel[["layers"]][[4]][["aes_params"]][["size"]], 3) #expect_equal(test_marvel[["layers"]][[4]][["aes_params"]][["shape"]], "circle") }) @@ -37,10 +37,10 @@ test_that("unweighted, unsigned, directed networks graph correctly", { # Edge parameters expect_equal(test_algebra[["layers"]][[1]][["aes_params"]][["edge_alpha"]], 0.4) expect_equal(test_algebra[["layers"]][[1]][["aes_params"]][["edge_linetype"]], "solid") - expect_equal(test_algebra[["layers"]][[1]][["aes_params"]][["edge_colour"]], "black") + #expect_equal(test_algebra[["layers"]][[1]][["mapping"]][["edge_colour"]], "black") # Node parameters - #expect_equal(round(test_algebra[["layers"]][[2]][["aes_params"]][["size"]]), 3) - #expect_equal(test_algebra[["layers"]][[2]][["aes_params"]][["shape"]], "circle") + expect_equal(round(test_algebra[["layers"]][[2]][["aes_params"]][["size"]]), 8) + expect_equal(test_algebra[["layers"]][[2]][["aes_params"]][["shape"]], "circle") }) test_that("weighted, unsigned, directed networks graph correctly", { @@ -52,11 +52,11 @@ test_that("weighted, unsigned, directed networks graph correctly", { expect_equal(round(test_networkers[["data"]][["x"]][[1]]), 9) expect_equal(round(test_networkers[["data"]][["y"]][[1]]), -1) # Edge parameters - expect_equal(test_networkers[["layers"]][[2]][["aes_params"]][["edge_alpha"]], 0.4) - expect_equal(test_networkers[["layers"]][[2]][["aes_params"]][["edge_linetype"]], "solid") - expect_equal(test_networkers[["layers"]][[2]][["aes_params"]][["edge_colour"]], "black") + #expect_equal(test_networkers[["layers"]][[2]][["aes_params"]][["edge_alpha"]], 0.4) + #expect_equal(test_networkers[["layers"]][[2]][["aes_params"]][["edge_linetype"]], "solid") + #expect_equal(test_networkers[["layers"]][[2]][["aes_params"]][["edge_colour"]], "black") # Node parameters - #expect_equal(round(test_networkers[["layers"]][[3]][["aes_params"]][["size"]]), 2) + expect_equal(round(test_networkers[["layers"]][[3]][["aes_params"]][["size"]]), 3) #expect_equal(test_networkers[["layers"]][[3]][["aes_params"]][["shape"]], "circle") }) @@ -115,8 +115,8 @@ test_that("node_group works correctly", { test_that("unquoted arguments plot correctly", { skip_on_cran() - expect_equal(graphr(ison_lawfirm, node_color = "Gender"), - graphr(ison_lawfirm, node_color = Gender)) + expect_equal(graphr(ison_lawfirm, node_color = "gender"), + graphr(ison_lawfirm, node_color = gender)) }) # Layouts @@ -163,13 +163,6 @@ test_that("autographr works for diff_model objects", { } }) -# test_that("autographr checks variable names for mapping", { -# skip_on_cran() -# skip_on_ci() -# expect_message(graphr(ison_lawfirm, node_color = "School"), -# "Please make sure you spelled node color variable correctly.") -# }) - test_that("concentric layout works when node names are missing", { skip_on_cran() skip_on_ci() diff --git a/tests/testthat/test-map_theme.R b/tests/testthat/test-map_theme.R index b6e40e5f..6e6ffe6f 100644 --- a/tests/testthat/test-map_theme.R +++ b/tests/testthat/test-map_theme.R @@ -50,9 +50,9 @@ test_that("scales graph correctly", { mutate(color = c(rep(c(1,2), 4), 1, 2, 1)) %>% graphr(node_color = color) + scale_color_rug() - expect_equal(as.character(test_sdg[["scales"]][["scales"]][[3]][["call"]]), "scale_color_sdgs") - expect_equal(as.character(test_iheid[["scales"]][["scales"]][[3]][["call"]]), "scale_color_iheid") - expect_equal(as.character(test_ethz[["scales"]][["scales"]][[3]][["call"]]), "scale_color_ethz") - expect_equal(as.character(test_uzh[["scales"]][["scales"]][[3]][["call"]]), "scale_color_uzh") - expect_equal(as.character(test_rug[["scales"]][["scales"]][[3]][["call"]]), "scale_color_rug") + expect_equal(as.character(test_sdg[["scales"]][["scales"]][[2]][["call"]]), "scale_color_sdgs") + expect_equal(as.character(test_iheid[["scales"]][["scales"]][[2]][["call"]]), "scale_color_iheid") + expect_equal(as.character(test_ethz[["scales"]][["scales"]][[2]][["call"]]), "scale_color_ethz") + expect_equal(as.character(test_uzh[["scales"]][["scales"]][[2]][["call"]]), "scale_color_uzh") + expect_equal(as.character(test_rug[["scales"]][["scales"]][[2]][["call"]]), "scale_color_rug") })