diff --git a/R/iterators.R b/R/iterators.R index 6eb1072e228..729a78c46ff 100644 --- a/R/iterators.R +++ b/R/iterators.R @@ -1132,7 +1132,7 @@ simple_es_index <- function(x, i, na_ok = FALSE) { } if (is.logical(ii) && (length(ii) != length(x) && length(ii) != 1)) { cli::cli_abort( - "Error: Logical index length does not match the number of edges. Recycling is not allowed." + "Logical index length does not match the number of edges. Recycling is not allowed." ) } @@ -1197,11 +1197,19 @@ simple_es_index <- function(x, i, na_ok = FALSE) { #' @name igraph-vs-attributes #' @export `[[<-.igraph.vs` <- function(x, i, value) { + if (!rlang::has_name(attributes(value), "attr_name")) { + cli::cli_abort("Can't find {.val name} for vertex attribute.") + } if ( - !"name" %in% names(attributes(value)) || - !"value" %in% names(attributes(value)) + !rlang::has_name(attributes(value), "attr_value") && + !is_complete_iterator(value) ) { - cli::cli_abort("Invalid indexing.") + cli::cli_abort( + c( + "Can't find {.val value} for vertex attribute {.val {attr(value, 'attr_name')}}.", + i = "Removing an attribute is only supported for the whole vertex sequence, e.g. {.code V(g)${attr(value, 'attr_name')} <- NULL}, not a subset. Use {.fn delete_vertex_attr}." + ) + ) } if (is.null(get_vs_graph(x))) { cli::cli_abort("Graph is unknown.", .internal = TRUE) @@ -1219,11 +1227,19 @@ simple_es_index <- function(x, i, na_ok = FALSE) { #' @name igraph-es-attributes #' @export `[[<-.igraph.es` <- function(x, i, value) { + if (!rlang::has_name(attributes(value), "attr_name")) { + cli::cli_abort("Can't find {.val name} for edge attribute.") + } if ( - !"name" %in% names(attributes(value)) || - !"value" %in% names(attributes(value)) + !rlang::has_name(attributes(value), "attr_value") && + !is_complete_iterator(value) ) { - cli::cli_abort("Invalid indexing.") + cli::cli_abort( + c( + "Can't find {.val value} for edge attribute {.val {attr(value, 'attr_name')}}.", + i = "Removing an attribute is only supported for the whole edge sequence, e.g. {.code E(g)${attr(value, 'attr_name')} <- NULL}, not a subset. Use {.fn delete_edge_attr}." + ) + ) } if (is.null(get_es_graph(x))) { cli::cli_abort("Graph is unknown.", .internal = TRUE) @@ -1292,7 +1308,7 @@ simple_es_index <- function(x, i, na_ok = FALSE) { `$.igraph.vs` <- function(x, name) { graph <- get_vs_graph(x) if (is.null(graph)) { - cli::cli_abort("Graph is unknown") + cli::cli_abort("Can't find graph.") } res <- vertex_attr(graph, name, x) if (is_single_index(x)) { @@ -1345,7 +1361,7 @@ simple_es_index <- function(x, i, na_ok = FALSE) { `$.igraph.es` <- function(x, name) { graph <- get_es_graph(x) if (is.null(graph)) { - cli::cli_abort("Graph is unknown") + cli::cli_abort("Can't find graph.") } res <- edge_attr(graph, name, x) if (is_single_index(x)) { @@ -1363,10 +1379,10 @@ simple_es_index <- function(x, i, na_ok = FALSE) { #' @export `$<-.igraph.vs` <- function(x, name, value) { if (is.null(get_vs_graph(x))) { - cli::cli_abort("Graph is unknown") + cli::cli_abort("Can't find graph.") } - attr(x, "name") <- name - attr(x, "value") <- value + attr(x, "attr_name") <- name + attr(x, "attr_value") <- value x } @@ -1378,10 +1394,10 @@ simple_es_index <- function(x, i, na_ok = FALSE) { #' @family vertex and edge sequences `$<-.igraph.es` <- function(x, name, value) { if (is.null(get_es_graph(x))) { - cli::cli_abort("Graph is unknown") + cli::cli_abort("Can't find graph.") } - attr(x, "name") <- name - attr(x, "value") <- value + attr(x, "attr_name") <- name + attr(x, "attr_value") <- value x } @@ -1389,17 +1405,25 @@ simple_es_index <- function(x, i, na_ok = FALSE) { #' @export `V<-` <- function(x, value) { ensure_igraph(x) - if ( - !"name" %in% names(attributes(value)) || - !"value" %in% names(attributes(value)) - ) { - cli::cli_abort("invalid indexing") + if (!rlang::has_name(attributes(value), "attr_name")) { + cli::cli_abort("Can't find {.val name} for vertex attribute.") + } + if (!rlang::has_name(attributes(value), "attr_value")) { + if (is_complete_iterator(value)) { + return(delete_vertex_attr(x, attr(value, "attr_name"))) + } + cli::cli_abort( + c( + "Can't find {.val value} for vertex attribute {.val {attr(value, 'attr_name')}}.", + i = "Removing an attribute is only supported for the whole vertex sequence, e.g. {.code V(g)${attr(value, 'attr_name')} <- NULL}, not a subset. Use {.fn delete_vertex_attr}." + ) + ) } i_set_vertex_attr( x, - attr(value, "name"), + name = attr(value, "attr_name"), index = value, - value = attr(value, "value"), + value = attr(value, "attr_value"), check = FALSE ) } @@ -1413,17 +1437,25 @@ simple_es_index <- function(x, i, na_ok = FALSE) { #' @export `E<-` <- function(x, path = NULL, P = NULL, directed = NULL, value) { ensure_igraph(x) - if ( - !"name" %in% names(attributes(value)) || - !"value" %in% names(attributes(value)) - ) { - cli::cli_abort("invalid indexing") + if (!rlang::has_name(attributes(value), "attr_name")) { + cli::cli_abort("Can't find {.val name} for edge attribute.") + } + if (!rlang::has_name(attributes(value), "attr_value")) { + if (is_complete_iterator(value)) { + return(delete_edge_attr(x, attr(value, "attr_name"))) + } + cli::cli_abort( + c( + "Can't find {.val value} for edge attribute {.val {attr(value, 'attr_name')}}.", + i = "Removing an attribute is only supported for the whole edge sequence, e.g. {.code E(g)${attr(value, 'attr_name')} <- NULL}, not a subset. Use {.fn delete_edge_attr}." + ) + ) } i_set_edge_attr( x, - attr(value, "name"), + name = attr(value, "attr_name"), index = value, - value = attr(value, "value"), + value = attr(value, "attr_value"), check = FALSE ) } diff --git a/tests/testthat/_snaps/iterators.md b/tests/testthat/_snaps/iterators.md index d01392169aa..14bfdb75dfe 100644 --- a/tests/testthat/_snaps/iterators.md +++ b/tests/testthat/_snaps/iterators.md @@ -106,5 +106,129 @@ E(g)[c(TRUE, FALSE)] Condition Error in `FUN()`: - ! Error: Logical index length does not match the number of edges. Recycling is not allowed. + ! Logical index length does not match the number of edges. Recycling is not allowed. + +# assigning `NULL` to a subset of vertices/edges errors instead of silently doing nothing + + Code + V(g)[1:3]$color <- NULL + Condition + Error in `[<-`: + ! Can't find "value" for vertex attribute "color". + i Removing an attribute is only supported for the whole vertex sequence, e.g. `V(g)$color <- NULL`, not a subset. Use `delete_vertex_attr()`. + +--- + + Code + E(g)[1:3]$weight <- NULL + Condition + Error in `[<-`: + ! Can't find "value" for edge attribute "weight". + i Removing an attribute is only supported for the whole edge sequence, e.g. `E(g)$weight <- NULL`, not a subset. Use `delete_edge_attr()`. + +# assigning `NULL` for a non-existent attribute errors like `delete_vertex_attr()`/`delete_edge_attr()` + + Code + V(g)$color <- NULL + Condition + Error in `delete_vertex_attr()`: + ! No vertex attribute `color` found. + +--- + + Code + E(g)$weight <- NULL + Condition + Error in `delete_edge_attr()`: + ! No edge attribute `weight` found. + +# direct misuse of `V<-`/`E<-`/`[<-`/`[[<-` errors well + + Code + V(g) <- "blue" + Condition + Error in `V<-`: + ! Can't find "name" for vertex attribute. + +--- + + Code + E(g) <- "blue" + Condition + Error in `E<-`: + ! Can't find "name" for edge attribute. + +--- + + Code + V(g)[1] <- "blue" + Condition + Error in `[<-`: + ! Can't find "name" for vertex attribute. + +--- + + Code + E(g)[1] <- "blue" + Condition + Error in `[<-`: + ! Can't find "name" for edge attribute. + +--- + + Code + V(g)[[1]] <- "blue" + Condition + Error in `[[<-`: + ! Can't find "name" for vertex attribute. + +--- + + Code + E(g)[[1]] <- "blue" + Condition + Error in `[[<-`: + ! Can't find "name" for edge attribute. + +# querying or setting attributes errors when the graph is unknown + + Code + vs$color + Condition + Error in `vs$color`: + ! Can't find graph. + +--- + + Code + vs$color <- "blue" + Condition + Error in `$<-`: + ! Can't find graph. + +--- + + Code + es$weight + Condition + Error in `es$weight`: + ! Can't find graph. + +--- + + Code + es$weight <- 0 + Condition + Error in `$<-`: + ! Can't find graph. + +# `[<-.igraph.vs` reports an internal error when the graph is unknown + + Code + `[<-.igraph.vs`(vs, 1, value = payload) + Condition + Error in `[<-.igraph.vs`: + ! Graph is unknown. + i This is an internal error that was detected in the igraph package. + Please report it at with a reprex () and the full backtrace. diff --git a/tests/testthat/test-iterators.R b/tests/testthat/test-iterators.R index 59a6a274fee..b11d384a4e6 100644 --- a/tests/testthat/test-iterators.R +++ b/tests/testthat/test-iterators.R @@ -476,3 +476,128 @@ test_that("identical_graphs() tail arguments and legacy positional recovery", { ) expect_identical(res, identical_graphs(g1, g2, attrs = FALSE)) }) + +test_that("`V(g)[idx]$attr <-` and `E(g)[idx]$attr <-` set attributes as intended", { + g <- make_ring(5) + V(g)$color <- "red" + E(g)$weight <- 1:5 + + V(g)[1:3]$color <- "blue" + expect_equal(V(g)$color, c("blue", "blue", "blue", "red", "red")) + + E(g)[1:3]$weight <- 0 + expect_equal(E(g)$weight, c(0, 0, 0, 4, 5)) + + V(g)$color <- "green" + expect_equal(V(g)$color, rep("green", 5)) + + E(g)$weight <- 9 + expect_equal(E(g)$weight, rep(9, 5)) +}) + +test_that("assigning `NA` blanks attribute values without removing the attribute", { + g <- make_ring(5) + V(g)$color <- "red" + + V(g)$color <- NA + expect_true(all(is.na(V(g)$color))) + expect_true("color" %in% vertex_attr_names(g)) +}) + +test_that("assigning `NULL` to the full sequence removes the attribute", { + g <- make_ring(5) + V(g)$color <- "red" + E(g)$weight <- 1:5 + + V(g)$color <- NULL + expect_false("color" %in% vertex_attr_names(g)) + + E(g)$weight <- NULL + expect_false("weight" %in% edge_attr_names(g)) +}) + +test_that("assigning `NULL` to a subset of vertices/edges errors instead of silently doing nothing", { + g <- make_ring(5) + V(g)$color <- "red" + E(g)$weight <- 1:5 + + expect_snapshot(error = TRUE, { + V(g)[1:3]$color <- NULL + }) + expect_snapshot(error = TRUE, { + E(g)[1:3]$weight <- NULL + }) +}) + +test_that("assigning `NULL` for a non-existent attribute errors like `delete_vertex_attr()`/`delete_edge_attr()`", { + g <- make_ring(5) + + expect_snapshot(error = TRUE, { + V(g)$color <- NULL + }) + expect_snapshot(error = TRUE, { + E(g)$weight <- NULL + }) +}) + +test_that("direct misuse of `V<-`/`E<-`/`[<-`/`[[<-` errors well", { + g <- make_( + ring(10), + with_vertex_( + name = LETTERS[1:10], + color = sample(1:2, 10, replace = TRUE) + ) + ) + expect_snapshot(error = TRUE, { + V(g) <- "blue" + }) + expect_snapshot(error = TRUE, { + E(g) <- "blue" + }) + expect_snapshot(error = TRUE, { + V(g)[1] <- "blue" + }) + expect_snapshot(error = TRUE, { + E(g)[1] <- "blue" + }) + expect_snapshot(error = TRUE, { + V(g)[[1]] <- "blue" + }) + expect_snapshot(error = TRUE, { + E(g)[[1]] <- "blue" + }) +}) + +test_that("querying or setting attributes errors when the graph is unknown", { + g <- make_ring(5) + V(g)$color <- "red" + E(g)$weight <- 1:5 + + vs <- V(g) + attr(vs, "env") <- NULL + es <- E(g) + attr(es, "env") <- NULL + + expect_snapshot(error = TRUE, vs$color) + expect_snapshot(error = TRUE, { + vs$color <- "blue" + }) + expect_snapshot(error = TRUE, es$weight) + expect_snapshot(error = TRUE, { + es$weight <- 0 + }) +}) + +test_that("`[<-.igraph.vs` reports an internal error when the graph is unknown", { + # Defensive branch flagged in PR #2006 review as possibly disappearing + # once attribute handling is reworked -- kept here as cheap insurance, + # not exhaustive coverage. + g <- make_ring(5) + vs <- V(g) + attr(vs, "env") <- NULL + payload <- structure(1, attr_name = "color", attr_value = "blue") + + expect_snapshot(error = TRUE, { + `[<-.igraph.vs`(vs, 1, value = payload) + }) +})