diff --git a/R/attributes.R b/R/attributes.R index d45ab8853f0..266ac1b329b 100644 --- a/R/attributes.R +++ b/R/attributes.R @@ -1256,7 +1256,11 @@ is_weighted <- function(graph) { is_bipartite <- function(graph) { ensure_igraph(graph) - "type" %in% vertex_attr_names(graph) + if (!"type" %in% vertex_attr_names(graph)) { + return(FALSE) + } + type_vals <- vertex_attr(graph, "type") + is.logical(type_vals) || !anyNA(as.logical(type_vals)) } ############# diff --git a/R/other.R b/R/other.R index fac2f133240..24f6bd739e2 100644 --- a/R/other.R +++ b/R/other.R @@ -159,11 +159,21 @@ handle_vertex_type_arg <- function(types, graph, required = T) { } if (!is.null(types)) { if (!is.logical(types)) { - cli::cli_warn("vertex types converted to logical.") - } - types <- as.logical(types) - if (any(is.na(types))) { - cli::cli_abort("`NA' is not allowed in vertex types") + converted <- suppressWarnings(as.logical(types)) + if (anyNA(converted)) { + cli::cli_abort( + "The {.arg type} vertex attribute is not logical and could not be \\ + converted to logical. Please set it to a logical vector." + ) + } + cli::cli_warn( + "The {.arg type} vertex attribute is not logical; converting to logical." + ) + types <- converted + } else if (anyNA(types)) { + cli::cli_abort( + "The {.arg type} vertex attribute contains {.val NA} values, which are not allowed." + ) } } if (is.null(types) && required) { diff --git a/tests/testthat/test-attributes.R b/tests/testthat/test-attributes.R index bf54e2ae311..bc521469eab 100644 --- a/tests/testthat/test-attributes.R +++ b/tests/testthat/test-attributes.R @@ -303,6 +303,29 @@ test_that("is_bipartite works", { ) }) +test_that("is_bipartite checks that type attribute is logical or convertible", { + g <- make_ring(4) + + # No type attribute + expect_false(is_bipartite(g)) + + # Logical type + V(g)$type <- c(FALSE, TRUE, FALSE, TRUE) + expect_true(is_bipartite(g)) + + # Numeric 0/1 is convertible to logical + V(g)$type <- c(0, 1, 0, 1) + expect_true(is_bipartite(g)) + + # Character not convertible via as.logical (produces NAs) + V(g)$type <- c("a", "b", "a", "b") + expect_false(is_bipartite(g)) + + # NA-producing conversion + V(g)$type <- c(1L, 2L, 1L, NA_integer_) + expect_false(is_bipartite(g)) +}) + test_that("without_attr", { withr::local_seed(42) g_stripped <- sample_gnp(10, 2 / 10) %>%