mutate_s() function to keep attributes during mutate()

mutate_s.R

mutate_s <- function(.data,...){
  if(!inherits(.data,"data.frame")) stop("mutate_s() can only act on data.frames")
  require(rlang)
  .dots <- rlang::enexprs(...)
  lhs <- names(.dots)
  k <- length(.dots)
  
  p_env <- parent.frame()
  
  prev_attr <- vector("list",length=k)
  
  for(i in 1:k){
    if(exists(lhs[i],envir=p_env)){
      prev_attr[[i]] <- attributes(get(lhs[i],p_env))
    }
  }
  
  out_expr <- vector("list",k)
  
  for(i in 1:k){
    if(!is.null(prev_attr[[i]])){
      out_expr[[i]] <- as.call(c(quote(`structure`),
                                 .dots[[i]],
                                 prev_attr[[i]]
      ))
        
    } else {
      out_expr[[i]] <- .dots[[i]]
    }
  }
  
  names(out_expr) <- lhs
  
  this_call <- as.call(c(as.call(list(quote(`::`),
                                      quote(`dplyr`),
                                      quote(`mutate`))),
                         quote(`.data`),
                         out_expr))
  
  eval(this_call)
}