Add is.na and is.na<- methods

hadley · hadley · commit 7170279b7e2d · 2016-10-28T12:47:31.000-05:00
diff --git a/NAMESPACE b/NAMESPACE
@@ -3,11 +3,13 @@
 S3method("[",blob)
 S3method("[<-",blob)
 S3method("[[<-",blob)
+S3method("is.na<-",blob)
 S3method(as.blob,character)
 S3method(as.blob,integer)
 S3method(as.blob,list)
 S3method(as.blob,raw)
 S3method(format,blob)
+S3method(is.na,blob)
 S3method(is_vector_s3,blob)
 S3method(obj_sum,blob)
 S3method(print,blob)
diff --git a/R/accessors.R b/R/accessors.R
@@ -14,9 +14,14 @@
 
 #' @export
 `[[<-.blob` <- function(x, i, ..., value) {
-  if (!is.raw(value)) {
-    stop("RHS must be raw vector", call. = FALSE)
+  if (!is.raw(value) && !is.null(value)) {
+    stop("RHS must be raw vector or NULL", call. = FALSE)
   }
 
-  NextMethod()
+  if (is.null(value)) {
+    x[i] <- list(NULL)
+    x
+  } else {
+    NextMethod()
+  }
 }
diff --git a/R/format.R b/R/format.R
@@ -3,7 +3,7 @@ format.blob <- function(x, ...) {
   if (length(x) == 0)
     return(character())
 
-  paste0("blob[", blob_size(x, ...) , "]")
+  ifelse(is.na(x), "<NA>", paste0("blob[", blob_size(x, ...) , "]"))
 }
 
 #' @export
diff --git a/R/missing.R b/R/missing.R
@@ -0,0 +1,14 @@
+#' @export
+is.na.blob <- function(x) {
+  vapply(x, is.null, logical(1))
+}
+
+#' @export
+`is.na<-.blob` <- function(x, value) {
+  if (!is.logical(value) || length(x) != length(value)) {
+    stop("RHS must be a logical the same length as `x`", call. = FALSE)
+  }
+
+  x[value] <- rep(list(NULL), sum(value))
+  x
+}
diff --git a/R/util.R b/R/util.R
@@ -2,9 +2,12 @@ is_raw_list <- function(x) {
   if (!is.list(x))
     return(FALSE)
 
-  all_raw <- all(vapply(x, is.raw, logical(1)))
-  if (!all_raw)
+  raw <- vapply(x, is.raw, logical(1))
+  null <- vapply(x, is.null, logical(1))
+
+  if (!all(raw | null))
     return(FALSE)
 
   TRUE
 }
+
diff --git a/tests/testthat/test-accessors.R b/tests/testthat/test-accessors.R
@@ -11,3 +11,14 @@ test_that("can't insert objects of incorrect type", {
   expect_error(x[[1]] <- 1, "must be raw vector")
   expect_error(x[1] <- 1, "must be list of raw vectors")
 })
+
+test_that("can insert raw or NULL", {
+  x <- as.blob(1:4)
+
+  x[[1]] <- as.raw(0)
+  x[2] <- list(as.raw(0))
+  x[[3]] <- NULL
+  x[4] <- list(NULL)
+
+  expect_equal(x, blob(as.raw(0), as.raw(0), NULL, NULL))
+})
diff --git a/tests/testthat/test-missing.R b/tests/testthat/test-missing.R
@@ -0,0 +1,13 @@
+context("missing")
+
+test_that("is.na detects nulls", {
+  x <- blob(as.raw(1), NULL, as.raw(2), NULL)
+  expect_equal(is.na(x), c(FALSE, TRUE, FALSE, TRUE))
+})
+
+test_that("is.na<- sets missing values", {
+  x <- as.blob(1:4)
+  is.na(x) <- (1:4 %% 2 == 0)
+
+  expect_equal(x, blob(as.raw(1), NULL, as.raw(3), NULL))
+})

Original file line number	Diff line number	Diff line change
`@@ -3,7 +3,7 @@ format.blob <- function(x, ...) {`
`3`	`3`	`if (length(x) == 0)`
`4`	`4`	`return(character())`
`5`	`5`
`6`		`- paste0("blob[", blob_size(x, ...) , "]")`
	`6`	`+ ifelse(is.na(x), "<NA>", paste0("blob[", blob_size(x, ...) , "]"))`
`7`	`7`	`}`
`8`	`8`
`9`	`9`	`#' @export`