return same class from function which was the input

General
1

Let add1 be a function which adds 1 to a numeric vector. After a while I realize that I need the same function applied to a data.frame, sometimes to a list, etc...
of course I do not write 10 different functions, I use R's great single dispatching system.
Do I really have to write a method for each data.frame, data.table, etc.. I ask because they are all lists and behave very similarly. Currently, I need to dispatch on each class because I want to have the same class returning from the function. How can I store the class at the beginning, and assign it to the end result of the function which is then returned?
Maybe there's another apply/map/ ... function I've missed,

library("data.table")

add1 <- function (x, ...) {
  UseMethod("add1")
}

add1.numeric <- function(x) {
  x <- x + 1
  return(x)
}

add1.list <- function(x) {
  x <- lapply(x, function(x) add1(x))
  return(x)
}

add1.data.frame <- function(x) {
  x <- lapply(x, function(x) add1(x))
  x <- as.data.frame(x)
  return(x)
}

add1.data.table <- function(x) {
  x <- lapply(x, function(x) add1(x))
  x <- data.table::as.data.table(x)
  return(x)
}

x <- rnorm(100)
x_df <- data.frame(rnorm(100), rnorm(100))
x_list <- list(rnorm(100), rnorm(100))
x_dt <- data.table::data.table(rnorm(100), rnorm(100))

add1(x)
add1(x_df)
add1(x_list)
add1(x_dt)
2

You mean with add1.default :


add1 <- function (x, ...) {
  UseMethod("add1")
}

add1.numeric <- function(x) {
  x <- x + 1
  return(x)
}

add1.list <- function(x) {
  x <- lapply(x, function(x) add1(x))
  return(x)
}

# add1.data.frame <- function(x) {
#   x <- lapply(x, function(x) add1(x))
#   x <- as.data.frame(x)
#   return(x)
# }

# add1.data.table <- function(x) {
#   x <- lapply(x, function(x) add1(x))
#   x <- data.table::as.data.table(x)
#   return(x)
# }

add1.default <- function(x) {
  y <- lapply(x, function(x) add1(x))
  class(y) <- class(x)
  return(y)
}

set.seed(2020)
# x <- rnorm(100)
# x_df <- data.frame(rnorm(100), rnorm(100))
# x_list <- list(rnorm(100), rnorm(100))
x_dt <- data.table::data.table(rnorm(100), rnorm(100))

# add1(x)
# add1(x_df)
# add1(x_list)
y = add1(x_dt)

head(x_dt,2)
#>           V1        V2
#> 1: 0.3769721 -1.728784
#> 2: 0.3015484 -0.991261
class(x_dt)
#> [1] "data.table" "data.frame"
head(y,2)
#>          V1           V2
#> 1: 1.376972 -0.728783941
#> 2: 1.301548  0.008739008
class(y)
#> [1] "data.table" "data.frame"

Created on 2020-07-20 by the reprex package (v0.3.0)

2 Likes
3

I didn't try your code @HanOostdijk two days ago, I just thought, wow that's great. I just tested it, and it doesn't work as (I) expected. But it's great to know about .default. If no method is set for a class, then a called function falls back to .default.
If an object has a class (I assume every object has a class since even NULL has a class) and a user calls a function, then R (the interpreter?) searches for an appropriate function (or better: method). A data.table has two classes (or better: one class and one subclass) "data.table" "data.frame" whereof data.table is the subclass and data.frame is the class of the object.
R (the interpreter?) first searches for a method for the subclass, if nothing is found it searches a method for the class and then it falls back to a default method. I guess using a default method might be dangerous since any object can be called with the function and the user does not know whether there is an unintended return value (if it doesn't fail). But it's good because newcomers do not need to care about classes in the first couple of months when learning R during studies or so.
Moreover, to answer my question, a data.table, a tibble and so on are all subclass of data.frame which means, that R will always call the proper function. In case you need a specialized funciton for a data.table you can expand your function by an additional method but unless so, the method for data.frame works just fine.

Moreover your suggested code is very dangerous because you just assigned a random class to an object at the end of the function. Consider following snippet:

x <- rnorm(100)
class(x) <- "data.frame"
class(x)

which is so "wrong"...
I'd rather suggest using something like:
y = eval(parse(text = paste0("as.", class(x), "(y)")))

An example:


add1 <- function (x, ...) {
  UseMethod("add1")
}

add1.numeric <- function(x) {
  x <- x + 1
  return(x)
}

add1.default <- function(x) {
  y <- lapply(x, function(x) add1(x))
  y = eval(parse(text = paste0("as.", class(x), "(y)")))
  return(y)
}

x <- rnorm(5)
add1(x)
# [1]  1.2616155  1.3159336  0.6712396 -0.4637370  1.3239693

y_input <- data.frame(n1 = x, n2 = x)
add1(y_input)
n1            n2
# 1   -0.2203136963 -0.2203136963
# 2    2.1397242299  2.1397242299
# 3    0.8763567672  0.8763567672
# 4    0.8109510231  0.8109510231
# 5    0.3797032551  0.3797032551

This ensures that the outputted object can be converted to the desired class.
In case you do stuff within your function such that the return object cannot be coerced to a data.frame it'll tell you.
Imagine you do stuff within the function and the object is then syrup. This is illustrated in the following example.

add1.default <- function(x) {
  y <- x
  class(y) <- "syrup"
  y = eval(parse(text = paste0("as.", class(x), "(y)")))
  return(y)
}
add1(y_input)

What happens?

Error in as.data.frame.default(y) : 
  cannot coerce class ‘"syrup"’ to a data.frame

You get an error saying it's impossible to convert it.
I suppose this is one way to go, please correct me if I'm wrong =)

AFAIK there's no converter function. Please correct me if something is wrong with it.

#' @title Class conversion
#' @description Try converting an object into the desired class. 
#' @param class `character`, specifying the desired output class.
#' @param x The object which is to be converted.
#' @param ... Further arguments passed to the class creator function.
#' @usage convert(x, class)
#' @return Depends on `class`
#' @examples 
#' \donttest{
#' x <- rnorm(5)
#' convert(x, "data.frame")
#' }
#' @export
convert <- function(x, class, ...) {
  y <- NULL
  if (is.null(y)) {
    y <- tryCatch(eval(parse(text = paste0("as.", class, "(x, ...)"))),
                  error = function(e) NULL)
  }
  if (is.null(y)) {
    y <- tryCatch(eval(parse(text = paste0("as_", class, "(x, ...)"))),
                  error = function(e) NULL)
  }
  if (is.null(y)) {
    stop("x cannot be coerced to class ", class)
  }
  return(y)
}

An example:

x <- rnorm(5)
x_syrup <- x
class(x_syrup) <- "syrup"

o <- convert(x, "data.frame")
o_syrup <- convert(x_syrup, "data.frame")

class(o) # data.frame

o is converted to a data.frame as expected, but o_syrup is not since as.data.frame does not know how to handle a syrup class.

The error message for convert(x_syrup, "data.frame")

Error in convert(x_syrup, "data.frame") : 
  x cannot be coerced to class data.frame