日志转换循环

A loop for log transformation

我的任务是编写一个函数,旨在根据声明的变量 ([=14) 的水平计算给定数据集 (dset) 中给定变量 (vars) 的对数=]).如果给定级别 byvar 的给定变量的最小值大于 0,则计算简单的自然对数。否则,给定段的给定变量的新值计算为:

new.value =  log(old.value + 1 + abs(min.value.of.given.var.for.given.level)

为了实现这一点,我写了这样一段代码(为了一个可重现的例子):

set.seed(1234567)  

data(iris)
iris$random <- rnorm(nrow(iris), 0, 1)

log.vars <- function(dset, vars, byvar, verbose = F){

  # a loop by levels of "byvar"

  for(i in 1:length(unique(dset[[byvar]]))){

    if(verbose == T){
      print(paste0("------ level=", unique(dset[[byvar]])[i], "----"))
    }

    # a loop by variables in "vars"

    for(j in 1:length(vars)){

      min.var <- min(dset[[vars[j]]][dset[[byvar]] == unique(dset[[byvar]])[i]])

      # if minimum of a given variable for a given level is greater than 0 then
      # calculate its logarithm;
      # otherwise, add to its value 1 and the mode of its minimum and calculate
      # its logarithm

      dset[[paste0("ln_", vars[j])]][dset[[byvar]] == unique(dset[[byvar]])[i]] <- 
        if(min.var > 0){
          log(dset[[vars[j]]][dset[[byvar]] == unique(dset[[byvar]])[i]])
        } else{
          log(dset[[vars[j]]][dset[[byvar]] == unique(dset[[byvar]])[i]] + 1 +
              abs(min.var))
        }
    }
  }
  return(dset)
}

iris2 <- log.vars(dset = iris,
         vars = c("Sepal.Length", "random", "Sepal.Width"),
         byvar = "Species",
         verbose = T)

head(iris2)

它可以工作,但是,它的可读性存在明显的问题。另外,我想知道它的性能是否可以提高。最后但并非最不重要的一点是,目的是保留数据集中观察的顺序。任何类型的 help/suggestions 将不胜感激

将我的评论变成答案:

不要重新发明轮子。在basetapplyave)、data.tableplyrdplyr中有"do function by group"的好方法。您不仅需要提供功能:

my_log = function(x) {
    m = min(x)
    if (m > 0) return(log(x))
    return(log1p(x - m))
}

以上实现了你描述的日志。由于您想 运行 在同一组中对多个列进行此操作,dplyr::mutate_each 可以让我们的生活变得轻松:

library(dplyr)
iris %>% group_by(Species) %>%
    mutate_each(funs = funs(logged = my_log))
# Source: local data frame [150 x 11]
# Groups: Species [3]
# 
#    Sepal.Length Sepal.Width Petal.Length Petal.Width Species       random Sepal.Length_logged
#           <dbl>       <dbl>        <dbl>       <dbl>  <fctr>        <dbl>               <dbl>
# 1           5.1         3.5          1.4         0.2  setosa  0.156703769            1.629241
# 2           4.9         3.0          1.4         0.2  setosa  1.373811191            1.589235
# 3           4.7         3.2          1.3         0.2  setosa  0.730670244            1.547563
# 4           4.6         3.1          1.5         0.2  setosa -1.350800927            1.526056
# 5           5.0         3.6          1.4         0.2  setosa -0.008514961            1.609438
# 6           5.4         3.9          1.7         0.4  setosa  0.320981863            1.686399
# 7           4.6         3.4          1.4         0.3  setosa -1.778148409            1.526056
# 8           5.0         3.4          1.5         0.2  setosa  0.909503835            1.609438
# 9           4.4         2.9          1.4         0.2  setosa -0.919404336            1.481605
# 10          4.9         3.1          1.5         0.1  setosa -0.157714831            1.589235
# # ... with 140 more rows, and 4 more variables: Sepal.Width_logged <dbl>, Petal.Length_logged <dbl>,
# #   Petal.Width_logged <dbl>, random_logged <dbl>

仅此而已!这看起来不错,简洁且可读。如果您想 "functionalize" 更多,您可以将其包装到一个函数中,如下所示,以获得相同的结果:

log_vars = function(data, vars, byvar) {
    data %>% group_by_(byvar) %>%
        mutate_each_(funs = funs(logged = my_log), vars = vars) %>%
        return
}

log_vars(iris, vars = c("Sepal.Width", "random"), byvar = "Species")

关于你的三个问题:

  1. 可读性 - 这似乎更具可读性。如果您愿意,可以在没有 %>% 管道的情况下重写。
  2. 性能 - 在重要的地方会更快:包含大量组的大型数据。
  3. 顺序 - 行的顺序不会改变。