More modify methods

NAMESPACE

@@ -4,11 +4,23 @@ S3method(as_mapper,character)
 S3method(as_mapper,default)
 S3method(as_mapper,list)
 S3method(as_mapper,numeric)
+S3method(modify,character)
 S3method(modify,default)
+S3method(modify,double)
+S3method(modify,integer)
+S3method(modify,logical)
 S3method(modify,pairlist)
+S3method(modify_at,character)
 S3method(modify_at,default)
+S3method(modify_at,double)
+S3method(modify_at,integer)
+S3method(modify_at,logical)
 S3method(modify_depth,default)
+S3method(modify_if,character)
 S3method(modify_if,default)
+S3method(modify_if,double)
+S3method(modify_if,integer)
+S3method(modify_if,logical)
 export("%>%")
 export("%@%")
 export("%||%")

R/modify.R

@@ -16,7 +16,9 @@
 #'
 #' All these functions are S3 generic. However, the default method is
 #' sufficient in many cases. It should be suitable for any data type
-#' that implements the subset-assignment method `[<-`.
+#' that implements the subset-assignment method `[<-`. Methods are provided
+#' for character, logical, integer and double classes (counterparts to `map_chr`,
+#' `map_lgl`, `map_int`, and `map_dbl`)
 #'
 #' In some cases it may make sense to provide a custom implementation
 #' with a method suited to your S3 class. For example, a `grouped_df`
@@ -87,6 +89,30 @@ modify.default <- function(.x, .f, ...) {
   .x[] <- map(.x, .f, ...)
   .x
 }
+#' @rdname modify
+#' @export
+modify.integer  <- function (.x, .f, ...) {
+  .x[] <- map_int(.x, .f, ...)
+  .x
+}
+#' @rdname modify
+#' @export
+modify.double  <- function (.x, .f, ...) {
+  .x[] <- map_dbl(.x, .f, ...)
+  .x
+}
+#' @rdname modify
+#' @export
+modify.character  <- function (.x, .f, ...) {
+  .x[] <- map_chr(.x, .f, ...)
+  .x
+}
+#' @rdname modify
+#' @export
+modify.logical  <- function (.x, .f, ...) {
+  .x[] <- map_lgl(.x, .f, ...)
+  .x
+}
 
 #' @export
 modify.pairlist <- function(.x, .f, ...) {
@@ -106,6 +132,34 @@ modify_if.default <- function(.x, .p, .f, ...) {
   .x[sel] <- map(.x[sel], .f, ...)
   .x
 }
+#' @rdname modify
+#' @export
+modify_if.integer <- function(.x, .p, .f, ...) {
+  sel <- probe(.x, .p)
+  .x[sel] <- map_int(.x[sel], .f, ...)
+  .x
+}
+#' @rdname modify
+#' @export
+modify_if.double <- function(.x, .p, .f, ...) {
+  sel <- probe(.x, .p)
+  .x[sel] <- map_dbl(.x[sel], .f, ...)
+  .x
+}
+#' @rdname modify
+#' @export
+modify_if.character <- function(.x, .p, .f, ...) {
+  sel <- probe(.x, .p)
+  .x[sel] <- map_chr(.x[sel], .f, ...)
+  .x
+}
+#' @rdname modify
+#' @export
+modify_if.logical <- function(.x, .p, .f, ...) {
+  sel <- probe(.x, .p)
+  .x[sel] <- map_lgl(.x[sel], .f, ...)
+  .x
+}
 
 #' @rdname modify
 #' @export
@@ -119,6 +173,34 @@ modify_at.default <- function(.x, .at, .f, ...) {
   .x[sel] <- map(.x[sel], .f, ...)
   .x
 }
+#' @rdname modify
+#' @export
+modify_at.integer <- function(.x, .at, .f, ...) {
+  sel <- inv_which(.x, .at)
+  .x[sel] <- map_int(.x[sel], .f, ...)
+  .x
+}
+#' @rdname modify
+#' @export
+modify_at.double <- function(.x, .at, .f, ...) {
+  sel <- inv_which(.x, .at)
+  .x[sel] <- map_dbl(.x[sel], .f, ...)
+  .x
+}
+#' @rdname modify
+#' @export
+modify_at.character <- function(.x, .at, .f, ...) {
+  sel <- inv_which(.x, .at)
+  .x[sel] <- map_chr(.x[sel], .f, ...)
+  .x
+}
+#' @rdname modify
+#' @export
+modify_at.logical <- function(.x, .at, .f, ...) {
+  sel <- inv_which(.x, .at)
+  .x[sel] <- map_lgl(.x[sel], .f, ...)
+  .x
+}
 
 #' @rdname modify
 #' @export

tests/testthat/test-modify.R

@@ -40,6 +40,23 @@ test_that("modify works with calls and pairlists", {
   expect_equal(out, pairlist(2, 3))
 })
 
+test_that("modify{,_at,_if} preserves atomic vector classes", {
+  expect_type(modify("a", identity), "character")
+  expect_type(modify(1L,  identity), "integer")
+  expect_type(modify(1,   identity), "double")
+  expect_type(modify(TRUE, identity), "logical")
+
+  expect_type(modify_at("a",   1L, identity), "character")
+  expect_type(modify_at(1L,    1L, identity), "integer")
+  expect_type(modify_at(1,     1L, identity), "double")
+  expect_type(modify_at(TRUE,  1L, identity), "logical")
+
+  expect_type(modify_if("a",   TRUE, identity), "character")
+  expect_type(modify_if(1L,    TRUE, identity), "integer")
+  expect_type(modify_if(1,     TRUE, identity), "double")
+  expect_type(modify_if(TRUE,  TRUE, identity), "logical")
+})
+
 # modify_depth ------------------------------------------------------------
 
 test_that("modify_depth modifies values at specified depth", {