2015-03-12 2 views
1

Я искал здесь и в Google и не нашел ответа, который я могу применить к моей ситуации.Применить функцию над столбцами dataframe в R, скомпилировать результаты

Допустим, у меня есть блок данных с колонками для элемента 1, элемента 2, элемента 3, метрики, другого. У меня есть еще одна внутренняя функция, которая имеет три аргумента (input_dataframe, element_position, metric_position), которые я использую для выполнения вычислений по одному элементу за раз. Он выводит фрейм данных, скажем, 1 строку на три переменные.

Я пытаюсь использовать либо lapply, либо для циклов, чтобы написать код, который позволит мне указать диапазон столбцов, содержащих элементы (в этом примере выше, его столбцы 1-3 для данных) и запустить функцию для всех указанных столбцов против столбца метрики, а затем объединить результаты в одну таблицу, которая имеет результаты каждого запуска функции. Мне не повезло, что эта работа пробовала варианты lapply и для циклов с seq_along. Какие-либо предложения? Пример данных, кода и вывода ниже для моего текущего неэффективного решения:

#example data 
element1 <- c("control", "control", "variation", "variation") 
element2 <- c("control", "variation", "variation", "control") 
element3 <- c("variation", "control", "variation", "variation") 
metric <- c(10,15,20,25) 
other <- c(2,4,2,6) 
data<-data.frame(element1, element2, element3, metric, other) 

#example function 
test_func <- function(input_df,element_position,metric_position) 
{ 
    df <- input_df[,c(element_position,metric_position)] 
    colnames(df) <- c("element","metric") 
    mean <- ddply(df,~element,summarise,mean(metric)) 
    control <- mean[1,2] 
    variation <- mean[2,2] 
    lift <- (variation-control)/control 
    df_table <<- data.frame(control,variation,lift) 
} 

#call function three times, once for each element, compile results 
test_func(data,1,4) 
element1 <- df_table 
test_func(data,2,4) 
element2 <- df_table 
test_func(data,3,4) 
element3 <- df_table 
summary_output <- rbind(element1,element2,element3) 

ответ

1

Я внесла некоторые незначительные изменения в вашу функцию. Вы должны просто вернуть объект и сохранить результат функции, а не с помощью <<-

#example data 
element1 <- c("control", "control", "variation", "variation") 
element2 <- c("control", "variation", "variation", "control") 
element3 <- c("variation", "control", "variation", "variation") 
metric <- c(10,15,20,25) 
other <- c(2,4,2,6) 
data<-data.frame(element1, element2, element3, metric, other) 

#example function 
test_func <- function(input_df,element_position,metric_position) 
{ 
    require('plyr') 
    df <- input_df[,c(element_position,metric_position)] 
    colnames(df) <- c("element","metric") 
    mean <- ddply(df,~element,summarise,mean(metric)) 
    control <- mean[1,2] 
    variation <- mean[2,2] 
    lift <- (variation-control)/control 
    data.frame(control,variation,lift) 
} 

это будет просто отобразить каждый набор параметров в test_func:

  1. data, element_position = 1, metric_position = 4
  2. data, element_position = 2, metric_position = 4
  3. data, element_position = 3, 4 = metric_position

т.д.

do.call('rbind', Map(test_func, rep(list(data), 3), 1:3, rep(4, 3))) 

# control variation  lift 
# 1 12.5 22.50000 0.8000000 
# 2 17.5 17.50000 0.0000000 
# 3 15.0 18.33333 0.2222222 
+0

Это работает безупречно! Спасибо за быстрый ответ! – data1082

0

Существует опечатка в части df_table <<- data.frame(control,variation,lift), Оператор <<- делает глобальное присваивание вместо локального окружения функции, следовательно, последнее значение переопределяет предыдущие. Редактирование опечатки и использование lapply и rbind дает ожидаемый результат.

test_func_modif <- function(input_df,element_position,metric_position) 
{ 
    df <- input_df[,c(element_position,metric_position)] 
    colnames(df) <- c("element","metric") 
    mean <- ddply(df,~element,summarise,mean(metric)) 
    control <- mean[1,2] 
    variation <- mean[2,2] 
    lift <- (variation-control)/control 
    df_table <- data.frame(control,variation,lift) 
} 




element_vec = 1:3 
metric_position_value = 4 
result_list = lapply(element_vec,function(x) test_func_modif(data,x,metric_position_value)) 
result_DF = do.call(rbind,result_list) 
# > result_DF 
# control variation  lift 
# 1 12.5 22.50000 0.8000000 
# 2 17.5 17.50000 0.0000000 
# 3 15.0 18.33333 0.2222222 
# > all.equal(summary_output,result_DF) 
# [1] TRUE 
+0

'<< -' было намеренно – rawr

+0

Да, это было намеренно, но явно ошибочно. Спасибо за это решение. И ваш ответ, и ответ от rawr работают отлично! Спасибо, что взяли это! – data1082