将自定义函数应用于多个 data.table 列

Question

我编写了下面的函数，它采用非标准时间格式，例如'730' (7:30) 并将其转换为十进制小时数，例如'7.5'。

decimal_time <- function(x) {
  x <- as.character(x)
  tmp <- nchar(x)

  if (tmp < 4 & !is.na(tmp)){
    x <- paste0(strrep('0',4-tmp),as.character(x))
  }

  x <-  sub("([[:digit:]]{2,2})$", ":\\1", x)
  x <- strsplit(x,':')[[1]]
  x <- as.numeric(x)
  x[1]+x[2]/60
}

要将其应用于一列，我执行以下操作...

dt_times[, New_Time := lapply(Time, decimal_time)]

但是我不知道如何将这个相同的函数应用于许多共享相同格式的列。当然，如果它是一个矢量化函数（比如“平均”），那么我可以写...

dt_times[, lapply(.SD, mean), .SDcols = c('col1', 'col2')]

...但是如果我的函数首先使用 lapply 我该怎么办？！请帮忙！

Answer 1

如果您的问题是您没有矢量化函数，那么您可以在函数内部使用 sapply

decimal_time <- function(y) {
  sapply(y,function(x) {
    x <- as.character(x)
    tmp <- nchar(x)

    if (tmp < 4 & !is.na(tmp)){
      x <- paste0(strrep('0',4-tmp),as.character(x))
    }

    x <-  sub("([[:digit:]]{2,2})$", ":\\1", x)
    x <- strsplit(x,':')[[1]]
    x <- as.numeric(x)
    x[1]+x[2]/60
  })
}

Answer 2

您不需要任何循环（函数外部或内部）。您可以完全矢量化您的功能：

decimal_time <- function(x) {
  x <- as.character(x)
  tmp <- nchar(x)
  ii <- tmp < 4 & !is.na(tmp)
  x[ii] <- paste0(strrep('0',4-tmp[ii]), x[ii])

   x <-  sub("([[:digit:]]{2,2})$", ":\\1", x)
  x <-  strsplit(x,':')
  x <- do.call(rbind, x)
  mode(x) <- "numeric"
  x[,1]+x[,2]/60
}

x <- c("1", "730")
decimal_time(x)
#[1] 0.01666667 7.50000000

使用整数除法比文本处理更容易：

decimal_time <- function(x) {
  x <- as.integer(x)
  if (any(x >= 2400)) warning("input >= 24 h")
  x %/% 100 + (x %% 100) / 60
}

x <- c("1", "730")
decimal_time(x)
#[1] 0.01666667 7.50000000

Answer 3

这是我过去遇到的一个问题。我的解决方案通常是运行 for 循环：

for(col in c('col1', 'col2'){
 dt_times[, (col):= vapply(col, function(x) decimal_time(get(x)), FUN.VALUE = numeric(1))]
}

也许不是最优雅的解决方案，但它应该可以完成工作。

Answer 4

我建议您使用 purrr 包中的 map_dfr 函数在 data.frame 上应用函数，同时返回一个 data.frame。在底层，map_* 系列函数的迭代方式与使用 for 循环相同，但以更易读和更整洁的方式进行。

另外，如果您想将此函数映射到特定的列名，您也可以使用 dplyr 包，结合使用 filter 和 contains 函数，您可以修改那些特定的变量。结合这些功能：

library(dplyr)
library(purrr)

df %>%
  filter(contains("some_string")) %>%
  map_dfr(decimal_time)