From a0140593a66909ccece5a51302e1655df8f7dd0e Mon Sep 17 00:00:00 2001 From: James Hollway Date: Mon, 16 Sep 2024 13:51:28 +0200 Subject: [PATCH 01/46] Added some progress updates on lengthier functions --- R/make_read.R | 1 + R/manip_split.R | 1 + 2 files changed, 2 insertions(+) diff --git a/R/make_read.R b/R/make_read.R index 729475a9..15cb809d 100644 --- a/R/make_read.R +++ b/R/make_read.R @@ -684,6 +684,7 @@ write_graphml <- function(.data, #' # edge_color = "type", node_color = "Compilation") #' @export read_cran <- function(pkg = "all"){ + cli::cli_progress_step("Downloading data about available packages from CRAN") cranInfoDF <- as.data.frame(utils::available.packages( utils::contrib.url(getOption("repos"), type = "source"))) if(pkg=="all") new <- cranInfoDF$Package else diff --git a/R/manip_split.R b/R/manip_split.R index 15668789..79a5771c 100644 --- a/R/manip_split.R +++ b/R/manip_split.R @@ -32,6 +32,7 @@ to_egos.igraph <- function(.data, max_dist = 1, min_dist = 0){ if(is_twomode(.data)) max_dist <- max_dist*2 + cli::cli_progress_step("Obtaining neighbourhoods") out <- igraph::make_ego_graph(.data, order = max_dist, mindist = min_dist) From d8805e4f62a23cd4209e1ec49de32c0d7c61c251 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Mon, 16 Sep 2024 13:51:46 +0200 Subject: [PATCH 02/46] Fixed spelling errors --- NEWS.md | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/NEWS.md b/NEWS.md index 063489ec..c97b433b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -98,7 +98,7 @@ - `table_data()` can now report on data from multiple packages - `{manynet}` and `{migraph}` are included by default, and if any are not installed they are just ignored -- `tabe_data()` can now filter by any reported formats, +- `table_data()` can now filter by any reported formats, such as 'directed' or 'twomode' ## Website @@ -198,7 +198,7 @@ including force-directed, layered, circular, spectral, and grid layouts existing network was incorrect - Added `generate_configuration()` for generating configuration models (including for two-mode networks) -- `play_diffuson()` now includes an explicit contact argument to control the +- `play_diffusion()` now includes an explicit contact argument to control the basis of exposure ## Marking @@ -277,7 +277,7 @@ and `node_is_infected()` (closes #71) `net_balance()`, `net_change()`, and `net_stability()` - Updated properties from mapping to measuring - Updated attributes from mapping to measuring - - Renamed `node_mode()` (deprecated) to node_is_mode() since it returns a + - Renamed `node_mode()` (deprecated) to `node_is_mode()` since it returns a logical vector - Updated `node_attribute()` and `tie_attribute()` to return measures when the output is numeric From 70440c6e028a4ca261257df41367ccbba86220ec Mon Sep 17 00:00:00 2001 From: Henrique Sposito Date: Tue, 17 Sep 2024 18:21:54 +0200 Subject: [PATCH 03/46] Removed size for loops in `graphr()` to avoid issues with plotting complex networks --- 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 0821fcb6..2fadaee7 100644 --- a/R/map_autograph.R +++ b/R/map_autograph.R @@ -388,7 +388,7 @@ graphr <- function(.data, layout, labels = TRUE, } } if (is_complex(g)) { - p <- p + ggraph::geom_edge_loop0(edge_width = esize, edge_alpha = 0.4) + p <- p + ggraph::geom_edge_loop0(edge_alpha = 0.4) } if (length(unique(esize)) == 1) { p <- p + ggplot2::guides(edge_width = "none") From 221704b0281aea1ee8cf5f029ffb1332593664e5 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Tue, 17 Sep 2024 20:51:53 +0200 Subject: [PATCH 04/46] Added add_info() for adding grand info to tidygraph objects --- NAMESPACE | 1 + R/manip_nodes.R | 34 ++++++++++++++++++++++++++++++++++ 2 files changed, 35 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index 9671e0bb..328e69aa 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -296,6 +296,7 @@ export("%>%") export(.E) export(.G) export(.N) +export(add_info) export(add_node_attribute) export(add_nodes) export(add_tie_attribute) diff --git a/R/manip_nodes.R b/R/manip_nodes.R index 988beda4..27aee3cd 100644 --- a/R/manip_nodes.R +++ b/R/manip_nodes.R @@ -173,3 +173,37 @@ rename <- tidygraph::rename filter_nodes <- function(.data, ..., .by){ tidygraph::filter(.data, ..., .by = .by) } + +#' @rdname manip_nodes +#' @examples +#' add_info(ison_algebra, name = "Algebra") +#' @export +add_info <- function(.data, ...){ + if(!is.null(igraph::graph_attr(.data)$grand)){ + cli::cli_inform("Hmm, I don't know how to do that yet.") + } else { + info <- list(...) + unrecog <- setdiff(names(info), c("name", "nodes", "ties", "doi", + "collection", "year", "mode", "vertex1", + "vertex1.total", "vertex2", + "vertex2.total", "edge.pos", "edge.neg")) + if(length(unrecog)>0) + cli::cli_alert_warning("{unrecog} are not recognised fields.") + if("nodes" %in% names(info)){ + info$vertex1 <- info$nodes[1] + if(is_twomode(.data) && length(info$nodes)==2) + info$vertex2 <- info$nodes[2] + info$nodes <- NULL + } + if("ties" %in% names(info)){ + info$edge.pos <- info$ties + info$ties <- NULL + } + # return(str(info)) # for debugging + out <- .data + igraph::graph_attr(out)$grand <- info + } + as_tidygraph(out) +} + + From ee2316a624b6a096bac2eca1f6c9300ed13c7c78 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Tue, 17 Sep 2024 20:53:50 +0200 Subject: [PATCH 05/46] print.mnet() now prints multiplex types if available --- R/class_networks.R | 33 +++++++++++++++++++++++++-------- 1 file changed, 25 insertions(+), 8 deletions(-) diff --git a/R/class_networks.R b/R/class_networks.R index c4947365..bb3e7dd9 100644 --- a/R/class_networks.R +++ b/R/class_networks.R @@ -6,22 +6,26 @@ print.mnet <- function(x, ..., n = 6) { arg_list <- list(...) arg_list[['useS4']] <- NULL - graph_desc <- describe_graph(x) - top <- dplyr::as_tibble(tidygraph::activate(x, "nodes")) - bottom <- dplyr::as_tibble(tidygraph::activate(x, "edges")) + if(is_grand(x) && !is.null(igraph::graph_attr(x, "grand")$name)) + cat('#', igraph::graph_attr(x, "grand")$name, '\n') if(is.null(igraph::graph_attr(x, "grand"))) node_name <- "nodes" else node_name <- igraph::graph_attr(x, "grand")$vertex1 - if(is.null(igraph::graph_attr(x, "grand"))) - tie_name <- ifelse(is_directed(x), "arcs", "ties") else - tie_name <- paste(igraph::graph_attr(x, "grand")$edge.pos, - ifelse(is_directed(x), "arcs", "ties")) + graph_desc <- describe_graph(x) + tie_desc <- describe_ties(x) cat('#', graph_desc, 'network of', igraph::gorder(x), node_name, 'and', - igraph::gsize(x), tie_name, '\n', sep = ' ') + tie_desc, '\n', sep = ' ') + + top <- dplyr::as_tibble(tidygraph::activate(x, "nodes")) + bottom <- dplyr::as_tibble(tidygraph::activate(x, "edges")) if (ncol(top)>0) print(top, n = n) if (ncol(bottom)>0) print(bottom, n = n, max_footer_lines = 1) invisible(x) } +is_grand <- function(.data){ + !is.null(igraph::graph_attr(.data, "grand")) +} + describe_graph <- function(x) { paste0("A ", ifelse(is_dynamic(x), "dynamic, ", ""), @@ -35,3 +39,16 @@ describe_graph <- function(x) { ifelse(is_directed(x), "directed", "undirected")) ) } + +describe_ties <- function(x){ + nt <- net_ties(x) + tie_name <- ifelse(is_directed(x), "arcs", "ties") + if(!is.null(igraph::graph_attr(x, "grand")$edge.pos)){ + tie_name <- paste(igraph::graph_attr(x, "grand")$edge.pos, + tie_name) + } else if(!is.null(tie_attribute(x, "type"))){ + tie_name <- paste(cli::ansi_collapse(unique(tie_attribute(x, "type"))), + tie_name) + } + paste(nt, tie_name) +} From fb42f43cfdd67a1c736053b931275b577aaebefb Mon Sep 17 00:00:00 2001 From: James Hollway Date: Tue, 17 Sep 2024 20:54:10 +0200 Subject: [PATCH 06/46] Added extra link to learning R --- inst/tutorials/tutorial0/tutorial0.Rmd | 1 + 1 file changed, 1 insertion(+) diff --git a/inst/tutorials/tutorial0/tutorial0.Rmd b/inst/tutorials/tutorial0/tutorial0.Rmd index 3cb9e704..d8d02cbf 100644 --- a/inst/tutorials/tutorial0/tutorial0.Rmd +++ b/inst/tutorials/tutorial0/tutorial0.Rmd @@ -36,6 +36,7 @@ Recommended elsewhere are the following: - http://data.princeton.edu/R/gettingStarted.html - http://www.ats.ucla.edu/stat/R/sk/ - http://www.statmethods.net/ +- https://www.r-bloggers.com/2022/05/best-books-to-learn-r-programming-2/ These sites will help you learn or refresh your memory. But you can also expect to return to Google often as you go and type "R ..." as a query. From ae5996353673226a8dabc1672c59a60575a1b93c Mon Sep 17 00:00:00 2001 From: James Hollway Date: Tue, 17 Sep 2024 20:54:47 +0200 Subject: [PATCH 07/46] Updated doc with better printing --- man/ison_adolescents.Rd | 3 ++- man/ison_algebra.Rd | 2 +- man/ison_hightech.Rd | 2 +- man/ison_lawfirm.Rd | 2 +- man/ison_monks.Rd | 2 +- man/ison_physicians.Rd | 8 ++++---- man/ison_thrones.Rd | 3 ++- man/manip_nodes.Rd | 4 ++++ 8 files changed, 16 insertions(+), 10 deletions(-) diff --git a/man/ison_adolescents.Rd b/man/ison_adolescents.Rd index 1628fe70..aa5d445b 100644 --- a/man/ison_adolescents.Rd +++ b/man/ison_adolescents.Rd @@ -5,7 +5,8 @@ \alias{ison_adolescents} \title{One-mode subset of the adolescent society network (Coleman 1961)} \format{ -\if{html}{\out{
}}\preformatted{#> # A labelled, undirected network of 8 adolescents and 10 friendships ties +\if{html}{\out{
}}\preformatted{#> # The Adolescent Society +#> # A labelled, undirected network of 8 adolescents and 10 friendships ties #> # A tibble: 8 x 1 #> name #> diff --git a/man/ison_algebra.Rd b/man/ison_algebra.Rd index 4a4d3a4a..e5182ab2 100644 --- a/man/ison_algebra.Rd +++ b/man/ison_algebra.Rd @@ -5,7 +5,7 @@ \alias{ison_algebra} \title{Multiplex graph object of friends, social, and task ties (McFarland 2001)} \format{ -\if{html}{\out{
}}\preformatted{#> # A multiplex, weighted, directed network of 16 nodes and 279 arcs +\if{html}{\out{
}}\preformatted{#> # A multiplex, weighted, directed network of 16 nodes and 279 social, tasks, and friends arcs #> # A tibble: 279 x 4 #> from to type weight #> diff --git a/man/ison_hightech.Rd b/man/ison_hightech.Rd index d5c4e9fa..558fb4ef 100644 --- a/man/ison_hightech.Rd +++ b/man/ison_hightech.Rd @@ -5,7 +5,7 @@ \alias{ison_hightech} \title{One-mode multiplex, directed network of managers of a high-tech company (Krackhardt 1987)} \format{ -\if{html}{\out{
}}\preformatted{#> # A multiplex, directed network of 21 nodes and 312 arcs +\if{html}{\out{
}}\preformatted{#> # A multiplex, directed network of 21 nodes and 312 friends, advice, and reports arcs #> # A tibble: 21 x 4 #> age tenure level dept #> diff --git a/man/ison_lawfirm.Rd b/man/ison_lawfirm.Rd index 5e8132de..aba5118f 100644 --- a/man/ison_lawfirm.Rd +++ b/man/ison_lawfirm.Rd @@ -5,7 +5,7 @@ \alias{ison_lawfirm} \title{One-mode lawfirm (Lazega 2001)} \format{ -\if{html}{\out{
}}\preformatted{#> # A multiplex, directed network of 71 nodes and 2571 arcs +\if{html}{\out{
}}\preformatted{#> # A multiplex, directed network of 71 nodes and 2571 friends, advice, and cowork arcs #> # A tibble: 71 x 7 #> status gender office seniority age practice school #> diff --git a/man/ison_monks.Rd b/man/ison_monks.Rd index d8c6c60a..d108d233 100644 --- a/man/ison_monks.Rd +++ b/man/ison_monks.Rd @@ -5,7 +5,7 @@ \alias{ison_monks} \title{Multiplex network of three one-mode signed, weighted networks and a three-wave longitudinal network of monks (Sampson 1969)} \format{ -\if{html}{\out{
}}\preformatted{#> # A longitudinal, labelled, multiplex, signed, weighted, directed network of 18 nodes and 463 arcs +\if{html}{\out{
}}\preformatted{#> # A longitudinal, labelled, multiplex, signed, weighted, directed network of 18 nodes and 463 like, esteem, influence, and praise arcs #> # A tibble: 18 x 3 #> name groups left #> diff --git a/man/ison_physicians.Rd b/man/ison_physicians.Rd index 092b42ac..4b4a2955 100644 --- a/man/ison_physicians.Rd +++ b/man/ison_physicians.Rd @@ -6,7 +6,7 @@ \title{Four multiplex one-mode physician diffusion data (Coleman, Katz, and Menzel, 1966)} \format{ \if{html}{\out{
}}\preformatted{#> $Peoria -#> # A multiplex, directed network of 117 nodes and 543 arcs +#> # A multiplex, directed network of 117 nodes and 543 friendship, advice, and discussion arcs #> # A tibble: 117 x 12 #> adoption specialty conferences journals practice community patients #> @@ -31,7 +31,7 @@ #> # i 537 more rows #> #> $Bloomington -#> # A multiplex, directed network of 50 nodes and 211 arcs +#> # A multiplex, directed network of 50 nodes and 211 friendship, discussion, and advice arcs #> # A tibble: 50 x 12 #> adoption specialty conferences journals practice community patients #> @@ -56,7 +56,7 @@ #> # i 205 more rows #> #> $Quincy -#> # A multiplex, directed network of 44 nodes and 174 arcs +#> # A multiplex, directed network of 44 nodes and 174 advice, discussion, and friendship arcs #> # A tibble: 44 x 12 #> adoption specialty conferences journals practice community patients #> @@ -81,7 +81,7 @@ #> # i 168 more rows #> #> $Galesburg -#> # A multiplex, directed network of 35 nodes and 171 arcs +#> # A multiplex, directed network of 35 nodes and 171 advice, discussion, and friendship arcs #> # A tibble: 35 x 12 #> adoption specialty conferences journals practice community patients #> diff --git a/man/ison_thrones.Rd b/man/ison_thrones.Rd index 78f3c574..f005b2cd 100644 --- a/man/ison_thrones.Rd +++ b/man/ison_thrones.Rd @@ -5,7 +5,8 @@ \alias{ison_thrones} \title{One-mode Game of Thrones kinship (Glander 2017)} \format{ -\if{html}{\out{
}}\preformatted{#> # A labelled, multiplex, directed network of 208 characters and 404 kinship arcs +\if{html}{\out{
}}\preformatted{#> # Game of Thrones Kinship +#> # A labelled, multiplex, directed network of 208 characters and 404 kinship arcs #> # A tibble: 208 x 8 #> name male culture house popularity house2 color shape #> diff --git a/man/manip_nodes.Rd b/man/manip_nodes.Rd index 7283d1a5..d20b6c31 100644 --- a/man/manip_nodes.Rd +++ b/man/manip_nodes.Rd @@ -12,6 +12,7 @@ \alias{rename_nodes} \alias{rename} \alias{filter_nodes} +\alias{add_info} \title{Modifying node data} \usage{ add_nodes(.data, nodes, attribute = NULL) @@ -38,6 +39,8 @@ rename_nodes(.data, ...) rename(.data, ...) filter_nodes(.data, ..., .by) + +add_info(.data, ...) } \arguments{ \item{.data}{An object of a manynet-consistent class: @@ -100,6 +103,7 @@ Below are the currently implemented S3 methods:\tabular{lrrr}{ other <- create_filled(4) \%>\% mutate(name = c("A", "B", "C", "D")) another <- create_filled(3) \%>\% mutate(name = c("E", "F", "G")) join_nodes(another, other) +add_info(ison_algebra, name = "Algebra") } \seealso{ Other modifications: From d723bfeb6dba7f9ff2de72f5b36dc191a8967e25 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Tue, 17 Sep 2024 20:55:37 +0200 Subject: [PATCH 08/46] Re #60 added ability to set theme options --- NAMESPACE | 1 + R/map_theme.R | 12 ++++++++++++ man/map_themes.Rd | 3 +++ 3 files changed, 16 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index 328e69aa..a0216a7f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -666,6 +666,7 @@ export(scale_fill_sdgs) export(scale_fill_uzh) export(scale_size) export(select_ties) +export(set_manynet_theme) export(summarise_ties) export(table_data) export(theme_ethz) diff --git a/R/map_theme.R b/R/map_theme.R index 594893f4..6f0f08c5 100644 --- a/R/map_theme.R +++ b/R/map_theme.R @@ -15,6 +15,18 @@ #' theme_iheid() NULL +#' @rdname map_themes +#' @export +set_manynet_theme <- function(theme = "default"){ + theme_opts <- c("default", "iheid", "ethz", "uzh", "rug", "crisp") + if(theme %in% theme_opts){ + options(mnet_theme = theme) + cli::cli_alert_success("Theme set to {theme}.") + } else { + cli::cli_alert_danger("Please choose one of the available themes: {.emph {theme_opts}}.") + } +} + #' @rdname map_themes #' @export theme_iheid <- function(base_size = 12, base_family = "serif") { diff --git a/man/map_themes.Rd b/man/map_themes.Rd index 0a499df4..12a54ca9 100644 --- a/man/map_themes.Rd +++ b/man/map_themes.Rd @@ -2,12 +2,15 @@ % Please edit documentation in R/map_theme.R \name{map_themes} \alias{map_themes} +\alias{set_manynet_theme} \alias{theme_iheid} \alias{theme_ethz} \alias{theme_uzh} \alias{theme_rug} \title{Many themes} \usage{ +set_manynet_theme(theme = "default") + theme_iheid(base_size = 12, base_family = "serif") theme_ethz(base_size = 12, base_family = "sans") From e3577965eb4874e4527079023039273ce4e1f486 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Wed, 18 Sep 2024 10:55:38 +0200 Subject: [PATCH 09/46] Using internal progress step to allow for quieting messages --- R/make_read.R | 2 +- R/manip_split.R | 2 +- R/zzz.R | 6 ++++++ 3 files changed, 8 insertions(+), 2 deletions(-) diff --git a/R/make_read.R b/R/make_read.R index 15cb809d..dde1f4bc 100644 --- a/R/make_read.R +++ b/R/make_read.R @@ -684,7 +684,7 @@ write_graphml <- function(.data, #' # edge_color = "type", node_color = "Compilation") #' @export read_cran <- function(pkg = "all"){ - cli::cli_progress_step("Downloading data about available packages from CRAN") + mnet_progress_step("Downloading data about available packages from CRAN") cranInfoDF <- as.data.frame(utils::available.packages( utils::contrib.url(getOption("repos"), type = "source"))) if(pkg=="all") new <- cranInfoDF$Package else diff --git a/R/manip_split.R b/R/manip_split.R index 79a5771c..8f17ae9f 100644 --- a/R/manip_split.R +++ b/R/manip_split.R @@ -32,7 +32,7 @@ to_egos.igraph <- function(.data, max_dist = 1, min_dist = 0){ if(is_twomode(.data)) max_dist <- max_dist*2 - cli::cli_progress_step("Obtaining neighbourhoods") + mnet_progress_step("Obtaining neighbourhoods") out <- igraph::make_ego_graph(.data, order = max_dist, mindist = min_dist) diff --git a/R/zzz.R b/R/zzz.R index 1549c505..3d8f3536 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -43,3 +43,9 @@ } } + +mnet_progress_step <- function(...){ + if(getOption("manynet_verbosity")!="quiet") + cli::cli_progress_step(...) +} + From c0f1408d0bec1c6520b70f7232ffce41e77420da Mon Sep 17 00:00:00 2001 From: James Hollway Date: Wed, 18 Sep 2024 10:56:21 +0200 Subject: [PATCH 10/46] "name" now included in reserved tie attributes --- R/mark_net.R | 2 +- man/ison_koenigsberg.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/mark_net.R b/R/mark_net.R index b5b3d927..b8d236d5 100644 --- a/R/mark_net.R +++ b/R/mark_net.R @@ -391,7 +391,7 @@ is_multiplex.matrix <- function(.data) { FALSE } -reserved_tie_attr <- c("wave","panel","sign","weight","date","begin","end") +reserved_tie_attr <- c("wave","panel","sign","weight","date","begin","end","name") #' @export is_multiplex.tbl_graph <- function(.data) { diff --git a/man/ison_koenigsberg.Rd b/man/ison_koenigsberg.Rd index 54656cdd..6fbd24f3 100644 --- a/man/ison_koenigsberg.Rd +++ b/man/ison_koenigsberg.Rd @@ -5,7 +5,7 @@ \alias{ison_koenigsberg} \title{One-mode Seven Bridges of Koenigsberg network (Euler 1741)} \format{ -\if{html}{\out{
}}\preformatted{#> # A labelled, multiplex, undirected network of 4 nodes and 7 ties +\if{html}{\out{
}}\preformatted{#> # A labelled, undirected network of 4 nodes and 7 ties #> # A tibble: 4 x 3 #> name lat lon #> From d3a73438b00d7940dbe3e7b1408dd1bbbf4d3e95 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Wed, 18 Sep 2024 11:36:41 +0200 Subject: [PATCH 11/46] Added manynet_console_theme internally as a cli theme which is used also to color the startup messages --- R/zzz.R | 60 +++++++++++++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 56 insertions(+), 4 deletions(-) diff --git a/R/zzz.R b/R/zzz.R index 3d8f3536..9ee469d1 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -3,15 +3,16 @@ # suppressMessages(suppressPackageStartupMessages(library("manynet", warn.conflicts = FALSE))) if (!interactive()) return() - + + options(manynet_verbosity = getOption("manynet_verbosity", "verbose")) + options(cli.theme = manynet_console_theme()) + # pkgs <- as.data.frame(utils::available.packages(utils::contrib.url(getOption("repos")))) # # cran_version <- pkgs[pkgs$Package == "manynet","Version"] local_version <- utils::packageVersion("manynet") - cli::cli_div(theme = list(span.emph = list(color = "red"))) - cli::cli_inform("This is {.pkg manynet} version {.emph {local_version}}", class = "packageStartupMessage") - cli::cli_end() + cli::cli_inform("This is {.pkg manynet} version {.version {local_version}}", class = "packageStartupMessage") old.list <- as.data.frame(utils::old.packages()) behind_cran <- "manynet" %in% old.list$Package @@ -20,6 +21,7 @@ "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" = "To eliminate package startup messages, use: `suppressPackageStartupMessages(library({.pkg manynet}))`.", + "i" = "If there are too many messages in the console, run `options(manynet_verbosity = 'quiet')`", "i" = "Visit the website to learn more: {.url https://stocnet.github.io/manynet/}.", "i" = "We recommend the 'Function Overview' page online to discover new analytic opportunities: {.url https://stocnet.github.io/manynet/reference/index.html}.", "i" = "Discover all the {.emph stocnet} R packages at {.url https://github.com/stocnet/}.", @@ -49,3 +51,53 @@ mnet_progress_step <- function(...){ cli::cli_progress_step(...) } +manynet_console_theme <- function(){ + # dark <- detect_dark_theme(dark) + list(h1 = list(`margin-top` = 1, `margin-bottom` = 0, color = "#199D77", + fmt = function(x) cli::rule(x, line_col = "#199D77")), + h2 = list(`margin-top` = 1, `margin-bottom` = 0, color = "#199D77", + fmt = function(x) paste0(symbol$line, " ", x, " ", symbol$line, symbol$line)), + h3 = list(`margin-top` = 1, `margin-bottom` = 0, color = "#199D77"), + par = list(`margin-top` = 0, `margin-bottom` = 1), + `.alert-danger` = list(`background-color` = "#D83127", color = "white", + before = function() paste0(symbol$cross, " ")), + `.alert-warning` = list(color = "#E6AB02", `font-weight` = "bold", before = paste0("!", " ")), + `.alert-success` = list(before = function() paste0(col_mnet_green(symbol$tick), " ")), + `.alert-info` = list(before = function() paste0(col_mnet_blue(symbol$info), " ")), + `.alert-start` = list(before = function() paste0(symbol$arrow_right, " ")), + span.pkg = list(color = "#199D77", `font-weight` = "bold"), + span.version = list(color = "#D83127"), + span.emph = list(color = "#D83127"), + span.strong = list(`font-weight` = "bold", `font-style` = "italic"), + span.fun = utils::modifyList(simple_theme_code(), + list(after = "()")), + span.fn = utils::modifyList(simple_theme_code(), + list(after = "()")), + span.arg = simple_theme_code(), + span.kbd = utils::modifyList(simple_theme_code(), + list(before = "<", after = ">")), + span.key = utils::modifyList(simple_theme_code(), + list(before = "<", after = ">")), + span.file = list(color = "#4576B5"), + span.path = list(color = "#4576B5"), + span.email = list(color = "#4576B5"), + span.url = utils::modifyList(list(color = "#4576B5"), list(before = "<", + after = ">")), + span.var = simple_theme_code(), + span.envvar = simple_theme_code(), + span.timestamp = list(before = "[", after = "]", color = "grey")) +} + +simple_theme_code <- function(){ + # if (dark) { + # list(`background-color` = "#232323", color = "#f0f0f0") + # } + # else { + list(`background-color` = "#f8f8f8", color = "#202020") + # } +} + +col_mnet_green <- cli::make_ansi_style("#199D77") + +col_mnet_blue <- cli::make_ansi_style("#4576B5") + From d902071ac78ca100b5e1b8a7f211b7b96f27e784 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Thu, 19 Sep 2024 17:30:48 +0200 Subject: [PATCH 12/46] printing describes the number of nodes better, including spelling out both nodesets for two-mode networks --- R/class_networks.R | 14 +++++++++++--- man/ison_algebra.Rd | 3 ++- man/ison_brandes.Rd | 2 +- man/ison_friends.Rd | 3 ++- man/ison_greys.Rd | 2 +- man/ison_hightech.Rd | 3 ++- man/ison_karateka.Rd | 2 +- man/ison_koenigsberg.Rd | 2 +- man/ison_laterals.Rd | 8 ++++---- man/ison_lawfirm.Rd | 3 ++- man/ison_lotr.Rd | 2 +- man/ison_marvel.Rd | 4 ++-- man/ison_monks.Rd | 3 ++- man/ison_networkers.Rd | 2 +- man/ison_physicians.Rd | 12 ++++++++---- man/ison_potter.Rd | 12 ++++++------ man/ison_southern_women.Rd | 2 +- man/ison_starwars.Rd | 14 +++++++------- man/ison_usstates.Rd | 2 +- 19 files changed, 56 insertions(+), 39 deletions(-) diff --git a/R/class_networks.R b/R/class_networks.R index bb3e7dd9..e2b8b336 100644 --- a/R/class_networks.R +++ b/R/class_networks.R @@ -12,9 +12,8 @@ print.mnet <- function(x, ..., n = 6) { node_name <- igraph::graph_attr(x, "grand")$vertex1 graph_desc <- describe_graph(x) tie_desc <- describe_ties(x) - cat('#', graph_desc, 'network of', igraph::gorder(x), node_name, 'and', - tie_desc, '\n', sep = ' ') - + node_desc <- describe_nodes(x) + cli::cli_text("# {graph_desc} network of {node_desc} and {tie_desc}") top <- dplyr::as_tibble(tidygraph::activate(x, "nodes")) bottom <- dplyr::as_tibble(tidygraph::activate(x, "edges")) if (ncol(top)>0) print(top, n = n) @@ -40,6 +39,15 @@ describe_graph <- function(x) { ) } +describe_nodes <- function(x){ + nd <- net_dims(x) + if(!is.null(igraph::graph_attr(x, "grand")$vertex1)){ + node_name <- paste(nd[1], igraph::graph_attr(x, "grand")$vertex1) + if(length(nd)==2 && !is.null(igraph::graph_attr(x, "grand")$vertex2)) + node_name <- c(node_name, paste(nd[2], igraph::graph_attr(x, "grand")$vertex2)) + } else node_name <- paste(sum(nd), "nodes") +} + describe_ties <- function(x){ nt <- net_ties(x) tie_name <- ifelse(is_directed(x), "arcs", "ties") diff --git a/man/ison_algebra.Rd b/man/ison_algebra.Rd index e5182ab2..e1d2903a 100644 --- a/man/ison_algebra.Rd +++ b/man/ison_algebra.Rd @@ -5,7 +5,8 @@ \alias{ison_algebra} \title{Multiplex graph object of friends, social, and task ties (McFarland 2001)} \format{ -\if{html}{\out{
}}\preformatted{#> # A multiplex, weighted, directed network of 16 nodes and 279 social, tasks, and friends arcs +\if{html}{\out{
}}\preformatted{#> # A multiplex, weighted, directed network of 16 nodes and 279 social, tasks, +#> and friends arcs #> # A tibble: 279 x 4 #> from to type weight #> diff --git a/man/ison_brandes.Rd b/man/ison_brandes.Rd index ff23e8c2..138747bd 100644 --- a/man/ison_brandes.Rd +++ b/man/ison_brandes.Rd @@ -5,7 +5,7 @@ \alias{ison_brandes} \title{One-mode and two-mode centrality demonstration networks} \format{ -\if{html}{\out{
}}\preformatted{#> # A undirected network of 11 nodes and 12 ties +\if{html}{\out{
}}\preformatted{#> # A undirected network of 11 nodes and 12 ties #> # A tibble: 11 x 1 #> twomode_type #> diff --git a/man/ison_friends.Rd b/man/ison_friends.Rd index 69353c7d..433db7a3 100644 --- a/man/ison_friends.Rd +++ b/man/ison_friends.Rd @@ -5,7 +5,8 @@ \alias{ison_friends} \title{One-mode Friends character connections (McNulty, 2020)} \format{ -\if{html}{\out{
}}\preformatted{#> # A longitudinal, labelled, weighted, directed network of 650 nodes and 3959 arcs +\if{html}{\out{
}}\preformatted{#> # A longitudinal, labelled, weighted, directed network of 650 nodes and 3959 +#> arcs #> # A tibble: 650 x 1 #> name #> diff --git a/man/ison_greys.Rd b/man/ison_greys.Rd index ac08dd62..8d48dc22 100644 --- a/man/ison_greys.Rd +++ b/man/ison_greys.Rd @@ -5,7 +5,7 @@ \alias{ison_greys} \title{One-mode undirected network of characters hook-ups on Grey's Anatomy TV show} \format{ -\if{html}{\out{
}}\preformatted{#> # A labelled, undirected network of 53 nodes and 56 ties +\if{html}{\out{
}}\preformatted{#> # A labelled, undirected network of 53 nodes and 56 ties #> # A tibble: 53 x 7 #> name sex race birthyear position season sign #> diff --git a/man/ison_hightech.Rd b/man/ison_hightech.Rd index 558fb4ef..1e96793c 100644 --- a/man/ison_hightech.Rd +++ b/man/ison_hightech.Rd @@ -5,7 +5,8 @@ \alias{ison_hightech} \title{One-mode multiplex, directed network of managers of a high-tech company (Krackhardt 1987)} \format{ -\if{html}{\out{
}}\preformatted{#> # A multiplex, directed network of 21 nodes and 312 friends, advice, and reports arcs +\if{html}{\out{
}}\preformatted{#> # A multiplex, directed network of 21 nodes and 312 friends, advice, and +#> reports arcs #> # A tibble: 21 x 4 #> age tenure level dept #> diff --git a/man/ison_karateka.Rd b/man/ison_karateka.Rd index 41c0d2cf..550c08a6 100644 --- a/man/ison_karateka.Rd +++ b/man/ison_karateka.Rd @@ -5,7 +5,7 @@ \alias{ison_karateka} \title{One-mode karateka network (Zachary 1977)} \format{ -\if{html}{\out{
}}\preformatted{#> # A labelled, weighted, undirected network of 34 nodes and 78 ties +\if{html}{\out{
}}\preformatted{#> # A labelled, weighted, undirected network of 34 nodes and 78 ties #> # A tibble: 34 x 2 #> name allegiance #> diff --git a/man/ison_koenigsberg.Rd b/man/ison_koenigsberg.Rd index 6fbd24f3..a0ddac92 100644 --- a/man/ison_koenigsberg.Rd +++ b/man/ison_koenigsberg.Rd @@ -5,7 +5,7 @@ \alias{ison_koenigsberg} \title{One-mode Seven Bridges of Koenigsberg network (Euler 1741)} \format{ -\if{html}{\out{
}}\preformatted{#> # A labelled, undirected network of 4 nodes and 7 ties +\if{html}{\out{
}}\preformatted{#> # A labelled, undirected network of 4 nodes and 7 ties #> # A tibble: 4 x 3 #> name lat lon #> diff --git a/man/ison_laterals.Rd b/man/ison_laterals.Rd index e59099b4..38172b85 100644 --- a/man/ison_laterals.Rd +++ b/man/ison_laterals.Rd @@ -6,7 +6,7 @@ \title{Two-mode projection examples (Hollway 2021)} \format{ \if{html}{\out{
}}\preformatted{#> $ison_bb -#> # A labelled, two-mode network of 10 nodes and 12 ties +#> # A labelled, two-mode network of 10 nodes and 12 ties #> # A tibble: 10 x 2 #> name type #> @@ -29,7 +29,7 @@ #> # i 6 more rows #> #> $ison_bm -#> # A labelled, two-mode network of 8 nodes and 9 ties +#> # A labelled, two-mode network of 8 nodes and 9 ties #> # A tibble: 8 x 2 #> name type #> @@ -52,7 +52,7 @@ #> # i 3 more rows #> #> $ison_mb -#> # A labelled, two-mode network of 8 nodes and 9 ties +#> # A labelled, two-mode network of 8 nodes and 9 ties #> # A tibble: 8 x 2 #> name type #> @@ -75,7 +75,7 @@ #> # i 3 more rows #> #> $ison_mm -#> # A labelled, two-mode network of 6 nodes and 6 ties +#> # A labelled, two-mode network of 6 nodes and 6 ties #> # A tibble: 6 x 2 #> name type #> diff --git a/man/ison_lawfirm.Rd b/man/ison_lawfirm.Rd index aba5118f..3518817a 100644 --- a/man/ison_lawfirm.Rd +++ b/man/ison_lawfirm.Rd @@ -5,7 +5,8 @@ \alias{ison_lawfirm} \title{One-mode lawfirm (Lazega 2001)} \format{ -\if{html}{\out{
}}\preformatted{#> # A multiplex, directed network of 71 nodes and 2571 friends, advice, and cowork arcs +\if{html}{\out{
}}\preformatted{#> # A multiplex, directed network of 71 nodes and 2571 friends, advice, and +#> cowork arcs #> # A tibble: 71 x 7 #> status gender office seniority age practice school #> diff --git a/man/ison_lotr.Rd b/man/ison_lotr.Rd index 52df999d..f3cfc898 100644 --- a/man/ison_lotr.Rd +++ b/man/ison_lotr.Rd @@ -5,7 +5,7 @@ \alias{ison_lotr} \title{One-mode network of Lord of the Rings character interactions} \format{ -\if{html}{\out{
}}\preformatted{#> # A labelled, complex, undirected network of 36 nodes and 66 ties +\if{html}{\out{
}}\preformatted{#> # A labelled, complex, undirected network of 36 nodes and 66 ties #> # A tibble: 36 x 2 #> name Race #> diff --git a/man/ison_marvel.Rd b/man/ison_marvel.Rd index 2e344d46..4ded2b5c 100644 --- a/man/ison_marvel.Rd +++ b/man/ison_marvel.Rd @@ -8,7 +8,7 @@ \title{Multilevel two-mode affiliation, signed one-mode networks of Marvel comic book characters (Yuksel 2017)} \format{ -\if{html}{\out{
}}\preformatted{#> # A labelled, two-mode network of 194 nodes and 683 ties +\if{html}{\out{
}}\preformatted{#> # A labelled, two-mode network of 194 nodes and 683 ties #> # A tibble: 194 x 2 #> type name #> @@ -31,7 +31,7 @@ book characters (Yuksel 2017)} #> # i 677 more rows }\if{html}{\out{
}} -\if{html}{\out{
}}\preformatted{#> # A labelled, complex, signed, undirected network of 53 nodes and 558 ties +\if{html}{\out{
}}\preformatted{#> # A labelled, complex, signed, undirected network of 53 nodes and 558 ties #> # A tibble: 53 x 10 #> name Gender Appearances Attractive Rich Intellect Omnilingual PowerOrigin #> diff --git a/man/ison_monks.Rd b/man/ison_monks.Rd index d108d233..59fcb206 100644 --- a/man/ison_monks.Rd +++ b/man/ison_monks.Rd @@ -5,7 +5,8 @@ \alias{ison_monks} \title{Multiplex network of three one-mode signed, weighted networks and a three-wave longitudinal network of monks (Sampson 1969)} \format{ -\if{html}{\out{
}}\preformatted{#> # A longitudinal, labelled, multiplex, signed, weighted, directed network of 18 nodes and 463 like, esteem, influence, and praise arcs +\if{html}{\out{
}}\preformatted{#> # A longitudinal, labelled, multiplex, signed, weighted, directed network of 18 +#> nodes and 463 like, esteem, influence, and praise arcs #> # A tibble: 18 x 3 #> name groups left #> diff --git a/man/ison_networkers.Rd b/man/ison_networkers.Rd index 9b17003a..c747489b 100644 --- a/man/ison_networkers.Rd +++ b/man/ison_networkers.Rd @@ -5,7 +5,7 @@ \alias{ison_networkers} \title{One-mode EIES dataset (Freeman and Freeman 1979)} \format{ -\if{html}{\out{
}}\preformatted{#> # A labelled, weighted, directed network of 32 nodes and 440 arcs +\if{html}{\out{
}}\preformatted{#> # A labelled, weighted, directed network of 32 nodes and 440 arcs #> # A tibble: 32 x 3 #> name Discipline Citations #> diff --git a/man/ison_physicians.Rd b/man/ison_physicians.Rd index 4b4a2955..6a7595db 100644 --- a/man/ison_physicians.Rd +++ b/man/ison_physicians.Rd @@ -6,7 +6,8 @@ \title{Four multiplex one-mode physician diffusion data (Coleman, Katz, and Menzel, 1966)} \format{ \if{html}{\out{
}}\preformatted{#> $Peoria -#> # A multiplex, directed network of 117 nodes and 543 friendship, advice, and discussion arcs +#> # A multiplex, directed network of 117 nodes and 543 friendship, advice, and +#> discussion arcs #> # A tibble: 117 x 12 #> adoption specialty conferences journals practice community patients #> @@ -31,7 +32,8 @@ #> # i 537 more rows #> #> $Bloomington -#> # A multiplex, directed network of 50 nodes and 211 friendship, discussion, and advice arcs +#> # A multiplex, directed network of 50 nodes and 211 friendship, discussion, and +#> advice arcs #> # A tibble: 50 x 12 #> adoption specialty conferences journals practice community patients #> @@ -56,7 +58,8 @@ #> # i 205 more rows #> #> $Quincy -#> # A multiplex, directed network of 44 nodes and 174 advice, discussion, and friendship arcs +#> # A multiplex, directed network of 44 nodes and 174 advice, discussion, and +#> friendship arcs #> # A tibble: 44 x 12 #> adoption specialty conferences journals practice community patients #> @@ -81,7 +84,8 @@ #> # i 168 more rows #> #> $Galesburg -#> # A multiplex, directed network of 35 nodes and 171 advice, discussion, and friendship arcs +#> # A multiplex, directed network of 35 nodes and 171 advice, discussion, and +#> friendship arcs #> # A tibble: 35 x 12 #> adoption specialty conferences journals practice community patients #> diff --git a/man/ison_potter.Rd b/man/ison_potter.Rd index bbf24936..e67885de 100644 --- a/man/ison_potter.Rd +++ b/man/ison_potter.Rd @@ -6,7 +6,7 @@ \title{Six complex one-mode support data in Harry Potter books (Bossaert and Meidert 2013)} \format{ \if{html}{\out{
}}\preformatted{#> $book1 -#> # A labelled, complex, directed network of 64 nodes and 47 arcs +#> # A labelled, complex, directed network of 64 nodes and 47 arcs #> # A tibble: 64 x 4 #> name schoolyear gender house #> @@ -29,7 +29,7 @@ #> # i 41 more rows #> #> $book2 -#> # A labelled, complex, directed network of 64 nodes and 110 arcs +#> # A labelled, complex, directed network of 64 nodes and 110 arcs #> # A tibble: 64 x 4 #> name schoolyear gender house #> @@ -52,7 +52,7 @@ #> # i 104 more rows #> #> $book3 -#> # A labelled, complex, directed network of 64 nodes and 104 arcs +#> # A labelled, complex, directed network of 64 nodes and 104 arcs #> # A tibble: 64 x 4 #> name schoolyear gender house #> @@ -75,7 +75,7 @@ #> # i 98 more rows #> #> $book4 -#> # A labelled, complex, directed network of 64 nodes and 49 arcs +#> # A labelled, complex, directed network of 64 nodes and 49 arcs #> # A tibble: 64 x 4 #> name schoolyear gender house #> @@ -98,7 +98,7 @@ #> # i 43 more rows #> #> $book5 -#> # A labelled, complex, directed network of 64 nodes and 160 arcs +#> # A labelled, complex, directed network of 64 nodes and 160 arcs #> # A tibble: 64 x 4 #> name schoolyear gender house #> @@ -121,7 +121,7 @@ #> # i 154 more rows #> #> $book6 -#> # A labelled, complex, directed network of 64 nodes and 74 arcs +#> # A labelled, complex, directed network of 64 nodes and 74 arcs #> # A tibble: 64 x 4 #> name schoolyear gender house #> diff --git a/man/ison_southern_women.Rd b/man/ison_southern_women.Rd index b407c104..f0014d8d 100644 --- a/man/ison_southern_women.Rd +++ b/man/ison_southern_women.Rd @@ -5,7 +5,7 @@ \alias{ison_southern_women} \title{Two-mode southern women (Davis, Gardner and Gardner 1941)} \format{ -\if{html}{\out{
}}\preformatted{#> # A labelled, two-mode network of 32 nodes and 89 ties +\if{html}{\out{
}}\preformatted{#> # A labelled, two-mode network of 32 nodes and 89 ties #> # A tibble: 32 x 4 #> type name Surname Title #> diff --git a/man/ison_starwars.Rd b/man/ison_starwars.Rd index 5cfbedfc..008db0cf 100644 --- a/man/ison_starwars.Rd +++ b/man/ison_starwars.Rd @@ -6,7 +6,7 @@ \title{Seven one-mode Star Wars character interactions (Gabasova 2016)} \format{ \if{html}{\out{
}}\preformatted{#> $`Episode I` -#> # A labelled, weighted, undirected network of 38 nodes and 135 ties +#> # A labelled, weighted, undirected network of 38 nodes and 135 ties #> # A tibble: 38 x 11 #> name height mass hair_color skin_color eye_color birth_year sex homeworld #> @@ -30,7 +30,7 @@ #> # i 129 more rows #> #> $`Episode II` -#> # A labelled, weighted, undirected network of 33 nodes and 101 ties +#> # A labelled, weighted, undirected network of 33 nodes and 101 ties #> # A tibble: 33 x 11 #> name height mass hair_color skin_color eye_color birth_year sex homeworld #> @@ -54,7 +54,7 @@ #> # i 95 more rows #> #> $`Episode III` -#> # A labelled, weighted, undirected network of 24 nodes and 65 ties +#> # A labelled, weighted, undirected network of 24 nodes and 65 ties #> # A tibble: 24 x 11 #> name height mass hair_color skin_color eye_color birth_year sex homeworld #> @@ -78,7 +78,7 @@ #> # i 59 more rows #> #> $`Episode IV` -#> # A labelled, weighted, undirected network of 21 nodes and 60 ties +#> # A labelled, weighted, undirected network of 21 nodes and 60 ties #> # A tibble: 21 x 11 #> name height mass hair_color skin_color eye_color birth_year sex homeworld #> @@ -102,7 +102,7 @@ #> # i 54 more rows #> #> $`Episode V` -#> # A labelled, weighted, undirected network of 21 nodes and 55 ties +#> # A labelled, weighted, undirected network of 21 nodes and 55 ties #> # A tibble: 21 x 11 #> name height mass hair_color skin_color eye_color birth_year sex homeworld #> @@ -126,7 +126,7 @@ #> # i 49 more rows #> #> $`Episode VI` -#> # A labelled, weighted, undirected network of 20 nodes and 55 ties +#> # A labelled, weighted, undirected network of 20 nodes and 55 ties #> # A tibble: 20 x 11 #> name height mass hair_color skin_color eye_color birth_year sex homeworld #> @@ -150,7 +150,7 @@ #> # i 49 more rows #> #> $`Episode VII` -#> # A labelled, weighted, undirected network of 27 nodes and 92 ties +#> # A labelled, weighted, undirected network of 27 nodes and 92 ties #> # A tibble: 27 x 11 #> name height mass hair_color skin_color eye_color birth_year sex homeworld #> diff --git a/man/ison_usstates.Rd b/man/ison_usstates.Rd index 591652de..bb42e747 100644 --- a/man/ison_usstates.Rd +++ b/man/ison_usstates.Rd @@ -5,7 +5,7 @@ \alias{ison_usstates} \title{One-mode undirected network of US state contiguity (Meghanathan 2017)} \format{ -\if{html}{\out{
}}\preformatted{#> # A labelled, undirected network of 50 nodes and 107 ties +\if{html}{\out{
}}\preformatted{#> # A labelled, undirected network of 50 nodes and 107 ties #> # A tibble: 50 x 3 #> name capitol population #> From 8f9d05cc593ca2afa2110b8ea5e2f173dba44abc Mon Sep 17 00:00:00 2001 From: James Hollway Date: Thu, 19 Sep 2024 17:31:15 +0200 Subject: [PATCH 13/46] add_info() now collects mode/collection too --- R/manip_nodes.R | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/R/manip_nodes.R b/R/manip_nodes.R index 27aee3cd..743bd7fc 100644 --- a/R/manip_nodes.R +++ b/R/manip_nodes.R @@ -174,13 +174,15 @@ filter_nodes <- function(.data, ..., .by){ tidygraph::filter(.data, ..., .by = .by) } -#' @rdname manip_nodes +# Network information #### + +#' @rdname manip_net #' @examples #' add_info(ison_algebra, name = "Algebra") #' @export add_info <- function(.data, ...){ if(!is.null(igraph::graph_attr(.data)$grand)){ - cli::cli_inform("Hmm, I don't know how to do that yet.") + cli::cli_abort("Hmm, I don't know how to do that yet.") } else { info <- list(...) unrecog <- setdiff(names(info), c("name", "nodes", "ties", "doi", @@ -199,6 +201,10 @@ add_info <- function(.data, ...){ info$edge.pos <- info$ties info$ties <- NULL } + if("collection" %in% names(info)){ + info$mode <- info$collection + info$collection <- NULL + } # return(str(info)) # for debugging out <- .data igraph::graph_attr(out)$grand <- info From 134fa16c1726047cdded5c04280bffd644773562 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Thu, 19 Sep 2024 17:31:42 +0200 Subject: [PATCH 14/46] Fixed cli dependency in console theme --- R/zzz.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/R/zzz.R b/R/zzz.R index 9ee469d1..4edaa5d6 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -56,15 +56,15 @@ manynet_console_theme <- function(){ list(h1 = list(`margin-top` = 1, `margin-bottom` = 0, color = "#199D77", fmt = function(x) cli::rule(x, line_col = "#199D77")), h2 = list(`margin-top` = 1, `margin-bottom` = 0, color = "#199D77", - fmt = function(x) paste0(symbol$line, " ", x, " ", symbol$line, symbol$line)), + fmt = function(x) paste0(symbol$line, " ", x, " ", cli::symbol$line, cli::symbol$line)), h3 = list(`margin-top` = 1, `margin-bottom` = 0, color = "#199D77"), par = list(`margin-top` = 0, `margin-bottom` = 1), `.alert-danger` = list(`background-color` = "#D83127", color = "white", - before = function() paste0(symbol$cross, " ")), + before = function() paste0(cli::symbol$cross, " ")), `.alert-warning` = list(color = "#E6AB02", `font-weight` = "bold", before = paste0("!", " ")), - `.alert-success` = list(before = function() paste0(col_mnet_green(symbol$tick), " ")), - `.alert-info` = list(before = function() paste0(col_mnet_blue(symbol$info), " ")), - `.alert-start` = list(before = function() paste0(symbol$arrow_right, " ")), + `.alert-success` = list(before = function() paste0(col_mnet_green(cli::symbol$tick), " ")), + `.alert-info` = list(before = function() paste0(col_mnet_blue(cli::symbol$info), " ")), + `.alert-start` = list(before = function() paste0(cli::symbol$arrow_right, " ")), span.pkg = list(color = "#199D77", `font-weight` = "bold"), span.version = list(color = "#D83127"), span.emph = list(color = "#D83127"), From 1b4145d2eebbb0b6adba1c9e97108c26c2f6868f Mon Sep 17 00:00:00 2001 From: James Hollway Date: Thu, 19 Sep 2024 17:45:43 +0200 Subject: [PATCH 15/46] Added create_ego() --- R/make_create.R | 37 ++++++++++++++++++++++++++++++++++++- 1 file changed, 36 insertions(+), 1 deletion(-) diff --git a/R/make_create.R b/R/make_create.R index 3bc7b436..eecbc48c 100644 --- a/R/make_create.R +++ b/R/make_create.R @@ -2,7 +2,6 @@ #' Making networks with explicit ties #' -#' #' @description #' This function creates a network from a vector of explicitly named nodes #' and ties between them. @@ -116,6 +115,42 @@ create_explicit <- function(...){ as_tidygraph(res) } +# Collections #### + +#' Making networks with explicit ties +#' +#' @description +#' This function creates an ego network through a set of interview questions. +#' @name make_ego +#' @family makes +#' @export +create_ego <- function(max_alters = Inf, + interrelater = FALSE){ + cli::cli_text("What is ego's name?") + ego <- readline() + alters <- vector() + repeat{ + cli::cli_text("Please name a contact:") + alters <- c(alters, readline()) + if(length(alters) == max_alters){ + cli::cli_alert_info("{.code max_alters} reached.") + break + } + if (q_yes("Are these all the contacts?")) break + } + out <- as_tidygraph(as.data.frame(cbind(ego, alters))) + out +} + +q_yes <- function(msg = NULL){ + if(!is.null(msg)) cli::cli_text(msg) + out <- readline() + if(is.logical(out)) return(out) + if(out=="") return(FALSE) + choices <- c("yes","no","true","false") + out <- c(TRUE,FALSE,TRUE,FALSE)[pmatch(tolower(out), tolower(choices))] + out +} # Defined #### #' Making networks with defined structures From 9c6c6c5b72241d7f841dc1991c81ad0879473e7e Mon Sep 17 00:00:00 2001 From: James Hollway Date: Thu, 19 Sep 2024 17:45:59 +0200 Subject: [PATCH 16/46] Added info to create_ego output --- R/make_create.R | 3 +++ 1 file changed, 3 insertions(+) diff --git a/R/make_create.R b/R/make_create.R index eecbc48c..d1337727 100644 --- a/R/make_create.R +++ b/R/make_create.R @@ -139,6 +139,9 @@ create_ego <- function(max_alters = Inf, if (q_yes("Are these all the contacts?")) break } out <- as_tidygraph(as.data.frame(cbind(ego, alters))) + out <- add_info(out, ties = ties, + collection = "Interview", + format(as.Date(Sys.Date(), format="%d/%m/%Y"),"%Y")) out } From d40d2bd77bda6ae1697089ea06f99d82f47d9d63 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Thu, 19 Sep 2024 17:46:29 +0200 Subject: [PATCH 17/46] Added interpreter functionality --- R/make_create.R | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/R/make_create.R b/R/make_create.R index d1337727..e52eb86a 100644 --- a/R/make_create.R +++ b/R/make_create.R @@ -125,9 +125,12 @@ create_explicit <- function(...){ #' @family makes #' @export create_ego <- function(max_alters = Inf, + interpreter = FALSE, interrelater = FALSE){ cli::cli_text("What is ego's name?") ego <- readline() + cli::cli_text("What is the relationship you are collecting? Name it in the singular, e.g. 'friendship'") + ties <- readline() alters <- vector() repeat{ cli::cli_text("Please name a contact:") @@ -139,6 +142,22 @@ create_ego <- function(max_alters = Inf, if (q_yes("Are these all the contacts?")) break } out <- as_tidygraph(as.data.frame(cbind(ego, alters))) + if(interpreter){ + attr <- vector() + repeat{ + cli::cli_text("Please name an attribute you are collecting:") + attr <- c(attr, readline()) + if (q_done()) break + } + for(att in attr){ + values <- vector() + for (alt in c(ego, alters)){ + cli::cli_text("What value does {alt} have for {att}:") + values <- c(values, readline()) + } + out <- add_node_attribute(out, att, values) + } + } out <- add_info(out, ties = ties, collection = "Interview", format(as.Date(Sys.Date(), format="%d/%m/%Y"),"%Y")) From 7cc2c8d349f35242d2a0bf97a648ce2492598217 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Fri, 20 Sep 2024 10:29:10 +0200 Subject: [PATCH 18/46] create_ego() now has an easier to manage interpreter section --- NAMESPACE | 1 + R/make_create.R | 34 ++++++++++++++++++++++++---------- 2 files changed, 25 insertions(+), 10 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index a0216a7f..aece2946 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -322,6 +322,7 @@ export(cluster_hierarchical) export(create_components) export(create_core) export(create_degree) +export(create_ego) export(create_empty) export(create_explicit) export(create_filled) diff --git a/R/make_create.R b/R/make_create.R index e52eb86a..46ddc207 100644 --- a/R/make_create.R +++ b/R/make_create.R @@ -117,10 +117,17 @@ create_explicit <- function(...){ # Collections #### -#' Making networks with explicit ties +#' Making ego networks through interviewing #' #' @description -#' This function creates an ego network through a set of interview questions. +#' This function creates an ego network through interactive interview questions. +#' Note that it only creates a simplex, directed network. +#' @param max_alters The maximum number of alters to collect. +#' By default infinity, but many name generators will expect a maximum of +#' e.g. 5 alters to be named. +#' @param interpreter Logical. If TRUE, then it will ask for which attributes +#' to collect and give prompts for each attribute for each node in the network. +#' By default FALSE. #' @name make_ego #' @family makes #' @export @@ -145,17 +152,24 @@ create_ego <- function(max_alters = Inf, if(interpreter){ attr <- vector() repeat{ - cli::cli_text("Please name an attribute you are collecting:") + cli::cli_text("Please name an attribute you are collecting, or press [Enter] to continue.") attr <- c(attr, readline()) - if (q_done()) break + if (attr[length(attr)]==""){ + attr <- attr[-length(attr)] + break + } } - for(att in attr){ - values <- vector() - for (alt in c(ego, alters)){ - cli::cli_text("What value does {alt} have for {att}:") - values <- c(values, readline()) + if(length(attr)>0){ + for(att in attr){ + values <- vector() + for (alt in c(ego, alters)){ + cli::cli_text("What value does {alt} have for {att}:") + values <- c(values, readline()) + } + out <- add_node_attribute(out, att, values) } - out <- add_node_attribute(out, att, values) + } + } } } out <- add_info(out, ties = ties, From 26f1dbc2b548d3a06694af908d156269a2461c71 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Fri, 20 Sep 2024 10:30:45 +0200 Subject: [PATCH 19/46] Added interrelater functionality to create_ego(), collecting information about ties from each of the alters --- R/make_create.R | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/R/make_create.R b/R/make_create.R index 46ddc207..0a5b061b 100644 --- a/R/make_create.R +++ b/R/make_create.R @@ -128,6 +128,8 @@ create_explicit <- function(...){ #' @param interpreter Logical. If TRUE, then it will ask for which attributes #' to collect and give prompts for each attribute for each node in the network. #' By default FALSE. +#' @param interrelater Logical. If TRUE, then it will ask for the contacts from +#' each of the alters perspectives too. #' @name make_ego #' @family makes #' @export @@ -170,6 +172,16 @@ create_ego <- function(max_alters = Inf, } } } + if(interrelater){ + for(alt in alters){ + others <- setdiff(c(ego,alters), alt) + extra <- vector() + for(oth in others){ + cli::cli_text("Is {alt} connected by {ties} to {oth}?") + extra <- c(extra, q_yes()) + } + # cat(c(rbind(alt, others[extra]))) + out <- add_ties(out, c(rbind(alt, others[extra]))) } } out <- add_info(out, ties = ties, @@ -187,6 +199,7 @@ q_yes <- function(msg = NULL){ out <- c(TRUE,FALSE,TRUE,FALSE)[pmatch(tolower(out), tolower(choices))] out } + # Defined #### #' Making networks with defined structures From b39c9a47342ea454f2527b10d65d0409cb569fd2 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Fri, 20 Sep 2024 10:32:32 +0200 Subject: [PATCH 20/46] Added roster functionality to create_ego() so that it can take a list of alters where available --- R/make_create.R | 28 ++++++++++++++++++-------- man/make_cran.Rd | 1 + man/make_create.Rd | 1 + man/make_ego.Rd | 45 ++++++++++++++++++++++++++++++++++++++++++ man/make_explicit.Rd | 1 + man/make_learning.Rd | 1 + man/make_play.Rd | 1 + man/make_random.Rd | 1 + man/make_read.Rd | 1 + man/make_stochastic.Rd | 1 + man/make_write.Rd | 1 + man/manip_nodes.Rd | 4 ---- 12 files changed, 74 insertions(+), 12 deletions(-) create mode 100644 man/make_ego.Rd diff --git a/R/make_create.R b/R/make_create.R index 0a5b061b..2c88af20 100644 --- a/R/make_create.R +++ b/R/make_create.R @@ -125,6 +125,7 @@ create_explicit <- function(...){ #' @param max_alters The maximum number of alters to collect. #' By default infinity, but many name generators will expect a maximum of #' e.g. 5 alters to be named. +#' @param roster A vector of node names to offer as potential alters for ego. #' @param interpreter Logical. If TRUE, then it will ask for which attributes #' to collect and give prompts for each attribute for each node in the network. #' By default FALSE. @@ -134,21 +135,32 @@ create_explicit <- function(...){ #' @family makes #' @export create_ego <- function(max_alters = Inf, + roster = NULL, interpreter = FALSE, interrelater = FALSE){ cli::cli_text("What is ego's name?") ego <- readline() cli::cli_text("What is the relationship you are collecting? Name it in the singular, e.g. 'friendship'") ties <- readline() + # cli::cli_text("Is this a weighted network?") + # weighted <- q_yes() alters <- vector() - repeat{ - cli::cli_text("Please name a contact:") - alters <- c(alters, readline()) - if(length(alters) == max_alters){ - cli::cli_alert_info("{.code max_alters} reached.") - break + if(!is.null(roster)){ + for (alt in roster){ + cli::cli_text("Is {ego} connected by {ties} to {alt}?") + alters <- c(alters, q_yes()) + } + alters <- roster[alters] + } else { + repeat{ + cli::cli_text("Please name a contact:") + alters <- c(alters, readline()) + if(length(alters) == max_alters){ + cli::cli_alert_info("{.code max_alters} reached.") + break + } + if (q_yes("Are these all the contacts?")) break } - if (q_yes("Are these all the contacts?")) break } out <- as_tidygraph(as.data.frame(cbind(ego, alters))) if(interpreter){ @@ -186,7 +198,7 @@ create_ego <- function(max_alters = Inf, } out <- add_info(out, ties = ties, collection = "Interview", - format(as.Date(Sys.Date(), format="%d/%m/%Y"),"%Y")) + year = format(as.Date(Sys.Date(), format="%d/%m/%Y"),"%Y")) out } diff --git a/man/make_cran.Rd b/man/make_cran.Rd index 9eac5dc9..4e19885d 100644 --- a/man/make_cran.Rd +++ b/man/make_cran.Rd @@ -45,6 +45,7 @@ by \href{https://github.com/stocnet/manynet/issues}{raising an issue on Github}. Other makes: \code{\link{make_create}}, +\code{\link{make_ego}}, \code{\link{make_explicit}}, \code{\link{make_learning}}, \code{\link{make_play}}, diff --git a/man/make_create.Rd b/man/make_create.Rd index 25c37851..bde76b01 100644 --- a/man/make_create.Rd +++ b/man/make_create.Rd @@ -147,6 +147,7 @@ create_core(6) Other makes: \code{\link{make_cran}}, +\code{\link{make_ego}}, \code{\link{make_explicit}}, \code{\link{make_learning}}, \code{\link{make_play}}, diff --git a/man/make_ego.Rd b/man/make_ego.Rd new file mode 100644 index 00000000..a71c18f3 --- /dev/null +++ b/man/make_ego.Rd @@ -0,0 +1,45 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/make_create.R +\name{make_ego} +\alias{make_ego} +\alias{create_ego} +\title{Making ego networks through interviewing} +\usage{ +create_ego( + max_alters = Inf, + roster = NULL, + interpreter = FALSE, + interrelater = FALSE +) +} +\arguments{ +\item{max_alters}{The maximum number of alters to collect. +By default infinity, but many name generators will expect a maximum of +e.g. 5 alters to be named.} + +\item{roster}{A vector of node names to offer as potential alters for ego.} + +\item{interpreter}{Logical. If TRUE, then it will ask for which attributes +to collect and give prompts for each attribute for each node in the network. +By default FALSE.} + +\item{interrelater}{Logical. If TRUE, then it will ask for the contacts from +each of the alters perspectives too.} +} +\description{ +This function creates an ego network through interactive interview questions. +Note that it only creates a simplex, directed network. +} +\seealso{ +Other makes: +\code{\link{make_cran}}, +\code{\link{make_create}}, +\code{\link{make_explicit}}, +\code{\link{make_learning}}, +\code{\link{make_play}}, +\code{\link{make_random}}, +\code{\link{make_read}}, +\code{\link{make_stochastic}}, +\code{\link{make_write}} +} +\concept{makes} diff --git a/man/make_explicit.Rd b/man/make_explicit.Rd index 6666325d..090ad7b0 100644 --- a/man/make_explicit.Rd +++ b/man/make_explicit.Rd @@ -32,6 +32,7 @@ See the example for a demonstration. Other makes: \code{\link{make_cran}}, \code{\link{make_create}}, +\code{\link{make_ego}}, \code{\link{make_learning}}, \code{\link{make_play}}, \code{\link{make_random}}, diff --git a/man/make_learning.Rd b/man/make_learning.Rd index 21420dbf..896392f3 100644 --- a/man/make_learning.Rd +++ b/man/make_learning.Rd @@ -83,6 +83,7 @@ These functions allow learning games to be played upon networks. Other makes: \code{\link{make_cran}}, \code{\link{make_create}}, +\code{\link{make_ego}}, \code{\link{make_explicit}}, \code{\link{make_play}}, \code{\link{make_random}}, diff --git a/man/make_play.Rd b/man/make_play.Rd index b76c94ac..3324672d 100644 --- a/man/make_play.Rd +++ b/man/make_play.Rd @@ -208,6 +208,7 @@ This can be used in in SEI, SEIS, SEIR, and SEIRS models. Other makes: \code{\link{make_cran}}, \code{\link{make_create}}, +\code{\link{make_ego}}, \code{\link{make_explicit}}, \code{\link{make_learning}}, \code{\link{make_random}}, diff --git a/man/make_random.Rd b/man/make_random.Rd index 299756fa..b79076b8 100644 --- a/man/make_random.Rd +++ b/man/make_random.Rd @@ -122,6 +122,7 @@ San Francisco: Jossey-Bass. Other makes: \code{\link{make_cran}}, \code{\link{make_create}}, +\code{\link{make_ego}}, \code{\link{make_explicit}}, \code{\link{make_learning}}, \code{\link{make_play}}, diff --git a/man/make_read.Rd b/man/make_read.Rd index 73d3af73..4718f899 100644 --- a/man/make_read.Rd +++ b/man/make_read.Rd @@ -102,6 +102,7 @@ you will need to unpack them and convert them one by one. Other makes: \code{\link{make_cran}}, \code{\link{make_create}}, +\code{\link{make_ego}}, \code{\link{make_explicit}}, \code{\link{make_learning}}, \code{\link{make_play}}, diff --git a/man/make_stochastic.Rd b/man/make_stochastic.Rd index 164755c2..ad048551 100644 --- a/man/make_stochastic.Rd +++ b/man/make_stochastic.Rd @@ -127,6 +127,7 @@ Barabasi, Albert-Laszlo, and Reka Albert. 1999. Other makes: \code{\link{make_cran}}, \code{\link{make_create}}, +\code{\link{make_ego}}, \code{\link{make_explicit}}, \code{\link{make_learning}}, \code{\link{make_play}}, diff --git a/man/make_write.Rd b/man/make_write.Rd index e78e6720..5d7de86d 100644 --- a/man/make_write.Rd +++ b/man/make_write.Rd @@ -77,6 +77,7 @@ by \href{https://github.com/stocnet/manynet/issues}{raising an issue on Github}. Other makes: \code{\link{make_cran}}, \code{\link{make_create}}, +\code{\link{make_ego}}, \code{\link{make_explicit}}, \code{\link{make_learning}}, \code{\link{make_play}}, diff --git a/man/manip_nodes.Rd b/man/manip_nodes.Rd index d20b6c31..7283d1a5 100644 --- a/man/manip_nodes.Rd +++ b/man/manip_nodes.Rd @@ -12,7 +12,6 @@ \alias{rename_nodes} \alias{rename} \alias{filter_nodes} -\alias{add_info} \title{Modifying node data} \usage{ add_nodes(.data, nodes, attribute = NULL) @@ -39,8 +38,6 @@ rename_nodes(.data, ...) rename(.data, ...) filter_nodes(.data, ..., .by) - -add_info(.data, ...) } \arguments{ \item{.data}{An object of a manynet-consistent class: @@ -103,7 +100,6 @@ Below are the currently implemented S3 methods:\tabular{lrrr}{ other <- create_filled(4) \%>\% mutate(name = c("A", "B", "C", "D")) another <- create_filled(3) \%>\% mutate(name = c("E", "F", "G")) join_nodes(another, other) -add_info(ison_algebra, name = "Algebra") } \seealso{ Other modifications: From b4b3ff7c089e2627e6b7b5c4f69fda17c83de7fe Mon Sep 17 00:00:00 2001 From: James Hollway Date: Fri, 20 Sep 2024 10:39:02 +0200 Subject: [PATCH 21/46] create_ego() now retains unconnected names from the roster as isolates --- R/make_create.R | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/R/make_create.R b/R/make_create.R index 2c88af20..a91a26fd 100644 --- a/R/make_create.R +++ b/R/make_create.R @@ -196,6 +196,10 @@ create_ego <- function(max_alters = Inf, out <- add_ties(out, c(rbind(alt, others[extra]))) } } + if(!is.null(roster) && any(!roster %in% node_names(out))){ + isolates <- roster[!roster %in% node_names(out)] + out <- add_nodes(out, length(isolates), list(name = isolates)) + } out <- add_info(out, ties = ties, collection = "Interview", year = format(as.Date(Sys.Date(), format="%d/%m/%Y"),"%Y")) From 1996128a136634d7a7bb1f89c83e264183d77a99 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Fri, 20 Sep 2024 10:45:58 +0200 Subject: [PATCH 22/46] Fixed bug in describe_nodes --- R/class_networks.R | 5 ++--- man/ison_adolescents.Rd | 4 ++-- man/ison_thrones.Rd | 5 +++-- 3 files changed, 7 insertions(+), 7 deletions(-) diff --git a/R/class_networks.R b/R/class_networks.R index e2b8b336..885256d0 100644 --- a/R/class_networks.R +++ b/R/class_networks.R @@ -7,9 +7,7 @@ print.mnet <- function(x, ..., n = 6) { arg_list <- list(...) arg_list[['useS4']] <- NULL if(is_grand(x) && !is.null(igraph::graph_attr(x, "grand")$name)) - cat('#', igraph::graph_attr(x, "grand")$name, '\n') - if(is.null(igraph::graph_attr(x, "grand"))) node_name <- "nodes" else - node_name <- igraph::graph_attr(x, "grand")$vertex1 + cli::cli_text("# {igraph::graph_attr(x, 'grand')$name}") graph_desc <- describe_graph(x) tie_desc <- describe_ties(x) node_desc <- describe_nodes(x) @@ -46,6 +44,7 @@ describe_nodes <- function(x){ if(length(nd)==2 && !is.null(igraph::graph_attr(x, "grand")$vertex2)) node_name <- c(node_name, paste(nd[2], igraph::graph_attr(x, "grand")$vertex2)) } else node_name <- paste(sum(nd), "nodes") + node_name } describe_ties <- function(x){ diff --git a/man/ison_adolescents.Rd b/man/ison_adolescents.Rd index aa5d445b..521ae860 100644 --- a/man/ison_adolescents.Rd +++ b/man/ison_adolescents.Rd @@ -5,8 +5,8 @@ \alias{ison_adolescents} \title{One-mode subset of the adolescent society network (Coleman 1961)} \format{ -\if{html}{\out{
}}\preformatted{#> # The Adolescent Society -#> # A labelled, undirected network of 8 adolescents and 10 friendships ties +\if{html}{\out{
}}\preformatted{#> # The Adolescent Society +#> # A labelled, undirected network of 8 adolescents and 10 friendships ties #> # A tibble: 8 x 1 #> name #> diff --git a/man/ison_thrones.Rd b/man/ison_thrones.Rd index f005b2cd..f87cea49 100644 --- a/man/ison_thrones.Rd +++ b/man/ison_thrones.Rd @@ -5,8 +5,9 @@ \alias{ison_thrones} \title{One-mode Game of Thrones kinship (Glander 2017)} \format{ -\if{html}{\out{
}}\preformatted{#> # Game of Thrones Kinship -#> # A labelled, multiplex, directed network of 208 characters and 404 kinship arcs +\if{html}{\out{
}}\preformatted{#> # Game of Thrones Kinship +#> # A labelled, multiplex, directed network of 208 characters and 404 kinship +#> arcs #> # A tibble: 208 x 8 #> name male culture house popularity house2 color shape #> From 6a062429750caab06b73fe311f0b9517636c3881 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Fri, 20 Sep 2024 10:46:12 +0200 Subject: [PATCH 23/46] At least a #patch update --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 73d420e7..54d1d666 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.1.0 -Date: 2024-09-12 +Version: 1.1.1 +Date: 2024-09-20 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, From f219b33d902a5910d1ec29dedcd9d716a0571b5f Mon Sep 17 00:00:00 2001 From: James Hollway Date: Fri, 20 Sep 2024 11:48:24 +0200 Subject: [PATCH 24/46] Fixed testing issues with console theming --- R/zzz.R | 6 +++--- tests/testthat/helper-manynet.R | 2 ++ 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/R/zzz.R b/R/zzz.R index 4edaa5d6..3e3c4f32 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -47,7 +47,7 @@ } mnet_progress_step <- function(...){ - if(getOption("manynet_verbosity")!="quiet") + if(getOption("manynet_verbosity", default = "quiet")!="quiet") cli::cli_progress_step(...) } @@ -56,7 +56,7 @@ manynet_console_theme <- function(){ list(h1 = list(`margin-top` = 1, `margin-bottom` = 0, color = "#199D77", fmt = function(x) cli::rule(x, line_col = "#199D77")), h2 = list(`margin-top` = 1, `margin-bottom` = 0, color = "#199D77", - fmt = function(x) paste0(symbol$line, " ", x, " ", cli::symbol$line, cli::symbol$line)), + fmt = function(x) paste0(cli::symbol$line, " ", x, " ", cli::symbol$line, cli::symbol$line)), h3 = list(`margin-top` = 1, `margin-bottom` = 0, color = "#199D77"), par = list(`margin-top` = 0, `margin-bottom` = 1), `.alert-danger` = list(`background-color` = "#D83127", color = "white", @@ -72,7 +72,7 @@ manynet_console_theme <- function(){ span.fun = utils::modifyList(simple_theme_code(), list(after = "()")), span.fn = utils::modifyList(simple_theme_code(), - list(after = "()")), + list(after = "")), span.arg = simple_theme_code(), span.kbd = utils::modifyList(simple_theme_code(), list(before = "<", after = ">")), diff --git a/tests/testthat/helper-manynet.R b/tests/testthat/helper-manynet.R index ea092d0c..82a391d3 100644 --- a/tests/testthat/helper-manynet.R +++ b/tests/testthat/helper-manynet.R @@ -1,3 +1,5 @@ +options(manynet_verbosity = "quiet") + collect_functions <- function(pattern, package = "manynet"){ getNamespaceExports(package)[grepl(pattern, getNamespaceExports(package))] } From 0d88adbecbd8274c4457600015f26e22e3837dcf Mon Sep 17 00:00:00 2001 From: James Hollway Date: Fri, 20 Sep 2024 11:49:02 +0200 Subject: [PATCH 25/46] Updated ison_southern_women with grand data --- data/ison_southern_women.rda | Bin 1091 -> 1159 bytes man/ison_southern_women.Rd | 4 +++- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/data/ison_southern_women.rda b/data/ison_southern_women.rda index 0ed513bfceb76c2b869a75cab95446ccb4da1312..dc1fd4fcdc2549d37f16243af95372571019366c 100644 GIT binary patch literal 1159 zcmV;21bF*GT4*^jL0KkKS$MOK#Q+SF|L_0vZAM+!|NsBr-Qd6H-{3$100DpqK)?Y2 z06<^`&;@<~000004m310Gy_0l27t%_15E%80LTCU1~|~r(9jJ5h#CVR01Y$%Gy@<2 z02t##Lqk9`1|Vn*fB-bm0MHD8003i+4Gj$d&=`TBG5`S6Km$NB0004kq>vFbnqUGn z(t4hTp{5fiQ_^VA$OeXnhKA9U!L?6MsU)74q@@4EpK^MU(i^1YPEhQQl$(U%ILcG5 zaujpBDbD6kWix15b5S%o$&!>b9k)T^dxw4Qo+o`CCxtLc<6iM3$>T#LPb)%4k*H+Q zmm?;#%4Tc1-N)n)bCvuTGjF|UoUeen%;RWrti|0)CyCS($4?>P?UbcaN=jFd$q6!` zkn%`gv0+QplE{_o$j=v#X^E6cF<`j45|l|jD(rKqfN5xZmq`xNG;?1?KT40ez%F+aI$w_AR7eq_t z3>WU&>WW>G>!2!uFsMjOsS*=?%I9!69k;sMbTrwD_HT9GS*3$up2KB}Hf)-jn` zw4`3xdDp##UhKG8wwap@UX_+{Gz=Fun(x7rsKJvp>{pgkH8)&qFkseV)>9MgV9BN& zG8|MyHew=FktF$5B$lZp6(LGcL|sxz1*y42st9*dP=UJtc0}H(7cf8hF&CpHL2(Sy z%3!g8r6jzISWwh%t{0^X>=q>o5y{2Y`tLmb?Y0b^mn)TLUASJwsgbN=QT-V%dX%~H zslKI@QHNLJx$^onrcDeK(&OVVZP2We%$k|8aWN gG+nxpEk@X32P7xqG#NfM0_K zm!mxy5sL;|RlLBH1FKcKjU3GJ159ybrLa zyr*$a?-t%H8Oe$0JnjX_N6^=O?ylQSE6%<3K9_HC?R6dPrqgBju66s?!P59vYNMTl zX>w>&ebd$6RP}Y3x0kP3a|P?mHQuMcy~M$T?{}YT?QJ@(Q#CkOI}&~kg6xy?EM;?X zn{A}ndu&^WYj;z9gMj=UhaBivT5BqHpVf42sNF2wT-xnACbmpiy{z1B|8XNz9u{hL z-wQ?ym%l54*k<2c-g|4?jn)r;SvaD)CGz717E)6sl`lB)Oc*}m;})}-lJ-sqGs<^o zsiA{;LeNIY4`Vt`$aE}8%U literal 1091 zcmV-J1ibq~T4*^jL0KkKS+el?#{dlbfA9bEZAM+!|NsBr-C)1x-=IJM004jpK)?Y2 z06<^`&;=d<00000aKve*gFqSp000^cgG~cK28{q>8UuzSO*9$+&;S4c&}15D8UQqC z0}#+0F&b&0&<21200x5~(?HMxqd*vjfZ>SKO$LB80000q83vjLfDIY|#54g?NuZ`e zVKGk;ritWD85*9a=_je`007X?4KY16Jxpy=)bzxW>Yk*if5b=E4`h?9P6Roj&L?!7 zZnT^P0H6Mzm{YiY~id9yCl8TTchAB5Kht-ZUM7cuk z`n5`MEn-PjgkFe=GonaOncRD>CljUOZ#)fFWV=U+<5{VTuukiJlSYi&EtdMs8&h{$ zMlHvsjvd=s#NK3f7kbuN?lUo9-fMdqwpg=hyCushqr9@~uGmu(Z|lXIVsXhas0U#J zR6u_P5?YBQR7$9%r4kW^1Qw?57AlJ>NhI+ksR<|NeD*}(sKJbXReKi zT_m-I3KoS6SW6O#LOHnkeOEm{71=r6$8l$MxLuQ5Gf|O8%FTgi$foj^QAPIu9uJe% zu$i_Psl&uzeFK~GGfnCxEPXR z!Kl7{oRB<;qJ=wR$|-{aV2MgZo}~#QlqWm%C-GCt|9eH>D~+R4C@@`4(wz%73Sg$& z7Q#k}GFYTPd)zyhXBfVt>2_EpKg(se zrtGTvA4}(Vyw3j9;NWhz9G?C9-gZrNbFpr)PqLgndz=bB-d0RKid|+5S6yb)%fZIG z>vnx_TXooL&BX1;+V&Y{o`#phveCb&-eTzA)ZuX${jNFSS0vE**hH~zVj99+I117h7 zJGRgAxRRDq>`dX<(+aMT@RrOl74CvA>mY#V5EOSPlE+>)s*JAlH{NKUC9*T JLPE>K=N!}v2;l$# diff --git a/man/ison_southern_women.Rd b/man/ison_southern_women.Rd index f0014d8d..77f91dd7 100644 --- a/man/ison_southern_women.Rd +++ b/man/ison_southern_women.Rd @@ -5,7 +5,9 @@ \alias{ison_southern_women} \title{Two-mode southern women (Davis, Gardner and Gardner 1941)} \format{ -\if{html}{\out{
}}\preformatted{#> # A labelled, two-mode network of 32 nodes and 89 ties +\if{html}{\out{
}}\preformatted{#> # Southern Women Data +#> # A labelled, two-mode network of 18 women and 14 social events and 89 +#> participation ties #> # A tibble: 32 x 4 #> type name Surname Title #> From 4eb0819cee3aed2610f236fde3abf2efa050152b Mon Sep 17 00:00:00 2001 From: James Hollway Date: Fri, 20 Sep 2024 11:49:27 +0200 Subject: [PATCH 26/46] Added documentation for add_info() --- R/manip_nodes.R | 18 +++++++++++++++++- R/map_theme.R | 2 ++ man/manip_net.Rd | 37 +++++++++++++++++++++++++++++++++++++ man/map_themes.Rd | 3 +++ 4 files changed, 59 insertions(+), 1 deletion(-) create mode 100644 man/manip_net.Rd diff --git a/R/manip_nodes.R b/R/manip_nodes.R index 743bd7fc..9562b528 100644 --- a/R/manip_nodes.R +++ b/R/manip_nodes.R @@ -176,7 +176,23 @@ filter_nodes <- function(.data, ..., .by){ # Network information #### -#' @rdname manip_net +#' Modifying network data +#' +#' @description +#' These functions allow users to add and edit information about the network +#' itself. +#' This includes the name, year, and mode of collection of the network, +#' as well as definitions of the nodes and ties in the network. +#' Where available, this information is printed for tidygraph-class objects, +#' and can be used for printing a grand table in the `{grand}` package. +#' @name manip_net +#' @inheritParams mark_is +#' @param ... Named attributes. The following are currently recognised: +#' "name", "year", and "doi" of the network, +#' "collection" or "mode" of the network +#' ("survey", "interview","sensor","observation","archival", or "simulation"), +#' "nodes" (a vector of the names of the nodes) or "vertex1"/"vertex2", +#' "ties" or "edge.pos"/"edge.neg" for defining the ties. #' @examples #' add_info(ison_algebra, name = "Algebra") #' @export diff --git a/R/map_theme.R b/R/map_theme.R index 6f0f08c5..0b60e769 100644 --- a/R/map_theme.R +++ b/R/map_theme.R @@ -16,6 +16,8 @@ NULL #' @rdname map_themes +#' @param theme String naming a theme. +#' By default "default". #' @export set_manynet_theme <- function(theme = "default"){ theme_opts <- c("default", "iheid", "ethz", "uzh", "rug", "crisp") diff --git a/man/manip_net.Rd b/man/manip_net.Rd new file mode 100644 index 00000000..4002883c --- /dev/null +++ b/man/manip_net.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/manip_nodes.R +\name{manip_net} +\alias{manip_net} +\alias{add_info} +\title{Modifying network data} +\usage{ +add_info(.data, ...) +} +\arguments{ +\item{.data}{An object of a manynet-consistent class: +\itemize{ +\item matrix (adjacency or incidence) from \code{{base}} R +\item edgelist, a data frame from \code{{base}} R or tibble from \code{{tibble}} +\item igraph, from the \code{{igraph}} package +\item network, from the \code{{network}} package +\item tbl_graph, from the \code{{tidygraph}} package +}} + +\item{...}{Named attributes. The following are currently recognised: +"name", "year", and "doi" of the network, +"collection" or "mode" of the network +("survey", "interview","sensor","observation","archival", or "simulation"), +"nodes" (a vector of the names of the nodes) or "vertex1"/"vertex2", +"ties" or "edge.pos"/"edge.neg" for defining the ties.} +} +\description{ +These functions allow users to add and edit information about the network +itself. +This includes the name, year, and mode of collection of the network, +as well as definitions of the nodes and ties in the network. +Where available, this information is printed for tidygraph-class objects, +and can be used for printing a grand table in the \code{{grand}} package. +} +\examples{ +add_info(ison_algebra, name = "Algebra") +} diff --git a/man/map_themes.Rd b/man/map_themes.Rd index 12a54ca9..288176ee 100644 --- a/man/map_themes.Rd +++ b/man/map_themes.Rd @@ -20,6 +20,9 @@ theme_uzh(base_size = 12, base_family = "sans") theme_rug(base_size = 12, base_family = "mono") } \arguments{ +\item{theme}{String naming a theme. +By default "default".} + \item{base_size}{Font size, by default 12.} \item{base_family}{Font family, by default "sans".} From 5127226ab7afb789ded72bcffb07fa93a3c1878a Mon Sep 17 00:00:00 2001 From: James Hollway Date: Fri, 20 Sep 2024 11:49:38 +0200 Subject: [PATCH 27/46] Added free play to data tutorial --- inst/tutorials/tutorial1/data.Rmd | 13 ++ inst/tutorials/tutorial1/data.html | 264 ++++++++++++++++++++--------- 2 files changed, 198 insertions(+), 79 deletions(-) diff --git a/inst/tutorials/tutorial1/data.Rmd b/inst/tutorials/tutorial1/data.Rmd index 7605b6c3..a8973e0a 100644 --- a/inst/tutorials/tutorial1/data.Rmd +++ b/inst/tutorials/tutorial1/data.Rmd @@ -514,6 +514,8 @@ Reimport the `data/adols.csv` file, make it an igraph-class object, and then mak read_edgelist("data/adols.csv") %>% as_igraph() %>% to_undirected() ``` +### Free play + Try this out with other compatible classes of objects, and reformatting other aspects of the network. For example: @@ -650,6 +652,8 @@ is just one (albeit the default) option for how ties in the projection are weigh Other options included in `{manynet}` include the Jaccard index, Rand simple matching coefficient, Pearson coefficient, and Yule's Q. These may be of interest if, for example, overlap should be weighted by participation. +### Other transformations + Other transforming functions include: - `to_giant()` identifies and returns only the main component of a network. @@ -658,11 +662,20 @@ Other transforming functions include: - `to_ties()` returns a network where the ties in the original network become the nodes, and the ties are shared adjacencies to nodes. - `to_matching()` returns a network in which each node is only tied to one of its previously existing ties such that the network's cardinality is maximised. +In other words, the algorithm tries to match nodes as best as possible so that each +node has a partner. +Note that this is not always possible. Remember, all these `to_*()` functions work on any compatible class; the `to_*()` functions will also attempt to return that same class of object, making it even easier to manipulate networks into shape for analysis. +### Free play + +```{r transform-free, exercise = TRUE, purl=FALSE} + +``` + ## Modifying data After choosing and/or importing some network data, diff --git a/inst/tutorials/tutorial1/data.html b/inst/tutorials/tutorial1/data.html index 044ee9d8..f1e9419d 100644 --- a/inst/tutorials/tutorial1/data.html +++ b/inst/tutorials/tutorial1/data.html @@ -247,6 +247,18 @@

Calling the data

+
+

Free play

+

See whether you can call up other datasets now too. You won’t need to +load the {manynet} package again (it’ll stay loaded), but +identify a network that interests you from table_data() and +then call/print it.

+
+ +
+

Describing networks

@@ -398,7 +410,7 @@

Network class objects

data-completion="1" data-diagnostics="1" data-startover="1" data-lines="0" data-pipe="|>"> 
data(package = "network")
-data(flo)
+data(flo, package = "network")
 flo

This data uses quite a different class to what we encountered above. @@ -650,6 +662,8 @@

Reformatting networks

data-lines="0" data-pipe="|>"> 
read_edgelist("data/adols.csv") %>% as_igraph() %>% to_undirected()
+
+

Free play

Try this out with other compatible classes of objects, and reformatting other aspects of the network. For example:

    @@ -676,6 +690,7 @@

    Reformatting networks

+

Transforming networks

These functions are similar to the reformatting functions, and are @@ -793,6 +808,9 @@

Projections

{manynet} include the Jaccard index, Rand simple matching coefficient, Pearson coefficient, and Yule’s Q. These may be of interest if, for example, overlap should be weighted by participation.

+
+
+

Other transformations

Other transforming functions include:

  • to_giant() identifies and returns only the main @@ -806,13 +824,23 @@

    Projections

    to nodes.
  • to_matching() returns a network in which each node is only tied to one of its previously existing ties such that the network’s -cardinality is maximised.
    • +cardinality is maximised. In other words, the algorithm tries to match +nodes as best as possible so that each node has a partner. Note that +this is not always possible.

Remember, all these to_*() functions work on any compatible class; the to_*() functions will also attempt to return that same class of object, making it even easier to manipulate networks into shape for analysis.

+
+

Free play

+
+ +
+

Modifying data

@@ -1028,19 +1056,19 @@

Adding/deleting attributes

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

Adding/deleting attributes

@@ -1129,6 +1157,45 @@

Adding/deleting attributes

))) + + + + + @@ -1206,23 +1273,23 @@

Adding/deleting attributes

@@ -1330,25 +1397,25 @@

Adding/deleting attributes

opts = list(label = "\"netdata\"", exercise = "TRUE", purl = "FALSE"), engine = "r")), code_check = NULL, error_check = NULL, check = NULL, solution = structure(c("data(package = \"network\")", - "data(flo)", "flo"), chunk_opts = list(label = "netdata-solution")), - tests = NULL, options = list(eval = FALSE, echo = TRUE, results = "markup", - tidy = FALSE, tidy.opts = NULL, collapse = FALSE, prompt = FALSE, - comment = NA, highlight = FALSE, size = "normalsize", - background = "#F7F7F7", strip.white = TRUE, cache = 0, - cache.path = "data_cache/html/", cache.vars = NULL, cache.lazy = TRUE, - dependson = NULL, autodep = FALSE, cache.rebuild = FALSE, - fig.keep = "high", fig.show = "asis", fig.align = "default", - fig.path = "data_files/figure-html/", dev = "png", dev.args = NULL, - dpi = 192, fig.ext = "png", fig.width = 6.5, fig.height = 4, - fig.env = "figure", fig.cap = NULL, fig.scap = NULL, - fig.lp = "fig:", fig.subcap = NULL, fig.pos = "", out.width = 624, - out.height = NULL, out.extra = NULL, fig.retina = 2, - external = TRUE, sanitize = FALSE, interval = 1, aniopts = "controls,loop", - warning = TRUE, error = FALSE, message = TRUE, render = NULL, - ref.label = NULL, child = NULL, engine = "r", split = FALSE, - include = TRUE, purl = FALSE, max.print = 1000, label = "netdata", - exercise = TRUE, code = "", out.width.px = 624, out.height.px = 384, - params.src = "netdata, exercise = TRUE, purl=FALSE", + "data(flo, package = \"network\")", "flo"), chunk_opts = list( + label = "netdata-solution")), tests = NULL, options = list( + eval = FALSE, echo = TRUE, results = "markup", tidy = FALSE, + tidy.opts = NULL, collapse = FALSE, prompt = FALSE, comment = NA, + highlight = FALSE, size = "normalsize", background = "#F7F7F7", + strip.white = TRUE, cache = 0, cache.path = "data_cache/html/", + cache.vars = NULL, cache.lazy = TRUE, dependson = NULL, + autodep = FALSE, cache.rebuild = FALSE, fig.keep = "high", + fig.show = "asis", fig.align = "default", fig.path = "data_files/figure-html/", + dev = "png", dev.args = NULL, dpi = 192, fig.ext = "png", + fig.width = 6.5, fig.height = 4, fig.env = "figure", + fig.cap = NULL, fig.scap = NULL, fig.lp = "fig:", fig.subcap = NULL, + fig.pos = "", out.width = 624, out.height = NULL, out.extra = NULL, + fig.retina = 2, external = TRUE, sanitize = FALSE, interval = 1, + aniopts = "controls,loop", warning = TRUE, error = FALSE, + message = TRUE, render = NULL, ref.label = NULL, child = NULL, + engine = "r", split = FALSE, include = TRUE, purl = FALSE, + max.print = 1000, label = "netdata", exercise = TRUE, + code = "", out.width.px = 624, out.height.px = 384, params.src = "netdata, exercise = TRUE, purl=FALSE", fig.num = 0L, exercise.df_print = "paged", exercise.checker = "NULL"), engine = "r", version = "4"), class = c("r", "tutorial_exercise" ))) @@ -1401,20 +1468,20 @@

Adding/deleting attributes

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

Adding/deleting attributes

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

Adding/deleting attributes

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

Adding/deleting attributes

+ + + + +
From b42bcebd77a8057c3c7e2774a5506db06185db2c Mon Sep 17 00:00:00 2001 From: James Hollway Date: Wed, 25 Sep 2024 19:02:30 +0200 Subject: [PATCH 28/46] to_unweighted() now passes through unweighted networks --- R/manip_reformat.R | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/R/manip_reformat.R b/R/manip_reformat.R index 6d636739..64a6f29b 100644 --- a/R/manip_reformat.R +++ b/R/manip_reformat.R @@ -264,10 +264,12 @@ to_unweighted <- function(.data, threshold = 1) UseMethod("to_unweighted") #' @export to_unweighted.tbl_graph <- function(.data, threshold = 1) { - edges <- weight <- NULL - .data %>% activate(edges) %>% - dplyr::filter(weight >= threshold) %>% - dplyr::select(-c(weight)) + if(is_weighted(.data)){ + edges <- weight <- NULL + .data %>% activate(edges) %>% + dplyr::filter(weight >= threshold) %>% + dplyr::select(-c(weight)) + } else .data } #' @export From dbf9203733d971be4054d7493ef94ab8d814b085 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Wed, 25 Sep 2024 19:02:57 +0200 Subject: [PATCH 29/46] Reordered nodes in ison_laterals data --- data/ison_laterals.rda | Bin 843 -> 705 bytes man/ison_laterals.Rd | 88 ++++++++++++++++++++--------------------- 2 files changed, 44 insertions(+), 44 deletions(-) diff --git a/data/ison_laterals.rda b/data/ison_laterals.rda index fc51fbc31b9b8068d5c5701dc5ee56379e157f27..7b4c4e4eeff3667bc07073c34c58a1fe30a4c425 100644 GIT binary patch literal 705 zcmV;y0zUmhT4*^jL0KkKSx!GmK>!Fg|A7Dh%|uiKf8hKB6Y#(1-5@{#&;xz|0c^-& zDoli)Df*_xJfV!5WFh4PBMGOZ#K9Q~r?oWnDB5Z=115j~&;voCpa405BLu_)0GK9> zhK2z!MkYCcBLu_)0GK9>hK2z!MkWf1LMDwh9zaH*&>CpTrc8`XfEhha;qViT;O19D z1`*QgVUbl;lQtA!>sF5lnxbwj*f=+~HJ$d+$+fh`!P4V&HJpv;$W-bma~;7-b&eo8 zhC^RDB4?1$WJv#wP~tS{(3;^WR8g(O(S~UG&c+BJ<4 z@1xyg-BFbr#_`Ad=P+a^-SzmqejN)xu2Hnk(#mdxMGRsjj!`JfZMOGyW<<`Ra?f^I z-sqz_oS01}kqvU7vQ#XTvWaCRvn)ik7Q~Qhu_8|Uu;zJ(oPHzFdS121^HLGSJAX30qX5=cC1Umtkr%)uI*s`LS3<@OH2qzg3beLtO4C%+WcHI3=^Rb2#3O>=; zFjZ2hRacGXVOp3G;8ZC}gZQJ%L!-$cO~WGx02Gu{9I(YD-n(DUpcoJxB(+T?<+(gG z57Yv%&tY)U)VT0I>Zwl`yU)-$as#yi1(_2Yjy&8ky~n(E4lTR-9b9}N)Gq`(emH0B z_rIFq$T_uh^JkZfIAh5U`cc`eQPMZ=j_BBjgS86IkDut*8nYfjjr^ld=I#TuN0jr4 nz*vk6D$6P?ypx_u*C&!-YLfNNSxDCR@8a%ArwS4Y$LS~_TY*Y8 literal 843 zcmV-R1GM}?T4*^jL0KkKSvFXBfB+1&e}Mo0%|=y2f8hKB6Y#(1-5_8A&;)(}00P)# zcxq`wPfZc(4Kx4-jWhrNGyniFc&3J<$_9WMXaS%A13=IKIBBLvBMGJg7zEP@!7(x# zWN2s#^+?dfXlaunpbVHJO)!Q=fB-ZKiV`A6jWq^_kN`B$01S;906k8S!Tuao+gGMh zSz$1h-FKNbQ!F%Wl+eM0Og2=@N~*$Pvb4j#(@M)`SW=9(VTR@uX_Z!*X)?>etuj{j z8DX)6!wf4A3b!;?=FN?oV5)eP$nHHOi!2WqlZnh6rR2RoJ0nrX#` z6N!diqqfrxnc1TqCqUO#SWNU=ZvEOKHBhZ^#%~g%Qks&@ zB2Dt3Sx{L;l7h)eET$|aqFN$G)e-9|H$;+Df<6kpp@OBwxL}HB1d&A*31C`TDkO%iKw`{N$t||q zY=J(YmLf;iIq-?>R3=KHRa7djf>5gv*i4JOWYCKh5T!sM2pB%Caa|%l$VB^`5Po|O zwX`gk*jgU=Q6$5Hemluax5XgYC@3;wDv({Jq#6^Pl1+qQ7^ednc%Tw^m;^3`NRZrVOr|gbY;NNY@Vy9jb;DnW%Jf$^0o&cfqgnU040zMN zly&clIF6op;5ktBdl0Qr>-!tycB9BK)66#L=i)mFCy;#+B$QcfMFmm`04adroI(;% V3bHK&JKUT2yOJrwgn_cd!~m+#cO3u# diff --git a/man/ison_laterals.Rd b/man/ison_laterals.Rd index 38172b85..23b5c71e 100644 --- a/man/ison_laterals.Rd +++ b/man/ison_laterals.Rd @@ -11,21 +11,21 @@ #> name type #> #> 1 A FALSE -#> 2 U TRUE -#> 3 B FALSE -#> 4 V TRUE -#> 5 C FALSE -#> 6 W TRUE +#> 2 B FALSE +#> 3 C FALSE +#> 4 D FALSE +#> 5 U TRUE +#> 6 V TRUE #> # i 4 more rows #> # A tibble: 12 x 2 #> from to #> -#> 1 1 2 -#> 2 1 4 -#> 3 3 2 -#> 4 3 6 -#> 5 3 7 -#> 6 3 8 +#> 1 1 5 +#> 2 1 6 +#> 3 2 5 +#> 4 2 7 +#> 5 2 8 +#> 6 2 9 #> # i 6 more rows #> #> $ison_bm @@ -34,21 +34,21 @@ #> name type #> #> 1 A FALSE -#> 2 U TRUE -#> 3 B FALSE -#> 4 V TRUE -#> 5 C FALSE -#> 6 W TRUE +#> 2 B FALSE +#> 3 C FALSE +#> 4 D FALSE +#> 5 U TRUE +#> 6 V TRUE #> # i 2 more rows #> # A tibble: 9 x 2 #> from to #> -#> 1 1 2 -#> 2 1 4 -#> 3 3 2 -#> 4 3 6 -#> 5 3 7 -#> 6 5 4 +#> 1 1 5 +#> 2 1 6 +#> 3 2 5 +#> 4 2 7 +#> 5 2 8 +#> 6 3 6 #> # i 3 more rows #> #> $ison_mb @@ -57,21 +57,21 @@ #> name type #> #> 1 A FALSE -#> 2 M TRUE -#> 3 B FALSE -#> 4 C FALSE -#> 5 X TRUE -#> 6 Y TRUE +#> 2 B FALSE +#> 3 C FALSE +#> 4 D FALSE +#> 5 M TRUE +#> 6 X TRUE #> # i 2 more rows #> # A tibble: 9 x 2 #> from to #> -#> 1 1 2 -#> 2 3 2 -#> 3 3 5 -#> 4 3 6 -#> 5 4 2 -#> 6 4 5 +#> 1 1 5 +#> 2 2 5 +#> 3 2 6 +#> 4 2 7 +#> 5 3 5 +#> 6 3 6 #> # i 3 more rows #> #> $ison_mm @@ -80,20 +80,20 @@ #> name type #> #> 1 A FALSE -#> 2 M TRUE -#> 3 B FALSE -#> 4 C FALSE -#> 5 N TRUE -#> 6 D FALSE +#> 2 B FALSE +#> 3 C FALSE +#> 4 D FALSE +#> 5 M TRUE +#> 6 N TRUE #> # A tibble: 6 x 2 #> from to #> -#> 1 1 2 -#> 2 3 2 -#> 3 3 5 -#> 4 4 2 -#> 5 4 5 -#> 6 6 5 +#> 1 1 5 +#> 2 2 5 +#> 3 2 6 +#> 4 3 5 +#> 5 3 6 +#> 6 4 6 }\if{html}{\out{
}} } \usage{ From 5bd89b0e5ebf5d32f866bc0e1eb430a734ad878a Mon Sep 17 00:00:00 2001 From: James Hollway Date: Wed, 25 Sep 2024 19:03:39 +0200 Subject: [PATCH 30/46] net_equivalency() now works with one-mode networks --- R/measure_closure.R | 28 +++++++++++++++++++++------- 1 file changed, 21 insertions(+), 7 deletions(-) diff --git a/R/measure_closure.R b/R/measure_closure.R index 844fb9d1..0057524d 100644 --- a/R/measure_closure.R +++ b/R/measure_closure.R @@ -94,20 +94,34 @@ node_transitivity <- function(.data) { #' @export net_equivalency <- function(.data) { if(missing(.data)) {expect_nodes(); .data <- .G()} - if (manynet::is_twomode(.data)) { + if(is_twomode(.data)){ mat <- manynet::as_matrix(.data) c <- ncol(mat) indegrees <- colSums(mat) twopaths <- crossprod(mat) diag(twopaths) <- 0 - output <- sum(twopaths * (twopaths - 1)) / + out <- sum(twopaths * (twopaths - 1)) / (sum(twopaths * (twopaths - 1)) + sum(twopaths * - (matrix(indegrees, c, c) - twopaths))) - if (is.nan(output)) output <- 1 - if(manynet::is_weighted(.data)) output <- output / mean(mat[mat>0]) - } else cli::cli_abort("This function expects a two-mode network") - make_network_measure(output, .data) + (matrix(indegrees, c, c) - twopaths))) + if (is.nan(out)) out <- 1 + if(manynet::is_weighted(.data)) out <- out / mean(mat[mat>0]) + } else { + out <- rowSums(vapply(cli::cli_progress_along(1:net_nodes(.data)), function(i){ + threepaths <- igraph::all_simple_paths(.data, i, cutoff = 3, + mode = "all") + onepaths <- threepaths[vapply(threepaths, length, + FUN.VALUE = numeric(1))==2] + threepaths <- threepaths[vapply(threepaths, length, + FUN.VALUE = numeric(1))==4] + c(sum(sapply(threepaths,"[[",4) %in% sapply(onepaths,"[[",2)), + length(threepaths)) + }, FUN.VALUE = numeric(2))) + out <- out[1]/out[2] + } + make_network_measure(out, .data) +} + } #' @rdname measure_closure From be44617871f7357e2e4483dd97d2d14f954640ce Mon Sep 17 00:00:00 2001 From: James Hollway Date: Wed, 25 Sep 2024 19:04:17 +0200 Subject: [PATCH 31/46] Added node_equivalency() for calculating four-cycle closure by node --- NAMESPACE | 1 + R/measure_closure.R | 19 +++++++++++++++++++ man/measure_closure.Rd | 4 ++++ tests/testthat/test-measure_closure.R | 6 ++++++ 4 files changed, 30 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index aece2946..cae46df8 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -539,6 +539,7 @@ export(node_efficiency) export(node_effsize) export(node_eigenvector) export(node_equivalence) +export(node_equivalency) export(node_exposure) export(node_fast_greedy) export(node_flow) diff --git a/R/measure_closure.R b/R/measure_closure.R index 0057524d..6b8300f0 100644 --- a/R/measure_closure.R +++ b/R/measure_closure.R @@ -122,6 +122,25 @@ net_equivalency <- function(.data) { make_network_measure(out, .data) } +#' @rdname measure_closure +#' @examples +#' node_equivalency(ison_southern_women) +#' @export +node_equivalency <- function(.data) { + if(missing(.data)) {expect_nodes(); .data <- .G()} + # if(is_weighted(.data)) + # mnet_info("Using unweighted form of the network.") + out <- vapply(cli::cli_progress_along(1:net_nodes(.data)), function(i){ + threepaths <- igraph::all_simple_paths(.data, i, cutoff = 3, + mode = "all") + onepaths <- threepaths[vapply(threepaths, length, + FUN.VALUE = numeric(1))==2] + threepaths <- threepaths[vapply(threepaths, length, + FUN.VALUE = numeric(1))==4] + mean(sapply(threepaths,"[[",4) %in% sapply(onepaths,"[[",2)) + }, FUN.VALUE = numeric(1)) + if (any(is.nan(out))) out[is.nan(out)] <- 0 + make_node_measure(out, .data) } #' @rdname measure_closure diff --git a/man/measure_closure.Rd b/man/measure_closure.Rd index 0aff6774..9890f888 100644 --- a/man/measure_closure.Rd +++ b/man/measure_closure.Rd @@ -7,6 +7,7 @@ \alias{net_transitivity} \alias{node_transitivity} \alias{net_equivalency} +\alias{node_equivalency} \alias{net_congruency} \title{Measures of network closure} \usage{ @@ -20,6 +21,8 @@ node_transitivity(.data) net_equivalency(.data) +node_equivalency(.data) + net_congruency(.data, object2) } \arguments{ @@ -74,6 +77,7 @@ node_reciprocity(to_unweighted(ison_networkers)) net_transitivity(ison_adolescents) node_transitivity(ison_adolescents) net_equivalency(ison_southern_women) +node_equivalency(ison_southern_women) } \references{ Robins, Garry L, and Malcolm Alexander. 2004. diff --git a/tests/testthat/test-measure_closure.R b/tests/testthat/test-measure_closure.R index 45228b94..c0a17dd3 100644 --- a/tests/testthat/test-measure_closure.R +++ b/tests/testthat/test-measure_closure.R @@ -29,6 +29,12 @@ test_that("two-mode object clustering is reported correctly",{ expect_output(print(net_equivalency(ison_southern_women))) }) +test_that("node_equivalency works correctly",{ + expect_equal(as.numeric(node_equivalency(ison_laterals$ison_mm)), + c(0,1,1,0,0.5,0.5), tolerance = 0.001) + expect_s3_class(node_equivalency(ison_southern_women), "node_measure") +}) + test_that("three-mode clustering calculated correctly",{ mat1 <- manynet::create_ring(c(10,5)) mat2 <- manynet::create_ring(c(5,8)) From fae75a3d90615f48a5985c803adc3a129306f191 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Thu, 26 Sep 2024 13:22:26 +0200 Subject: [PATCH 32/46] make_node_motif now adds modes and names only where available --- R/class_motifs.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/class_motifs.R b/R/class_motifs.R index d20faf6a..055e9a6b 100644 --- a/R/class_motifs.R +++ b/R/class_motifs.R @@ -1,6 +1,7 @@ make_node_motif <- function(out, .data) { class(out) <- c("node_motif", class(out)) - attr(out, "mode") <- node_is_mode(.data) + if(is_twomode(.data)) attr(out, "mode") <- node_is_mode(.data) + if(is_labelled(.data)) attr(out, "dimnames")[[1]] <- node_names(.data) out } From 03bec14bc55f28c7de5df067e0bfdf52be316dfd Mon Sep 17 00:00:00 2001 From: James Hollway Date: Thu, 26 Sep 2024 13:23:46 +0200 Subject: [PATCH 33/46] print.node_motif converts to tibble and adds names just for printing (underlying object is still a matrix for serving e.g. equivalence algorithms) --- R/class_motifs.R | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/R/class_motifs.R b/R/class_motifs.R index 055e9a6b..8ae07863 100644 --- a/R/class_motifs.R +++ b/R/class_motifs.R @@ -15,14 +15,20 @@ make_network_motif <- function(out, .data) { print.node_motif <- function(x, ..., n = 6, digits = 3) { - if(!is.null(attr(x, "dimnames")[[1]])){ - x <- data.frame(names = attr(x, "dimnames")[[1]], x) - } if (any(attr(x, "mode"))) { - print(dplyr::tibble(as.data.frame(x)[!attr(x, "mode")]), n = n) - print(dplyr::tibble(as.data.frame(x)[attr(x, "mode")]), n = n) + y <- as.data.frame(x[!attr(x, "mode"),]) + z <- as.data.frame(x[attr(x, "mode"),]) + if(!is.null(attr(x, "dimnames")[[1]])){ + y <- data.frame(names = attr(x, "dimnames")[[1]][!attr(x, "mode")], y) + z <- data.frame(names = attr(x, "dimnames")[[1]][attr(x, "mode")], z) + } + print(dplyr::tibble(y), n = n) + print(dplyr::tibble(z), n = n) } else { - print(dplyr::tibble(as.data.frame(x)), n = n) + if(!is.null(attr(x, "dimnames")[[1]])){ + x <- data.frame(names = attr(x, "dimnames")[[1]], x) + } else x <- as.data.frame(x) + print(dplyr::tibble(x), n = n) } } From b399f1f760d5254f759881ea400fa3d7d89c8875 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Thu, 26 Sep 2024 13:29:24 +0200 Subject: [PATCH 34/46] Added net_by_quad() for network level quad motifs --- NAMESPACE | 2 +- R/motif_census.R | 47 +++++++++++++++++++++++++++++++++++++++++++++++ man/motif_net.Rd | 4 ++++ 3 files changed, 52 insertions(+), 1 deletion(-) diff --git a/NAMESPACE b/NAMESPACE index cae46df8..4232b108 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -408,6 +408,7 @@ export(net_betweenness) export(net_by_brokerage) export(net_by_dyad) export(net_by_mixed) +export(net_by_quad) export(net_by_triad) export(net_change) export(net_closeness) @@ -913,7 +914,6 @@ importFrom(stats,cor) importFrom(stats,cutree) importFrom(stats,hclust) importFrom(stats,median) -importFrom(tidygraph,"%E>%") importFrom(tidygraph,.E) importFrom(tidygraph,.G) importFrom(tidygraph,.N) diff --git a/R/motif_census.R b/R/motif_census.R index 6bb9545c..4b3c701e 100644 --- a/R/motif_census.R +++ b/R/motif_census.R @@ -275,6 +275,53 @@ net_by_triad <- function(.data) { } } +#' @rdname motif_net +#' @examples +#' net_by_quad(ison_southern_women) +#' @export +net_by_quad <- function(.data){ + if(missing(.data)) {expect_nodes(); .data <- .G()} + cmbs <- combn(1:net_nodes(.data), 4) + mat <- as_matrix(to_onemode(.data)) + dens <- apply(cmbs, 2, function(x) sum(mat[x,x])) + + E4 <- sum(dens == 0) + I4 <- sum(dens == 1) + + if(any(dens==2)){ + if(sum(dens==2)>1){ + twosies <- apply(cmbs[,dens==2], 2, function(x) max(rowSums(mat[x,x]))) + } else twosies <- max(rowSums(mat[cmbs[,dens==2], cmbs[,dens==2]])) + H4 <- sum(twosies==1) + L4 <- sum(twosies==2) + } else H4 <- L4 <- 0 + + if(any(dens==3)){ + if(sum(dens==3)>1){ + threesies <- apply(cmbs[,dens==3], 2, function(x) max(rowSums(mat[x,x]))) + } else threesies <- max(rowSums(mat[cmbs[,dens==3], cmbs[,dens==3]])) + D4 <- sum(threesies==2) + U4 <- sum(threesies==1) + Y4 <- sum(threesies==3) + } else D4 <- U4 <- Y4 <- 0 + + if(any(dens==4)){ + if(sum(dens==4)>1){ + foursies <- apply(cmbs[,dens==4], 2, function(x) max(rowSums(mat[x,x]))) + } else foursies <- max(rowSums(mat[cmbs[,dens==4], cmbs[,dens==4]])) + P4 <- sum(foursies==3) + C4 <- sum(foursies==2) + } else P4 <- C4 <- 0 + + Z4 <- sum(dens == 5) + X4 <- sum(dens == 6) + + out <- c(E4 = E4, I4 = I4, H4 = H4, L4 = L4, D4 = D4, U4 = U4, Y4 = Y4, + P4 = P4, C4 = C4, Z4 = Z4, X4 = X4) + + make_network_motif(out, .data) +} + #' @rdname motif_net #' @source Alejandro Espinosa 'netmem' #' @references diff --git a/man/motif_net.Rd b/man/motif_net.Rd index 75765963..6c46724f 100644 --- a/man/motif_net.Rd +++ b/man/motif_net.Rd @@ -4,6 +4,7 @@ \alias{motif_net} \alias{net_by_dyad} \alias{net_by_triad} +\alias{net_by_quad} \alias{net_by_mixed} \title{Motifs at the network level} \source{ @@ -14,6 +15,8 @@ net_by_dyad(.data) net_by_triad(.data) +net_by_quad(.data) + net_by_mixed(.data, object2) } \arguments{ @@ -41,6 +44,7 @@ a one-mode and a two-mode network. \examples{ net_by_dyad(manynet::ison_algebra) net_by_triad(manynet::ison_adolescents) +net_by_quad(ison_southern_women) marvel_friends <- to_unsigned(ison_marvel_relationships, "positive") (mixed_cen <- net_by_mixed(marvel_friends, ison_marvel_teams)) } From 0102e8401ca75f7e3d6d412eefa9caff1fa268be Mon Sep 17 00:00:00 2001 From: James Hollway Date: Thu, 26 Sep 2024 13:31:06 +0200 Subject: [PATCH 35/46] Using own implementation for node_by_quad() now, slower than oaqc c++ code, but flexible and removes a dependency --- DESCRIPTION | 1 - R/motif_census.R | 160 +++++++++++++++++------------ man/motif_node.Rd | 36 +------ tests/testthat/test-motif_census.R | 2 +- 4 files changed, 95 insertions(+), 104 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 54d1d666..a9adad65 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -41,7 +41,6 @@ Suggests: methods, multiplex, netdiffuseR, - oaqc, patchwork, readxl, rmarkdown, diff --git a/R/motif_census.R b/R/motif_census.R index 4b3c701e..c8d9ddde 100644 --- a/R/motif_census.R +++ b/R/motif_census.R @@ -95,83 +95,109 @@ node_by_triad <- function(.data){ if(missing(.data)) {expect_nodes(); .data <- .G()} out <- t(sapply(seq.int(manynet::net_nodes(.data)), function(x) net_by_triad(.data) - net_by_triad(manynet::delete_nodes(.data, x)))) - rownames(out) <- manynet::node_names(.data) make_node_motif(out, .data) } -#' @rdname motif_node -#' @section Quad census: -#' The quad census uses the `{oaqc}` package to do -#' the heavy lifting of counting the number of each orbits. -#' See `vignette('oaqc')`. -#' However, our function relabels some of the motifs -#' to avoid conflicts and improve some consistency with -#' other census-labelling practices. -#' The letter-number pairing of these labels indicate -#' the number and configuration of ties. -#' For now, we offer a rough translation: -#' -#' | migraph | Ortmann and Brandes -#' | ------------- |------------- | -#' | E4 | co-K4 -#' | I40, I41 | co-diamond -#' | H4 | co-C4 -#' | L42, L41, L40 | co-paw -#' | D42, D40 | co-claw -#' | U42, U41 | P4 -#' | Y43, Y41 | claw -#' | P43, P42, P41 | paw -#' | 04 | C4 -#' | Z42, Z43 | diamond -#' | X4 | K4 -#' -#' See also [this list of graph classes](https://www.graphclasses.org/smallgraphs.html#nodes4). -#' @importFrom tidygraph %E>% -#' @references -#' Ortmann, Mark, and Ulrik Brandes. 2017. -#' “Efficient Orbit-Aware Triad and Quad Census in Directed and Undirected Graphs.” -#' \emph{Applied Network Science} 2(1):13. -#' \doi{10.1007/s41109-017-0027-2}. +# #' @rdname motif_node +# #' @section Quad census: +# #' The quad census uses the `{oaqc}` package to do +# #' the heavy lifting of counting the number of each orbits. +# #' See `vignette('oaqc')`. +# #' However, our function relabels some of the motifs +# #' to avoid conflicts and improve some consistency with +# #' other census-labelling practices. +# #' The letter-number pairing of these labels indicate +# #' the number and configuration of ties. +# #' For now, we offer a rough translation: +# #' +# #' | migraph | Ortmann and Brandes +# #' | ------------- |------------- | +# #' | E4 | co-K4 +# #' | I40, I41 | co-diamond +# #' | H4 | co-C4 +# #' | L42, L41, L40 | co-paw +# #' | D42, D40 | co-claw +# #' | U42, U41 | P4 +# #' | Y43, Y41 | claw +# #' | P43, P42, P41 | paw +# #' | 04 | C4 +# #' | Z42, Z43 | diamond +# #' | X4 | K4 +# #' +# #' See also [this list of graph classes](https://www.graphclasses.org/smallgraphs.html#nodes4). +# #' @importFrom tidygraph %E>% +# #' @references +# #' Ortmann, Mark, and Ulrik Brandes. 2017. +# #' “Efficient Orbit-Aware Triad and Quad Census in Directed and Undirected Graphs.” +# #' \emph{Applied Network Science} 2(1):13. +# #' \doi{10.1007/s41109-017-0027-2}. +# #' @examples +# #' node_by_quad(ison_southern_women) +# #' @export +# node_by_quad <- function(.data){ +# if(missing(.data)) {expect_nodes(); .data <- .G()} +# thisRequires("oaqc") +# graph <- .data %>% manynet::as_tidygraph() %E>% +# as.data.frame() +# if(ncol(graph)>2) graph <- graph[,1:2] +# out <- oaqc::oaqc(graph)[[1]] +# out <- out[-1,] +# rownames(out) <- manynet::node_names(.data) +# colnames(out) <- c("E4", # co-K4 +# "I41","I40", # co-diamond +# "H4", # co-C4 +# "L42","L41","L40", # co-paw +# "D42","D40", # co-claw +# "U42","U41", # P4 +# "Y43","Y41", # claw +# "P43","P42","P41", # paw +# "04", # C4 +# "Z42","Z43", # diamond +# "X4") # K4 +# if(manynet::is_twomode(.data)) out <- out[,-c(8,9,14,15,16,18,19,20)] +# make_node_motif(out, .data) +# } + +#' @rdname motif_node #' @examples -#' node_by_quad(manynet::ison_southern_women) +#' node_by_quad(ison_southern_women) #' @export node_by_quad <- function(.data){ - if(missing(.data)) {expect_nodes(); .data <- .G()} - thisRequires("oaqc") - graph <- .data %>% manynet::as_tidygraph() %E>% - as.data.frame() - if(ncol(graph)>2) graph <- graph[,1:2] - out <- oaqc::oaqc(graph)[[1]] - out <- out[-1,] - rownames(out) <- manynet::node_names(.data) - colnames(out) <- c("E4", # co-K4 - "I41","I40", # co-diamond - "H4", # co-C4 - "L42","L41","L40", # co-paw - "D42","D40", # co-claw - "U42","U41", # P4 - "Y43","Y41", # claw - "P43","P42","P41", # paw - "04", # C4 - "Z42","Z43", # diamond - "X4") # K4 - if(manynet::is_twomode(.data)) out <- out[,-c(8,9,14,15,16,18,19,20)] + cmbs <- combn(1:net_nodes(.data), 4) + mat <- as_matrix(to_onemode(.data)) + dd <- apply(cmbs, 2, function(x) c(sum(mat[x,x]), + max(rowSums(mat[x,x])))) + + types <- rep(NA, ncol(cmbs)) + types[dd[1,] == 0] <- "E4" + types[dd[1,] == 2] <- "I4" + types[dd[1,] == 4 & dd[2,] == 1] <- "H4" + types[dd[1,] == 4 & dd[2,] == 2] <- "L4" + types[dd[1,] == 6 & dd[2,] == 2] <- "D4" + types[dd[1,] == 6 & dd[2,] == 1] <- "U4" + types[dd[1,] == 6 & dd[2,] == 3] <- "Y4" + types[dd[1,] == 8 & dd[2,] == 3] <- "P4" + types[dd[1,] == 8 & dd[2,] == 2] <- "C4" + types[dd[1,] == 10] <- "Z4" + types[dd[1,] == 12] <- "X4" + + appears <- sapply(seq.int(net_nodes(.data)), + function(x) types[which(cmbs == x, arr.ind = TRUE)[,2]]) + out <- apply(appears, 2, table) + + if(is.list(out)){ + out <- as.matrix(dplyr::bind_rows(out)) + } else out <- as.matrix(as.data.frame(t(out))) + out.order <- c("E4","I4","H4","L4","D4","U4","Y4","P4","C4","Z4","X4") + out <- out[,match(out.order, colnames(out))] + colnames(out) <- out.order + out[is.na(out)] <- 0 + make_node_motif(out, .data) } -# #' @export -# node_bmotif_census <- function(.data, normalized = FALSE){ -# if (!("bmotif" %in% rownames(utils::installed.packages()))) { -# message("Please install package `{bmotif}`.") -# out <- bmotif::node_positions(manynet::as_matrix(.data), -# weights_method = ifelse(manynet::is_weighted(.data), -# 'mean_motifweights', 'none'), -# normalisation = ifelse(normalized, -# 'levelsize_NAzero', 'none')) -# make_node_motif(out, .data) -# } # } -# + # #' @export # node_igraph_census <- function(.data, normalized = FALSE){ # out <- igraph::motifs(manynet::as_igraph(.data), 4) diff --git a/man/motif_node.Rd b/man/motif_node.Rd index 8cbea8c5..0e0cd2a8 100644 --- a/man/motif_node.Rd +++ b/man/motif_node.Rd @@ -41,40 +41,11 @@ in motifs of four nodes. of each node to every other node in the network. } } -\section{Quad census}{ - -The quad census uses the \code{{oaqc}} package to do -the heavy lifting of counting the number of each orbits. -See \code{vignette('oaqc')}. -However, our function relabels some of the motifs -to avoid conflicts and improve some consistency with -other census-labelling practices. -The letter-number pairing of these labels indicate -the number and configuration of ties. -For now, we offer a rough translation:\tabular{ll}{ - migraph \tab Ortmann and Brandes \cr - E4 \tab co-K4 \cr - I40, I41 \tab co-diamond \cr - H4 \tab co-C4 \cr - L42, L41, L40 \tab co-paw \cr - D42, D40 \tab co-claw \cr - U42, U41 \tab P4 \cr - Y43, Y41 \tab claw \cr - P43, P42, P41 \tab paw \cr - 04 \tab C4 \cr - Z42, Z43 \tab diamond \cr - X4 \tab K4 \cr -} - - -See also \href{https://www.graphclasses.org/smallgraphs.html#nodes4}{this list of graph classes}. -} - \examples{ task_eg <- to_named(to_uniplex(ison_algebra, "tasks")) (tie_cen <- node_by_tie(task_eg)) (triad_cen <- node_by_triad(task_eg)) -node_by_quad(manynet::ison_southern_women) +node_by_quad(ison_southern_women) node_by_path(manynet::ison_adolescents) node_by_path(manynet::ison_southern_women) } @@ -82,11 +53,6 @@ node_by_path(manynet::ison_southern_women) Davis, James A., and Samuel Leinhardt. 1967. “\href{https://files.eric.ed.gov/fulltext/ED024086.pdf}{The Structure of Positive Interpersonal Relations in Small Groups}.” 55. -Ortmann, Mark, and Ulrik Brandes. 2017. -“Efficient Orbit-Aware Triad and Quad Census in Directed and Undirected Graphs.” -\emph{Applied Network Science} 2(1):13. -\doi{10.1007/s41109-017-0027-2}. - Dijkstra, Edsger W. 1959. "A note on two problems in connexion with graphs". \emph{Numerische Mathematik} 1, 269-71. diff --git a/tests/testthat/test-motif_census.R b/tests/testthat/test-motif_census.R index dff3e7d5..40939815 100644 --- a/tests/testthat/test-motif_census.R +++ b/tests/testthat/test-motif_census.R @@ -38,7 +38,7 @@ test_that("net_triad census works", { test <- node_by_quad(ison_southern_women) test_that("node quad census works", { expect_s3_class(test, "node_motif") - expect_equal(test[1,1], 1463) + expect_equal(test[1,1], 1241) }) test_that("net_mixed census works", { From 30a2362ea2fe05d27a6d16a93d63191b95379087 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Thu, 26 Sep 2024 13:32:38 +0200 Subject: [PATCH 36/46] node_in_equivalence() now uses census directly --- R/member_equivalence.R | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/R/member_equivalence.R b/R/member_equivalence.R index 6e99e5f3..b94d5a75 100644 --- a/R/member_equivalence.R +++ b/R/member_equivalence.R @@ -57,8 +57,7 @@ node_in_equivalence <- function(.data, census, range = 8L){ if(missing(.data)) {expect_nodes(); .data <- .G()} hc <- switch(match.arg(cluster), - hierarchical = cluster_hierarchical(`if`(manynet::is_twomode(.data), - manynet::to_onemode(census), census), + hierarchical = cluster_hierarchical(census, match.arg(distance)), concor = cluster_concor(.data, census)) @@ -105,13 +104,13 @@ node_in_structural <- function(.data, #' } #' @export node_in_regular <- function(.data, - k = c("silhouette", "elbow", "strict"), - cluster = c("hierarchical", "concor"), - distance = c("euclidean", "maximum", "manhattan", - "canberra", "binary", "minkowski"), - range = 8L){ + k = c("silhouette", "elbow", "strict"), + cluster = c("hierarchical", "concor"), + distance = c("euclidean", "maximum", "manhattan", + "canberra", "binary", "minkowski"), + range = 8L){ if(missing(.data)) {expect_nodes(); .data <- .G()} - if(manynet::is_twomode(.data)){ + if(is_twomode(.data)){ mat <- as.matrix(node_by_quad(.data)) } else { mat <- node_by_triad(.data) From f0299c70ee8eb7b906aafbb628c1e426eb2c6aef Mon Sep 17 00:00:00 2001 From: James Hollway Date: Thu, 26 Sep 2024 17:15:51 +0200 Subject: [PATCH 37/46] Added node_hub() and node_authority() centrality measures --- NAMESPACE | 2 ++ R/measure_centrality.R | 23 +++++++++++++++++++++++ man/measure_central_eigen.Rd | 13 +++++++++++++ pkgdown/_pkgdown.yml | 1 + 4 files changed, 39 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index 4232b108..21ff5e9d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -512,6 +512,7 @@ export(network_upperbound) export(node_adoption_time) export(node_alpha) export(node_attribute) +export(node_authority) export(node_automorphic_equivalence) export(node_betweenness) export(node_bridges) @@ -548,6 +549,7 @@ export(node_fluid) export(node_harmonic) export(node_heterophily) export(node_hierarchy) +export(node_hub) export(node_in_adopter) export(node_in_automorphic) export(node_in_betweenness) diff --git a/R/measure_centrality.R b/R/measure_centrality.R index 7cf2af32..c1874791 100644 --- a/R/measure_centrality.R +++ b/R/measure_centrality.R @@ -657,6 +657,8 @@ net_harmonic <- function(.data, normalized = TRUE, k = 2){ #' - `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. #' @@ -825,6 +827,27 @@ node_pagerank <- function(.data){ .data) } +#' @rdname measure_central_eigen +#' @references +#' Kleinberg, Jon. 1999. +#' "Authoritative sources in a hyperlinked environment". +#' _Journal of the ACM_ 46(5): 604–632. +#' \doi{110.1145/324133.324140}. +#' @export +node_authority <- function(.data){ + if(missing(.data)) {expect_nodes(); .data <- .G()} + make_node_measure(igraph::authority_score(manynet::as_igraph(.data))$vector, + .data) +} + +#' @rdname measure_central_eigen +#' @export +node_hub <- function(.data){ + if(missing(.data)) {expect_nodes(); .data <- .G()} + make_node_measure(igraph::hub_score(manynet::as_igraph(.data))$vector, + .data) +} + #' @rdname measure_central_eigen #' @examples #' tie_eigenvector(ison_adolescents) diff --git a/man/measure_central_eigen.Rd b/man/measure_central_eigen.Rd index 159f1d3c..3f51a719 100644 --- a/man/measure_central_eigen.Rd +++ b/man/measure_central_eigen.Rd @@ -6,6 +6,8 @@ \alias{node_power} \alias{node_alpha} \alias{node_pagerank} +\alias{node_authority} +\alias{node_hub} \alias{tie_eigenvector} \alias{net_eigenvector} \title{Measures of eigenvector-like centrality and centralisation} @@ -18,6 +20,10 @@ node_alpha(.data, alpha = 0.85) node_pagerank(.data) +node_authority(.data) + +node_hub(.data) + tie_eigenvector(.data, normalized = TRUE) net_eigenvector(.data, normalized = TRUE) @@ -57,6 +63,8 @@ These functions calculate common eigenvector-related centrality measures for one \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. } @@ -139,6 +147,11 @@ Bonacich, P. and Lloyd, P. 2001. Brin, Sergey and Page, Larry. 1998. "The anatomy of a large-scale hypertextual web search engine". \emph{Proceedings of the 7th World-Wide Web Conference}. Brisbane, Australia. + +Kleinberg, Jon. 1999. +"Authoritative sources in a hyperlinked environment". +\emph{Journal of the ACM} 46(5): 604–632. +\doi{110.1145/324133.324140}. } \seealso{ Other centrality: diff --git a/pkgdown/_pkgdown.yml b/pkgdown/_pkgdown.yml index 0776afcb..7da4f5b2 100644 --- a/pkgdown/_pkgdown.yml +++ b/pkgdown/_pkgdown.yml @@ -53,6 +53,7 @@ reference: directed and undirected, one-mode and two-mode networks. contents: - make_explicit + - make_ego - make_create - starts_with("generate_") - subtitle: "Playing" From 4af77ae0f6edad66301be88edf502b7c59012ba7 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Thu, 26 Sep 2024 17:16:26 +0200 Subject: [PATCH 38/46] Added mnet_info internal function --- R/zzz.R | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/R/zzz.R b/R/zzz.R index 3e3c4f32..85721932 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -12,7 +12,8 @@ # cran_version <- pkgs[pkgs$Package == "manynet","Version"] local_version <- utils::packageVersion("manynet") - cli::cli_inform("This is {.pkg manynet} version {.version {local_version}}", class = "packageStartupMessage") + cli::cli_inform("You are using {.pkg manynet} version {.version {local_version}}.", + class = "packageStartupMessage") old.list <- as.data.frame(utils::old.packages()) behind_cran <- "manynet" %in% old.list$Package @@ -51,6 +52,11 @@ mnet_progress_step <- function(...){ cli::cli_progress_step(...) } +mnet_info <- function(...){ + if(getOption("manynet_verbosity", default = "quiet")!="quiet") + cli::cli_alert_info(...) +} + manynet_console_theme <- function(){ # dark <- detect_dark_theme(dark) list(h1 = list(`margin-top` = 1, `margin-bottom` = 0, color = "#199D77", From 322b95b4837fd3caff714e4965e715b5ad4a37de Mon Sep 17 00:00:00 2001 From: James Hollway Date: Thu, 26 Sep 2024 17:18:18 +0200 Subject: [PATCH 39/46] Faster version of combn possible, but only choose 2 at the moment --- R/motif_census.R | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/R/motif_census.R b/R/motif_census.R index c8d9ddde..41c492b1 100644 --- a/R/motif_census.R +++ b/R/motif_census.R @@ -163,7 +163,7 @@ node_by_triad <- function(.data){ #' node_by_quad(ison_southern_women) #' @export node_by_quad <- function(.data){ - cmbs <- combn(1:net_nodes(.data), 4) + cmbs <- utils::combn(1:net_nodes(.data), 4) mat <- as_matrix(to_onemode(.data)) dd <- apply(cmbs, 2, function(x) c(sum(mat[x,x]), max(rowSums(mat[x,x])))) @@ -196,6 +196,14 @@ node_by_quad <- function(.data){ make_node_motif(out, .data) } +# https://stackoverflow.com/questions/26828301/faster-version-of-combn#26828486 +# comb2.int <- function(n, choose = 2){ +# # e.g. n=3 => (1,2), (1,3), (2,3) +# x <- rep(1:n,(n:1)-1) +# i <- seq_along(x)+1 +# o <- c(0,cumsum((n-2):1)) +# y <- i-o[x] +# return(cbind(x,y)) # } # #' @export @@ -307,7 +315,7 @@ net_by_triad <- function(.data) { #' @export net_by_quad <- function(.data){ if(missing(.data)) {expect_nodes(); .data <- .G()} - cmbs <- combn(1:net_nodes(.data), 4) + cmbs <- utils::combn(1:net_nodes(.data), 4) mat <- as_matrix(to_onemode(.data)) dens <- apply(cmbs, 2, function(x) sum(mat[x,x])) From f9d5770f8e30d9260a21af12d3154eacca150b7b Mon Sep 17 00:00:00 2001 From: James Hollway Date: Fri, 27 Sep 2024 13:55:39 +0200 Subject: [PATCH 40/46] Added node_by_dyad() --- R/motif_census.R | 24 ++++++++++++++++++++++-- man/motif_node.Rd | 4 ++++ 2 files changed, 26 insertions(+), 2 deletions(-) diff --git a/R/motif_census.R b/R/motif_census.R index 41c492b1..cf7439f0 100644 --- a/R/motif_census.R +++ b/R/motif_census.R @@ -84,6 +84,26 @@ node_by_tie <- function(.data){ make_node_motif(t(mat), object) } +#' @rdname motif_node +#' @examples +#' node_by_dyad(ison_networkers) +#' @export +node_by_dyad <- function(.data) { + if(missing(.data)) {expect_nodes(); .data <- .G()} + if(is_weighted(.data)){ + .data <- to_unweighted(.data) + mnet_info("Ignoring tie weights.") + } + mat <- as_matrix(.data) + out <- t(vapply(seq_nodes(.data), function(x){ + vec <- mat[x,] + mat[,x] + c(sum(vec==2), sum(vec==1), sum(vec==0)) + }, FUN.VALUE = numeric(3))) + colnames(out) <- c("Mutual", "Asymmetric", "Null") + if (!is_directed(.data)) out <- out[,c(1, 3)] + make_node_motif(out, .data) +} + #' @rdname motif_node #' @references #' Davis, James A., and Samuel Leinhardt. 1967. @@ -238,8 +258,8 @@ node_by_quad <- function(.data){ #' _Social Networks_ 32(3): 245-51. #' \doi{10.1016/j.socnet.2010.03.006}. #' @examples -#' node_by_path(manynet::ison_adolescents) -#' node_by_path(manynet::ison_southern_women) +#' node_by_path(ison_adolescents) +#' node_by_path(ison_southern_women) #' @export node_by_path <- function(.data){ if(missing(.data)) {expect_nodes(); .data <- .G()} diff --git a/man/motif_node.Rd b/man/motif_node.Rd index 0e0cd2a8..1dd64d75 100644 --- a/man/motif_node.Rd +++ b/man/motif_node.Rd @@ -3,6 +3,7 @@ \name{motif_node} \alias{motif_node} \alias{node_by_tie} +\alias{node_by_dyad} \alias{node_by_triad} \alias{node_by_quad} \alias{node_by_path} @@ -10,6 +11,8 @@ \usage{ node_by_tie(.data) +node_by_dyad(.data) + node_by_triad(.data) node_by_quad(.data) @@ -44,6 +47,7 @@ of each node to every other node in the network. \examples{ task_eg <- to_named(to_uniplex(ison_algebra, "tasks")) (tie_cen <- node_by_tie(task_eg)) +node_by_dyad(ison_networkers) (triad_cen <- node_by_triad(task_eg)) node_by_quad(ison_southern_women) node_by_path(manynet::ison_adolescents) From f284a5d21eb9450c36ad67f8ed4493900d2e48e9 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Fri, 27 Sep 2024 13:56:14 +0200 Subject: [PATCH 41/46] Added internal mnet_unavailable() to direct users to the issues page --- R/motif_census.R | 2 +- R/zzz.R | 8 ++++++++ 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/R/motif_census.R b/R/motif_census.R index cf7439f0..57789bad 100644 --- a/R/motif_census.R +++ b/R/motif_census.R @@ -297,7 +297,7 @@ NULL net_by_dyad <- function(.data) { if(missing(.data)) {expect_nodes(); .data <- .G()} if (manynet::is_twomode(.data)) { - cli::cli_abort("A twomode or multilevel option for a dyad census is not yet implemented.") + mnet_unavailable("A twomode or multilevel option for a dyad census is not yet implemented.") } else { out <- suppressWarnings(igraph::dyad_census(manynet::as_igraph(.data))) out <- unlist(out) diff --git a/R/zzz.R b/R/zzz.R index 85721932..024c6ce8 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -57,6 +57,14 @@ mnet_info <- function(...){ cli::cli_alert_info(...) } +mnet_unavailable <- function(...){ + if(getOption("manynet_verbosity", default = "quiet")!="quiet") + cli::cli_alert_warning(paste(..., + "If you are interested in this feature,", + "please vote for it or raise it as an issue at", + "{.url https://github.com/stocnet/manynet/issues}.")) +} + manynet_console_theme <- function(){ # dark <- detect_dark_theme(dark) list(h1 = list(`margin-top` = 1, `margin-bottom` = 0, color = "#199D77", From a49cf6a698cc349cf582b6712b03967e731e0cd1 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Fri, 27 Sep 2024 17:03:16 +0200 Subject: [PATCH 42/46] Added create_motifs() --- NAMESPACE | 1 + R/make_create.R | 68 ++++++++++++++++++++++++++++++ R/manynet-utils.R | 6 ++- R/zzz.R | 2 +- man/make_cran.Rd | 1 + man/make_create.Rd | 1 + man/make_ego.Rd | 1 + man/make_explicit.Rd | 1 + man/make_learning.Rd | 1 + man/make_motifs.Rd | 45 ++++++++++++++++++++ man/make_play.Rd | 1 + man/make_random.Rd | 1 + man/make_read.Rd | 1 + man/make_stochastic.Rd | 1 + man/make_write.Rd | 1 + man/motif_node.Rd | 4 +- pkgdown/_pkgdown.yml | 1 + tests/testthat/test-motif_census.R | 2 - 18 files changed, 133 insertions(+), 6 deletions(-) create mode 100644 man/make_motifs.Rd diff --git a/NAMESPACE b/NAMESPACE index 21ff5e9d..7fb0c227 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -327,6 +327,7 @@ export(create_empty) export(create_explicit) export(create_filled) export(create_lattice) +export(create_motifs) export(create_ring) export(create_star) export(create_tree) diff --git a/R/make_create.R b/R/make_create.R index a91a26fd..fe7dbfd8 100644 --- a/R/make_create.R +++ b/R/make_create.R @@ -216,6 +216,74 @@ q_yes <- function(msg = NULL){ out } +# Collections #### + +#' Making motifs +#' +#' @description +#' `create_motifs()` is used to create a list of networks that represent the +#' subgraphs or motifs corresponding to a certain number of nodes and direction. +#' Note that currently only `n==2` to `n==4` is implemented, +#' and the latter only for undirected networks. +#' +#' @inheritParams make_create +#' @name make_motifs +#' @family makes +#' @export +create_motifs <- function(n, directed = FALSE){ + directed <- infer_directed(n, directed) + n <- infer_n(n) + if(!directed & n==2){ + return(list(Null = mutate_nodes(create_empty(2), + name = c("A","B")), + M = create_explicit(A--B))) + } else if(directed & n==2){ + return(list(Null = mutate_nodes(create_empty(2, directed = TRUE), + name = c("A","B")), + Asymmetric = create_explicit(A-+B), + Mutual = create_explicit(A++B))) + } else if(!directed & n==3){ + return(list(Empty = mutate_nodes(create_empty(3), + names = c("A","B","C")), + Edge = create_explicit(A--B, C), + Path = create_explicit(A--B--C), + Triangle = create_explicit(A--B--C--A))) + } else if(directed & n==3){ + return(list(`003` = mutate_nodes(create_empty(3, directed = TRUE), + names = c("A","B","C")), + `012` = create_explicit(A-+B, C), + `102` = create_explicit(A++B, C), + `021D` = create_explicit(A-+B, A-+C), + `021U` = create_explicit(A+-B, A+-C), + `021C` = create_explicit(A-+B, B-+C), + `111D` = create_explicit(A++B, C-+B), + `111U` = create_explicit(A++B, B-+C), + `030T` = create_explicit(A-+B, A-+C, B-+C), + `030C` = create_explicit(A-+B, B-+C, C-+A), + `201` = create_explicit(A++B, B++C), + `120D` = create_explicit(A++B, C-+A:B), + `120U` = create_explicit(A++B, A:B-+C), + `120C` = create_explicit(A++B, A-+C-+B), + `210` = create_explicit(A++B, B++C, A-+C), + `300` = create_explicit(A++B++C++A))) + } else if(!directed & n==4){ + return(list(E4 = mutate_nodes(create_empty(4), + name = c("A","B","C","D")), + I4 = create_explicit(A--B, C, D), + H4 = create_explicit(A--B, C--D), + L4 = create_explicit(A--B--C, D), + D4 = create_explicit(A--B--C--A, D), + U4 = create_explicit(A--B--C--D), + Y4 = create_explicit(A--B--C, B--D), + P4 = create_explicit(A--B--C, B--D--C), + C4 = create_explicit(A--B--C--D--A), + Z4 = create_explicit(A--B--C--D--A--C), + X4 = create_explicit(A--B--C--D--A--C, B--D))) + } else + cli::cli_alert_warning("Motifs not yet available for that kind of network.") +} + + # Defined #### #' Making networks with defined structures diff --git a/R/manynet-utils.R b/R/manynet-utils.R index 51cdcedb..bd146c06 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", "from", "to", "name")) +utils::globalVariables(c(".data", "obs", "from", "to", "name", "A","B","C","D")) # Helper function for declaring available methods available_methods <- function(fun_vctr) { @@ -41,6 +41,10 @@ thisRequiresBio <- function(pkgname) { patchwork::wrap_plots(e1, e2, ...) } +seq_nodes <- function(.data){ + seq.int(net_nodes(.data)) +} + # #' @export # `%||%` <- function(x, y) { # if (is_null(x)) y else x diff --git a/R/zzz.R b/R/zzz.R index 024c6ce8..c7f99bb7 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -59,7 +59,7 @@ mnet_info <- function(...){ mnet_unavailable <- function(...){ if(getOption("manynet_verbosity", default = "quiet")!="quiet") - cli::cli_alert_warning(paste(..., + cli::cli_abort(paste(..., "If you are interested in this feature,", "please vote for it or raise it as an issue at", "{.url https://github.com/stocnet/manynet/issues}.")) diff --git a/man/make_cran.Rd b/man/make_cran.Rd index 4e19885d..b49d70b3 100644 --- a/man/make_cran.Rd +++ b/man/make_cran.Rd @@ -48,6 +48,7 @@ Other makes: \code{\link{make_ego}}, \code{\link{make_explicit}}, \code{\link{make_learning}}, +\code{\link{make_motifs}}, \code{\link{make_play}}, \code{\link{make_random}}, \code{\link{make_read}}, diff --git a/man/make_create.Rd b/man/make_create.Rd index bde76b01..dd7741bd 100644 --- a/man/make_create.Rd +++ b/man/make_create.Rd @@ -150,6 +150,7 @@ Other makes: \code{\link{make_ego}}, \code{\link{make_explicit}}, \code{\link{make_learning}}, +\code{\link{make_motifs}}, \code{\link{make_play}}, \code{\link{make_random}}, \code{\link{make_read}}, diff --git a/man/make_ego.Rd b/man/make_ego.Rd index a71c18f3..e37ac759 100644 --- a/man/make_ego.Rd +++ b/man/make_ego.Rd @@ -36,6 +36,7 @@ Other makes: \code{\link{make_create}}, \code{\link{make_explicit}}, \code{\link{make_learning}}, +\code{\link{make_motifs}}, \code{\link{make_play}}, \code{\link{make_random}}, \code{\link{make_read}}, diff --git a/man/make_explicit.Rd b/man/make_explicit.Rd index 090ad7b0..aec4bd71 100644 --- a/man/make_explicit.Rd +++ b/man/make_explicit.Rd @@ -34,6 +34,7 @@ Other makes: \code{\link{make_create}}, \code{\link{make_ego}}, \code{\link{make_learning}}, +\code{\link{make_motifs}}, \code{\link{make_play}}, \code{\link{make_random}}, \code{\link{make_read}}, diff --git a/man/make_learning.Rd b/man/make_learning.Rd index 896392f3..11566d1a 100644 --- a/man/make_learning.Rd +++ b/man/make_learning.Rd @@ -85,6 +85,7 @@ Other makes: \code{\link{make_create}}, \code{\link{make_ego}}, \code{\link{make_explicit}}, +\code{\link{make_motifs}}, \code{\link{make_play}}, \code{\link{make_random}}, \code{\link{make_read}}, diff --git a/man/make_motifs.Rd b/man/make_motifs.Rd new file mode 100644 index 00000000..cc81a3ec --- /dev/null +++ b/man/make_motifs.Rd @@ -0,0 +1,45 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/make_create.R +\name{make_motifs} +\alias{make_motifs} +\alias{create_motifs} +\title{Making motifs} +\usage{ +create_motifs(n, directed = FALSE) +} +\arguments{ +\item{n}{Given: +\itemize{ +\item A single integer, e.g. \code{n = 10}, +a one-mode network will be created. +\item A vector of two integers, e.g. \code{n = c(5,10)}, +a two-mode network will be created. +\item A manynet-compatible object, +a network of the same dimensions will be created. +}} + +\item{directed}{Logical whether the graph should be directed. +By default \code{directed = FALSE}. +If the opposite direction is desired, +use \code{to_redirected()} on the output of these functions.} +} +\description{ +\code{create_motifs()} is used to create a list of networks that represent the +subgraphs or motifs corresponding to a certain number of nodes and direction. +Note that currently only \code{n==2} to \code{n==4} is implemented, +and the latter only for undirected networks. +} +\seealso{ +Other makes: +\code{\link{make_cran}}, +\code{\link{make_create}}, +\code{\link{make_ego}}, +\code{\link{make_explicit}}, +\code{\link{make_learning}}, +\code{\link{make_play}}, +\code{\link{make_random}}, +\code{\link{make_read}}, +\code{\link{make_stochastic}}, +\code{\link{make_write}} +} +\concept{makes} diff --git a/man/make_play.Rd b/man/make_play.Rd index 3324672d..8c3119a1 100644 --- a/man/make_play.Rd +++ b/man/make_play.Rd @@ -211,6 +211,7 @@ Other makes: \code{\link{make_ego}}, \code{\link{make_explicit}}, \code{\link{make_learning}}, +\code{\link{make_motifs}}, \code{\link{make_random}}, \code{\link{make_read}}, \code{\link{make_stochastic}}, diff --git a/man/make_random.Rd b/man/make_random.Rd index b79076b8..cb144dfb 100644 --- a/man/make_random.Rd +++ b/man/make_random.Rd @@ -125,6 +125,7 @@ Other makes: \code{\link{make_ego}}, \code{\link{make_explicit}}, \code{\link{make_learning}}, +\code{\link{make_motifs}}, \code{\link{make_play}}, \code{\link{make_read}}, \code{\link{make_stochastic}}, diff --git a/man/make_read.Rd b/man/make_read.Rd index 4718f899..6f7fe770 100644 --- a/man/make_read.Rd +++ b/man/make_read.Rd @@ -105,6 +105,7 @@ Other makes: \code{\link{make_ego}}, \code{\link{make_explicit}}, \code{\link{make_learning}}, +\code{\link{make_motifs}}, \code{\link{make_play}}, \code{\link{make_random}}, \code{\link{make_stochastic}}, diff --git a/man/make_stochastic.Rd b/man/make_stochastic.Rd index ad048551..f2006a85 100644 --- a/man/make_stochastic.Rd +++ b/man/make_stochastic.Rd @@ -130,6 +130,7 @@ Other makes: \code{\link{make_ego}}, \code{\link{make_explicit}}, \code{\link{make_learning}}, +\code{\link{make_motifs}}, \code{\link{make_play}}, \code{\link{make_random}}, \code{\link{make_read}}, diff --git a/man/make_write.Rd b/man/make_write.Rd index 5d7de86d..40f9d8b4 100644 --- a/man/make_write.Rd +++ b/man/make_write.Rd @@ -80,6 +80,7 @@ Other makes: \code{\link{make_ego}}, \code{\link{make_explicit}}, \code{\link{make_learning}}, +\code{\link{make_motifs}}, \code{\link{make_play}}, \code{\link{make_random}}, \code{\link{make_read}}, diff --git a/man/motif_node.Rd b/man/motif_node.Rd index 1dd64d75..751c3894 100644 --- a/man/motif_node.Rd +++ b/man/motif_node.Rd @@ -50,8 +50,8 @@ task_eg <- to_named(to_uniplex(ison_algebra, "tasks")) node_by_dyad(ison_networkers) (triad_cen <- node_by_triad(task_eg)) node_by_quad(ison_southern_women) -node_by_path(manynet::ison_adolescents) -node_by_path(manynet::ison_southern_women) +node_by_path(ison_adolescents) +node_by_path(ison_southern_women) } \references{ Davis, James A., and Samuel Leinhardt. 1967. diff --git a/pkgdown/_pkgdown.yml b/pkgdown/_pkgdown.yml index 7da4f5b2..55b0b17b 100644 --- a/pkgdown/_pkgdown.yml +++ b/pkgdown/_pkgdown.yml @@ -54,6 +54,7 @@ reference: contents: - make_explicit - make_ego + - make_motifs - make_create - starts_with("generate_") - subtitle: "Playing" diff --git a/tests/testthat/test-motif_census.R b/tests/testthat/test-motif_census.R index 40939815..26b05bfe 100644 --- a/tests/testthat/test-motif_census.R +++ b/tests/testthat/test-motif_census.R @@ -21,8 +21,6 @@ test_that("net_dyad census works", { expect_equal(test[[2]], 18) expect_equal(names(test), c("Mutual", "Null")) expect_s3_class(test, "network_motif") - # Error - expect_error(net_by_dyad(ison_southern_women)) }) test <- net_by_triad(ison_adolescents) From 92f79700abedccdb34f5ae22af7b53c8b39ee7dc Mon Sep 17 00:00:00 2001 From: James Hollway Date: Fri, 27 Sep 2024 17:04:18 +0200 Subject: [PATCH 43/46] Added plot methods for network_motif and node_motif classes --- NAMESPACE | 3 +++ R/class_motifs.R | 32 ++++++++++++++++++++++++++++++++ 2 files changed, 35 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index 7fb0c227..bb376eaf 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -138,8 +138,10 @@ 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) @@ -522,6 +524,7 @@ export(node_brokering) export(node_brokering_activity) export(node_brokering_exclusivity) export(node_by_brokerage) +export(node_by_dyad) export(node_by_exposure) export(node_by_path) export(node_by_quad) diff --git a/R/class_motifs.R b/R/class_motifs.R index 8ae07863..12e68465 100644 --- a/R/class_motifs.R +++ b/R/class_motifs.R @@ -32,6 +32,38 @@ 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 mnet_unavailable("Cannot plot these motifs yet, sorry.") +} + +#' @export +plot.network_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 mnet_unavailable("Cannot plot these motifs yet, sorry.") +} + # summary(node_by_triad(mpn_elite_mex), # membership = node_regular_equivalence(mpn_elite_mex, "elbow")) #' @export From 2e457d44a8d67fcc0fbc5df164400fa079dd6bd6 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Fri, 27 Sep 2024 17:28:15 +0200 Subject: [PATCH 44/46] #minor bump and filled in the NEWS --- DESCRIPTION | 4 ++-- NEWS.md | 58 +++++++++++++++++++++++++++++++++++++++++++++++++++++ R/zzz.R | 2 ++ 3 files changed, 62 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index a9adad65..10c109d9 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.1.1 -Date: 2024-09-20 +Version: 1.2.0 +Date: 2024-09-27 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 c97b433b..361946e0 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,61 @@ +# manynet 1.2.0 + +## Package + +- Added progress updates, information, and unavailability errors to several functions + - These can be silenced by setting `options(manynet_verbosity ="quiet")` + - Where a feature is unavailable, users are directed to the Github issues page +- Added console theme to color the startup and various warning or info messages + +## Making + +- Added `create_ego()` for collecting ego networks through interviews, including arguments for: + - Indicating whether a roster should be used, otherwise follows a name generator approach + - Indicating whether nodes should be interpreted, i.e. nodal attributes collected + - Indicating whether ties between alters should be requested +- Added `create_motifs()` for creating networks that correspond to the isomorphic subgraphs of certain size and format + +## Modifying + +- Improved `print.mnet()` + - Prints multiplex types if available + - Prints both nodesets for two-mode networks +- Added `add_info()` for adding grand info to tidygraph objects + - This includes the name of the network, node sets and ties, DOI, year and mode of collection +- Fixed `to_unweighted()` so that it passes through unweighted networks correctly + +## Mapping + +- Added `set_manynet_theme()` to set theme (re #60), but not yet fully implemented + +## Marking + +- Improved `is_multiplex()` to ignore "name" tie attributes + +## Measuring + +- Added `node_authority()` and `node_hub()` centrality measures +- Added `node_equivalency()` for calculating four-cycle closure by node +- Extended `net_equivalency()` to one-mode networks + +## Members + +- Fixed `node_in_equivalence()` to use census directly + +## Motifs + +- Added plot methods for network_motif and node_motif classes that use `create_motifs()` +- Added `node_by_dyad()` for node level dyad census +- Added `net_by_quad()` for network level quad census +- Improved `node_by_quad()` to avoid `{oaqc}` dependency, more flexible but slower +- Fixed `print.node_motif()` to convert to tibble and add modes and names where available only upon print + - The underlying object is still a matrix, used for equivalence and blockmodelling + +## Data + +- Updated `ison_southern_women` with grand info +- Updated `ison_laterals` with reordered nodes + # manynet 1.1.0 ## Package diff --git a/R/zzz.R b/R/zzz.R index c7f99bb7..9a048c47 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -5,6 +5,7 @@ if (!interactive()) return() options(manynet_verbosity = getOption("manynet_verbosity", "verbose")) + # options(manynet_theme = getOption("manynet_theme", "default")) options(cli.theme = manynet_console_theme()) # pkgs <- as.data.frame(utils::available.packages(utils::contrib.url(getOption("repos")))) @@ -22,6 +23,7 @@ "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" = "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')`", "i" = "Visit the website to learn more: {.url https://stocnet.github.io/manynet/}.", "i" = "We recommend the 'Function Overview' page online to discover new analytic opportunities: {.url https://stocnet.github.io/manynet/reference/index.html}.", From 0fcc65e2942fd8ca0a82b029fed4f33cca3bf0e9 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Sat, 28 Sep 2024 18:35:34 +0200 Subject: [PATCH 45/46] Attempt to fix pushrelease.yaml --- .github/workflows/pushrelease.yml | 30 ++++++++++++------------------ DESCRIPTION | 2 +- NEWS.md | 2 +- 3 files changed, 14 insertions(+), 20 deletions(-) diff --git a/.github/workflows/pushrelease.yml b/.github/workflows/pushrelease.yml index 9e92356b..cee4b41a 100644 --- a/.github/workflows/pushrelease.yml +++ b/.github/workflows/pushrelease.yml @@ -61,18 +61,20 @@ jobs: path: build/ - name: Calculate code coverage + if: runner.os == 'macOS-latest' run: Rscript -e "covr::codecov()" release: name: Bump version and release if: ${{ always() }} needs: build + if: github.event.pull_request.merged == true runs-on: ubuntu-latest permissions: contents: write steps: - name: Checkout one - uses: actions/checkout@master + uses: actions/checkout@v4 with: fetch-depth: '0' - name: Bump version and push tag @@ -84,24 +86,16 @@ jobs: DEFAULT_BUMP: patch RELEASE_BRANCHES: main - name: Checkout two - uses: actions/checkout@v2 - - name: Create Release - id: create_release - uses: actions/create-release@v1 - env: - GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} - with: - tag_name: ${{ steps.newtag.outputs.tag }} - release_name: Release ${{ steps.newtag.outputs.tag }} - draft: false - prerelease: false + uses: actions/checkout@v4 + + - name: Extract version + run: | + echo "PACKAGE_VERSION=$(grep '^Version' DESCRIPTION | sed 's/.*: *//')" >> $GITHUB_ENV + echo "PACKAGE_NAME=$(grep '^Package' DESCRIPTION | sed 's/.*: *//')" >> $GITHUB_ENV - name: Download binaries uses: actions/download-artifact@v4 - - name: Display structure of downloaded files - run: ls -R - - name: Rename binaries release shell: bash run: | @@ -111,9 +105,9 @@ jobs: cp ./winOS/${{ env.PACKAGE_NAME }}_${{ env.PACKAGE_VERSION }}*.zip . echo "Renamed files" ls manynet_* - + - name: Create Release and Upload Assets - id: upload_release + id: create_release uses: softprops/action-gh-release@v2 with: tag_name: ${{ steps.newtag.outputs.tag }} @@ -127,7 +121,7 @@ jobs: manynet_*.tar.gz manynet_*.zip env: - GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} + GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} pkgdown: name: Build and deploy website diff --git a/DESCRIPTION b/DESCRIPTION index 10c109d9..b17a0e9f 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.0 -Date: 2024-09-27 +Date: 2024-09-28 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 361946e0..89554636 100644 --- a/NEWS.md +++ b/NEWS.md @@ -47,7 +47,7 @@ - Added plot methods for network_motif and node_motif classes that use `create_motifs()` - Added `node_by_dyad()` for node level dyad census - Added `net_by_quad()` for network level quad census -- Improved `node_by_quad()` to avoid `{oaqc}` dependency, more flexible but slower +- Fixed `node_by_quad()` to avoid `{oaqc}` dependency (#89), more flexible but slower - Fixed `print.node_motif()` to convert to tibble and add modes and names where available only upon print - The underlying object is still a matrix, used for equivalence and blockmodelling From ffd2fd0b3e9a1dfbf0174825bf9d2724c96be9cb Mon Sep 17 00:00:00 2001 From: James Hollway Date: Sun, 29 Sep 2024 10:00:25 +0200 Subject: [PATCH 46/46] Updated CRAN comments --- cran-comments.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/cran-comments.md b/cran-comments.md index 732539ec..2e6e0b1f 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -8,3 +8,5 @@ ## R CMD check results 0 errors | 0 warnings | 0 notes + +* This version fixes errors on Linux versions for which the {oaqc} package is not available \ No newline at end of file