Skip to content

Instantly share code, notes, and snippets.

@coolbutuseless
Forked from MyKo101/mutate.listframe
Created April 19, 2021 09:47
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save coolbutuseless/eeef97d6bc9c6e6404385f7db8940f97 to your computer and use it in GitHub Desktop.
Save coolbutuseless/eeef97d6bc9c6e6404385f7db8940f97 to your computer and use it in GitHub Desktop.
Application of the mutate method to a listframe
listframe <- function(...){
structure(
tibble(...),
class = c("listframe","tbl_df","tbl","data.frame")
)
}
lf <- listframe(
a = list(1,c("a","b","c"),matrix(1:4,2,2)),
b = list(as.raw(1:3),"hello",c(1,3,4)),
c = list("one","two","three")
)
lf
extract_dots <- function ()
{
.pcall <- match.call(sys.function(sys.parent()), sys.call(sys.parent()),
expand.dots = F, envir = parent.frame(2L))
dots <- .pcall[["..."]]
dots <- dots[names(dots) != ""]
list2env(lapply(dots, eval, parent.frame(2)), parent.frame())
}
named_pmap <- function(.l,.f,...){
.f <- as_mapper(.f,...)
body(.f) <- call("{", quote(extract_dots()), body(.f))
pmap(.l,.f)
}
mutate.listframe <- function(.data,...){
.call <- match.call(expand.dots = FALSE)
if(!...length()){
.data
} else {
.call_out <- match.call()
.call_out[[1]] <- quote(dplyr:::mutate.data.frame)
nms <- names(.call[["..."]])
for(c_nm in nms){
if(is_formula(.call_out[[c_nm]])){
.call_out[[c_nm]] <- call("named_pmap",
substitute(.data),
.call_out[[c_nm]])
}
#.call_out[[c_nm]] <- call("named_pmap",
# substitute(.data),
# call("~",.call_out[[c_nm]]))
}
eval.parent(.call_out)
}
}
lf %>%
mutate(amax = ~max(a),
bclass = ~deparse(class(b)),
)
mutate(lf,amax = ~max(a))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment