Петля для преобразования журнала

Question

Моя задача - написать функцию, которая предназначена для вычисления логарифмов заданных переменных (vars) в заданном наборе данных (dset) уровнями объявленной переменной (byvar). Если минимум заданной переменной для заданного уровня 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) 

Он работает , однако, существует четкая проблема с его читабельностью. Кроме того, мне интересно, можно ли повысить его производительность. И последнее, но не менее важное: цель состоит в том, чтобы сохранить порядок наблюдений в наборе данных. Любой вид помощи/предложения будут оценены

Answer 1

Обращаясь мои комментарии к ответу:

Не изобретать колесо. Существует хороший способ «выполнять функцию по группам» в base (tapply и ave), data.table, plyr и dplyr. Вы не просто обязаны предоставить эту функцию:

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> 

И это все, что есть к этому! Это кажется приятным, лаконичным и удобочитаемым. Если вы хотите «функционализации» это даже больше, вы можете обернуть, что вверх в функцию, что-то, как показано ниже, для того же результата:

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. Заказ - порядок строк не изменяется.