diff --git a/.github/workflows/pushrelease.yml b/.github/workflows/pushrelease.yml index 6b47fca8..bb9ae555 100644 --- a/.github/workflows/pushrelease.yml +++ b/.github/workflows/pushrelease.yml @@ -134,7 +134,7 @@ jobs: - uses: r-lib/actions/setup-r@v2 - - uses: r-lib/actions/setup-pandoc@v1 + - uses: r-lib/actions/setup-pandoc@v2 - uses: r-lib/actions/setup-r-dependencies@v2 with: diff --git a/DESCRIPTION b/DESCRIPTION index 54ec2dd5..cd57fb6c 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.4.1 -Date: 2025-04-09 +Version: 1.5.0 +Date: 2025-06-22 Description: Many tools for making, modifying, mapping, marking, measuring, and motifs and memberships of many different types of networks. All functions operate with matrices, edge lists, and 'igraph', 'network', and 'tidygraph' objects, diff --git a/NAMESPACE b/NAMESPACE index c5259370..d70d1f4e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -140,18 +140,7 @@ S3method(net_dims,igraph) S3method(net_dims,matrix) S3method(net_dims,network) S3method(pillar_shaft,logi) -S3method(plot,diff_model) -S3method(plot,diffs_model) -S3method(plot,learn_model) -S3method(plot,matrix) -S3method(plot,network_measures) -S3method(plot,network_motif) -S3method(plot,node_measure) -S3method(plot,node_member) -S3method(plot,node_motif) -S3method(plot,tie_measure) S3method(print,diff_model) -S3method(print,diffs_model) S3method(print,learn_model) S3method(print,mnet) S3method(print,network_measure) @@ -165,7 +154,6 @@ S3method(print,tie_measure) S3method(select_nodes,igraph) S3method(select_nodes,tbl_graph) S3method(summary,diff_model) -S3method(summary,diffs_model) S3method(summary,learn_model) S3method(summary,network_measure) S3method(summary,network_motif) @@ -242,6 +230,7 @@ S3method(to_no_isolates,list) S3method(to_no_isolates,matrix) S3method(to_no_isolates,network) S3method(to_no_isolates,tbl_graph) +S3method(to_no_missing,tbl_graph) S3method(to_onemode,igraph) S3method(to_onemode,matrix) S3method(to_onemode,tbl_graph) @@ -792,6 +781,7 @@ export(to_mode2) export(to_multilevel) export(to_named) export(to_no_isolates) +export(to_no_missing) export(to_onemode) export(to_permuted) export(to_reciprocated) @@ -844,15 +834,9 @@ importFrom(dplyr,tibble) importFrom(dplyr,ungroup) importFrom(ggplot2,aes) importFrom(ggplot2,arrow) -importFrom(ggplot2,element_blank) -importFrom(ggplot2,element_text) -importFrom(ggplot2,geom_histogram) -importFrom(ggplot2,geom_hline) importFrom(ggplot2,geom_point) importFrom(ggplot2,geom_segment) importFrom(ggplot2,geom_text) -importFrom(ggplot2,geom_tile) -importFrom(ggplot2,geom_vline) importFrom(ggplot2,ggplot) importFrom(ggplot2,ggsave) importFrom(ggplot2,ggtitle) @@ -861,12 +845,7 @@ importFrom(ggplot2,labs) importFrom(ggplot2,scale_alpha_manual) importFrom(ggplot2,scale_color_brewer) importFrom(ggplot2,scale_fill_brewer) -importFrom(ggplot2,scale_fill_gradient) importFrom(ggplot2,scale_size) -importFrom(ggplot2,scale_x_discrete) -importFrom(ggplot2,scale_y_discrete) -importFrom(ggplot2,theme) -importFrom(ggplot2,theme_grey) importFrom(ggplot2,theme_void) importFrom(ggplot2,unit) importFrom(ggplot2,xlab) diff --git a/NEWS.md b/NEWS.md index e39f2f70..b17498ee 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,34 @@ +# manynet 1.5.0 + +## Package + +- Updated pandoc setup in pushrelease workflow + +## Making + +- Dropped print and summary methods for diffs_model (moved to `{migraph}`) + +## Modifying + +- Added `to_no_missing()` for removing nodes with missing data +- Fixed `as_diffusion.mnet()` so that it includes "diff_model" class + +## Measuring + +- Dropped plotting methods (moved to `{autograph}`) +- Added Page 2010 citation to `node_richness()` documentation + +## Memberships + +- Fixed `node_in_leiden()` to use resolution parameter in call to igraph + +## Data + +- Improved `table_data()` so that it lists components, longitudinal, dynamic, +and changing data +- Added more description for `fict_lotr` +- Added `irps_revere` data + # manynet 1.4.1 ## Making diff --git a/R/class_measures.R b/R/class_measures.R index a3a30992..5c0e8341 100644 --- a/R/class_measures.R +++ b/R/class_measures.R @@ -28,16 +28,6 @@ make_network_measure <- function(out, .data, call) { out } -make_network_measures <- function(out, .data) { - time <- value <- NULL - out <- dplyr::as_tibble(out) %>% - dplyr::mutate(time = as.numeric(names(out))) %>% - dplyr::select(time, value) - class(out) <- c("network_measures", class(out)) - attr(out, "mode") <- net_dims(.data) - out -} - # Printing #### #' @importFrom cli spark_bar #' @export @@ -135,70 +125,3 @@ summary.network_measure <- function(object, ..., ", p = ", cli::style_italic(round(p,3)), ")") } - -# Plotting #### -#' @export -plot.node_measure <- function(x, type = c("h", "d"), ...) { - #type <- match.arg(type) - density <- NULL - if (is.null(attr(x, "mode"))) attr(x, "mode") <- rep(FALSE, length(x)) - data <- data.frame(Score = x, Mode = attr(x, "mode")) - if (length(type) == 2) { - p <- ggplot2::ggplot(data = data, ggplot2::aes(x = .data$Score)) + - ggplot2::geom_histogram(ggplot2::aes(y = ggplot2::after_stat(density)), - binwidth = ifelse(max(data$Score) > 1, 1, - ifelse(max(data$Score) > - .1, .1, .01))) + - ggplot2::geom_density(col = 2) + - ggplot2::scale_y_continuous("Frequency", sec.axis = - ggplot2::sec_axis(~ ., breaks = c(0,1), - name = "Density")) - } else if (length(type) == 1 & type == "h") { - p <- ggplot2::ggplot(data = data, ggplot2::aes(x = .data$Score)) + - ggplot2::geom_histogram(ggplot2::aes(y = ggplot2::after_stat(density)), - binwidth = ifelse(max(data$Score) > 1, 1, - ifelse(max(data$Score) > - .1, .1, .01))) + - ggplot2::labs(x = "Density", y = "Frequency") - } else if (length(type) == 1 & type == "d") { - p <- ggplot2::ggplot(data = data, ggplot2::aes(x = .data$Score)) + - ggplot2::geom_density(col = 2) + - ggplot2::ylab("Density") - } - p + - ggplot2::theme_classic() + - ggplot2::theme(panel.grid.major = ggplot2::element_line(colour = "grey90")) -} - -#' @export -plot.tie_measure <- function(x, type = c("h", "d"), ...) { - type <- match.arg(type) - data <- data.frame(Score = x) - if (type == "h") { - p <- ggplot2::ggplot(data = data) + - ggplot2::geom_histogram(ggplot2::aes(x = .data$Score), - binwidth = ifelse(max(data$Score) > 1, 1, - ifelse(max(data$Score) > .1, - .1, - .01))) + - ggplot2::ylab("Frequency") - } else { - p <- ggplot2::ggplot(data = data) + - ggplot2::geom_density(ggplot2::aes(x = .data$Score)) + - ggplot2::ylab("Density") - } - p + ggplot2::theme_classic() + - ggplot2::theme(panel.grid.major = ggplot2::element_line(colour = "grey90")) -} - -#' @export -plot.network_measures <- function(x, ...) { - ggplot2::ggplot(data = x, ggplot2::aes(x = .data$time, y = .data$value)) + - ggplot2::geom_line() + - ggplot2::theme_minimal() + - ggplot2::xlab("Time") + - ggplot2::ylab("Value") -} - -# defining global variables more centrally -utils::globalVariables(c(".data")) diff --git a/R/class_members.R b/R/class_members.R index 40721c95..cf4bf01e 100644 --- a/R/class_members.R +++ b/R/class_members.R @@ -58,144 +58,4 @@ summary.node_member <- function(object, ..., } } -#' @importFrom stats cutree -#' @export -plot.node_member <- function(x, ...) { - thisRequires("ggdendro") - hc <- attr(x, "hc") - k <- attr(x, "k") - memb <- x[hc$order] - clust <- memb[!duplicated(memb)] - colors <- ifelse(match(memb, clust) %% 2, - "#000000", "#E20020") - ggdendro::ggdendrogram(hc, rotate = TRUE) + - ggplot2::geom_hline(yintercept = hc$height[length(hc$order) - k], - linetype = 2, - color = "#E20020") + - ggplot2::theme(axis.text.x = ggplot2::element_text(colour = "#5c666f"), - axis.text.y = suppressWarnings( - ggplot2::element_text(colour = colors))) -} - -# plot(as_matrix(ison_adolescents), -# membership = node_regular_equivalence(ison_adolescents, "e")) -# plot(as_matrix(ison_southern_women), -# membership = node_regular_equivalence(ison_southern_women, "e")) -#' @importFrom ggplot2 ggplot geom_tile aes scale_fill_gradient theme_grey labs theme scale_x_discrete scale_y_discrete geom_vline geom_hline element_blank element_text -#' @export -plot.matrix <- function(x, ..., membership = NULL) { - - thisRequires("tidyr") - if (!is_twomode(x)) { - blocked_data <- as_matrix(x) - if (!is.null(membership)) blocked_data <- blocked_data[order(membership), - order(membership)] - } else if (is_twomode(x) && - length(intersect(membership[!node_is_mode(x)], - membership[!node_is_mode(x)])) > 0) { - blocked_data <- as_matrix(to_multilevel(x)) - if (!is.null(membership)) blocked_data <- blocked_data[order(membership), - order(membership)] - } else { - blocked_data <- manynet::as_matrix(x) - } - - from <- to <- weight <- NULL - - plot_data <- as_edgelist(blocked_data) - if(!is_labelled(x)){ - indices <- c(plot_data$from,plot_data$to) - plot_data$from <- paste0("N", gsub("\\s", "0", - format(plot_data$from, - width=max(nchar(indices))))) - plot_data$to <- paste0("N", gsub("\\s", "0", - format(plot_data$to, - width=max(nchar(indices))))) - } - all_nodes <- expand.grid(node_names(blocked_data), - node_names(blocked_data)) - all_nodes <- data.frame(from = all_nodes$Var1, to = all_nodes$Var2, - weight = 0) - plot_data <- rbind(plot_data, all_nodes) %>% dplyr::distinct(from, to, .keep_all = TRUE) - g <- ggplot2::ggplot(plot_data, ggplot2::aes(to, from)) + - ggplot2::theme_grey(base_size = 9) + - ggplot2::labs(x = "", y = "") + - ggplot2::theme( - legend.position = "none", - axis.ticks = ggplot2::element_blank(), - axis.text.y = ggplot2::element_text( - size = 9 * 0.8, - colour = "grey50" - ), - axis.text.x = ggplot2::element_text( - size = 9 * 0.8, - angle = 30, hjust = 0, - colour = "grey50" - ) - ) + - # ggplot2::geom_tile(ggplot2::aes(fill = .data[["value"]]), - ggplot2::geom_tile(ggplot2::aes(fill = weight), - colour = "white" - ) - - # Color for signed networks - if (is_signed(x)) { - g <- g + - ggplot2::scale_fill_gradient2(high = "#003049", - mid = "white", - low = "#d62828") - } else { - g <- g + - ggplot2::scale_fill_gradient( - low = "white", - high = "black" - ) - } - - # Structure for multimodal networks - if (!is_twomode(x)) { - g <- g + - ggplot2::scale_x_discrete(expand = c(0, 0), position = "top", - limits = colnames(blocked_data) - ) + - ggplot2::scale_y_discrete(expand = c(0, 0), - limits = rev(rownames(blocked_data)) - ) - if (!is.null(membership)) - if(!is.numeric(membership)) membership <- as.numeric(as.factor(membership)) - g <- g + ggplot2::geom_vline( - xintercept = c(1 + which(diff(membership[order(membership)]) != 0)) - - .5, - colour = "red" - ) + - ggplot2::geom_hline( - yintercept = nrow(blocked_data) - - c(1 + which(diff(membership[order(membership)]) != 0)) + - 1.5, - colour = "red" - ) - } else { - g <- g + - ggplot2::scale_y_discrete(expand = c(0, 0), - limits = rev(rownames(x[["blocked.data"]])[x[["order.vector"]][["nodes1"]]]) - ) + - ggplot2::scale_x_discrete(expand = c(0, 0), position = "top", - limits = colnames(x[["blocked.data"]])[x[["order.vector"]][["nodes2"]]] - ) + - ggplot2::geom_vline( - xintercept = - c(1 + which(diff(x[["block.membership"]][["nodes2"]]) != 0)) - - .5, - colour = "blue" - ) + - ggplot2::geom_hline( - yintercept = nrow(x[["blocked.data"]]) - - c(1 + which(diff(x[["block.membership"]][["nodes1"]]) != 0)) - + 1.5, - colour = "red" - ) - } - g -} - elementwise.all.equal <- Vectorize(function(x, y) {isTRUE(all.equal(x, y))}) diff --git a/R/class_models.R b/R/class_models.R index d76ce8b0..52c85980 100644 --- a/R/class_models.R +++ b/R/class_models.R @@ -11,12 +11,6 @@ make_diff_model <- function(events, report, .data) { report } -make_diffs_model <- function(report, .data) { - class(report) <- c("diffs_model", class(report)) - attr(report, "mode") <- node_is_mode(.data) - report -} - #' @export print.diff_model <- function(x, ..., verbose = FALSE){ x <- x[,colSums(x, na.rm=TRUE) != 0] @@ -30,99 +24,11 @@ print.diff_model <- function(x, ..., verbose = FALSE){ print(dplyr::tibble(x, ...)) } -#' @export -print.diffs_model <- function(x, ...){ - x <- x[,colSums(x, na.rm=TRUE) != 0] - x$I_new <- NULL - print(dplyr::tibble(x, ...)) -} - #' @export summary.diff_model <- function(object, ...) { dplyr::tibble(attr(object, "events"), ...) } -#' @export -summary.diffs_model <- function(object, ...) { - sim <- fin <- n <- NULL - object %>% dplyr::mutate(fin = (I!=n)*1) %>% - dplyr::group_by(sim) %>% dplyr::summarise(toa = sum(fin)+1) -} - -#' @importFrom dplyr left_join -#' @importFrom ggplot2 geom_histogram -#' @export -plot.diff_model <- function(x, ..., all_steps = TRUE){ - S <- E <- I <- I_new <- n <- R <- NULL # initialize variables to avoid CMD check notes - if(nrow(x)==1) warning("No diffusion observed.") else { - data <- x - if(!all_steps) data <- data %>% dplyr::filter(!(data$I==data$I[length(data$I)] * - duplicated(data$I==data$I[length(data$I)]))) - p <- ggplot2::ggplot(data) + - ggplot2::geom_line(ggplot2::aes(x = t, y = S/n, color = "A"), linewidth = 1.25) + - ggplot2::geom_line(ggplot2::aes(x = t, y = I/n, color = "C"), linewidth = 1.25) + - ggplot2::geom_col(ggplot2::aes(x = t, y = I_new/n), - alpha = 0.4) + - ggplot2::theme_minimal() + - ggplot2::coord_cartesian(ylim = c(0,1)) + # using coord_cartesian to avoid printing warnings - ggplot2::scale_x_continuous(breaks = function(x) pretty(x, n=6)) + - ggplot2::ylab("Proportion") + ggplot2::xlab("Steps") - labs <- c("Susceptible", "Infected") - if(any(data$E>0)){ - p <- p + - ggplot2::geom_line(ggplot2::aes(x = t, y = E/n, color = "B"),size = 1.25) - labs <- c("Susceptible", "Exposed", "Infected") - } - if(any(data$R>0)){ - p <- p + - ggplot2::geom_line(ggplot2::aes(x = t, y = R/n, color = "D"),size = 1.25) - labs <- c(labs, "Recovered") - } - - p + ggplot2::scale_color_manual("Legend", - labels = labs, - values = c(A = "#4575b4", B = "#E6AB02", - C = "#d73027", D = "#66A61E"), - guide = "legend") - } -} - -#' @export -plot.diffs_model <- function(x, ...){ - S <- E <- I <- R <- n <- NULL # initialize variables to avoid CMD check notes - data <- dplyr::tibble(x) - # ggplot2::ggplot(data) + geom_smooth() - p <- ggplot2::ggplot(data) + - # ggplot2::geom_point(ggplot2::aes(x = t, y = S/n)) - ggplot2::geom_smooth(ggplot2::aes(x = t, y = S/n, color = "A"), - method = "loess", se=TRUE, level = .95, formula = 'y~x') + - ggplot2::geom_smooth(ggplot2::aes(x = t, y = I/n, color = "C"), - method = "loess", se=TRUE, level = .95, formula = 'y~x') + - ggplot2::theme_minimal() + - ggplot2::coord_cartesian(ylim = c(0,1)) + # using coord_cartesion to avoid printing warnings - ggplot2::scale_x_continuous(breaks = function(x) pretty(x, n=6)) + - ggplot2::ylab("Proportion") + ggplot2::xlab("Steps") - labs <- c("Susceptible", "Infected") - if(any(data$E>0)){ - p <- p + - ggplot2::geom_smooth(ggplot2::aes(x = t, y = E/n, color = "B"), - method = "loess", se=TRUE, level = .95, formula = 'y~x') - labs <- c("Susceptible", "Exposed", "Infected") - } - if(any(data$R>0)){ - p <- p + - ggplot2::geom_smooth(ggplot2::aes(x = t, y = R/n, color = "D"), - method = "loess", se=TRUE, level = .95, formula = 'y~x') - labs <- c(labs, "Recovered") - } - - p + ggplot2::scale_color_manual("Legend", - labels = labs, - values = c(A = "#4575b4", B = "#E6AB02", - C = "#d73027", D = "#66A61E"), - guide = "legend") -} - # learn_model #### make_learn_model <- function(out, .data) { out <- as.data.frame(out) @@ -152,14 +58,3 @@ summary.learn_model <- function(object, ..., epsilon = 0.0005) { steps-1, "steps.")) } -#' @export -plot.learn_model <- function(x, ...){ - Step <- Freq <- Var1 <- n <- NULL - y <- t(x) - colnames(y) <- paste0("t",0:(ncol(y)-1)) - y <- as.data.frame.table(y) - y$Step <- as.numeric(gsub("t", "", y$Var2)) - ggplot2::ggplot(y, ggplot2::aes(x = Step, y = Freq, color = Var1)) + - ggplot2::geom_line(show.legend = FALSE) + ggplot2::theme_minimal() + - ggplot2::ylab("Belief") -} diff --git a/R/class_motifs.R b/R/class_motifs.R index e3af971d..294865aa 100644 --- a/R/class_motifs.R +++ b/R/class_motifs.R @@ -33,37 +33,6 @@ print.node_motif <- function(x, ..., } } -#' @export -plot.node_motif <- function(x, ...) { - motifs <- dimnames(x)[[2]] - if("X4" %in% motifs){ - graphs(create_motifs(4), waves = 1:11) - } else if("021D" %in% motifs){ - graphs(create_motifs(3, directed = TRUE), waves = 1:16) - } else if("102" %in% motifs){ - graphs(create_motifs(3), waves = 1:4) - } else if("Asymmetric" %in% motifs){ - graphs(create_motifs(2, directed = TRUE), waves = 1:3) - } else if("Mutual" %in% motifs){ - graphs(create_motifs(2), waves = 1:2) - } else snet_unavailable("Cannot plot these motifs yet, sorry.") -} - -#' @export -plot.network_motif <- function(x, ...) { - motifs <- attr(x, "names") - if("X4" %in% motifs){ - graphs(create_motifs(4), waves = 1:11) - } else if("021D" %in% motifs){ - graphs(create_motifs(3, directed = TRUE), waves = 1:16) - } else if("102" %in% motifs){ - graphs(create_motifs(3), waves = 1:4) - } else if("Asymmetric" %in% motifs){ - graphs(create_motifs(2, directed = TRUE), waves = 1:3) - } else if("Mutual" %in% motifs){ - graphs(create_motifs(2), waves = 1:2) - } else snet_unavailable("Cannot plot these motifs yet, sorry.") -} # summary(node_by_triad(mpn_elite_mex), # membership = node_regular_equivalence(mpn_elite_mex, "elbow")) diff --git a/R/class_networks.R b/R/class_networks.R index 1c314a5b..b84e1d6f 100644 --- a/R/class_networks.R +++ b/R/class_networks.R @@ -106,6 +106,18 @@ is_grand <- function(.data){ !is.null(igraph::graph_attr(.data, "grand")) } +net_name <- function(.data, prefix = NULL){ + existname <- "" + if(!is.null(igraph::graph_attr(.data, "name"))) { + existname <- igraph::graph_attr(.data, 'name') + } else if(is_grand(.data) && + !is.null(igraph::graph_attr(.data, "grand")$name)){ + existname <- igraph::graph_attr(.data, 'grand')$name + } + if(existname != "" && !is.null(prefix)) existname <- paste(prefix, existname) + existname +} + describe_graph <- function(x) { paste0("A ", ifelse(is_dynamic(x), "dynamic, ", ""), diff --git a/R/data_ison.R b/R/data_ison.R index 923a4197..6c9de06e 100644 --- a/R/data_ison.R +++ b/R/data_ison.R @@ -456,9 +456,18 @@ #' One-mode network of Lord of the Rings character interactions #' #' @description -#' A network of 36 Lord of the Rings book characters and 66 interactional relationships. +#' The Lord of the Rings is a beloved, epic high fantasy novel written by +#' J.R.R. Tolkien. +#' This is a network of 36 Lord of the Rings book characters and +#' 66 interactional relationships. +#' #' The ties are unweighted and concern only interaction. #' Interaction can be cooperative or conflictual. +#' +#' In addition, the race of these characters has been coded, +#' though not without debate. +#' The most contentious is the coding of Tom Bombadil and Goldberry as Maiar, +#' presumably coded as such to avoid having categories of one. #' @docType data #' @keywords datasets #' @name fict_lotr @@ -787,3 +796,46 @@ #' irps_usgeo #' ``` "irps_usgeo" + +## Revere #### + +#' Two-mode network of Paul Revere's (Fischer 1995) +#' +#' @description +#' This network is of Paul Revere and 253 of his contemporary's overlapping +#' memberships in seven colonial organisations. +#' The data has been collected by Kieran Healy from the appendix to +#' David Hackett Fischer's "Paul Revere's Ride". +#' It highlights Paul Revere's centrality in this network, and thus his +#' ability to mobilise the towns he rode through on horseback north +#' from Boston on the night of April 18, 1775. +#' This is in contrast to William Dawes, who set out the same night, +#' but south. +#' Despite both men coming from similar class and backgrounds, +#' and riding through towns with similar demography and political leanings, +#' only Paul Revere was able to mobilise those he encountered, +#' and his social network was thought key to this. +#' @docType data +#' @keywords datasets +#' @name irps_revere +#' @usage data(irps_revere) +#' @references +#' Fischer, David Hackett. 1995. +#' "Paul Revere's Ride". +#' Oxford: Oxford University Press. +#' +#' Han, Shin-Kap. 2009. +#' "The Other Ride of Paul Revere: The Brokerage Role in the Making of the American Revolution". +#' _Mobilization: An International Quarterly_, 14(2): 143-162. +#' \doi{10.17813/maiq.14.2.g360870167085210} +#' +#' Healy, Kieran. 2013. +#' "Using Metadata to find Paul Revere". +#' @format +#' ```{r, echo = FALSE} +#' irps_revere +#' ``` +"irps_revere" + + + diff --git a/R/manip_as.R b/R/manip_as.R index bf4a6f45..8c463f01 100644 --- a/R/manip_as.R +++ b/R/manip_as.R @@ -1035,6 +1035,7 @@ as_diffusion.mnet <- function(.data, twomode = FALSE, events) { dplyr::any_of(c("time", "n", "S", "s", "E", "E_new", "I", "I_new", "R", "R_new"))) # make_diff_model(events, report, .data) + class(report) <- c("diff_model", class(report)) report } diff --git a/R/manip_format.R b/R/manip_format.R index b780f855..2cf76024 100644 --- a/R/manip_format.R +++ b/R/manip_format.R @@ -1,6 +1,6 @@ # Deformatting #### -#' Modifying network formats +#' Modifying network formats by removing information #' #' @description #' These functions reformat manynet-consistent data. diff --git a/R/manip_reformed.R b/R/manip_reformed.R index 55a9e38b..d28c3499 100644 --- a/R/manip_reformed.R +++ b/R/manip_reformed.R @@ -218,7 +218,9 @@ to_ties.matrix <- function(.data){ #' #' - `to_ego()` scopes a network into the local neighbourhood of a given node. #' - `to_giant()` scopes a network into one including only the main component and no smaller components or isolates. -#' - `to_no_isolates()` scopes a network into one excluding all nodes without ties +#' - `to_no_isolates()` scopes a network into one excluding all nodes without ties. +#' - `to_no_missing()` scopes a network to one retaining only complete cases, +#' i.e. nodes with no missing values. #' - `to_subgraph()` scopes a network into a subgraph by filtering on some node-related logical statement. #' - `to_blocks()` reduces a network to ties between a given partition membership vector. #' @details @@ -242,6 +244,16 @@ to_ties.matrix <- function(.data){ #' with certain modifications as outlined for each function. NULL +#' @rdname manip_scope +#' @export +to_no_missing <- function(.data) UseMethod("to_no_missing") + +#' @export +to_no_missing.tbl_graph <- function(.data){ + delete_nodes(.data, !stats::complete.cases(as_nodelist(.data))) +} + + #' @rdname manip_scope #' @param node Name or index of node. #' @param max_dist The maximum breadth of the neighbourhood. @@ -268,7 +280,9 @@ to_ego.tbl_graph <- function(.data, node, max_dist = 1, min_dist = 0, direction = c("out","in")){ egos <- to_egos(.data, max_dist = max_dist, min_dist = min_dist, direction = direction) - as_tidygraph(egos[[node]]) + existname <- net_name(.data, prefix = "from") + out <- as_tidygraph(egos[[node]]) + add_info(out, name = paste("Ego network of", node, existname)) } #' @rdname manip_scope diff --git a/R/manynet-tutorials.R b/R/manynet-tutorials.R index 4a393beb..7b654f98 100644 --- a/R/manynet-tutorials.R +++ b/R/manynet-tutorials.R @@ -113,8 +113,7 @@ NULL #' dplyr::distinct(directed, weighted, twomode, signed, #' .keep_all = TRUE) #' @export -table_data <- function(pkg = c("manynet","migraph"), - ...) { +table_data <- function(..., pkg = c("manynet","migraph")) { nodes <- NULL pkg <- intersect(pkg, rownames(utils::installed.packages())) out <- lapply(pkg, function(x){ @@ -124,7 +123,8 @@ table_data <- function(pkg = c("manynet","migraph"), datanames <- datanames[!vapply(datasets, is_list, logical(1))] datasets <- datasets[!vapply(datasets, is_list, logical(1))] dplyr::tibble(dataset = tibble::char(datanames, min_chars = 18), - nodes = vapply(datasets, net_nodes, numeric(1)), + components = vapply(datasets, net_components, numeric(1)), + nodes = vapply(datasets, net_nodes, numeric(1)), ties = vapply(datasets, net_ties, numeric(1)), nattr = vapply(datasets, function (x) length(net_node_attributes(x)), @@ -141,7 +141,7 @@ table_data <- function(pkg = c("manynet","migraph"), twomode = as.logi(vapply(datasets, is_twomode, logical(1))), - labelled = as.logi(vapply(datasets, + labelled = as.logi(vapply(datasets, is_labelled, logical(1))), signed = as.logi(vapply(datasets, @@ -150,7 +150,16 @@ table_data <- function(pkg = c("manynet","migraph"), multiplex = as.logi(vapply(datasets, is_multiplex, logical(1))), - acyclic = as.logi(vapply(datasets, + longitudinal = as.logi(vapply(datasets, + is_longitudinal, + logical(1))), + dynamic = as.logi(vapply(datasets, + is_dynamic, + logical(1))), + changing = as.logi(vapply(datasets, + is_changing, + logical(1))), + acyclic = as.logi(vapply(datasets, is_acyclic, logical(1))), attributed = as.logi(vapply(datasets, diff --git a/R/manynet-utils.R b/R/manynet-utils.R index 0c0406bf..36aa8688 100644 --- a/R/manynet-utils.R +++ b/R/manynet-utils.R @@ -1,5 +1,5 @@ # defining global variables more centrally -utils::globalVariables(c(".data", "obs", +utils::globalVariables(c(".data", "obs", "from", "to", "name", "weight","sign","wave", "nodes","event","exposure", "student","students","colleges", diff --git a/R/measure_heterogeneity.R b/R/measure_heterogeneity.R index 32c64893..2c9aa549 100644 --- a/R/measure_heterogeneity.R +++ b/R/measure_heterogeneity.R @@ -71,6 +71,11 @@ node_richness <- function(.data, attribute){ #' Blau, Peter M. 1977. #' _Inequality and heterogeneity_. #' New York: Free Press. +#' +#' Page, Scott E. 2010. +#' _Diversity and Complexity_. +#' Princeton: Princeton University Press. +#' \doi{10.1515/9781400835140} #' @examples #' marvel_friends <- to_unsigned(ison_marvel_relationships, "positive") #' net_diversity(marvel_friends, "Gender") diff --git a/R/member_community.R b/R/member_community.R index bb79af0f..16bf7971 100644 --- a/R/member_community.R +++ b/R/member_community.R @@ -350,7 +350,7 @@ node_in_leiden <- function(.data, resolution = 1){ resolution <- sum(tie_weights(.data))/(n*(n - 1)/2) } out <- igraph::cluster_leiden(as_igraph(.data), - resolution_parameter = resolution + resolution = resolution )$membership make_node_member(out, .data) } @@ -399,9 +399,6 @@ NULL #' \doi{10.1103/PhysRevE.69.026113} #' @examples #' node_in_betweenness(ison_adolescents) -#' if(require("ggdendro", quietly = TRUE)){ -#' plot(node_in_betweenness(ison_adolescents)) -#' } #' @export node_in_betweenness <- function(.data){ if(missing(.data)) {expect_nodes(); .data <- .G()} diff --git a/R/member_equivalence.R b/R/member_equivalence.R index d469896c..622da391 100644 --- a/R/member_equivalence.R +++ b/R/member_equivalence.R @@ -77,12 +77,7 @@ node_in_equivalence <- function(.data, census, #' @rdname member_equivalence #' @examples -#' \donttest{ #' (nse <- node_in_structural(ison_algebra)) -#' if(require("ggdendro", quietly = TRUE)){ -#' plot(nse) -#' } -#' } #' @export node_in_structural <- function(.data, k = c("silhouette", "elbow", "strict"), @@ -101,13 +96,8 @@ node_in_structural <- function(.data, #' @rdname member_equivalence #' @examples -#' \donttest{ #' (nre <- node_in_regular(ison_southern_women, #' cluster = "concor")) -#' if(require("ggdendro", quietly = TRUE)){ -#' plot(nre) -#' } -#' } #' @export node_in_regular <- function(.data, k = c("silhouette", "elbow", "strict"), @@ -134,14 +124,9 @@ node_in_regular <- function(.data, #' @rdname member_equivalence #' @examples -#' \donttest{ #' if(require("sna", quietly = TRUE)){ #' (nae <- node_in_automorphic(ison_southern_women, #' k = "elbow")) -#' if(require("ggdendro", quietly = TRUE)){ -#' plot(nae) -#' } -#' } #' } #' @export node_in_automorphic <- function(.data, diff --git a/cran-comments.md b/cran-comments.md index cc5ca856..7c5065eb 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -1,9 +1,9 @@ ## Test environments -* local R installation, aarch64-apple-darwin20, R 4.4.2 -* macOS 14.5 (on Github), R 4.4.1 -* Microsoft Windows Server 2022 10.0.20348 (on Github), R 4.4.1 -* Ubuntu 22.04.4 (on Github), R 4.4.1 +* local R installation, aarch64-apple-darwin20, R 4.5.1 +* macOS 14.7.6 (on Github), R 4.5.1 +* Microsoft Windows Server 2022 10.0.20348 (on Github), R 4.5.1 +* Ubuntu 24.04.2 (on Github), R 4.5.1 ## R CMD check results diff --git a/data/irps_revere.rda b/data/irps_revere.rda new file mode 100644 index 00000000..6dbcd6d3 Binary files /dev/null and b/data/irps_revere.rda differ diff --git a/devmanynet.Rproj b/dev_manynet.Rproj similarity index 100% rename from devmanynet.Rproj rename to dev_manynet.Rproj diff --git a/man/data_overview.Rd b/man/data_overview.Rd index 88a14715..7bfe9ccc 100644 --- a/man/data_overview.Rd +++ b/man/data_overview.Rd @@ -5,13 +5,13 @@ \alias{table_data} \title{Obtain overview of available network data} \usage{ -table_data(pkg = c("manynet", "migraph"), ...) +table_data(..., pkg = c("manynet", "migraph")) } \arguments{ -\item{pkg}{String, name of the package.} - \item{...}{Network marks, e.g. directed, twomode, or signed, that are used to filter the results.} + +\item{pkg}{String, name of the package.} } \description{ This function makes it easy to get an overview of available data: diff --git a/man/fict_lotr.Rd b/man/fict_lotr.Rd index e4e0eb78..779720e2 100644 --- a/man/fict_lotr.Rd +++ b/man/fict_lotr.Rd @@ -39,8 +39,17 @@ data(fict_lotr) } \description{ -A network of 36 Lord of the Rings book characters and 66 interactional relationships. +The Lord of the Rings is a beloved, epic high fantasy novel written by +J.R.R. Tolkien. +This is a network of 36 Lord of the Rings book characters and +66 interactional relationships. + The ties are unweighted and concern only interaction. Interaction can be cooperative or conflictual. + +In addition, the race of these characters has been coded, +though not without debate. +The most contentious is the coding of Tom Bombadil and Goldberry as Maiar, +presumably coded as such to avoid having categories of one. } \keyword{datasets} diff --git a/man/irps_revere.Rd b/man/irps_revere.Rd new file mode 100644 index 00000000..e5348372 --- /dev/null +++ b/man/irps_revere.Rd @@ -0,0 +1,67 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data_ison.R +\docType{data} +\name{irps_revere} +\alias{irps_revere} +\title{Two-mode network of Paul Revere's (Fischer 1995)} +\format{ +\if{html}{\out{
}}\preformatted{#> # A labelled, two-mode network of 261 nodes and 319 ties +#> +#> -- Nodes +#> # A tibble: 261 x 2 +#> type name +#> +#> 1 FALSE Adams.John +#> 2 FALSE Adams.Samuel +#> 3 FALSE Allen.Dr +#> 4 FALSE Appleton.Nathaniel +#> 5 FALSE Ash.Gilbert +#> 6 FALSE Austin.Benjamin +#> # i 255 more rows +#> +#> -- Ties +#> # A tibble: 319 x 2 +#> from to +#> +#> 1 1 257 +#> 2 1 258 +#> 3 2 257 +#> 4 2 258 +#> 5 2 260 +#> 6 2 261 +#> # i 313 more rows +#> +}\if{html}{\out{
}} +} +\usage{ +data(irps_revere) +} +\description{ +This network is of Paul Revere and 253 of his contemporary's overlapping +memberships in seven colonial organisations. +The data has been collected by Kieran Healy from the appendix to +David Hackett Fischer's "Paul Revere's Ride". +It highlights Paul Revere's centrality in this network, and thus his +ability to mobilise the towns he rode through on horseback north +from Boston on the night of April 18, 1775. +This is in contrast to William Dawes, who set out the same night, +but south. +Despite both men coming from similar class and backgrounds, +and riding through towns with similar demography and political leanings, +only Paul Revere was able to mobilise those he encountered, +and his social network was thought key to this. +} +\references{ +Fischer, David Hackett. 1995. +"Paul Revere's Ride". +Oxford: Oxford University Press. + +Han, Shin-Kap. 2009. +"The Other Ride of Paul Revere: The Brokerage Role in the Making of the American Revolution". +\emph{Mobilization: An International Quarterly}, 14(2): 143-162. +\doi{10.17813/maiq.14.2.g360870167085210} + +Healy, Kieran. 2013. +"Using Metadata to find Paul Revere". +} +\keyword{datasets} diff --git a/man/manip_deformat.Rd b/man/manip_deformat.Rd index cdfdaed9..e62d3c97 100644 --- a/man/manip_deformat.Rd +++ b/man/manip_deformat.Rd @@ -8,7 +8,7 @@ \alias{to_unsigned} \alias{to_simplex} \alias{to_uniplex} -\title{Modifying network formats} +\title{Modifying network formats by removing information} \usage{ to_unnamed(.data) diff --git a/man/manip_scope.Rd b/man/manip_scope.Rd index 3959b12d..1c7c194a 100644 --- a/man/manip_scope.Rd +++ b/man/manip_scope.Rd @@ -2,6 +2,7 @@ % Please edit documentation in R/manip_reformed.R \name{manip_scope} \alias{manip_scope} +\alias{to_no_missing} \alias{to_ego} \alias{to_time} \alias{to_giant} @@ -10,6 +11,8 @@ \alias{to_blocks} \title{Modifying networks scope} \usage{ +to_no_missing(.data) + to_ego(.data, node, max_dist = 1, min_dist = 0, direction = c("out", "in")) to_time(.data, time) @@ -69,7 +72,9 @@ than the original object. \itemize{ \item \code{to_ego()} scopes a network into the local neighbourhood of a given node. \item \code{to_giant()} scopes a network into one including only the main component and no smaller components or isolates. -\item \code{to_no_isolates()} scopes a network into one excluding all nodes without ties +\item \code{to_no_isolates()} scopes a network into one excluding all nodes without ties. +\item \code{to_no_missing()} scopes a network to one retaining only complete cases, +i.e. nodes with no missing values. \item \code{to_subgraph()} scopes a network into a subgraph by filtering on some node-related logical statement. \item \code{to_blocks()} reduces a network to ties between a given partition membership vector. } diff --git a/man/measure_heterogeneity.Rd b/man/measure_heterogeneity.Rd index dc425095..8a995173 100644 --- a/man/measure_heterogeneity.Rd +++ b/man/measure_heterogeneity.Rd @@ -115,6 +115,11 @@ net_spatial(ison_lawfirm, "age") Blau, Peter M. 1977. \emph{Inequality and heterogeneity}. New York: Free Press. + +Page, Scott E. 2010. +\emph{Diversity and Complexity}. +Princeton: Princeton University Press. +\doi{10.1515/9781400835140} } \subsection{On heterophily}{ diff --git a/man/member_community_hier.Rd b/man/member_community_hier.Rd index b96aabbe..89138572 100644 --- a/man/member_community_hier.Rd +++ b/man/member_community_hier.Rd @@ -90,9 +90,6 @@ information about the hierarchical merging of communities is collected. \examples{ node_in_betweenness(ison_adolescents) -if(require("ggdendro", quietly = TRUE)){ -plot(node_in_betweenness(ison_adolescents)) -} node_in_greedy(ison_adolescents) node_in_eigen(ison_adolescents) node_in_walktrap(ison_adolescents) diff --git a/man/member_equivalence.Rd b/man/member_equivalence.Rd index efc6af46..eacc157a 100644 --- a/man/member_equivalence.Rd +++ b/man/member_equivalence.Rd @@ -104,27 +104,12 @@ of the hierarchical cluster and showing the returned cluster assignment. } \examples{ -\donttest{ (nse <- node_in_structural(ison_algebra)) -if(require("ggdendro", quietly = TRUE)){ -plot(nse) -} -} -\donttest{ (nre <- node_in_regular(ison_southern_women, cluster = "concor")) -if(require("ggdendro", quietly = TRUE)){ -plot(nre) -} -} -\donttest{ if(require("sna", quietly = TRUE)){ (nae <- node_in_automorphic(ison_southern_women, k = "elbow")) -if(require("ggdendro", quietly = TRUE)){ -plot(nae) -} -} } } \seealso{ diff --git a/tests/testthat/test-manip_reformed.R b/tests/testthat/test-manip_reformed.R new file mode 100644 index 00000000..5afe68dd --- /dev/null +++ b/tests/testthat/test-manip_reformed.R @@ -0,0 +1,14 @@ +test_that("to_no_missing.tbl_graph removes nodes with missing values", { + # Create a tbl_graph with some missing values + graph <- tbl_graph( + nodes = tibble::tibble(name = c("A", "B", NA, "D")), + edges = tibble::tibble(from = c(1, 2, 3), to = c(2, 3, 4)) + ) + + # Apply the function + cleaned_graph <- to_no_missing(graph) + + # Check that nodes with missing values are removed + expect_equal(nrow(as_tibble(cleaned_graph, active = "nodes")), 3) + expect_true(all(complete.cases(as_tibble(cleaned_graph, active = "nodes")))) +}) diff --git a/tests/testthat/test-manynet-tutorials.R b/tests/testthat/test-manynet-tutorials.R new file mode 100644 index 00000000..9bd9e3ea --- /dev/null +++ b/tests/testthat/test-manynet-tutorials.R @@ -0,0 +1,6 @@ +test_that("table_data returns a tibble with expected columns", { + result <- table_data(pkg = "manynet") + + expect_s3_class(result, "tbl_df") + expect_true(all(c("dataset", "nodes", "ties", "directed") %in% names(result))) +}) \ No newline at end of file diff --git a/tests/testthat/test-mark_nodes.R b/tests/testthat/test-mark_nodes.R index 66f28e06..9342c71a 100644 --- a/tests/testthat/test-mark_nodes.R +++ b/tests/testthat/test-mark_nodes.R @@ -67,6 +67,16 @@ test_that("additional node mark functions work", { expect_mark(node_is_random(ison_adolescents, 2), c(F,T,F)) }) +test_that("node_is_pendant correctly identifies pendant nodes", { + # Apply the function + result <- node_is_pendant(create_star(5)) + + # The center of the star (node 1) is not pendant, others are + expect_type(result, "logical") + expect_length(result, 5) + expect_equal(as.logical(result), c(FALSE, TRUE, TRUE, TRUE, TRUE)) +}) + test_that("node infection, exposure, and recovery works", { skip_on_cran() skip_on_ci() diff --git a/tests/testthat/test-measure_centrality.R b/tests/testthat/test-measure_centrality.R index 836d3158..c3987d25 100644 --- a/tests/testthat/test-measure_centrality.R +++ b/tests/testthat/test-measure_centrality.R @@ -84,9 +84,6 @@ test_that("node measure class works", { expect_s3_class(node_closeness(ison_adolescents), "node_measure") expect_s3_class(node_eigenvector(ison_adolescents), "node_measure") expect_s3_class(node_reach(ison_adolescents), "node_measure") - testplot <- plot(node_degree(ison_adolescents)) - expect_equal(testplot$data$Score, unname(node_degree(ison_adolescents))) - # expect_equal(testplot$labels$y, "Frequency") }) # ####### Centralization diff --git a/tests/testthat/test-member_community.R b/tests/testthat/test-member_community.R index 311aee61..c7634e39 100644 --- a/tests/testthat/test-member_community.R +++ b/tests/testthat/test-member_community.R @@ -22,3 +22,13 @@ test_that("node_walktrap algorithm works", { expect_length(node_in_walktrap(ison_southern_women), net_nodes(ison_southern_women)) }) + +test_that("node_in_community uses node_in_optimal on small networks", { + options(manynet_verbosity = "verbose") + options(snet_verbosity = "verbose") + expect_message(node_in_community(manynet::create_ring(10)), "optimal") + expect_message(node_in_community(manynet::create_ring(200)), "xcluding") + expect_message(node_in_community(fict_thrones), "xcluding") + options(manynet_verbosity = "quiet") + options(snet_verbosity = "quiet") +}) \ No newline at end of file