From 175c3cc73161e40af41a32c19b1d1acafbc16217 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Sun, 30 Aug 2026 15:21:47 +0200 Subject: [PATCH 01/14] Fixed the print header naming only the first of three or more modes `describe_nodes()` gave every node the first mode's name, because `ifelse()` returns as many values as its first argument holds. `mode_nodes()` also counted the whole network as one mode, unless the network was two-mode, and `net_modes()` read no more than two modes from an igraph 'lvl' attribute. Each mode now carries its own count and name. Closes #174 Co-Authored-By: Claude Opus 5 --- DESCRIPTION | 2 +- NEWS.md | 13 ++++++++++ R/class_describe.R | 12 +++++++-- R/measure_properties.R | 34 ++++++++++++++++++++++--- man/measure_dims.Rd | 4 +-- tests/testthat/test-functional_prints.R | 23 +++++++++++++++++ 6 files changed, 79 insertions(+), 9 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index f801baa0..519a4b98 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: manynet Title: Many Ways to Make, Manipulate, and Modify Myriad Networks -Version: 2.3.1 +Version: 2.3.2 Description: Many tools for making, manipulating, and modifying many different types of networks. All functions operate with matrices, edge lists, and 'igraph', 'network', and 'tidygraph' objects, on directed, multiplex, multimodal, signed, and other networks. diff --git a/NEWS.md b/NEWS.md index 10dc5ff4..ba269f68 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,16 @@ +# manynet 2.3.2 + +## Classes + +- Improved `describe_nodes()` on networks of three or more modes (closed #174) + - Names each mode instead of naming every node after the first mode + - Reports a node count for each mode, not one count for the whole network + +## Measuring + +- Improved `mode_nodes()` to count the nodes in each of three or more modes +- Improved `net_modes()` to count the levels an igraph 'lvl' attribute records + # manynet 2.3.1 ## Marking diff --git a/R/class_describe.R b/R/class_describe.R index 9b51f582..a757dca7 100644 --- a/R/class_describe.R +++ b/R/class_describe.R @@ -91,8 +91,16 @@ describe_network <- function(.data) { describe_nodes <- function(.data){ nd <- mode_nodes(.data) nn <- mode_names(.data) - if(is.null(nn)) nn <- "nodes" - nn <- ifelse(nd==1, singularize(nn), pluralize(nn)) + # A network that names its modes gives one name for each count. Where it + # names fewer or more than it counts, no name can be matched to a count + # with confidence, so every mode is described by the general word instead. + if(is.null(nn) || length(nn) != length(nd)) nn <- rep("nodes", length(nd)) + # `ifelse()` returns as many values as its first argument holds, so it + # would report only the first name where there are three or more modes. + nn <- vapply(seq_along(nd), + function(i) if(nd[i] == 1) singularize(nn[i]) else + pluralize(nn[i]), + character(1)) node_name <- paste(nd, nn) phrase(node_name) } diff --git a/R/measure_properties.R b/R/measure_properties.R index 321c42f3..96d690c2 100644 --- a/R/measure_properties.R +++ b/R/measure_properties.R @@ -23,8 +23,8 @@ #' @return `net_*()` functions always relate to the overall graph or network, #' usually returning a scalar. #' `mode_nodes()` returns an integer of the number of nodes in a one-mode network, -#' or two integers representing the number of nodes in each nodeset -#' in the case of a two-mode network. +#' or one integer per mode (in `mode_names()` order) in the case of a +#' two-mode, three-mode, or other multimodal network. #' `layer_ties()` returns an integer of the number of ties in a single-layer #' network, or one integer per layer (in `layer_names()` order) #' in the case of a multiplex network. @@ -96,6 +96,11 @@ net_modes.stocnet <- function(.data){ #' @export net_modes.igraph <- function(.data){ + # `to_multilevel()` records the modes in a 'lvl' attribute and deletes + # 'type', so a network converted that way, which may hold more than two + # modes, is counted by its levels instead. + if("lvl" %in% igraph::vertex_attr_names(.data)) + return(length(unique(igraph::vertex_attr(.data, "lvl")))) if(is_twomode(.data)) 2L else 1L } @@ -276,6 +281,10 @@ mode_nodes.igraph <- function(.data){ if(is_twomode(.data)){ c(sum(!igraph::V(.data)$type), sum(igraph::V(.data)$type)) + } else if("lvl" %in% igraph::vertex_attr_names(.data)){ + # A 'lvl' attribute can name more than the two modes a 'type' attribute + # can, so each of its levels is counted here. + .count_modes(igraph::vertex_attr(.data, "lvl"), mode_names(.data)) } else { igraph::vcount(.data) } @@ -295,11 +304,28 @@ mode_nodes.network <- function(.data){ #' @export mode_nodes.stocnet <- function(.data){ - if(is_twomode(.data)){ - out <- tabulate(match(.data$nodes$mode, unique(.data$nodes$mode))) + # A 'stocnet' holds its modes in the 'mode' variable of its nodes table, + # which can name three or more modes, so every mode is counted and not + # only the two a two-mode network holds. + if(net_modes(.data) > 1){ + .count_modes(.data$nodes$mode, mode_names(.data)) } else net_nodes(.data) } +# The number of nodes in each mode, given the mode of each node. +# The counts are returned in the order `mode_names()` names the modes, +# so that each count is reported under its own name. +.count_modes <- function(modes, nms = NULL){ + lvls <- unique(modes) + # A mode recorded as a number, such as the 'lvl' attribute holds, is + # ordered by its value, since the names are given in that order. A mode + # recorded by its name is matched to the names where every name matches, + # and is otherwise ordered by where it first appears. + if(!is.character(lvls)) lvls <- sort(lvls) else + if(!is.null(nms) && setequal(nms, lvls)) lvls <- nms + as.integer(tabulate(match(modes, lvls), nbins = length(lvls))) +} + #' @rdname measure_dims #' @export net_dims <- mode_nodes diff --git a/man/measure_dims.Rd b/man/measure_dims.Rd index 682aed59..163bcd84 100644 --- a/man/measure_dims.Rd +++ b/man/measure_dims.Rd @@ -46,8 +46,8 @@ net_dims(.data) \verb{net_*()} functions always relate to the overall graph or network, usually returning a scalar. \code{mode_nodes()} returns an integer of the number of nodes in a one-mode network, -or two integers representing the number of nodes in each nodeset -in the case of a two-mode network. +or one integer per mode (in \code{mode_names()} order) in the case of a +two-mode, three-mode, or other multimodal network. \code{layer_ties()} returns an integer of the number of ties in a single-layer network, or one integer per layer (in \code{layer_names()} order) in the case of a multiplex network. diff --git a/tests/testthat/test-functional_prints.R b/tests/testthat/test-functional_prints.R index d9ca24c1..0fc3faf0 100644 --- a/tests/testthat/test-functional_prints.R +++ b/tests/testthat/test-functional_prints.R @@ -48,6 +48,29 @@ test_that("print.stocnet() prints stocnet objects", { expect_no_error(expect_prints(as_stocnet(ison_southern_women), "stocnet")) }) +test_that("describe_nodes() names every mode of a three-mode network", { + # A 'stocnet' holds its modes in 'mode', which can name three or more, + # and each of them is counted and named, see #174. + three <- as_stocnet(fict_marvel) + three$nodes$mode[1:5] <- "third" + three$info$modes <- NULL + expect_length(as.numeric(mode_nodes(three)), 3) + expect_equal(sum(as.numeric(mode_nodes(three))), + as.numeric(net_nodes(three))) + desc <- describe_nodes(three) + for (nm in mode_names(three)) + expect_match(desc, nm) + # An igraph records more than two modes in 'lvl' rather than in 'type'. + levelled <- to_multilevel(as_igraph(fict_marvel)) + levelled <- igraph::set_vertex_attr(levelled, "lvl", + index = 1:5, value = 3) + levelled <- igraph::set_graph_attr(levelled, "modes", + c("hero", "team", "third")) + expect_equal(as.numeric(net_modes(levelled)), 3) + expect_length(as.numeric(mode_nodes(levelled)), 3) + expect_match(describe_nodes(levelled), "third") +}) + test_that("describe_*() helpers return informative strings", { for (d in list(ison_adolescents, ison_southern_women, ison_algebra, fict_starwars)) { From f612908fbd37b6bab6dcf8c68c4aa88d92716141 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Sun, 30 Aug 2026 18:08:58 +0200 Subject: [PATCH 02/14] Added a NEWS convention on naming a generic or one of its methods Co-Authored-By: Claude Opus 5 --- .github/CONTRIBUTING.md | 6 ++++++ NEWS.md | 6 ++---- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/.github/CONTRIBUTING.md b/.github/CONTRIBUTING.md index ebb7700b..0dcbae37 100644 --- a/.github/CONTRIBUTING.md +++ b/.github/CONTRIBUTING.md @@ -362,6 +362,12 @@ Start each bullet with a verb matching the change type: Any of these verbs can also lead a sub-bullet. +Name a function by the generic, e.g. `net_modes()`, where the change reaches +every class it dispatches on. +Where it reaches only one method, spell that method out in full, +e.g. `net_modes.igraph()`, +so that a reader knows which classes the change applies to. + Keep every bullet to one line of fewer than 81 characters ideally (a few more or less is fine). If a bullet wraps, it holds too much: shorten it, or split it into a lead bullet and sub-bullets. diff --git a/NEWS.md b/NEWS.md index ba269f68..a008b796 100644 --- a/NEWS.md +++ b/NEWS.md @@ -3,13 +3,11 @@ ## Classes - Improved `describe_nodes()` on networks of three or more modes (closed #174) - - Names each mode instead of naming every node after the first mode - - Reports a node count for each mode, not one count for the whole network ## Measuring -- Improved `mode_nodes()` to count the nodes in each of three or more modes -- Improved `net_modes()` to count the levels an igraph 'lvl' attribute records +- Fixed `mode_nodes()` to count the nodes in each of three or more modes +- Fixed `net_modes.igraph()` to count the levels an igraph 'lvl' attribute records # manynet 2.3.1 From cb62e6474baea646ea3f4e88f87f13f4a9bec302 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Mon, 31 Aug 2026 12:25:45 +0200 Subject: [PATCH 03/14] Added `layer_is_directed()` --- NAMESPACE | 4 +++ NEWS.md | 6 +++++ R/mark_format.R | 22 +++++++++++++--- R/measure_properties.R | 49 +++++++++++++++++++++++++++++++++++ man/mark_format_tie.Rd | 23 +++++++++++----- man/member_names.Rd | 20 ++++++++++++++ tests/testthat/test-mark_is.R | 43 ++++++++++++++++++++++++++++++ 7 files changed, 156 insertions(+), 11 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 776e3cb1..99c32c86 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -301,6 +301,9 @@ S3method(is_weighted,tbl_graph) S3method(join_nodes,default) S3method(join_nodes,igraph) S3method(join_nodes,stocnet) +S3method(layer_is_directed,default) +S3method(layer_is_directed,igraph) +S3method(layer_is_directed,stocnet) S3method(layer_names,default) S3method(layer_names,igraph) S3method(layer_names,stocnet) @@ -751,6 +754,7 @@ export(is_uniplex) export(is_weighted) export(join_nodes) export(join_ties) +export(layer_is_directed) export(layer_names) export(layer_ties) export(make_stocnet) diff --git a/NEWS.md b/NEWS.md index a008b796..1996e253 100644 --- a/NEWS.md +++ b/NEWS.md @@ -4,6 +4,12 @@ - Improved `describe_nodes()` on networks of three or more modes (closed #174) +## Marking + +- Improved `is_directed()` on a network tied within a level as well as between +- Fixed `is_multilevel.igraph()` looping through `tie_is_twomode()` +- Added `layer_is_directed()`, reporting each layer of a network (closed #171) + ## Measuring - Fixed `mode_nodes()` to count the nodes in each of three or more modes diff --git a/R/mark_format.R b/R/mark_format.R index 5c09b42c..7a3d735b 100644 --- a/R/mark_format.R +++ b/R/mark_format.R @@ -121,7 +121,13 @@ is_multilevel.igraph <- function(.data) { # network without any ties is neither, and is returned early because # `tie_is_twomode()` cannot name an empty measure. if (net_ties(.data) == 0) return(FALSE) - between <- tie_is_twomode(.data) + # `tie_is_twomode()` would name its result through `make_tie_mark()`, which + # asks `is_directed()`, which asks this function: the same loop that + # `node_is_mode()` notes. The modes of the two ends of each tie are read + # directly instead, as `is_multilevel.stocnet()` reads them. + modes <- igraph::vertex_attr(.data, "type") + el <- igraph::as_edgelist(.data, names = FALSE) + between <- modes[el[, 1]] != modes[el[, 2]] any(between) && any(!between) } @@ -377,19 +383,27 @@ is_directed.data.frame <- function(.data) { .infer_net_reciprocity(.data) == 1) } +# A single bipartite relation runs between the modes and has no direction to +# report, but a multilevel network also ties within a level, and those ties can +# be directed. Such a network is therefore exempt from the two-mode rule, and +# is marked by whatever its underlying object or its info records. +.twomode_undirected <- function(.data) { + is_twomode(.data) && !is_multilevel(.data) +} + #' @export is_directed.igraph <- function(.data) { - if(is_twomode(.data)) FALSE else igraph::is_directed(.data) + if(.twomode_undirected(.data)) FALSE else igraph::is_directed(.data) } #' @export is_directed.stocnet <- function(.data) { - if(is_twomode(.data)) FALSE else any(.data$info$directed) + if(.twomode_undirected(.data)) FALSE else any(.data$info$directed) } #' @export is_directed.tbl_graph <- function(.data) { - if(is_twomode(.data)) FALSE else igraph::is_directed(.data) + if(.twomode_undirected(.data)) FALSE else igraph::is_directed(.data) } #' @export diff --git a/R/measure_properties.R b/R/measure_properties.R index 96d690c2..1ee56737 100644 --- a/R/measure_properties.R +++ b/R/measure_properties.R @@ -343,6 +343,8 @@ net_dims <- mode_nodes #' - `net_node_attributes()` returns a vector of nodal attributes in a network. #' - `layer_names()` returns a vector of the names of the layers in a network, #' if they have been defined. +#' - `layer_is_directed()` returns whether each layer of a network is +#' directed, named by layer. #' - `net_tie_attributes()` returns a vector of tie attributes in a network. #' #' These functions are also often used as helpers within other functions. @@ -488,6 +490,53 @@ layer_names.stocnet <- function(.data){ .data$info$layers %||% unique(.data$ties[["layer"]]) } +#' @rdname member_names +#' @param layer An optional character string naming one of the layers, +#' one of those returned by `layer_names()`. +#' Where a layer is named, a single value is returned for that layer; +#' otherwise a value is returned for every layer, named by layer. +#' @details +#' A network can be directed in one layer and undirected in another, +#' as a network of interstate trade and of state membership in +#' intergovernmental organisations is. +#' `is_directed()` marks such a network TRUE, since it holds arcs, +#' and `layer_is_directed()` says which of its layers those arcs are in. +#' Where a network records nothing about a layer, +#' the network's own direction is reported for it. +#' @examples +#' layer_is_directed(ison_algebra) +#' @export +layer_is_directed <- function(.data, layer = NULL) UseMethod("layer_is_directed") + +#' @export +layer_is_directed.default <- function(.data, layer = NULL){ + layer_is_directed(as_igraph(.data), layer = layer) +} + +#' @export +layer_is_directed.igraph <- function(.data, layer = NULL){ + .layers_directed(igraph::graph_attr(.data, "directed"), .data, layer) +} + +#' @export +layer_is_directed.stocnet <- function(.data, layer = NULL){ + .layers_directed(.data$info$directed, .data, layer) +} + +# A network records the direction of each of its layers in a logical vector +# named by layer. Where it records none, or none for the layer asked about, +# the direction of the network as a whole is the best answer available. +.layers_directed <- function(directed, .data, layer = NULL){ + if(is.null(names(directed))) directed <- NULL + known <- function(l) if(!is.null(directed) && !is.na(l) && + l %in% names(directed)) + unname(directed[[l]]) else is_directed(.data) + if(!is.null(layer)) return(vapply(layer, known, logical(1), USE.NAMES = FALSE)) + layers <- layer_names(.data) + if(is.null(layers) || length(layers) == 0) return(is_directed(.data)) + stats::setNames(vapply(layers, known, logical(1), USE.NAMES = FALSE), layers) +} + #' @rdname member_names #' @importFrom igraph edge_attr_names #' @examples diff --git a/man/mark_format_tie.Rd b/man/mark_format_tie.Rd index 71b367b4..c9baa49c 100644 --- a/man/mark_format_tie.Rd +++ b/man/mark_format_tie.Rd @@ -65,13 +65,22 @@ sender and receiver. Not all functions have methods available for all object classes. Below are the currently implemented S3 methods for these functions: -\if{html}{\out{
}}\preformatted{ data.frame default igraph list matrix network stocnet tbl_graph -is_complex * * * * * * * * -is_directed * * * * * * * -is_multiplex * * * * * * * -is_signed * * * * * * * -is_uniplex * * -is_weighted * * * * * * * +\if{html}{\out{
}}\preformatted{ data.frame default igraph list matrix network stocnet +is_complex * * * * * * * +is_directed * * * * * * +is_multiplex * * * * * * +is_signed * * * * * * +is_uniplex * * +is_weighted * * * * * * +layer_is_directed * * * + tbl_graph +is_complex * +is_directed * +is_multiplex * +is_signed * +is_uniplex +is_weighted * +layer_is_directed }\if{html}{\out{
}} If a method is not available for a particular class, but a default method is, diff --git a/man/member_names.Rd b/man/member_names.Rd index b8caa7bc..1fdadf65 100644 --- a/man/member_names.Rd +++ b/man/member_names.Rd @@ -6,6 +6,7 @@ \alias{mode_names} \alias{net_node_attributes} \alias{layer_names} +\alias{layer_is_directed} \alias{net_tie_attributes} \title{Describing network names} \usage{ @@ -17,6 +18,8 @@ net_node_attributes(.data) layer_names(.data) +layer_is_directed(.data, layer = NULL) + net_tie_attributes(.data) } \arguments{ @@ -31,6 +34,11 @@ net_tie_attributes(.data) }} \item{prefix}{An optional string to be added before the name of the network.} + +\item{layer}{An optional character string naming one of the layers, +one of those returned by \code{layer_names()}. +Where a layer is named, a single value is returned for that layer; +otherwise a value is returned for every layer, named by layer.} } \value{ \verb{net_*()} functions always relate to the overall graph or network, @@ -47,16 +55,28 @@ if they have been defined. \item \code{net_node_attributes()} returns a vector of nodal attributes in a network. \item \code{layer_names()} returns a vector of the names of the layers in a network, if they have been defined. +\item \code{layer_is_directed()} returns whether each layer of a network is +directed, named by layer. \item \code{net_tie_attributes()} returns a vector of tie attributes in a network. } These functions are also often used as helpers within other functions. } +\details{ +A network can be directed in one layer and undirected in another, +as a network of interstate trade and of state membership in +intergovernmental organisations is. +\code{is_directed()} marks such a network TRUE, since it holds arcs, +and \code{layer_is_directed()} says which of its layers those arcs are in. +Where a network records nothing about a layer, +the network's own direction is reported for it. +} \examples{ net_name(ison_southern_women) mode_names(ison_algebra) net_node_attributes(fict_lotr) layer_names(ison_algebra) + layer_is_directed(ison_algebra) net_tie_attributes(ison_algebra) } \concept{attributes} diff --git a/tests/testthat/test-mark_is.R b/tests/testthat/test-mark_is.R index b30e445d..34441ae3 100644 --- a/tests/testthat/test-mark_is.R +++ b/tests/testthat/test-mark_is.R @@ -84,3 +84,46 @@ test_that("is_longitudinal does not mark a network whose ties carry no moment", expect_true(is_longitudinal(ison_classmates)) expect_true(is_longitudinal(fict_starwars)) }) + +# A network of interstate trade and of state membership in intergovernmental +# organisations: two modes, a directed within-level layer, an undirected +# between-level one. See #170 and #171. +trade_igos <- function(){ + make_stocnet( + info = list(modes = c("states", "IGOs"), + layers = c("trade", "membership"), + directed = c(trade = TRUE, membership = FALSE)), + nodes = tibble::tibble(label = c("a", "b", "x"), + mode = c("states", "states", "IGOs")), + ties = tibble::tibble(from = c(1L, 2L, 1L), to = c(2L, 1L, 3L), + weight = c(5, 9, 1), + layer = c("trade", "trade", "membership")) + ) +} + +test_that("is_directed marks a multilevel network by its layers", { + net <- trade_igos() + # two modes, but tied within a level as well as between + expect_true(is_twomode(net)) + expect_true(is_multilevel(net)) + expect_true(is_directed(net)) + # and the same once coerced + expect_true(is_directed(as_igraph(net))) + expect_true(is_directed(as_tidygraph(net))) + # a network tied only between its modes has no direction to report + expect_false(is_directed(ison_southern_women)) + expect_false(is_directed(as_igraph(ison_southern_women))) +}) + +test_that("layer_is_directed reports each layer of a mixed network", { + net <- trade_igos() + expect_equal(layer_is_directed(net), + c(trade = TRUE, membership = FALSE)) + expect_equal(layer_is_directed(as_igraph(net)), + c(trade = TRUE, membership = FALSE)) + # a single layer can be asked about on its own + expect_true(layer_is_directed(net, "trade")) + expect_false(layer_is_directed(net, "membership")) + # where a network records nothing per layer, it reports its own direction + expect_equal(unname(layer_is_directed(ison_adolescents)), FALSE) +}) From 5620d5b0d349bba4127b6042f718d6fc51266f89 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Mon, 31 Aug 2026 12:27:29 +0200 Subject: [PATCH 04/14] Added three `snet_verbosity` levels, 'quiet', 'normal', and 'verbose' --- NEWS.md | 7 ++ R/class_interface.R | 93 ++++++++++++++++++--------- man/interface.Rd | 42 +++++++++--- man/progress.Rd | 5 +- tests/testthat/test-class_interface.R | 34 ++++++++++ 5 files changed, 141 insertions(+), 40 deletions(-) create mode 100644 tests/testthat/test-class_interface.R diff --git a/NEWS.md b/NEWS.md index 1996e253..8dd380c5 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,12 @@ # manynet 2.3.2 +## Package + +- Added three `snet_verbosity` levels, 'quiet', 'normal', and 'verbose' + - `snet_info()` and `snet_success()` report from 'normal' + - `snet_minor_info()` and the `snet_progress_*()` functions report from 'verbose' +- Improved `snet_warn()` and `snet_unavailable()` so that neither is silenced (closed #169) + ## Classes - Improved `describe_nodes()` on networks of three or more modes (closed #174) diff --git a/R/class_interface.R b/R/class_interface.R index 5477dc2c..575a67fc 100644 --- a/R/class_interface.R +++ b/R/class_interface.R @@ -4,17 +4,36 @@ #' @description #' These functions wrap `{cli}` functions and elements #' to build an attractive command line interface (CLI). +#' They divide into those that change what a function does +#' and those that only report what it did. #' -#' - `snet_info()` for general information messages. -#' - `snet_minor_info()` for minor information messages. -#' - `snet_warn()` for warning messages. -#' - `snet_abort()` for error messages. -#' - `snet_success()` for success messages. -#' - `snet_prompt()` for prompts to the user. -#' - `snet_unavailable()` for features that are not yet available. +#' A call that changes control flow always fires, +#' whatever the verbosity, because silencing it would let the code it guards +#' run on and return a wrong answer instead of an explanation: #' -#' If you wish to receive fewer messages in the console, -#' run `options(snet_verbosity = 'quiet')`. +#' - `snet_abort()` for an error the user has to fix. +#' - `snet_unavailable()` for a feature that is not yet available. +#' - `snet_warn()` for a result the user should not trust without reading, +#' such as a value that is dropped or a name that does not match. +#' +#' A call that only reports is silenced under the default verbosity: +#' +#' - `snet_info()` for what a function chose on the user's behalf. +#' - `snet_success()` for the completion of a long task. +#' - `snet_minor_info()` for detail that is useful only while debugging. +#' - `snet_progress_step()` and the other `snet_progress_*()` functions +#' for a progress bar. +#' +#' `snet_prompt()` asks the user something, so it always shows. +#' @section Verbosity: +#' The `snet_verbosity` option takes three levels: +#' +#' - `'quiet'`, the default, reports nothing that is not an error, +#' a warning, or a prompt. +#' - `'normal'` adds `snet_info()` and `snet_success()`. +#' - `'verbose'` adds `snet_minor_info()` and the progress bars. +#' +#' Set one with, for example, `options(snet_verbosity = 'verbose')`. #' @param ... One or more character strings. #' For most of these functions, if multiple strings are passed these will be #' pasted together. @@ -23,25 +42,37 @@ #' @name interface NULL +# The three verbosity levels, in order, so that a level can be compared with +# the level a message needs. An unrecognised value reads as 'normal', which is +# what every value other than 'quiet' meant before the levels were named. +.snet_levels <- c("quiet", "normal", "verbose") + +.snet_verbose <- function(level = "normal"){ + set <- match(getOption("snet_verbosity", default = "quiet"), .snet_levels) + if(is.na(set)) set <- 2L + set >= match(level, .snet_levels) +} + #' @rdname interface #' @export snet_info <- function(..., .envir = parent.frame()){ - if(getOption("snet_verbosity", default = "quiet")!="quiet") + if(.snet_verbose("normal")) cli::cli_alert_info(paste(...), .envir = .envir) } #' @rdname interface #' @export snet_minor_info <- function(..., .envir = parent.frame()){ - if(getOption("snet_verbosity", default = "quiet")!="quiet") + if(.snet_verbose("verbose")) cli::cli_alert_info(cli::col_grey(paste(...)), .envir = .envir) } #' @rdname interface #' @export snet_warn <- function(..., .envir = parent.frame()){ - if(getOption("snet_verbosity", default = "quiet")!="quiet") - cli::cli_alert_warning(paste(...), .envir = .envir) + # A warning tells the user not to trust a result, so it raises a condition + # they can catch or escalate, and it is not silenced by the verbosity. + cli::cli_warn(paste(...), .envir = .envir) } #' @rdname interface @@ -54,27 +85,30 @@ snet_abort <- function(..., .envir = parent.frame()){ #' @rdname interface #' @export snet_success <- function(..., .envir = parent.frame()){ - if(getOption("snet_verbosity", default = "quiet")!="quiet") + if(.snet_verbose("normal")) cli::cli_alert_success(paste(...), .envir = .envir) } #' @rdname interface #' @export snet_prompt <- function(..., .envir = parent.frame()){ - # if(getOption("snet_verbosity", default = "quiet")!="quiet") - cli::cli_text(cli::style_italic(paste(...)), - .envir = .envir) + cli::cli_text(cli::style_italic(paste(...)), + .envir = .envir) } #' @rdname interface #' @export snet_unavailable <- function(..., .envir = parent.frame()){ - if(getOption("snet_verbosity", default = "quiet")!="quiet") - 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}."), - .envir = .envir) + # The guard has to abort whatever the verbosity, or the code it guards runs + # on and returns a wrong answer. Only the invitation depends on the level. + msg <- paste(...) + if(!nzchar(msg)) msg <- "That is not yet available." + if(.snet_verbose("normal")) + msg <- paste(msg, + "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}.") + cli::cli_abort(msg, .envir = .envir) } # Progress #### @@ -89,8 +123,9 @@ snet_unavailable <- function(..., .envir = parent.frame()){ #' - `snet_progress_seq()` for progress along a sequence. #' - `snet_progress_nodes()` for progress along the nodes of a network. #' -#' If you wish to receive fewer messages in the console, -#' run `options(snet_verbosity = 'quiet')`. +#' A progress bar reports what a function did and not what it decided, +#' so it shows only where `options(snet_verbosity = 'verbose')`. +#' See the verbosity section of [interface]. #' @inheritParams interface #' @template param_data #' @name progress @@ -99,21 +134,21 @@ NULL #' @rdname progress #' @export snet_progress_step <- function(..., .envir = parent.frame()){ - if(getOption("snet_verbosity", default = "quiet")!="quiet") + if(.snet_verbose("verbose")) cli::cli_progress_step(..., .envir = .envir) } #' @rdname progress #' @export snet_progress_along <- function(..., .envir = parent.frame()){ - if(getOption("snet_verbosity", default = "quiet")!="quiet") + if(.snet_verbose("verbose")) cli::cli_progress_along(..., .envir = .envir) } #' @rdname progress #' @export snet_progress_seq <- function(..., .envir = parent.frame()){ - if(getOption("snet_verbosity", default = "quiet")!="quiet") + if(.snet_verbose("verbose")) cli::cli_progress_along(seq.int(...), .envir = .envir, total = ..., clear = TRUE) } @@ -121,7 +156,7 @@ snet_progress_seq <- function(..., .envir = parent.frame()){ #' @rdname progress #' @export snet_progress_nodes <- function(..., .envir = parent.frame()){ - if(getOption("snet_verbosity", default = "quiet")!="quiet" && interactive()){ + if(.snet_verbose("verbose") && interactive()){ cli::cli_progress_along(seq.int(net_nodes(...)), .envir = .envir, total = ..., clear = TRUE) } else seq.int(net_nodes(...)) diff --git a/man/interface.Rd b/man/interface.Rd index b0c9e482..1d3904f0 100644 --- a/man/interface.Rd +++ b/man/interface.Rd @@ -36,16 +36,40 @@ pasted together.} \description{ These functions wrap \code{{cli}} functions and elements to build an attractive command line interface (CLI). +They divide into those that change what a function does +and those that only report what it did. + +A call that changes control flow always fires, +whatever the verbosity, because silencing it would let the code it guards +run on and return a wrong answer instead of an explanation: +\itemize{ +\item \code{snet_abort()} for an error the user has to fix. +\item \code{snet_unavailable()} for a feature that is not yet available. +\item \code{snet_warn()} for a result the user should not trust without reading, +such as a value that is dropped or a name that does not match. +} + +A call that only reports is silenced under the default verbosity: +\itemize{ +\item \code{snet_info()} for what a function chose on the user's behalf. +\item \code{snet_success()} for the completion of a long task. +\item \code{snet_minor_info()} for detail that is useful only while debugging. +\item \code{snet_progress_step()} and the other \verb{snet_progress_*()} functions +for a progress bar. +} + +\code{snet_prompt()} asks the user something, so it always shows. +} +\section{Verbosity}{ + +The \code{snet_verbosity} option takes three levels: \itemize{ -\item \code{snet_info()} for general information messages. -\item \code{snet_minor_info()} for minor information messages. -\item \code{snet_warn()} for warning messages. -\item \code{snet_abort()} for error messages. -\item \code{snet_success()} for success messages. -\item \code{snet_prompt()} for prompts to the user. -\item \code{snet_unavailable()} for features that are not yet available. +\item \code{'quiet'}, the default, reports nothing that is not an error, +a warning, or a prompt. +\item \code{'normal'} adds \code{snet_info()} and \code{snet_success()}. +\item \code{'verbose'} adds \code{snet_minor_info()} and the progress bars. } -If you wish to receive fewer messages in the console, -run \code{options(snet_verbosity = 'quiet')}. +Set one with, for example, \code{options(snet_verbosity = 'verbose')}. } + diff --git a/man/progress.Rd b/man/progress.Rd index f291c36e..b2ffa95b 100644 --- a/man/progress.Rd +++ b/man/progress.Rd @@ -50,6 +50,7 @@ to build an attractive command line interface (CLI). \item \code{snet_progress_nodes()} for progress along the nodes of a network. } -If you wish to receive fewer messages in the console, -run \code{options(snet_verbosity = 'quiet')}. +A progress bar reports what a function did and not what it decided, +so it shows only where \code{options(snet_verbosity = 'verbose')}. +See the verbosity section of \link{interface}. } diff --git a/tests/testthat/test-class_interface.R b/tests/testthat/test-class_interface.R new file mode 100644 index 00000000..9ffc6863 --- /dev/null +++ b/tests/testthat/test-class_interface.R @@ -0,0 +1,34 @@ +# The console interface divides into calls that change what a function does, +# which always fire, and calls that only report, which the verbosity silences. + +test_that("a guard aborts under the default verbosity", { + op <- options(snet_verbosity = "quiet") + on.exit(options(op), add = TRUE) + # it used to return invisibly, letting the code it guards run on + expect_error(snet_unavailable("Not yet."), "Not yet.") + expect_error(snet_abort("No."), "No.") + # a guard given no message still says something + expect_error(snet_unavailable()) +}) + +test_that("a warning raises a condition under the default verbosity", { + op <- options(snet_verbosity = "quiet") + on.exit(options(op), add = TRUE) + expect_warning(snet_warn("Some values were dropped."), "dropped") +}) + +test_that("the verbosity levels order the reports", { + op <- options(snet_verbosity = "quiet") + on.exit(options(op), add = TRUE) + expect_silent(snet_info("chose a default")) + expect_silent(snet_minor_info("a detail")) + expect_silent(snet_success("done")) + + options(snet_verbosity = "normal") + expect_message(snet_info("chose a default"), "default") + expect_message(snet_success("done"), "done") + expect_silent(snet_minor_info("a detail")) + + options(snet_verbosity = "verbose") + expect_message(snet_minor_info("a detail"), "detail") +}) From acf7fd25e2a879adeee1b1de08ecb85e1100bacc Mon Sep 17 00:00:00 2001 From: James Hollway Date: Mon, 31 Aug 2026 12:29:10 +0200 Subject: [PATCH 05/14] Fixed `keep_nodes()` to drop and reindex `$missings` (closed #173) --- NEWS.md | 6 ++++++ R/class_missing.R | 13 +++---------- R/manip_nodes.R | 13 ++++++++++++- 3 files changed, 21 insertions(+), 11 deletions(-) diff --git a/NEWS.md b/NEWS.md index 8dd380c5..6c202782 100644 --- a/NEWS.md +++ b/NEWS.md @@ -10,6 +10,12 @@ ## Classes - Improved `describe_nodes()` on networks of three or more modes (closed #174) +- Fixed `keep_nodes()` to drop and reindex `$missings` (closed #173) + - `reserved_cols()` now names every out-of-range id, instead of erroring + +## Modifying + +- Fixed `to_layer()` pointing arcs at the wrong nodes (closed #170) ## Marking diff --git a/R/class_missing.R b/R/class_missing.R index df341b44..96a38136 100644 --- a/R/class_missing.R +++ b/R/class_missing.R @@ -79,13 +79,6 @@ alters } -# Whether each layer is directed, named by layer. -.layer_directed <- function(.data, layer){ - directed <- .data$info$directed - if(!is.null(directed) && !is.null(names(directed)) && !is.na(layer) && - layer %in% names(directed)) unname(directed[layer]) else is_directed(.data) -} - # The ties a network records as missing, derived from its nonresponse records. .expand_missing <- function(.data){ empty <- dplyr::tibble(from = integer(0), to = integer(0), @@ -103,7 +96,7 @@ absent <- which(na_state[, at] & act_state[, at]) absent <- .layer_absent(.data, absent, layer, time) if(!length(absent)) return(NULL) - directed <- .layer_directed(.data, layer) + directed <- layer_is_directed(.data, layer) pairs <- lapply(absent, function(node){ alters <- .stocnet_alters(.data, node, act_state[, at]) if(!length(alters)) return(NULL) @@ -179,7 +172,7 @@ at <- if(is.na(time)) 1L else match(time, times) if(is.na(at)) at <- 1L sub <- missing[.same_occasion(missing, layer, time), , drop = FALSE] - directed <- .layer_directed(x, layer) + directed <- layer_is_directed(x, layer) for(node in unique(c(sub$from, if(!directed) sub$to))){ alters <- .stocnet_alters(x, node, act_state[, at]) held <- if(directed) sub$to[sub$from == node] else @@ -209,7 +202,7 @@ covered <- rep(FALSE, nrow(missing)) for(r in seq_len(nrow(found))){ same <- .same_occasion(missing, found$layer[[r]], found$time[[r]]) - directed <- .layer_directed(x, found$layer[[r]]) + directed <- layer_is_directed(x, found$layer[[r]]) covered <- covered | (same & (missing$from == found$node[[r]] | (!directed & missing$to == found$node[[r]]))) } diff --git a/R/manip_nodes.R b/R/manip_nodes.R index 624cc13b..cd324937 100644 --- a/R/manip_nodes.R +++ b/R/manip_nodes.R @@ -269,6 +269,17 @@ keep_nodes <- function(.data, kept){ out_changes <- .data$changes } + # The missings list dyads, so dropping nodes drops the dyads either of whose + # ends is gone, and renumbers the rest, exactly as it does for the ties. + if(!is.null(.data$missings) && nrow(.data$missings) > 0){ + out_missings <- dplyr::filter(.data$missings, from %in% kept, to %in% kept) |> + dplyr::mutate(from = match(from, kept), + to = match(to, kept)) + if(nrow(out_missings) == 0) out_missings <- NULL + } else { + out_missings <- .data$missings + } + # Dropping nodes can drop the last tie of a layer, and the information on # that layer goes with it. out_info <- if(!is.null(out_ties) && "layer" %in% names(out_ties)){ @@ -277,7 +288,7 @@ keep_nodes <- function(.data, kept){ } else .data$info make_stocnet(nodes = out_nodes, ties = out_ties, changes = out_changes, - globals = .data$globals, missings = .data$missings, info = out_info) + globals = .data$globals, missings = out_missings, info = out_info) } #' @rdname manip_nodes_num From 47bc4092866e8c24dc65232942a210efdc094913 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Mon, 31 Aug 2026 12:30:21 +0200 Subject: [PATCH 06/14] Improved `validate_stocnet()` on names it reserves but does not rename --- NEWS.md | 2 ++ R/class_validate.R | 15 ++++++++++++--- R/manip_changes.R | 6 ++++-- R/modif_motifs.R | 4 ++-- tests/testthat/test-functional_from.R | 5 +++-- tests/testthat/test-make_collect.R | 4 +--- tests/testthat/test-manip_layers.R | 22 ++++++++++++++++++++++ tests/testthat/test-manip_nodes.R | 27 +++++++++++++++++++++++++++ tests/testthat/test-manip_transform.R | 22 +++++++--------------- tests/testthat/test-modif_proximity.R | 10 +++------- tests/testthat/test-to_motifs.R | 4 +++- 11 files changed, 86 insertions(+), 35 deletions(-) diff --git a/NEWS.md b/NEWS.md index 6c202782..f9545f5c 100644 --- a/NEWS.md +++ b/NEWS.md @@ -12,6 +12,8 @@ - Improved `describe_nodes()` on networks of three or more modes (closed #174) - Fixed `keep_nodes()` to drop and reindex `$missings` (closed #173) - `reserved_cols()` now names every out-of-range id, instead of erroring +- Improved `validate_stocnet()` on names it reserves but does not rename + ## Modifying diff --git a/R/class_validate.R b/R/class_validate.R index de38170e..52af8de6 100644 --- a/R/class_validate.R +++ b/R/class_validate.R @@ -16,8 +16,11 @@ validate_stocnet <- function(.data) { validate_nodes <- function(.data){ if(is.null(.data$nodes)) return(invisible(.data)) expect_class(.data, "nodes", "tbl_df") + # Note that an 'id' is not among the names for a label here, for the reason + # `rename_nodes()` gives: a file format requires an id of its own, so taking + # it for a label would name nodes the file never named. reserved_cols(.data, "nodes", "label", "character", - aka = c("name", "id")) + aka = "name") reserved_cols(.data, "nodes", "mode", "character") reserved_cols(.data, "nodes", "active", "logical") reserved_cols(.data, "nodes", "na", "logical") @@ -43,9 +46,13 @@ validate_ties <- function(.data){ # Note that 'begin' and 'end' are not among the names for a time here. # These mark the span over which a tie is present, which `is_dynamic()` # reads as such, rather than a time that is named some other way. + # Note that a 'date' is not among the names for a time here, for the reason + # `is_longitudinal()` gives: it reads a moment under 'time', 'wave', or + # 'panel' and not under 'date', so a network of dated events, such as + # `ison_southern_women`, records those dates as the attribute they are. reserved_cols(.data, "ties", "time", class = c("character","numeric","integer","mdate","Date","POSIXct","POSIXlt"), - aka = c("wave", "period", "date")) + aka = c("wave", "period", "panel")) reserved_cols(.data, "ties", "layer", "character", aka = c("type", "plex", "tie")) invisible(.data) @@ -137,7 +144,9 @@ reserved_cols <- function(.data, component, column, class, if(!all(.data[[component]][[column]] %in% pool)){ values <- unique(as.character(.data[[component]][[column]])) unmatched <- values[which(!values %in% pool)] - if(is.na(unmatched)) unmatched <- "NA (probably unmatched ids)" + # More than one value can be unmatched, so the NA is named elementwise + # rather than in a condition that only a single value would satisfy. + unmatched[is.na(unmatched)] <- "NA (probably unmatched ids)" snet_abort("'{component}${column}' includes {phrase(unmatched)},", "which must be one of {phrase(pool)}.") } diff --git a/R/manip_changes.R b/R/manip_changes.R index 4a3deb46..10499f3a 100644 --- a/R/manip_changes.R +++ b/R/manip_changes.R @@ -130,7 +130,8 @@ bind_changes.igraph <- function(.data, changes, var, ...){ net_nodes(out), fill = TRUE)) - } else snet_unavailable() + } else snet_unavailable("A composition table must name its columns", + "{.val node}, {.val begin}, and {.val end}.") changes <- stats::reshape(changes, varying = colnames(changes)[-1], @@ -181,7 +182,8 @@ bind_changes.igraph <- function(.data, changes, var, ...){ first <- changes[changes[,1] == min(changes[,1]),] starts[first[,2]] <- first[,4] starts[is.na(starts) & changes[changes$var == "active" & changes$value == TRUE & changes$wave > min(changes$wave),2]] <- FALSE - } else snet_unavailable() + } else snet_unavailable("Inferring which nodes start active is not yet", + "available for this changelog.") out <- .data |> mutate_nodes(active = starts) } out diff --git a/R/modif_motifs.R b/R/modif_motifs.R index 74ad4425..fdf28355 100644 --- a/R/modif_motifs.R +++ b/R/modif_motifs.R @@ -96,7 +96,7 @@ to_motifs <- function(.data = NULL, n = NULL, directed = FALSE, signed = FALSE){ n <- infer_n(n, .data) if(length(n) > 1){ # two-mode #### if(signed) - return(snet_unavailable("Signed motifs are not yet available for two-mode networks.")) + snet_unavailable("Signed motifs are not yet available for two-mode networks.") # The bipartite motifs up to four nodes (Simmons et al. 2019, `bmotif`), # labelled by their `bmotif` dictionary IDs. Rows are one mode, columns the # other; the 2x2 four-cycle (motif 6) needs `twomode` to disambiguate it @@ -158,7 +158,7 @@ to_motifs <- function(.data = NULL, n = NULL, directed = FALSE, signed = FALSE){ `+--` = mutate_ties(create_explicit(A--B--C--A), sign = c(1, -1, -1)), `---` = mutate_ties(create_explicit(A--B--C--A), sign = c(-1, -1, -1)))) } else - return(snet_unavailable("Signed motifs not yet available for that kind of network.")) + snet_unavailable("Signed motifs not yet available for that kind of network.") } if(n>3 && directed){ diff --git a/tests/testthat/test-functional_from.R b/tests/testthat/test-functional_from.R index f1f8a014..e19f0e5f 100644 --- a/tests/testthat/test-functional_from.R +++ b/tests/testthat/test-functional_from.R @@ -169,12 +169,13 @@ test_that("from_layers() carries changes tables through the merge", { expect_false(is.null(out$changes)) }) -test_that("from_layers() resolves conflicting dates and DOIs without warnings", { +test_that("from_layers() warns about conflicting dates and DOIs it resolves", { sn1 <- add_info(as_stocnet(ison_adolescents), date = "2001", doi = "10.1/first") sn2 <- add_info(as_stocnet(create_star(8)), date = "1999", doi = "10.1/second") - expect_no_warning(out <- from_layers(a = sn1, b = sn2)) + expect_warning(out <- from_layers(a = sn1, b = sn2), "different 'date'") + out <- suppressWarnings(from_layers(a = sn1, b = sn2)) expect_identical(out$info$date, "1999") expect_identical(out$info$doi, "10.1/first") }) diff --git a/tests/testthat/test-make_collect.R b/tests/testthat/test-make_collect.R index a1f35aab..4b3ef949 100644 --- a/tests/testthat/test-make_collect.R +++ b/tests/testthat/test-make_collect.R @@ -138,9 +138,7 @@ test_that("collect_pkg() only includes external functions where asked", { test_that("collect_pkg() reports scripts it cannot parse", { dir <- fixture_pkg(broken = TRUE) - op <- options(snet_verbosity = "verbose") - on.exit(options(op), add = TRUE) - expect_message(out <- collect_pkg(dir), "b.R") + expect_warning(out <- collect_pkg(dir), "b.R") # The scripts that do parse are still collected expect_true("foo" %in% node_labels(out)) }) diff --git a/tests/testthat/test-manip_layers.R b/tests/testthat/test-manip_layers.R index e44e502a..05c7d82d 100644 --- a/tests/testthat/test-manip_layers.R +++ b/tests/testthat/test-manip_layers.R @@ -202,3 +202,25 @@ test_that("a duplicated tie in an undirected layer is not doubled", { expect_equal(igraph::ecount(as_igraph(net)), 5) expect_equal(nrow(as_stocnet(as_igraph(net))$ties), 3) }) + +test_that("to_layer keeps the endpoints of each arc (#170)", { + net <- make_stocnet( + info = list(modes = c("states", "IGOs"), + layers = c("trade", "membership"), + directed = c(trade = TRUE, membership = FALSE)), + nodes = tibble::tibble(label = c("a", "b", "x"), + mode = c("states", "states", "IGOs")), + ties = tibble::tibble(from = c(1L, 2L, 1L), to = c(2L, 1L, 3L), + weight = c(5, 9, 1), + layer = c("trade", "trade", "membership")) + ) + out <- to_layer(net, "trade") + # `b -> a` used to be reindexed onto `a -> b`, which `as_matrix()` then + # summed with the arc already there + expect_equal(out$ties$from, c(1L, 2L)) + expect_equal(out$ties$to, c(2L, 1L)) + expect_equal(out$ties$weight, c(5, 9)) + mat <- as_matrix(out) + expect_equal(mat["a", "b"], 5) + expect_equal(mat["b", "a"], 9) +}) diff --git a/tests/testthat/test-manip_nodes.R b/tests/testthat/test-manip_nodes.R index 88198c81..3285f68b 100644 --- a/tests/testthat/test-manip_nodes.R +++ b/tests/testthat/test-manip_nodes.R @@ -154,3 +154,30 @@ test_that("filter_nodes empties a layer without error", { expect_equal(out$info$layers, "friends") expect_no_error(validate_stocnet(out)) }) + +test_that("dropping nodes drops and renumbers the missings (#173)", { + sn <- as_stocnet(ison_adolescents) + # two dyads the network could have observed and did not + sn$missings <- tibble::tibble(from = c(6L, 7L), to = c(8L, 1L)) + sn <- validate_stocnet(sn) + # keeping every node leaves the missings as they were + expect_equal(to_subgraph(sn, seq_len(8) <= 8)$missings, sn$missings) + # dropping either end of a dyad drops the dyad with it + out <- to_subgraph(sn, seq_len(8) <= 4) + expect_no_error(validate_stocnet(out)) + expect_null(out$missings) + # a dyad both of whose ends remain is renumbered onto the nodes that are left + sn$missings <- tibble::tibble(from = c(3L, 7L), to = c(4L, 1L)) + sn <- validate_stocnet(sn) + kept <- to_subgraph(sn, seq_len(8) >= 3) + expect_equal(kept$missings$from, 1L) + expect_equal(kept$missings$to, 2L) + expect_true(all(unlist(kept$missings) <= nrow(kept$nodes))) +}) + +test_that("validate_stocnet names every out-of-range id (#173)", { + sn <- as_stocnet(ison_adolescents) + sn$missings <- tibble::tibble(from = c(20L, 30L), to = c(1L, 2L)) + # two unmatched ids used to make the message builder itself error + expect_error(validate_stocnet(sn), "20 and 30") +}) diff --git a/tests/testthat/test-manip_transform.R b/tests/testthat/test-manip_transform.R index 18fe9aad..61233470 100644 --- a/tests/testthat/test-manip_transform.R +++ b/tests/testthat/test-manip_transform.R @@ -409,13 +409,9 @@ test_that("binary-only measures dichotomise valued networks", { set.seed(1234) valued <- sw_mat valued[valued == 1] <- sample(1:3, sum(valued == 1), replace = TRUE) - # snet_warn() emits a cli alert, which is a message rather than a warning, - # and cli alerts are silenced unless manynet is set to be verbose - op <- options(snet_verbosity = "verbose") - on.exit(options(op), add = TRUE) - expect_message(to_mode1(valued, "jaccard"), "binary") - # dichotomising is what the message says it does - expect_equal(suppressMessages(to_mode1(valued, "jaccard")), + expect_warning(to_mode1(valued, "jaccard"), "binary") + # dichotomising is what the warning says it does + expect_equal(suppressWarnings(to_mode1(valued, "jaccard")), to_mode1((valued > 0) * 1, "jaccard")) # whereas a measure defined for valued data uses the values expect_silent(to_mode1(valued, "crossmin")) @@ -595,10 +591,8 @@ test_that("to_normalised leaves a node with nothing to scale against", { expect_true(all(is.finite(out))) expect_true(all(is.finite(to_normalised(norm_mat, rule = "max", across = "rows")))) - options(snet_verbosity = "verbose") - expect_message(to_normalised(norm_mat, rule = "sum", across = "rows"), + expect_warning(to_normalised(norm_mat, rule = "sum", across = "rows"), "no value to be scaled against") - options(snet_verbosity = "quiet") }) test_that("to_normalised returns a directed network where it must", { @@ -752,16 +746,14 @@ test_that("the default filter retains something where disparity cannot", { test_that("to_backbone reports what would otherwise pass unnoticed", { # `snet_warn()` is silent at the default verbosity, so it is raised here - before <- options(snet_verbosity = "verbose") - on.exit(options(before), add = TRUE) # every filter builds its null model from the ties as the network holds # them, so a tie restated at each wave is tested once per wave repeated <- to_uniplex(ison_monks, layer = "like") expect_true(any(grepl("more than once", - capture_messages(tie_is_backbone(repeated))))) + capture_warnings(tie_is_backbone(repeated))))) expect_false(any(grepl("more than once", - capture_messages(tie_is_backbone(ison_networkers))))) + capture_warnings(tie_is_backbone(ison_networkers))))) # a threshold that deletes every tie is more likely a mismatch than a finding expect_true(any(grepl("retains no tie", - capture_messages(to_backbone(ison_karateka, filter = "disparity"))))) + capture_warnings(to_backbone(ison_karateka, filter = "disparity"))))) }) diff --git a/tests/testthat/test-modif_proximity.R b/tests/testthat/test-modif_proximity.R index 0dbbcd81..3425e606 100644 --- a/tests/testthat/test-modif_proximity.R +++ b/tests/testthat/test-modif_proximity.R @@ -149,15 +149,11 @@ test_that("to_proximity shares to_mode1()'s measures and conventions", { expect_equal(rk(to_proximity(bin, "hamming", dyad = "include")), rk(to_proximity(bin, "rand", dyad = "include"))) # a valued network is dichotomised for the binary-only measures. snet_warn() - # emits a cli alert, which is a message rather than a warning, and cli alerts - # are silenced unless manynet is set to be verbose - op <- options(snet_verbosity = "verbose") - on.exit(options(op), add = TRUE) # both the pairwise and the vectorised path say so - expect_message(to_proximity(prox_mat * 2, "jaccard"), "binary") - expect_message(to_proximity(prox_mat * 2, "jaccard", dyad = "include"), + expect_warning(to_proximity(prox_mat * 2, "jaccard"), "binary") + expect_warning(to_proximity(prox_mat * 2, "jaccard", dyad = "include"), "binary") - expect_equal(suppressMessages(to_proximity(prox_mat * 2, "jaccard")), + expect_equal(suppressWarnings(to_proximity(prox_mat * 2, "jaccard")), to_proximity(prox_mat, "jaccard")) # the result is square, symmetric, and has a zeroed diagonal out <- to_proximity(prox_mat, "pearson") diff --git a/tests/testthat/test-to_motifs.R b/tests/testthat/test-to_motifs.R index 40dfa8ca..b7c7bc32 100644 --- a/tests/testthat/test-to_motifs.R +++ b/tests/testthat/test-to_motifs.R @@ -132,7 +132,9 @@ test_that("to_motifs() returns the bmotif bipartite motifs up to four nodes", { }) test_that("to_motifs() does not (yet) return signed two-mode motifs", { - expect_null(to_motifs(c(4, 6), signed = TRUE)) + # the guard aborts whatever the verbosity, so that the code it guards does + # not run on and return something wrong instead + expect_error(to_motifs(c(4, 6), signed = TRUE), "two-mode") }) # Signed motifs -------------------------------------------------------------- From 27a722cad37e0690ed8b8f06459fe3dce1d5abda Mon Sep 17 00:00:00 2001 From: James Hollway Date: Mon, 31 Aug 2026 12:30:46 +0200 Subject: [PATCH 07/14] Fixed `as_igraph.stocnet()` on multimodal and multilevel networks (closed #170) --- NEWS.md | 3 +++ R/coerce_graph.R | 23 +++++++++++++++++-- tests/testthat/test-coercion.R | 41 ++++++++++++++++++++++++++++++++++ 3 files changed, 65 insertions(+), 2 deletions(-) diff --git a/NEWS.md b/NEWS.md index f9545f5c..fce71de1 100644 --- a/NEWS.md +++ b/NEWS.md @@ -14,6 +14,9 @@ - `reserved_cols()` now names every out-of-range id, instead of erroring - Improved `validate_stocnet()` on names it reserves but does not rename +## Coercion + +- Fixed `as_igraph.stocnet()` on multimodal and multilevel networks (closed #170) ## Modifying diff --git a/R/coerce_graph.R b/R/coerce_graph.R index c174aa9b..7285b539 100644 --- a/R/coerce_graph.R +++ b/R/coerce_graph.R @@ -306,9 +306,24 @@ as_igraph.stocnet <- function(.data, twomode = FALSE) { if(is_labelled(.data)) vertices <- vertices |> dplyr::mutate(name = label) |> dplyr::select(name, dplyr::everything(), -label) + # igraph records two modes in a logical 'type' attribute, which its + # bipartite functions require, and three or more in the 'lvl' attribute + # that `to_multilevel()` writes and `as_stocnet()` maps back to 'mode'. + # A bare 'mode' column would survive coercion as an ordinary attribute + # that no reader looks for, so it is translated either way. if(is_twomode(.data)) vertices <- vertices |> dplyr::mutate(type = mode == unique(mode)[2]) |> dplyr::select(dplyr::any_of("name"), dplyr::everything(), -mode) + else if(net_modes(.data) > 2){ + # `mode_names()` is read here rather than inside `mutate()`, where dplyr + # masks '.data' with its own pronoun. `as_stocnet()` sorts the levels it + # finds and reads their names back out of info, so the level of a mode is + # its position in that same order. + lvls <- mode_names(.data) %||% unique(vertices$mode) + vertices <- vertices |> + dplyr::mutate(lvl = match(mode, lvls)) |> + dplyr::select(dplyr::any_of("name"), dplyr::everything(), -mode) + } if(is_labelled(.data)){ out <- igraph::graph_from_data_frame(as_edgelist(.data), directed = directed, @@ -330,7 +345,10 @@ as_igraph.stocnet <- function(.data, twomode = FALSE) { } } - if(is_twomode(.data)) + # A two-mode network holds one tie per dyad, unless it also ties within a + # level, in which case those ties can be directed and each arc is its own + # row. Collapsing then points both arcs of a dyad at the same pair of nodes. + if(is_twomode(.data) && !is_directed(.data)) out <- to_undirected(out) if(!is.null(as_infolist(.data)) && length(as_infolist(.data)) > 0) igraph::graph_attr(out) <- as_infolist(.data) @@ -1863,7 +1881,8 @@ as_diffnet.diff_model <- function(.data, out$nodes <- node_labels(as_igraph(.data))[out$nodes] toa <- stats::setNames(out$t, out$nodes) if(is_dynamic(.data)){ - snet_unavailable() + snet_unavailable("Coercing a dynamic network to a diffnet is not yet", + "available.") # netdiffuseR::igraph_to_diffnet(graph.list = to_waves(.data)) } else { graph <- as_tidygraph(.data) |> mutate(toa = as.numeric(toa)) |> as_igraph() diff --git a/tests/testthat/test-coercion.R b/tests/testthat/test-coercion.R index d99bee44..d8365ceb 100644 --- a/tests/testthat/test-coercion.R +++ b/tests/testthat/test-coercion.R @@ -478,3 +478,44 @@ test_that("mnet objects printed correctly", { # class(sample_net) # expect_no_failure(as_igraph(sample_net)) # }) + +test_that("a directed multilevel network round trips through igraph", { + net <- make_stocnet( + info = list(modes = c("states", "IGOs"), + layers = c("trade", "membership"), + directed = c(trade = TRUE, membership = FALSE)), + nodes = tibble::tibble(label = c("a", "b", "x"), + mode = c("states", "states", "IGOs")), + ties = tibble::tibble(from = c(1L, 2L, 1L), to = c(2L, 1L, 3L), + weight = c(5, 9, 1), + layer = c("trade", "trade", "membership")) + ) + ig <- as_igraph(net) + # the network holds arcs, so it does not reach igraph as an undirected graph + expect_true(igraph::is_directed(ig)) + # the undirected layer travels as a reciprocated pair, and collapses again + expect_equal(igraph::ecount(ig), 4) + back <- as_stocnet(ig) + expect_equal(back$ties$from, net$ties$from) + expect_equal(back$ties$to, net$ties$to) + expect_equal(back$info$directed, net$info$directed) +}) + +test_that("a network of three modes keeps them through igraph", { + net <- make_stocnet( + info = list(modes = c("A", "B", "C")), + nodes = tibble::tibble(label = c("a", "b", "x", "z"), + mode = c("A", "A", "B", "C")), + ties = tibble::tibble(from = c(1L, 1L, 3L), to = c(2L, 3L, 4L)) + ) + ig <- as_igraph(net) + # igraph records two modes as 'type' and more as 'lvl', which is what + # net_modes() and is_multilevel() read; a bare 'mode' attribute is read by + # neither, so the modes would be lost + expect_true("lvl" %in% igraph::vertex_attr_names(ig)) + expect_false("mode" %in% igraph::vertex_attr_names(ig)) + expect_equal(net_modes(ig), 3) + expect_equal(mode_nodes(ig), c(2L, 1L, 1L)) + expect_true(is_multilevel(ig)) + expect_equal(as_stocnet(ig)$nodes$mode, net$nodes$mode) +}) From bacba4de8f9821c6dcaf477a4478e5144ca694d6 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Tue, 1 Sep 2026 09:14:09 +0200 Subject: [PATCH 08/14] Added `keep = "both"` to `to_unsigned()`, which keeps every tie but not its sign - Fixed `to_unsigned.data.frame()` erroring on a signed edgelist - now drops the ties of the other sign, as the other methods do - now reads signs held as negative weights as well as in a 'sign' column - Fixed `to_unsigned.network()` ignoring its `keep` argument 'both' excludes no tie, so it records no exclusion. None of the transformation items names the taking of a magnitude, so it goes unrecorded until one does. Whether an exported positive-ties guard should join it is open as #176. Co-Authored-By: Claude Opus 5 --- NEWS.md | 5 ++ R/modif_weight.R | 85 +++++++++++++++++++----------- man/modif_weight.Rd | 13 +++-- tests/testthat/test-manip_format.R | 44 +++++++++++++++- 4 files changed, 112 insertions(+), 35 deletions(-) diff --git a/NEWS.md b/NEWS.md index fce71de1..77edb0ff 100644 --- a/NEWS.md +++ b/NEWS.md @@ -20,6 +20,11 @@ ## Modifying +- Added `keep = "both"` to `to_unsigned()`, which keeps every tie but not its sign +- Fixed `to_unsigned.data.frame()` erroring on a signed edgelist + - now drops the ties of the other sign, as the other methods do + - now reads signs held as negative weights as well as in a 'sign' column +- Fixed `to_unsigned.network()` ignoring its `keep` argument - Fixed `to_layer()` pointing arcs at the wrong nodes (closed #170) ## Marking diff --git a/R/modif_weight.R b/R/modif_weight.R index 35061d79..59171c9c 100644 --- a/R/modif_weight.R +++ b/R/modif_weight.R @@ -5,8 +5,9 @@ #' #' - `to_unweighted()` reformats weighted network data to unweighted network #' data, with all tie weights removed. -#' - `to_unsigned()` reformats signed network data to unsigned network data -#' keeping just the "positive" or "negative" ties. +#' - `to_unsigned()` reformats signed network data to unsigned network data, +#' keeping just the "positive" or the "negative" ties, or "both", +#' which keeps every tie but replaces its sign with its magnitude. #' - `to_normalised()` rescales tie weights relative to the other ties of the #' same node, so that a value reads as a share rather than a count. #' @@ -33,20 +34,27 @@ NULL #' @rdname modif_weight #' @param keep In the case of a signed network, whether to retain -#' the "positive" or "negative" ties. +#' the "positive" or the "negative" ties, or "both", +#' which retains every tie but replaces its sign with its magnitude. #' @importFrom igraph delete_edges E delete_edge_attr +#' @examples +#' marvel <- to_uniplex(fict_marvel, "relationship") +#' to_unsigned(marvel, "positive") +#' to_unsigned(marvel, "both") #' @export to_unsigned <- function(.data, - keep = c("positive", "negative")) UseMethod("to_unsigned") + keep = c("positive", "negative", + "both")) UseMethod("to_unsigned") #' @export -to_unsigned.default <- function(.data, keep = c("positive", "negative")){ +to_unsigned.default <- function(.data, keep = c("positive", "negative", + "both")){ as_input(.data, to_unsigned, keep = keep) } #' @export to_unsigned.matrix <- function(.data, - keep = c("positive", "negative")){ + keep = c("positive", "negative", "both")){ keep <- match.arg(keep) out <- .data if(keep == "positive"){ @@ -54,66 +62,82 @@ to_unsigned.matrix <- function(.data, } else if (keep == "negative"){ out[out > 0] <- 0 out <- abs(out) - } else snet_abort("Indicate whether 'positive' or 'negative' ties should be kept.") + } else out <- abs(out) out } #' @export to_unsigned.data.frame <- function(.data, - keep = c("positive", "negative")){ + keep = c("positive", "negative", "both")){ + if(!is_signed(.data)) return(.data) keep <- match.arg(keep) - out <- .data - if(is_signed(.data)){ - if(keep == "positive"){ - out$sign[out$sign < 0] <- 0 - } else if (keep == "negative"){ - out$sign[out$sign > 0] <- 0 - out$sign <- out$sign(out) - } else snet_abort("Indicate whether 'positive' or 'negative' ties should be kept.") - } + # signs may be held either in a 'sign' column or as negative weights. + # The ties of the other sign are dropped rather than zeroed, so that an + # edgelist reads as the other methods' networks do. + # a tibble warns where `$` names a column it does not have, so `[[` is used + signs <- if(!is.null(.data[["sign"]])) sign(.data[["sign"]]) else + sign(.data[["weight"]]) + out <- .data[switch(keep, + positive = signs >= 0, + negative = signs <= 0, + both = rep(TRUE, length(signs))), , drop = FALSE] + rownames(out) <- NULL + out$sign <- NULL + # the weights that remain carry the magnitude of the relation, not its + # direction, so an unsigned network keeps them positive + if(!is.null(out[["weight"]])) out$weight <- abs(out[["weight"]]) out } #' @export to_unsigned.tbl_graph <- function(.data, - keep = c("positive", "negative")){ + keep = c("positive", "negative", "both")){ keep <- match.arg(keep) out <- to_unsigned(as_igraph(.data), keep = keep) - dropped <- if(keep == "positive") "negative ties" else "positive ties" + dropped <- switch(keep, positive = "negative ties", + negative = "positive ties", both = "no ties") + # 'both' excludes no tie, so this records nothing. Taking the magnitude of a + # weight is not an exclusion, and none of the transformation items names it, + # so it goes unrecorded until one does. as_tidygraph(out) |> .record_exclusion(.data, dropped, "ties") } #' @export to_unsigned.stocnet <- function(.data, - keep = c("positive", "negative")){ + keep = c("positive", "negative", "both")){ if(!is_signed(.data)) return(.data) keep <- match.arg(keep) # signs may be held either in a 'sign' column or as negative weights. # The ties to drop are named rather than the ties to keep, so that a tie # with no sign is kept, as it is in the igraph method. signs <- as.numeric(tie_signs(.data)) - dropped <- which(if(keep == "positive") signs < 0 else signs > 0) + dropped <- switch(keep, positive = which(signs < 0), + negative = which(signs > 0), both = integer(0)) out <- keep_ties(.data, setdiff(seq_len(nrow(.data$ties)), dropped)) out$ties$sign <- NULL # the weights that remain carry the magnitude of the relation, not its # direction, so an unsigned network keeps them positive if(!is.null(out$ties$weight)) out$ties$weight <- abs(out$ties$weight) - dropped <- if(keep == "positive") "negative ties" else "positive ties" + dropped <- switch(keep, positive = "negative ties", + negative = "positive ties", both = "no ties") + # 'both' excludes no tie, so this records nothing. Taking the magnitude of a + # weight is not an exclusion, and none of the transformation items names it, + # so it goes unrecorded until one does. .record_exclusion(out, .data, dropped, "ties") } #' @export to_unsigned.igraph <- function(.data, - keep = c("positive", "negative")){ + keep = c("positive", "negative", "both")){ if (is_signed(.data)) { keep <- match.arg(keep) # signs may be held either in a 'sign' attribute or as negative weights signs <- as.numeric(tie_signs(.data)) - if (keep == "positive") { - out <- igraph::delete_edges(.data, which(signs < 0)) - } else { - out <- igraph::delete_edges(.data, which(signs > 0)) - } + out <- if (keep == "positive") { + igraph::delete_edges(.data, which(signs < 0)) + } else if (keep == "negative") { + igraph::delete_edges(.data, which(signs > 0)) + } else .data if ("sign" %in% igraph::edge_attr_names(out)) out <- igraph::delete_edge_attr(out, "sign") if ("weight" %in% igraph::edge_attr_names(out)) { @@ -130,8 +154,9 @@ to_unsigned.igraph <- function(.data, #' @export to_unsigned.network <- function(.data, - keep = c("positive", "negative")){ - as_network(to_unsigned(as_igraph(.data))) + keep = c("positive", "negative", "both")){ + keep <- match.arg(keep) + as_network(to_unsigned(as_igraph(.data), keep = keep)) } #' @rdname modif_weight diff --git a/man/modif_weight.Rd b/man/modif_weight.Rd index ca790df9..27fe601e 100644 --- a/man/modif_weight.Rd +++ b/man/modif_weight.Rd @@ -10,7 +10,7 @@ \alias{to_normalized} \title{Modifying tie weight formats} \usage{ -to_unsigned(.data, keep = c("positive", "negative")) +to_unsigned(.data, keep = c("positive", "negative", "both")) to_unweighted(.data, threshold = 1) @@ -42,7 +42,8 @@ to_normalized( }} \item{keep}{In the case of a signed network, whether to retain -the "positive" or "negative" ties.} +the "positive" or the "negative" ties, or "both", +which retains every tie but replaces its sign with its magnitude.} \item{threshold}{For a matrix, the threshold to binarise/dichotomise at.} @@ -94,8 +95,9 @@ These functions reformat tie attributes like their weight or sign: \itemize{ \item \code{to_unweighted()} reformats weighted network data to unweighted network data, with all tie weights removed. -\item \code{to_unsigned()} reformats signed network data to unsigned network data -keeping just the "positive" or "negative" ties. +\item \code{to_unsigned()} reformats signed network data to unsigned network data, +keeping just the "positive" or the "negative" ties, or "both", +which keeps every tie but replaces its sign with its magnitude. \item \code{to_normalised()} rescales tie weights relative to the other ties of the same node, so that a value reads as a share rather than a count. } @@ -131,6 +133,9 @@ sends \eqn{i}. Where such a network is undirected, each tie is therefore split into two, and the network is returned directed. } \examples{ +marvel <- to_uniplex(fict_marvel, "relationship") +to_unsigned(marvel, "positive") +to_unsigned(marvel, "both") to_normalised(ison_networkers, rule = "sum", across = "rows") } \seealso{ diff --git a/tests/testthat/test-manip_format.R b/tests/testthat/test-manip_format.R index bd22aef1..ee0a5f95 100644 --- a/tests/testthat/test-manip_format.R +++ b/tests/testthat/test-manip_format.R @@ -87,10 +87,52 @@ test_that("to_unsigned keeps the ties of the sign it is asked for", { as_matrix(to_unsigned(ison_southern_women, "negative")))) }) +test_that("to_unsigned keeps every tie's magnitude where 'both' is asked for", { + # the mark is given so that the ring is signed the same way on every run + ring <- to_signed(create_ring(8), mark = rep(c(TRUE, FALSE), 4)) + for(x in list(ring, as_igraph(ring), as_tidygraph(ring), as_network(ring))){ + both <- to_unsigned(x, "both") + expect_false(is_signed(both)) + expect_equal(as.numeric(net_ties(both)), as.numeric(net_ties(x))) + expect_equal(as.numeric(net_ties(both)), + as.numeric(net_ties(to_unsigned(x, "positive"))) + + as.numeric(net_ties(to_unsigned(x, "negative")))) + } + # 'fict_marvel' holds its signs in a 'sign' attribute, where the ring holds + # them as negative weights, so both representations are covered + marvel <- to_uniplex(fict_marvel, "relationship") + both <- to_unsigned(marvel, "both") + expect_false(is_signed(both)) + expect_equal(as.numeric(net_ties(both)), as.numeric(net_ties(marvel))) + expect_true(all(as_matrix(both) >= 0)) + expect_false("sign" %in% igraph::edge_attr_names(as_igraph(both))) +}) + +test_that("to_unsigned reads a signed edgelist of either representation", { + # a sign can be held in a 'sign' column or as a negative weight + el <- data.frame(from = c("a","b","c"), to = c("b","c","a"), + sign = c(1,-1,1)) + el2 <- data.frame(from = c("a","b"), to = c("b","c"), weight = c(2,-3)) + expect_equal(nrow(to_unsigned(el, "positive")), 2) + expect_equal(nrow(to_unsigned(el, "negative")), 1) + expect_equal(nrow(to_unsigned(el, "both")), 3) + expect_false("sign" %in% names(to_unsigned(el, "both"))) + expect_equal(to_unsigned(el2, "positive")$weight, 2) + # the magnitude of the relation is kept, not its direction + expect_equal(to_unsigned(el2, "negative")$weight, 3) + expect_equal(to_unsigned(el2, "both")$weight, c(2,3)) +}) + +test_that("to_unsigned.network keeps the sign it is asked for", { + n <- as_network(to_signed(create_ring(8), mark = rep(c(TRUE, FALSE), 4))) + expect_equal(as.numeric(net_ties(to_unsigned(n, "positive"))), 4) + expect_equal(as.numeric(net_ties(to_unsigned(n, "negative"))), 4) +}) + test_that("to_named relabels an unlabelled network, or with names given", { expect_true(is_labelled(to_named(to_unnamed(ison_southern_women)))) expect_true(is_labelled(to_named(ison_southern_women, - seq_len(igraph::vcount(ison_southern_women))))) + seq_len(net_nodes(ison_southern_women))))) }) test_that("multilevel works", { From 7651d24fe1db488ae234f93640f29c0717502ef7 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Wed, 2 Sep 2026 18:22:31 +0200 Subject: [PATCH 09/14] Fixed dropping nodes leaving the changes naming nodes that are gone `delete_nodes()` had no 'stocnet' method, so it went through igraph, where the changes travel as a graph attribute and are not renumbered with the nodes. It now delegates to `keep_nodes()`, which renumbers every component together. A projection discards a whole mode, so a change about a node of that mode describes a node the result does not have. `to_mode1()` and `to_mode2()` now drop those and renumber the rest by rank among the nodes they keep. Both errored on `validate_stocnet()` before, on any network with changes. Co-Authored-By: Claude Opus 5 --- NAMESPACE | 3 + R/manip_nodes.R | 18 +++++ R/modif_project.R | 46 +++++++++++++ data-raw/stocnet_conversion.R | 124 ++++++++++++++++++++++++++++++++++ man/manip_nodes_num.Rd | 2 +- man/modif_project.Rd | 4 +- 6 files changed, 194 insertions(+), 3 deletions(-) create mode 100644 data-raw/stocnet_conversion.R diff --git a/NAMESPACE b/NAMESPACE index 99c32c86..8f26fdb9 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -159,6 +159,7 @@ S3method(delete_node_attribute,tbl_graph) S3method(delete_nodes,default) S3method(delete_nodes,igraph) S3method(delete_nodes,network) +S3method(delete_nodes,stocnet) S3method(delete_nodes,tbl_graph) S3method(delete_tie_attribute,data.frame) S3method(delete_tie_attribute,default) @@ -520,12 +521,14 @@ S3method(to_mode1,default) S3method(to_mode1,igraph) S3method(to_mode1,matrix) S3method(to_mode1,network) +S3method(to_mode1,stocnet) S3method(to_mode1,tbl_graph) S3method(to_mode2,data.frame) S3method(to_mode2,default) S3method(to_mode2,igraph) S3method(to_mode2,matrix) S3method(to_mode2,network) +S3method(to_mode2,stocnet) S3method(to_mode2,tbl_graph) S3method(to_multilevel,default) S3method(to_multilevel,igraph) diff --git a/R/manip_nodes.R b/R/manip_nodes.R index cd324937..cb22bc9e 100644 --- a/R/manip_nodes.R +++ b/R/manip_nodes.R @@ -92,6 +92,24 @@ delete_nodes.network <- function(.data, nodes){ as_network(igraph::delete_vertices(as_igraph(.data), v = nodes)) } +#' @export +delete_nodes.stocnet <- function(.data, nodes){ + # A stocnet holds its changes and its missings in tables of node indices, + # which the igraph route carries across unrenumbered because they travel as + # graph attributes. `keep_nodes()` renumbers every component together. + keep_nodes(.data, .nodes_kept(.data, nodes)) +} + +# The nodes a call names, as the indices of the nodes it leaves behind. A call +# can name them by index, by label, or by a logical mark of which to drop. +.nodes_kept <- function(.data, nodes){ + all <- seq_nodes(.data) + dropped <- if(is.logical(nodes)) all[nodes] else + if(is.character(nodes)) match(nodes, node_labels(.data)) else + as.integer(nodes) + setdiff(all, dropped[!is.na(dropped)]) +} + #' @rdname manip_nodes_num #' @importFrom tidygraph node_is_isolated #' @importFrom dplyr filter diff --git a/R/modif_project.R b/R/modif_project.R index b41d8e95..6c057f1c 100644 --- a/R/modif_project.R +++ b/R/modif_project.R @@ -177,6 +177,20 @@ to_mode1 <- function(.data, similarity = c("count", "jaccard", "rand", "pearson" UseMethod("to_mode1") } +# A projection keeps one mode and discards the other, so a change recorded +# about a node of the discarded mode describes a node the result does not have. +# The projection keeps the nodes it retains in their original order, so the new +# index of a kept node is its rank among them. Without this the changes still +# name the old indices, which `validate_stocnet()` then rejects. +.project_changes <- function(.data, kept){ + if(is.null(.data$changes) || nrow(.data$changes) == 0) return(.data) + out <- .data + out$changes <- dplyr::filter(.data$changes, node %in% kept) |> + dplyr::mutate(node = match(node, kept)) + if(nrow(out$changes) == 0) out$changes <- NULL + out +} + #' @export to_mode1.default <- function(.data, similarity = c("count", "jaccard", "rand", "pearson", "yule", @@ -188,6 +202,22 @@ to_mode1.default <- function(.data, as_input(.data, to_mode1, similarity = similarity) } +#' @export +to_mode1.stocnet <- function(.data, + similarity = c("count", "jaccard", "rand", "pearson", "yule", + "match", "overlap", "crossmin", "maxcrossmin", + "sqdiff", "covariance", "bonacich", "ochiai", + "ochiai2", "czekanowski", "sokalsneath", + "hamann", "rogerstanimoto", "euclidean", "manhattan", + "hamming", "cosine", "spearman", "kendall")){ + similarity <- match.arg(similarity) + # The tidygraph method is called directly rather than through `as_input()`, + # which would pick this method again and recurse. + out <- to_mode1(as_tidygraph(.project_changes(.data, which(!node_is_mode(.data)))), + similarity = similarity) + as_stocnet(out) +} + #' @export to_mode1.matrix <- function(.data, similarity = c("count", "jaccard", "rand", "pearson", "yule", "match", "overlap", "crossmin", "maxcrossmin", @@ -292,6 +322,22 @@ to_mode2.default <- function(.data, as_input(.data, to_mode2, similarity = similarity) } +#' @export +to_mode2.stocnet <- function(.data, + similarity = c("count", "jaccard", "rand", "pearson", "yule", + "match", "overlap", "crossmin", "maxcrossmin", + "sqdiff", "covariance", "bonacich", "ochiai", + "ochiai2", "czekanowski", "sokalsneath", + "hamann", "rogerstanimoto", "euclidean", "manhattan", + "hamming", "cosine", "spearman", "kendall")){ + similarity <- match.arg(similarity) + # The tidygraph method is called directly rather than through `as_input()`, + # which would pick this method again and recurse. + out <- to_mode2(as_tidygraph(.project_changes(.data, which(node_is_mode(.data)))), + similarity = similarity) + as_stocnet(out) +} + #' @export to_mode2.matrix <- function(.data, similarity = c("count", "jaccard", "rand", "pearson", "yule", "match", "overlap", "crossmin", "maxcrossmin", diff --git a/data-raw/stocnet_conversion.R b/data-raw/stocnet_conversion.R new file mode 100644 index 00000000..811d206a --- /dev/null +++ b/data-raw/stocnet_conversion.R @@ -0,0 +1,124 @@ +# Converts the temporal datasets that were still 'mnet' objects into 'stocnet' +# objects. A stocnet holds what these networks know about themselves that an +# 'mnet' cannot: which layer was observed how ('info$observation'), how each +# record of a tie relates to the one before it ('info$update'), and the mode +# and layer names under the names a stocnet reserves for them. +# It also spells the moment each tie was recorded at in a 'time' column, which +# is the moment column in every class. +# +# Re-runnable: converting a stocnet returns it unchanged, and the info entries +# are set to what they already say. + +devtools::load_all(quiet = TRUE) + +# 'nodes' and 'ties' were the names an mnet gave the mode and layer names, +# before 'modes' and 'layers' were reserved for them. +conform_names <- function(x){ + info <- x$info + if(!is.null(info$nodes) && is.null(info$modes)) info$modes <- info$nodes + if(!is.null(info$ties) && is.null(info$layers)) info$layers <- info$ties + info$nodes <- NULL + info$ties <- NULL + x$info <- info + x +} + +fict_potter <- as_stocnet(manynet::fict_potter) |> conform_names() |> + add_info(observation = "panel", update = "replace") + +fict_starwars <- as_stocnet(manynet::fict_starwars) |> conform_names() |> + add_info(observation = "panel", update = "replace") + +# Only the 'like' layer of Sampson's monks was observed at every wave; the +# other three were recorded once, and state something holding throughout. +ison_monks <- as_stocnet(manynet::ison_monks) |> conform_names() +ison_monks <- add_info(ison_monks, + observation = stats::setNames( + ifelse(layer_names(ison_monks) == "like", + "panel", "cross-sectional"), + layer_names(ison_monks)), + update = "replace") + +# A 'sign' column beside a 'weight' column records twice what one signed weight +# records once, and a matrix can hold only one value per tie, so the sign is +# the one that a coercion to a matrix drops. The weights of these ties rank the +# first choice 3, the second 2, and the third 1, so a signed weight runs from +# -3 to 3 and both the valence and the rank survive. +if("sign" %in% names(ison_monks$ties)){ + ison_monks$ties$weight <- ison_monks$ties$weight * ison_monks$ties$sign + ison_monks$ties$sign <- NULL +} + +usethis::use_data(fict_potter, overwrite = TRUE, compress = "bzip2") +usethis::use_data(fict_starwars, overwrite = TRUE, compress = "bzip2") +usethis::use_data(ison_monks, overwrite = TRUE, compress = "bzip2") + +# The four networks that `tie_is_parallel()` marks (#158) were still 'mnet' +# objects. A stocnet records what each of them knows about itself that an +# 'mnet' cannot: how it was collected, where, when, and how each record of a +# tie relates to the one before it. + +# Euler presented the problem to the St Petersburg Academy on 26 August 1735 +# and it was published in 1741 as Eneström 53. The seven bridges are the +# network, so the two pairs of parallel bridges are the point of it and are +# left as parallel ties rather than collapsed into a weight. +ison_koenigsberg <- as_stocnet(manynet::ison_koenigsberg) |> conform_names() |> + add_info(name = "Seven Bridges of Koenigsberg", + observation = "cross-sectional", + directed = FALSE, + source = "Empirical", method = "Archival", boundary = "roster", + location = "Koenigsberg, Prussia", + date = 1735, + doi = "https://scholarlycommons.pacific.edu/euler-works/53/") + +# Adamic and Glance gathered blog URLs from the eTalkingHead, BlogCatalog, +# CampaignLine, and Blogarama directories, retrieved a front page for each on +# 8 February 2005, then added the blogs those pages cited 17 or more times and +# retrieved their pages on 22 February 2005. A roster drawn from directories +# and then extended by citation is a snowball. +irps_blogs <- as_stocnet(manynet::irps_blogs) |> conform_names() |> + add_info(observation = "cross-sectional", + directed = TRUE, + source = "Empirical", method = "Archival", boundary = "snowball", + location = "United States", + date = "2005-02", + doi = "10.1145/1134271.1134277") +# 'collection' was the mnet field for how a network was collected, before +# 'method' was reserved for it. +irps_blogs$info$collection <- NULL + +# Each row is one claim by one speaker about one concept on one day, so the +# network records a stream of events rather than a panel. A claim is +# supportive or critical, which `as_stocnet()` carries into the reserved +# 'weight' column as a sign of 1 or -1. +irps_nuclear <- as_stocnet(manynet::irps_nuclear) |> conform_names() |> + add_info(name = "German nuclear discourse network", + observation = "event", update = "increment", + directed = FALSE, + sender = "speakers", receiver = "concepts", + source = "Empirical", method = "Archival", + location = "Germany", + date = "2011", + doi = "10.1017/nws.2022.31") + +# Both layers are undirected: a relationship holds between two characters, and +# an affiliation between a character and a team. +fict_marvel <- as_stocnet(manynet::fict_marvel) |> conform_names() |> + add_info(name = "Marvel universe", + observation = "cross-sectional", + directed = stats::setNames(c(FALSE, FALSE), + c("relationship", "affiliation")), + sender = "characters", receiver = "teams", + source = "Empirical", method = "Archival", boundary = "roster", + date = 2017) +# Only the relationship layer is signed, so `as_stocnet()` leaves the +# affiliation ties with an NA weight. An NA weight is how manynet records a +# tie whose value is unknown, which would make every affiliation missing and +# `as_matrix()` return a matrix of NAs. An affiliation is a positive tie, so +# it is weighted 1 instead. +fict_marvel$ties$weight[is.na(fict_marvel$ties$weight)] <- 1 + +usethis::use_data(ison_koenigsberg, overwrite = TRUE, compress = "bzip2") +usethis::use_data(irps_blogs, overwrite = TRUE, compress = "bzip2") +usethis::use_data(irps_nuclear, overwrite = TRUE, compress = "bzip2") +usethis::use_data(fict_marvel, overwrite = TRUE, compress = "bzip2") diff --git a/man/manip_nodes_num.Rd b/man/manip_nodes_num.Rd index fa78685b..086e7b86 100644 --- a/man/manip_nodes_num.Rd +++ b/man/manip_nodes_num.Rd @@ -78,7 +78,7 @@ arrange_nodes * * bind_nodes * * delete_incomplete * * delete_isolates * * * * * * * -delete_nodes * * * +delete_nodes * * * * filter_nodes * * tbl_graph add_nodes * diff --git a/man/modif_project.Rd b/man/modif_project.Rd index f4c2c2c5..28c5971d 100644 --- a/man/modif_project.Rd +++ b/man/modif_project.Rd @@ -190,8 +190,8 @@ Below are the currently implemented S3 methods: \if{html}{\out{
}}\preformatted{ data.frame default igraph matrix network stocnet tbl_graph to_hypergraph * * * to_linegraph * * -to_mode1 * * * * * * -to_mode2 * * * * * * +to_mode1 * * * * * * * +to_mode2 * * * * * * * }\if{html}{\out{
}} } \section{Comparison of two-mode projection methods}{ From b0b08760bba88ffadf56c7ac8156d3ad66b48315 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Wed, 2 Sep 2026 18:22:43 +0200 Subject: [PATCH 10/14] Improved `validate_stocnet()` to read a tie 'date' as another name for a time A moment is a moment however it is written. How a moment relates to the one before it is a separate question, which `info$update` answers, so naming a column 'time' does not by itself make a network a panel. Co-Authored-By: Claude Opus 5 --- R/class_validate.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/R/class_validate.R b/R/class_validate.R index 52af8de6..c4aca2a6 100644 --- a/R/class_validate.R +++ b/R/class_validate.R @@ -46,13 +46,13 @@ validate_ties <- function(.data){ # Note that 'begin' and 'end' are not among the names for a time here. # These mark the span over which a tie is present, which `is_dynamic()` # reads as such, rather than a time that is named some other way. - # Note that a 'date' is not among the names for a time here, for the reason - # `is_longitudinal()` gives: it reads a moment under 'time', 'wave', or - # 'panel' and not under 'date', so a network of dated events, such as - # `ison_southern_women`, records those dates as the attribute they are. + # A 'date' is among the names for a time because a moment is a moment however + # it is written. How a moment relates to the one before it is a separate + # question, which `info$update` answers, so naming a column 'time' does not + # by itself make a network a panel. See `.time_rule()`. reserved_cols(.data, "ties", "time", class = c("character","numeric","integer","mdate","Date","POSIXct","POSIXlt"), - aka = c("wave", "period", "panel")) + aka = c("wave", "period", "panel", "date")) reserved_cols(.data, "ties", "layer", "character", aka = c("type", "plex", "tie")) invisible(.data) From d14c73dc100481be136b375bf0a6d4d6b5afceee Mon Sep 17 00:00:00 2001 From: James Hollway Date: Wed, 2 Sep 2026 18:22:43 +0200 Subject: [PATCH 11/14] Improved `ison_southern_women` to record when each of its events is held The date belongs to the event and not to the attendance: every tie to an event carries the same date, and no woman carries one of her own. Each of the 14 events now enters the network on the date it is held, which the changes component records, so `is_changing()` marks the network. An `active` node attribute gives the starting state, as `fict_starwars` has. The unscoped network is unchanged: 32 nodes, 89 ties, the same matrix. `to_time()` returns the events held so far. Co-Authored-By: Claude Opus 5 --- R/data_ison.R | 9 +++- data/ison_southern_women.rda | Bin 1131 -> 1072 bytes man/ison_southern_women.Rd | 55 +++++++++++++++---------- tests/testthat/test-functional_marks.R | 9 ++-- 4 files changed, 45 insertions(+), 28 deletions(-) diff --git a/R/data_ison.R b/R/data_ison.R index 0a4522bb..97bdb38b 100644 --- a/R/data_ison.R +++ b/R/data_ison.R @@ -725,8 +725,13 @@ #' By convention, the nodes are named by the women's first names #' and the code numbers of the events, #' but the women's surnames and titles (Miss, Mrs.) are recorded here too. -#' The events' dates are recorded in place of the Surname, -#' and these dates are also offered as a tie attribute. +#' The events' dates are recorded in place of the Surname. +#' A date describes the event and not the attendance, +#' so each event enters the network on the date it is held, +#' which the changes component records. +#' `is_changing()` therefore marks this network TRUE, +#' and `to_time()` returns the events held up to a given moment, +#' without the women who attended no event by then. #' @docType data #' @keywords datasets #' @name ison_southern_women diff --git a/data/ison_southern_women.rda b/data/ison_southern_women.rda index 6e8771677b1a2651975bad76170f5968ccdb30ea..b52d8ca9e4984b8f3b38491043b159e041751fe7 100644 GIT binary patch literal 1072 zcmV-01kd|IT4*^jL0KkKS)~0ML;wbGfA9bEZ~xub|NsBr-Qd6H-=IJM00DpqK)?Y2 z06=gB&;!p>SqUtaZLpL{pd~#$Q_<>e04cQ(Q^JSpO+7$j9;4LA0iX>H1Jrs$N0jvj zrb8lXG-ynko|ug_G#-=ChMGM<000000i)E@8iB@!fHVL!0000Q00001kN^P01C0#; zXaHyc001-q0009Z00D>sB?%2mdqq71NrOq^m;pSdG@qmhX_0^d7(mlZ08dPTmxuTL z&nG9Ba&;`ok_k+xD%drJFWgJ_Qu09y9MTdS(i^K#6M*<+{+;WcT^OgmD0_wE%U9YUf5q5SB2Z zOf(TgSqwHRR3*`90S%5Behy8>1On?+sG2CRUm-MZE$XNH_|Kx{@fU{?N}SMb7Fw!A^{Zu z@W5T9L8!505E9WO1rs(2NUGK-85Sy`O|Sb?Z2`}UVwX~f|1ksrp?xhvQLsUQ0y5E{ zLB?iOEdtb_$O)ai(7NHbj@JH`7(+<#*bYrK6oLf8(d=u1`U^aafiiSsUgF?f8C)`x z6@;@v7UQUZVk#h~Q`DemtkI1Y2|x(+Lcm(Nn~Mo*A6Dk$>P}p(;rx6qk|q2!Ba%xJW^I?C z0CAm8#5ZuT)_y5kj26}076~c&bH$}Il}sz0cz|I&=T~a`Tf51(4b94wsZ2pzgbnP$ zs?MT=aa*w(@)T<*(3R|WM0e?n#c*07R~Na=X$;_X+glOi5?bwjW`(sjFCr7)0H+G; z-BKr9Zp}LIO60RQRvIrn;;K|d9H4F|kTPKfFhRpZjG+^BG%Rp7Fb4~F*^p}t(>{uW z7Q^!A!DfSca5(FC;+5I~MMWlWGOciI8ReN`MIBtOWcwDYb~4KfW3fu?`}41f%P z$N+EvG#VNW02*W(83RoK02u%o0gwRT0BAHc8UQrNG%^O7001%oG6Nt0RFY^U1i+aZ z162J}@+s-Gnx0eAX_G;q8X9N~8%Bi2)jdz0B%e#^DL$f4u{~(&4gz-5x*g%vlYE?K zWTiVtY@?apPG>58dJCB%+ZiNfYW>6E_OTTN!HQmqu`|0r$tBRslQTRH`Ktgs*{RvxSn))~DRjvc;oP?3XO2j{3{4yHc2+^>$4bRB_2R zDG+VJ5~L)b#YqUV6e&Uxg-9W|q^ea+Dj;~0QUUs3?#P@KBL+wQCPMI*A)#e1v2jXC zaxGy)T;5RCk>+W0Vh zUad)+Qx!P4%p8;}B(o;FHcmD~!Hc(x6JNQQ$)iSVh1f3U#KbR)7PHl+tjNiWJ!Nn) zB*lYRzI*u~c@sqncLkJF1_Z$pl!-k`5=AIZ`S7RmQ_A%8HkiIQVX3Z)3>QghAogaho_?Thju9ubdl=7+2r;D+@lNOR> z^&XcK1f%^nUu&(r)}?w^eD9ghzVPijcU!H;+QHiCw^QC`*rS*QkK zU2@DAuDZ>KpMQyU-(%~2ZMM@}H5@D)l6|jPhH3A!vB2MIZ#B)gg`1myUCQD<=FI3< zVs;fdpCbs}QNCHc!MV({qHE^KcY{Y^)6S8w%ZZ|#&wZ;F3%%zHw$Z}D!tk!&a4~uH z(~c{iS$blk%1Sd?Qs;*w7B8^C$*$#QU7Lx@dJh!!wJ~t0TDwf$cdg=g9cA9zOjtfP zvxS>*a3@mk!;vs`I9^3GN|#eZl_jEGtlQvTV2lzeVw9yTX-TxDb7y3XR(q;6HP%$S zU8A participation ties #> #> -- Nodes -#> # A tibble: 32 x 4 -#> type name Surname Title -#> -#> 1 FALSE Evelyn Jefferson Mrs -#> 2 FALSE Laura Mandeville Miss -#> 3 FALSE Theresa Anderson Miss -#> 4 FALSE Brenda Rogers Miss -#> 5 FALSE Charlotte McDowd Miss -#> 6 FALSE Frances Anderson Miss -#> # i 26 more rows +#> # A tibble: 32 x 5 +#> name Surname Title active type +#> +#> 1 Evelyn Jefferson Mrs TRUE FALSE +#> 2 Laura Mandeville Miss TRUE FALSE +#> 3 Theresa Anderson Miss TRUE FALSE +#> 4 Brenda Rogers Miss TRUE FALSE +#> # i 28 more rows +#> +#> -- Changes +#> # A tibble: 14 x 4 +#> time node var value +#> +#> 1 1936-02-23 29 active TRUE +#> 2 1936-02-25 23 active TRUE +#> 3 1936-03-02 20 active TRUE +#> 4 1936-03-15 25 active TRUE +#> # i 10 more rows #> #> -- Ties -#> # A tibble: 89 x 3 -#> from to date -#> -#> 1 14 29 1936-02-23 -#> 2 15 29 1936-02-23 -#> 3 17 29 1936-02-23 -#> 4 18 29 1936-02-23 -#> 5 1 23 1936-02-25 -#> 6 2 23 1936-02-25 -#> # i 83 more rows +#> # A tibble: 89 x 2 +#> from to +#> +#> 1 14 29 +#> 2 15 29 +#> 3 17 29 +#> 4 18 29 +#> # i 85 more rows #> }\if{html}{\out{
}} } @@ -46,8 +52,13 @@ as reported in the \emph{Old City Herald} in 1936. By convention, the nodes are named by the women's first names and the code numbers of the events, but the women's surnames and titles (Miss, Mrs.) are recorded here too. -The events' dates are recorded in place of the Surname, -and these dates are also offered as a tie attribute. +The events' dates are recorded in place of the Surname. +A date describes the event and not the attendance, +so each event enters the network on the date it is held, +which the changes component records. +\code{is_changing()} therefore marks this network TRUE, +and \code{to_time()} returns the events held up to a given moment, +without the women who attended no event by then. } \references{ Davis, Allison, Burleigh B. Gardner, and Mary R. Gardner. 1941. diff --git a/tests/testthat/test-functional_marks.R b/tests/testthat/test-functional_marks.R index 9fa85836..61e1d937 100644 --- a/tests/testthat/test-functional_marks.R +++ b/tests/testthat/test-functional_marks.R @@ -9,11 +9,12 @@ is_funs <- setdiff(alive_functions("^is_"), "is_manynet") # Which is_*() functions the twomode fixture, ison_southern_women, satisfies. # A two-mode network of women's attendance at events is labelled, attributed, -# connected, uniplex, and held as a graph, and is none of the other things a -# mark names. Matching on the name rather than listing the functions keeps a -# newly added mark covered without an entry here. +# connected, uniplex, and held as a graph. Each event enters the network on the +# date it is held, which the changes record, so it is also changing, and it is +# none of the other things a mark names. Matching on the name rather than +# listing the functions keeps a newly added mark covered without an entry here. .twomode_marks <- paste0("twomode|attributed|igraph|connected|labelled|", - "(? Date: Wed, 2 Sep 2026 18:22:43 +0200 Subject: [PATCH 12/14] Tested the two-mode fixture through the package's own accessors Three tests reached for `igraph::vcount()`, `igraph::delete_vertex_attr()`, and the class a projection happens to return. They now use `net_nodes()`, coerce with `as_igraph()` where the comparison is an igraph one, and assert that a projection returns the class it was given. Co-Authored-By: Claude Opus 5 --- tests/testthat/test-manip_format.R | 9 ++++++--- tests/testthat/test-manip_transform.R | 8 ++++++-- 2 files changed, 12 insertions(+), 5 deletions(-) diff --git a/tests/testthat/test-manip_format.R b/tests/testthat/test-manip_format.R index ee0a5f95..c782df7e 100644 --- a/tests/testthat/test-manip_format.R +++ b/tests/testthat/test-manip_format.R @@ -75,11 +75,14 @@ test_that("to_reciprocated works",{ test_that("to_onemode works",{ expect_false(is_twomode(to_onemode(ison_southern_women))) - expect_equal(c(to_onemode(ison_southern_women))[3], - c(igraph::delete_vertex_attr(ison_southern_women, "type"))[3]) + # 'type' is how an igraph marks the two modes, so the comparison is made in + # that class rather than on whichever class the fixture happens to be + sw_ig <- as_igraph(ison_southern_women) + expect_equal(c(to_onemode(sw_ig))[3], + c(igraph::delete_vertex_attr(sw_ig, "type"))[3]) expect_equal(as_matrix(to_onemode(as_tidygraph(ison_southern_women))), as_matrix(as_tidygraph( - igraph::delete_vertex_attr(ison_southern_women, "type")))) + igraph::delete_vertex_attr(sw_ig, "type")))) }) test_that("to_unsigned keeps the ties of the sign it is asked for", { diff --git a/tests/testthat/test-manip_transform.R b/tests/testthat/test-manip_transform.R index 61233470..12abb29a 100644 --- a/tests/testthat/test-manip_transform.R +++ b/tests/testthat/test-manip_transform.R @@ -420,10 +420,14 @@ test_that("binary-only measures dichotomise valued networks", { }) test_that("every projection measure works across classes", { + # a `to_*()` function returns the class it was given, so the fixture's own + # class is what each projection of it should come back as for (s in c("match", "overlap", "crossmin", "bonacich", "covariance")) { - expect_s3_class(to_mode1(ison_southern_women, s), "tbl_graph") + expect_s3_class(to_mode1(ison_southern_women, s), class(ison_southern_women)[1]) expect_true(is.matrix(to_mode1(sw_mat, s))) - expect_s3_class(to_mode2(ison_southern_women, s), "tbl_graph") + expect_s3_class(to_mode2(ison_southern_women, s), class(ison_southern_women)[1]) + expect_s3_class(to_mode1(as_tidygraph(ison_southern_women), s), "tbl_graph") + expect_s3_class(to_mode2(as_tidygraph(ison_southern_women), s), "tbl_graph") } }) From 2fa58fc6775bc7f82a430e57bd8facce79ceb008 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Wed, 2 Sep 2026 18:22:43 +0200 Subject: [PATCH 13/14] Updated NEWS for this patch Co-Authored-By: Claude Opus 5 --- NEWS.md | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 77edb0ff..e6163130 100644 --- a/NEWS.md +++ b/NEWS.md @@ -12,14 +12,22 @@ - Improved `describe_nodes()` on networks of three or more modes (closed #174) - Fixed `keep_nodes()` to drop and reindex `$missings` (closed #173) - `reserved_cols()` now names every out-of-range id, instead of erroring -- Improved `validate_stocnet()` on names it reserves but does not rename +- Improved `validate_stocnet()` to read a node 'id' as an id and not a label +- Improved `validate_stocnet()` to read a tie 'date' as another name for a time ## Coercion - Fixed `as_igraph.stocnet()` on multimodal and multilevel networks (closed #170) +## Manipulating + +- Added `delete_nodes.stocnet()`, which reindexes every component it keeps + - Deleting nodes used to leave the changes naming nodes that were gone + ## Modifying +- Added `to_mode1.stocnet()` and `to_mode2.stocnet()`, which prune the changes + - A projection discards a mode, so a change about it describes no node - Added `keep = "both"` to `to_unsigned()`, which keeps every tie but not its sign - Fixed `to_unsigned.data.frame()` erroring on a signed edgelist - now drops the ties of the other sign, as the other methods do @@ -38,6 +46,12 @@ - Fixed `mode_nodes()` to count the nodes in each of three or more modes - Fixed `net_modes.igraph()` to count the levels an igraph 'lvl' attribute records +## Data + +- Improved `ison_southern_women` to record when each of its events is held + - `is_changing()` now marks it TRUE, as each event enters on its own date + - The dates move from a tie attribute to the changes, where they describe the event + # manynet 2.3.1 ## Marking From 6c8b7e0e9d69ae319089e16208384e8dc11abe9b Mon Sep 17 00:00:00 2001 From: James Hollway Date: Thu, 3 Sep 2026 04:58:22 +0200 Subject: [PATCH 14/14] Added an additional style point --- .github/CONTRIBUTING.md | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/.github/CONTRIBUTING.md b/.github/CONTRIBUTING.md index 0dcbae37..6b286e35 100644 --- a/.github/CONTRIBUTING.md +++ b/.github/CONTRIBUTING.md @@ -110,7 +110,13 @@ they need. ## Style -In terms of style, we are aiming for pleasant predictability in terms of user experience. +In terms of style, we are aiming for: + +- "declarative simplicity". Functions should not have many arguments, +as this requires that the user read the documentation carefully to understand +what all of the options imply. +Functions should be named after what they do, not their (often insider) reference to their progenitor. +- "pleasant predictability" in terms of user experience. To that end, we have a regular syntax that users can rely on producing expected effects. Functions in the same family (`as_*()`, `is_*()`, `create_*()`, etc.) should share argument order and naming, so that behaviour is guessable across the family.