From afd4642f5ecf355d97daa47f5cf4b76ce7d96545 Mon Sep 17 00:00:00 2001 From: Henrique Sposito Date: Tue, 1 Oct 2024 21:57:28 +0200 Subject: [PATCH 01/21] Re-worked `graphr()` to make the function more concise and consistent so it is easier to debug in the future --- R/map_autograph.R | 651 +++++++++++++++++++++------------------------- 1 file changed, 291 insertions(+), 360 deletions(-) diff --git a/R/map_autograph.R b/R/map_autograph.R index 2fadaee7..d7c0f0da 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,336 +176,222 @@ 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 + out <- .infer_edge_mapping(g, edge_color, edge_size, node_size) 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") - } - } + 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_alpha = 0.4, edge_linetype = out[["line_type"]], + strength = ifelse(igraph::which_mutual(g), 0.2, 0), + arrow = ggplot2::arrow(angle = 15, type = "closed", + length = ggplot2::unit(2, 'mm'))) } 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") - } - } + 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"]]) } 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 +# 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_edge_mapping <- function(g, edge_color, edge_size, node_size) { + check_edge_variables(g, edge_color, edge_size) + if (is_directed(g)) { + list("ecolor" = .infer_ecolor(g, edge_color), + "esize" = .infer_esize(g, edge_size), + "line_type" = .infer_line_type(g, edge_color), + "end_cap" = .infer_end_cap(g, node_size)) + } else { + list("ecolor" = .infer_ecolor(g, edge_color), + "esize" = .infer_esize(g, edge_size), + "line_type" = .infer_line_type(g, edge_color)) + } } -.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)) - } - } else if (is_twomode(g)) { - out <- ifelse(igraph::V(g)$type, "square", "circle") +.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))) + } else { + out <- .check_color(edge_color) + } + } else if (is.null(edge_color) & is_signed(g)) { + out <- ifelse(igraph::E(g)$sign >= 0, "Positive", "Negative") + out <- ifelse(length(unique(out)) == 1, "black", out) } 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 { out <- 0.5 } + as.numeric(out) +} + +.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) + } out } +.infer_line_type <- function(g, edge_color) { + if (is_signed(g)) { + out <- ifelse(igraph::E(g)$sign >= 0, "solid", "dashed") + ifelse(length(unique(out)) == 1, unique(out), out) + } else "solid" +} + .check_color <- function(v) { color <- grDevices::colors() color <- color[!color %in% "black"] @@ -569,27 +406,6 @@ graphr <- function(.data, layout, labels = TRUE, v } -# .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 -} - check_edge_variables <- function(g, edge_color, edge_size) { if (!is.null(edge_color)) { if (any(!tolower(edge_color) %in% tolower(igraph::edge_attr_names(g))) & @@ -604,6 +420,52 @@ check_edge_variables <- function(g, edge_color, edge_size) { } } +.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))) + } 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 +480,75 @@ 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 +} + # Longitudinal or comparative networks #### #' Easily graph a set of networks with sensible defaults From cca31be77728b58a7fd56b42610588ca23bfd3ea Mon Sep 17 00:00:00 2001 From: Henrique Sposito Date: Tue, 1 Oct 2024 21:58:33 +0200 Subject: [PATCH 02/21] Fixed issues with testing for `graphr()` and themes --- tests/testthat/test-map_autographr.R | 31 +++++++++++----------------- tests/testthat/test-map_theme.R | 10 ++++----- 2 files changed, 17 insertions(+), 24 deletions(-) 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") }) From 8834563f8480559ceca83fcc7dac9b5d3f70f753 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Wed, 2 Oct 2024 11:50:11 +0200 Subject: [PATCH 03/21] Added gifs to centrality tute --- inst/tutorials/tutorial3/centrality.Rmd | 26 +++- inst/tutorials/tutorial3/centrality.html | 150 +++++++++++++++-------- 2 files changed, 120 insertions(+), 56 deletions(-) diff --git a/inst/tutorials/tutorial3/centrality.Rmd b/inst/tutorials/tutorial3/centrality.Rmd index 58366a98..2ec9ea01 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. @@ -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. -
+ + + + + +

From 9630d14699f3c3d3a2eb4d9b1be25c97b1ca2f02 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Wed, 2 Oct 2024 11:51:04 +0200 Subject: [PATCH 04/21] Updated theme in early tutorials --- inst/tutorials/tutorial0/tutorial0.Rmd | 2 +- inst/tutorials/tutorial1/data.Rmd | 2 +- inst/tutorials/tutorial1/data.html | 116 ++++++++++++------------- 3 files changed, 60 insertions(+), 60 deletions(-) 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

From 4eb3929313a8ce84c178f282e8dc5f1a680edb6f Mon Sep 17 00:00:00 2001 From: James Hollway Date: Wed, 2 Oct 2024 11:51:23 +0200 Subject: [PATCH 05/21] Updated theme in later tutorials --- inst/tutorials/tutorial6/topology.Rmd | 2 +- inst/tutorials/tutorial6/topology.html | 128 ++++++++++++------------ inst/tutorials/tutorial7/diffusion.Rmd | 2 +- inst/tutorials/tutorial7/diffusion.html | 118 +++++++++++----------- 4 files changed, 125 insertions(+), 125 deletions(-) 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

From 436c1472dbe16deb924c77b874e96d7adba2a76c Mon Sep 17 00:00:00 2001 From: James Hollway Date: Wed, 2 Oct 2024 11:51:46 +0200 Subject: [PATCH 06/21] Added more detail to closeness centrality documentation --- R/measure_centrality.R | 162 +++++++++++++++++++++++++++-------- man/measure_central_close.Rd | 121 +++++++++++++++++++++++--- man/measure_central_eigen.Rd | 28 +++--- 3 files changed, 254 insertions(+), 57 deletions(-) diff --git a/R/measure_centrality.R b/R/measure_centrality.R index 8fd34954..ddbea615 100644 --- a/R/measure_centrality.R +++ b/R/measure_centrality.R @@ -435,17 +435,22 @@ 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_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 +469,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,29 +514,21 @@ 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". @@ -529,13 +543,81 @@ node_harmonic <- function(.data, normalized = TRUE, k = -1){ } #' @rdname measure_central_close +#' @param steps Integer of steps out to calculate reach. +#' By default 2. +#' @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 +#' \eqn{steps}. +#' This parameter is usually called \eqn{k} or \eqn{m}, +#' 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{steps = 1}, then this returns the node's degree. +#' @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, steps = 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<=steps) + 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) } @@ -656,23 +738,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/man/measure_central_close.Rd b/man/measure_central_close.Rd index bfe83d23..65e91c54 100644 --- a/man/measure_central_close.Rd +++ b/man/measure_central_close.Rd @@ -3,8 +3,8 @@ \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_distance} \alias{tie_closeness} @@ -15,10 +15,10 @@ \usage{ node_closeness(.data, normalized = TRUE, direction = "out", cutoff = NULL) -node_reach(.data, normalized = TRUE, k = 2) - node_harmonic(.data, normalized = TRUE, k = -1) +node_reach(.data, normalized = TRUE, steps = 2) + node_information(.data, normalized = TRUE) node_distance(.data, from, to, normalized = TRUE) @@ -56,22 +56,28 @@ 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{steps}{Integer of steps out to calculate reach. +By default 2.} \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_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 +90,65 @@ 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 +\eqn{steps}. +This parameter is usually called \eqn{k} or \eqn{m}, +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{steps = 1}, then this returns the node's degree. +} + +\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. +} + \examples{ node_closeness(ison_southern_women) node_reach(ison_adolescents) @@ -94,16 +159,50 @@ 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} +} } \seealso{ Other centrality: 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. From c2e3bf0ac522860244755ee571731045b2a7c78e Mon Sep 17 00:00:00 2001 From: James Hollway Date: Wed, 2 Oct 2024 11:52:10 +0200 Subject: [PATCH 07/21] Updated themes in middle tutorials --- inst/tutorials/tutorial2/visualisation.Rmd | 2 +- inst/tutorials/tutorial2/visualisation.html | 10 +-- inst/tutorials/tutorial4/community.Rmd | 2 +- inst/tutorials/tutorial4/community.html | 66 +++++++++--------- inst/tutorials/tutorial5/position.Rmd | 2 +- inst/tutorials/tutorial5/position.html | 74 ++++++++++----------- 6 files changed, 78 insertions(+), 78 deletions(-) diff --git a/inst/tutorials/tutorial2/visualisation.Rmd b/inst/tutorials/tutorial2/visualisation.Rmd index d0eeb2b4..932c6ab9 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 diff --git a/inst/tutorials/tutorial2/visualisation.html b/inst/tutorials/tutorial2/visualisation.html index 09b9e1f6..94718338 100644 --- a/inst/tutorials/tutorial2/visualisation.html +++ b/inst/tutorials/tutorial2/visualisation.html @@ -1127,11 +1127,11 @@

Exporting plots to PDF

@@ -1602,12 +1602,12 @@

Exporting plots to PDF

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

From 97b66bc5d41d124bef313947ee92e984e142a8df Mon Sep 17 00:00:00 2001 From: James Hollway Date: Wed, 2 Oct 2024 11:52:42 +0200 Subject: [PATCH 08/21] #patch bump for now --- DESCRIPTION | 4 ++-- NEWS.md | 2 ++ R/zzz.R | 2 +- 3 files changed, 5 insertions(+), 3 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 38f0d683..c2098bcc 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-02 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/NEWS.md b/NEWS.md index b19646d5..1562d1ad 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,5 @@ +# manynet 1.2.2 + # manynet 1.2.1 ## Making 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')`", From 64e4d8da280d8543e8132650c994e2742be5800d Mon Sep 17 00:00:00 2001 From: Henrique Sposito Date: Wed, 2 Oct 2024 14:28:19 +0200 Subject: [PATCH 09/21] Fixed issues with `graphr()` related to examples --- R/map_autograph.R | 217 +++++++++++++++++++++------------------------- R/mark_ties.R | 5 +- 2 files changed, 100 insertions(+), 122 deletions(-) diff --git a/R/map_autograph.R b/R/map_autograph.R index d7c0f0da..222b0053 100644 --- a/R/map_autograph.R +++ b/R/map_autograph.R @@ -279,7 +279,7 @@ graphr <- function(.data, layout, labels = TRUE, } } -# Helper functions +# `graphr()` helper functions reduce_categories <- function(g, node_group) { limit <- toCondense <- NULL if (sum(table(node_attribute(g, node_group)) <= 2) > 2 & @@ -339,14 +339,22 @@ reduce_categories <- function(g, node_group) { 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 if (length(edge_color) == 1) { + out <- rep(edge_color, net_ties(g)) } else { - out <- .check_color(edge_color) - } + out <- edge_color + } } else if (is.null(edge_color) & is_signed(g)) { - out <- ifelse(igraph::E(g)$sign >= 0, "Positive", "Negative") - out <- ifelse(length(unique(out)) == 1, "black", out) + out <- as.factor(ifelse(igraph::E(g)$sign >= 0, "Positive", "Negative")) + if (length(unique(out)) == 1) { + out <- rep("black", net_ties(g)) + } } else { - out <- "black" + out <- rep("black", net_ties(g)) } out } @@ -355,13 +363,15 @@ reduce_categories <- function(g, node_group) { if (!is.null(edge_size)) { if (any(edge_size %in% names(tie_attribute(g)))) { out <- tie_attribute(g, edge_size) + } else if (is.numeric(edge_size) & length(edge_size) == 1) { + out <- rep(edge_size, net_ties(g)) } else { out <- edge_size } } else if (is.null(edge_size) & is_weighted(g)) { out <- tie_attribute(g, "weight") } else { - out <- 0.5 + out <- rep(0.5, net_ties(g)) } as.numeric(out) } @@ -392,20 +402,6 @@ reduce_categories <- function(g, node_group) { } else "solid" } -.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) - } - } - } - v -} - check_edge_variables <- function(g, edge_color, edge_size) { if (!is.null(edge_color)) { if (any(!tolower(edge_color) %in% tolower(igraph::edge_attr_names(g))) & @@ -459,6 +455,10 @@ check_edge_variables <- function(g, edge_color, edge_size) { 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" @@ -549,6 +549,70 @@ map_nodes <- function(p, out) { 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 @@ -645,6 +709,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))))) & @@ -900,107 +965,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..a515fc58 100644 --- a/R/mark_ties.R +++ b/R/mark_ties.R @@ -85,8 +85,9 @@ tie_is_bridge <- function(.data){ #' 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()} From 7da0dd699a4e32e743e713b7dd018e24714906a1 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Wed, 2 Oct 2024 14:29:39 +0200 Subject: [PATCH 10/21] Added node_eccentricity --- R/measure_centrality.R | 24 ++++++++++++++++++++++++ man/map_graphr.Rd | 12 +++++------- man/measure_central_close.Rd | 20 ++++++++++++++++++++ 3 files changed, 49 insertions(+), 7 deletions(-) diff --git a/R/measure_centrality.R b/R/measure_centrality.R index ddbea615..e8ace254 100644 --- a/R/measure_centrality.R +++ b/R/measure_centrality.R @@ -558,6 +558,7 @@ node_harmonic <- function(.data, normalized = TRUE, k = -1){ #' 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{steps = 1}, then this returns the node's degree. +#' At higher steps 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. @@ -621,6 +622,29 @@ node_information <- function(.data, normalized = TRUE){ make_node_measure(out, .data) } +#' @rdname measure_central_close +#' @section Eccentricity centrality: +#' Eccentricity centrality is the 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) +} + #' @rdname measure_central_close #' @param from,to Index or name of a node to calculate distances from or to. #' @export 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/measure_central_close.Rd b/man/measure_central_close.Rd index 65e91c54..64797673 100644 --- a/man/measure_central_close.Rd +++ b/man/measure_central_close.Rd @@ -6,6 +6,7 @@ \alias{node_harmonic} \alias{node_reach} \alias{node_information} +\alias{node_eccentricity} \alias{node_distance} \alias{tie_closeness} \alias{net_closeness} @@ -21,6 +22,8 @@ node_reach(.data, normalized = TRUE, steps = 2) node_information(.data, normalized = TRUE) +node_eccentricity(.data) + node_distance(.data, from, to, normalized = TRUE) tie_closeness(.data, normalized = TRUE) @@ -125,6 +128,7 @@ 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{steps = 1}, then this returns the node's degree. +At higher steps reach centrality returns the size of the node's component. } \section{Information centrality}{ @@ -149,6 +153,14 @@ to many others in the network, and are thus considered to have greater control of the flow of information. } +\section{Eccentricity centrality}{ + +Eccentricity centrality is the 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) @@ -203,6 +215,14 @@ Brandes, Ulrik, and Daniel Fleischer. 2005. \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: From b0fe843a2b7817636998e57e99a7cfe53da39a97 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Wed, 2 Oct 2024 18:13:39 +0200 Subject: [PATCH 11/21] Added to_dominating() --- NAMESPACE | 1 + R/manip_reformed.R | 13 ++++++++++++- man/manip_paths.Rd | 4 ++++ 3 files changed, 17 insertions(+), 1 deletion(-) diff --git a/NAMESPACE b/NAMESPACE index 16f16531..651f1c38 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -712,6 +712,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) diff --git a/R/manip_reformed.R b/R/manip_reformed.R index 6052ab16..54a4960a 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,15 @@ 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 +#' @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/man/manip_paths.Rd b/man/manip_paths.Rd index e829dfa6..009f19b7 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: @@ -57,6 +60,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{ From f60ac557ce4d702efa6314cd1b413d58934c5008 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Wed, 2 Oct 2024 18:20:10 +0200 Subject: [PATCH 12/21] node_eccentricity() now a (closeness) centrality measure --- R/measure_centrality.R | 18 +++++++++++++++++- R/measure_holes.R | 13 ------------- man/measure_central_close.Rd | 7 +++++-- man/measure_holes.Rd | 6 ------ 4 files changed, 22 insertions(+), 22 deletions(-) diff --git a/R/measure_centrality.R b/R/measure_centrality.R index e8ace254..3b0727be 100644 --- a/R/measure_centrality.R +++ b/R/measure_centrality.R @@ -447,6 +447,8 @@ net_betweenness <- function(.data, normalized = TRUE, #' for disconnected networks. #' - `node_information()` measures nodes' information centrality or #' current-flow closeness centrality. +#' - `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 @@ -624,7 +626,8 @@ node_information <- function(.data, normalized = TRUE){ #' @rdname measure_central_close #' @section Eccentricity centrality: -#' Eccentricity centrality is the inverse of the distance to the furthest node: +#' Eccentricity centrality, or graph centrality, +#' is the 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. @@ -645,6 +648,19 @@ node_eccentricity <- function(.data, normalized = TRUE){ 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 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/man/measure_central_close.Rd b/man/measure_central_close.Rd index 64797673..5d7444f6 100644 --- a/man/measure_central_close.Rd +++ b/man/measure_central_close.Rd @@ -22,7 +22,7 @@ node_reach(.data, normalized = TRUE, steps = 2) node_information(.data, normalized = TRUE) -node_eccentricity(.data) +node_eccentricity(.data, normalized = TRUE) node_distance(.data, from, to, normalized = TRUE) @@ -77,6 +77,8 @@ 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_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 @@ -155,7 +157,8 @@ control of the flow of information. \section{Eccentricity centrality}{ -Eccentricity centrality is the inverse of the distance to the furthest node: +Eccentricity centrality, or graph centrality, +is the 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. 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' From 8e9bbb07d375c0468d9e792bcfaaaea2c7e6b68c Mon Sep 17 00:00:00 2001 From: James Hollway Date: Wed, 2 Oct 2024 18:20:59 +0200 Subject: [PATCH 13/21] Added node_stress() and updated documentation on betweenness, induced, and flow centralities --- NAMESPACE | 2 +- man/measure_central_between.Rd | 64 ++++++++++++++++++++++++++++++++++ 2 files changed, 65 insertions(+), 1 deletion(-) diff --git a/NAMESPACE b/NAMESPACE index 651f1c38..510a228f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -616,6 +616,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) @@ -836,7 +837,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/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: From 00f982739a39264eede2f47ac764a740c4c2be8d Mon Sep 17 00:00:00 2001 From: James Hollway Date: Wed, 2 Oct 2024 18:21:26 +0200 Subject: [PATCH 14/21] Added node_leverage() --- NAMESPACE | 1 + R/measure_centrality.R | 86 ++++++++++++++++++++++++++++++++--- man/measure_central_degree.Rd | 19 ++++++++ 3 files changed, 100 insertions(+), 6 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 510a228f..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) diff --git a/R/measure_centrality.R b/R/measure_centrality.R index 3b0727be..19588ebb 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 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 From 8b578a3aafd38bc26373bac1631dd9a7d226c141 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Wed, 2 Oct 2024 18:21:42 +0200 Subject: [PATCH 15/21] Updated centrality tutorial --- inst/tutorials/tutorial3/centrality.Rmd | 8 ++++---- man/mark_ties.Rd | 5 +++-- 2 files changed, 7 insertions(+), 6 deletions(-) diff --git a/inst/tutorials/tutorial3/centrality.Rmd b/inst/tutorials/tutorial3/centrality.Rmd index 2ec9ea01..4f65c7b4 100644 --- a/inst/tutorials/tutorial3/centrality.Rmd +++ b/inst/tutorials/tutorial3/centrality.Rmd @@ -277,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") ``` 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: From 62e0d03a85e33859eb31f82cc38488c3d4dda1cc Mon Sep 17 00:00:00 2001 From: Henrique Sposito Date: Thu, 3 Oct 2024 13:18:30 +0200 Subject: [PATCH 16/21] Made `graphr()` more explicity about when to map edge aestehtics versus when to set map aesthetics to facilitate debugging and make the function more predictable. --- R/map_autograph.R | 114 ++++++++++++++++++++++++++++++++-------------- 1 file changed, 81 insertions(+), 33 deletions(-) diff --git a/R/map_autograph.R b/R/map_autograph.R index 222b0053..7d3caba0 100644 --- a/R/map_autograph.R +++ b/R/map_autograph.R @@ -182,19 +182,12 @@ graphr <- function(.data, layout, labels = TRUE, } .graph_edges <- function(p, g, edge_color, edge_size, node_size) { - out <- .infer_edge_mapping(g, edge_color, edge_size, node_size) if (is_directed(g)) { - 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_alpha = 0.4, edge_linetype = out[["line_type"]], - strength = ifelse(igraph::which_mutual(g), 0.2, 0), - arrow = ggplot2::arrow(angle = 15, type = "closed", - length = ggplot2::unit(2, 'mm'))) + out <- .infer_directed_edge_mapping(g, edge_color, edge_size, node_size) + p <- map_directed_edges(p, g, out) } 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"]]) + 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) @@ -318,18 +311,19 @@ reduce_categories <- function(g, node_group) { out } -.infer_edge_mapping <- function(g, edge_color, edge_size, node_size) { +.infer_directed_edge_mapping <- function(g, edge_color, edge_size, node_size) { check_edge_variables(g, edge_color, edge_size) - if (is_directed(g)) { - list("ecolor" = .infer_ecolor(g, edge_color), - "esize" = .infer_esize(g, edge_size), - "line_type" = .infer_line_type(g, edge_color), - "end_cap" = .infer_end_cap(g, node_size)) - } else { - list("ecolor" = .infer_ecolor(g, edge_color), - "esize" = .infer_esize(g, edge_size), - "line_type" = .infer_line_type(g, edge_color)) - } + 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_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){ @@ -343,18 +337,16 @@ reduce_categories <- function(g, node_group) { out <- rep("black", net_ties(g)) message("Please indicate a variable with more than one value or level when mapping edge colors.") } - } else if (length(edge_color) == 1) { - out <- rep(edge_color, net_ties(g)) } else { - out <- edge_color + 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 <- rep("black", net_ties(g)) + out <- "black" } } else { - out <- rep("black", net_ties(g)) + out <- "black" } out } @@ -363,17 +355,15 @@ reduce_categories <- function(g, node_group) { if (!is.null(edge_size)) { if (any(edge_size %in% names(tie_attribute(g)))) { out <- tie_attribute(g, edge_size) - } else if (is.numeric(edge_size) & length(edge_size) == 1) { - out <- rep(edge_size, net_ties(g)) } else { out <- edge_size } } else if (is.null(edge_size) & is_weighted(g)) { out <- tie_attribute(g, "weight") } else { - out <- rep(0.5, net_ties(g)) + out <- 0.5 } - as.numeric(out) + out } .infer_end_cap <- function(g, node_size) { @@ -395,9 +385,10 @@ reduce_categories <- function(g, node_group) { out } -.infer_line_type <- function(g, edge_color) { +.infer_line_type <- function(g) { if (is_signed(g)) { - out <- ifelse(igraph::E(g)$sign >= 0, "solid", "dashed") + out <- ifelse(as.numeric(tie_attribute(ison_marvel_relationships, "sign")) >= 0, + "solid", "dashed") ifelse(length(unique(out)) == 1, unique(out), out) } else "solid" } @@ -416,6 +407,63 @@ 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), From 32a30bdd7384088c965c224f8f034a1067d74b81 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Fri, 4 Oct 2024 16:57:38 +0200 Subject: [PATCH 17/21] Updated eccentricity documentation --- R/measure_centrality.R | 4 ++-- man/measure_central_close.Rd | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/measure_centrality.R b/R/measure_centrality.R index 19588ebb..99354602 100644 --- a/R/measure_centrality.R +++ b/R/measure_centrality.R @@ -700,8 +700,8 @@ node_information <- function(.data, normalized = TRUE){ #' @rdname measure_central_close #' @section Eccentricity centrality: -#' Eccentricity centrality, or graph centrality, -#' is the inverse of the distance to the furthest node: +#' 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. diff --git a/man/measure_central_close.Rd b/man/measure_central_close.Rd index 5d7444f6..62d4d88f 100644 --- a/man/measure_central_close.Rd +++ b/man/measure_central_close.Rd @@ -157,8 +157,8 @@ control of the flow of information. \section{Eccentricity centrality}{ -Eccentricity centrality, or graph centrality, -is the inverse of the distance to the furthest node: +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. From 241b1b8d50cc70b4f0e244d3db18aff8d8cb5e9d Mon Sep 17 00:00:00 2001 From: James Hollway Date: Fri, 4 Oct 2024 16:57:55 +0200 Subject: [PATCH 18/21] Small edits to visualization tutorial --- inst/tutorials/tutorial2/visualisation.Rmd | 27 +++-- inst/tutorials/tutorial2/visualisation.html | 108 +++++++++++++------- 2 files changed, 90 insertions(+), 45 deletions(-) diff --git a/inst/tutorials/tutorial2/visualisation.Rmd b/inst/tutorials/tutorial2/visualisation.Rmd index 932c6ab9..b27e4967 100644 --- a/inst/tutorials/tutorial2/visualisation.Rmd +++ b/inst/tutorials/tutorial2/visualisation.Rmd @@ -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 94718338..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:

  • Pivot multidimensional scaling: "pmds"
+
+
+
+
+
+ +
+

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" ))) + + - + + - - + - + + - - + - + + - - + - + + - - + - + + - - + - + +
From 889f250876db55d687190f184220ad05fff7c42d Mon Sep 17 00:00:00 2001 From: James Hollway Date: Fri, 4 Oct 2024 18:32:37 +0200 Subject: [PATCH 19/21] Fixed documentation issues --- R/manip_reformed.R | 2 ++ R/mark_ties.R | 2 +- R/measure_centrality.R | 28 +++++++++++++--------------- man/manip_paths.Rd | 4 ++++ man/measure_central_close.Rd | 21 +++++++++------------ 5 files changed, 29 insertions(+), 28 deletions(-) diff --git a/R/manip_reformed.R b/R/manip_reformed.R index 54a4960a..e53b9f68 100644 --- a/R/manip_reformed.R +++ b/R/manip_reformed.R @@ -657,6 +657,8 @@ to_tree <- function(.data) { } #' @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) diff --git a/R/mark_ties.R b/R/mark_ties.R index a515fc58..d95f2597 100644 --- a/R/mark_ties.R +++ b/R/mark_ties.R @@ -79,7 +79,7 @@ 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. diff --git a/R/measure_centrality.R b/R/measure_centrality.R index 99354602..85a6c5c7 100644 --- a/R/measure_centrality.R +++ b/R/measure_centrality.R @@ -610,31 +610,29 @@ node_closeness <- function(.data, normalized = TRUE, #' "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 -#' @param steps Integer of steps out to calculate reach. -#' By default 2. #' @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 -#' \eqn{steps}. -#' This parameter is usually called \eqn{k} or \eqn{m}, +#' 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. +#' \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{steps = 1}, then this returns the node's degree. -#' At higher steps reach centrality returns the size of the node's component. +#' 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. @@ -643,14 +641,14 @@ node_harmonic <- function(.data, normalized = TRUE, k = -1){ #' @examples #' node_reach(ison_adolescents) #' @export -node_reach <- function(.data, normalized = TRUE, steps = 2){ +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<=steps) + out <- rowSums(out <= cutoff) if(normalized) out <- out/(net_nodes(.data)-1) out <- make_node_measure(out, .data) out @@ -830,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) @@ -840,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) diff --git a/man/manip_paths.Rd b/man/manip_paths.Rd index 009f19b7..8c47be1c 100644 --- a/man/manip_paths.Rd +++ b/man/manip_paths.Rd @@ -45,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. diff --git a/man/measure_central_close.Rd b/man/measure_central_close.Rd index 62d4d88f..8c1af71e 100644 --- a/man/measure_central_close.Rd +++ b/man/measure_central_close.Rd @@ -16,9 +16,9 @@ \usage{ node_closeness(.data, normalized = TRUE, direction = "out", cutoff = NULL) -node_harmonic(.data, normalized = TRUE, k = -1) +node_harmonic(.data, normalized = TRUE, cutoff = -1) -node_reach(.data, normalized = TRUE, steps = 2) +node_reach(.data, normalized = TRUE, cutoff = 2) node_information(.data, normalized = TRUE) @@ -30,9 +30,9 @@ 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: @@ -59,9 +59,6 @@ against only the centrality scores of the other nodes in that mode.} \item{cutoff}{Maximum path length to use during calculations.} -\item{steps}{Integer of steps out to calculate reach. -By default 2.} - \item{from, to}{Index or name of a node to calculate distances from or to.} } \description{ @@ -121,16 +118,16 @@ harmonic centrality is to be preferred in these cases. 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 -\eqn{steps}. -This parameter is usually called \eqn{k} or \eqn{m}, +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. +\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{steps = 1}, then this returns the node's degree. -At higher steps reach centrality returns the size of the node's component. +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}{ From 144e8157599a934b9f667b4e4897b6309d562f27 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Fri, 4 Oct 2024 18:33:00 +0200 Subject: [PATCH 20/21] Avoided hard coding comic book characters into line types --- R/map_autograph.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/map_autograph.R b/R/map_autograph.R index 7d3caba0..cb1f05b4 100644 --- a/R/map_autograph.R +++ b/R/map_autograph.R @@ -387,7 +387,7 @@ reduce_categories <- function(g, node_group) { .infer_line_type <- function(g) { if (is_signed(g)) { - out <- ifelse(as.numeric(tie_attribute(ison_marvel_relationships, "sign")) >= 0, + out <- ifelse(as.numeric(tie_attribute(g, "sign")) >= 0, "solid", "dashed") ifelse(length(unique(out)) == 1, unique(out), out) } else "solid" From 242179c1cc6cbb473749669a0b39436d25bc2d2d Mon Sep 17 00:00:00 2001 From: James Hollway Date: Fri, 4 Oct 2024 18:40:16 +0200 Subject: [PATCH 21/21] Updated NEWS and #patch bump --- DESCRIPTION | 2 +- NEWS.md | 22 ++++++++++++++++++++++ 2 files changed, 23 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index c2098bcc..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.2 -Date: 2024-10-02 +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/NEWS.md b/NEWS.md index 1562d1ad..be9ecd62 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +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