Skip to content

Instantly share code, notes, and snippets.

@dholstius
Last active May 10, 2019 21:52
Show Gist options
  • Save dholstius/cbc4ec40057fbc2d9f4b to your computer and use it in GitHub Desktop.
Save dholstius/cbc4ec40057fbc2d9f4b to your computer and use it in GitHub Desktop.
Patch data on-the-fly (DRAFT)
#' Patch data on the fly.
#'
#' @param object to be patched
#' @param cond logical condition(s) to be evaluated within scope of object
#' @param \dots name-value pairs
#' @param quiet suppress messages
#'
#' @examples
#' patch(mtcars, where(vs == 0, am == 1), gear = Inf, carb = carb + 10)
#'
#' @export
patch <- function (object, cond, ...) UseMethod("patch")
#' @export
patch.data.frame <- function (object, cond, ..., quiet = FALSE) {
# Rows to be patched
masks <- lazyeval::lazy_eval(cond, object)
i <- which(apply(do.call(cbind, masks), 1, all)) # rows to be patched
if (length(i) == 0) {
warning("conditions are not all TRUE for any rows: nothing patched")
} else {
if (!quiet) message("Patching ", length(i), " rows")
}
# Columns to be patched
dots <- lazyeval::lazy_dots(...)
j <- match(names(dots), names(object))
if (length(j) == 0) warning("no common names: nothing patched")
x <- lazyeval::lazy_eval(dots, data = object[i, ]) # replacement values
object[i, j] <- data.frame(i, x, stringsAsFactors = FALSE)[, -1] # use `i` to force identical shape
return(object)
}
# Not sure where this really ought to be defined
where <- lazyeval::lazy_dots
# Toy example
if (interactive())
patch(mtcars, where(vs == 0, am == 1), gear = Inf, carb = carb + 10)
@MilesMcBain
Copy link

I love this! I've been thinking about something similar for a while, but your implementation with where() is just so nifty. I just need this to not break for factors. Are you thinking of putting this in a package? I'd be keen to help with the legwork if so.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment