使用自定义函数reduce

时间:2017-07-21 16:58:14

标签: r loops reduce

这是我之前发布的更新(并且希望简化)的问题。

我有一个自定义功能,其目的是优化花费数周,花费分配到高销售活动期间。

我对该功能感到满意,但需要一种能够多次遍历数据的方法。我本来希望使用' reduce'实现这一目标的功能,但没有多少运气。

以下是要输入函数的初始数据:

sales <-  data.frame(salesx = c(3000, 2250,850,1800,1700,560,58,200,965,1525)
                     ,week = seq(from = 1, to = 10, by = 1)
                     ,uplift = c(0.04)
                     ,slope = c(100))
spend <- data.frame(spend = seq(from = 1, to = 500, by = 1))
datasetfinal <- merge(spend,sales,all=TRUE)

这是一个功能稍微简化的版本(所有功能都确定了根据销售活动投入500美元的花费的最佳位置...对于每次迭代,我想排除&#39;反向&# 39;支出数据的值:

library(dplyr)
library(zoo)
library(data.table)
library(plyr)
library(sqldf)

  optimizationfunc <- function(data) {
  datasetfinal2 <- data %>% mutate(optimized = salesx*(uplift*(1-exp(-spend/slope))))
  datasetfinal2$spend <- with(datasetfinal2, if ("reverse" %in% colnames(datasetfinal2)) spend - reverse else spend)
  datasetfinal2 <- with(datasetfinal2, if ("reverse" %in% colnames(datasetfinal2)) within(datasetfinal2, rm(reverse)) else datasetfinal2)    
  datasetfinal2$optimized2 <- datasetfinal2$optimized/datasetfinal2$spend

  datasetfinal2$spend <- ave(datasetfinal2$spend, datasetfinal2$week, FUN = seq_along)
  datasetfinal2 <- datasetfinal2 %>%  arrange(desc(optimized2))
  datasetfinal2$counter <- seq.int(nrow(datasetfinal2))

  datasetfinal3 <- datasetfinal2 %>%  dplyr::filter(counter <= 500)  %>% dplyr::mutate(value = optimized2*spend)

  datasetfinal4 <- datasetfinal3 %>% group_by(week) %>% top_n(1, value) %>% dplyr::select(-salesx)
  datasetfinal4 <- merge(datasetfinal4[, c('week', 'spend', 'optimized', 'optimized2', 'value')],sales,by="week",all = TRUE)
  datasetfinal4[is.na(datasetfinal4)] <- 0
  datasetfinal4 <- colwise(na.locf)(datasetfinal4)

  #This is a filter I want to exclude from spend in the next run. 
  #So if it is 20 for week 1 I want to exclude the first $20 of spend.
  datasetfinal4$randomfilter <- sample(100, size = nrow(datasetfinal4))
  datasetfinal4$difference <- with(datasetfinal4, randomfilter - optimized)
  datasetfinal4$difference <- with(datasetfinal4, ifelse(difference < 0, 0, difference))
  datasetfinal4$reverse <- with(datasetfinal4, round(-log(1-(difference/salesx/uplift))*slope),1)
  datasetfinal4$reverse[is.na(datasetfinal4$reverse)] <- 0
  return(datasetfinal4)
}

让我们运行功能:

datasetfinal4 <- optimizationfunc(datasetfinal)

现在我想使用该功能的输出,加入回原始数据,并过滤掉“花费”#39;已经分配:

reversefunc <- function(data1, data2) {sqldf("select a.*, b.reverse from data1 a left join data2 b on a.week = b.week") %>%  filter(spend > reverse) %>% dplyr::select(-reverse)}
datasetfinal5 <- reversefunc(datasetfinal, datasetfinal4)

这很好用,但我需要多次重复这个过程(比方说5),例如。

datasetfinal6 <- optimizationfunc(datasetfinal5)
datasetfinal7 <- reversefunc(datasetfinal5, datasetfinal6)

我希望减少功能可以在这里工作但是没有多少运气。如果我没有得到任何叮咬,我将进一步简化它。

这里有一个解决这个问题的简单版本的方法: R: run function over same dataframe multiple times

更新 所以基于下面和其他地方的答案,这几乎是我想要的。运行optimizationfunc两次似乎效率不高:

iterationFunc <- function(x,...){
optimizedData <- optimizationfunc(x)
finalData <- reversefunc(x, optimizedData)
return(finalData)}

out <- Reduce(iterationFunc, 1:10, init=datasetfinal, accumulate = TRUE)
out2 <- lapply(out, function(x) optimizationfunc(x))
out3 <- lapply(out2, function(x) sum(x$value))
out4 <- ldply(out3, data.frame)

2 个答案:

答案 0 :(得分:1)

require(purrr)

#put data into a list
dfList <- list(datasetfinal,datasetfinal4)

#pass list to reversefunc
finalDF <- dfList %>% reduce(reversefunc)

identical(datasetfinal5,finalDF)
[1] TRUE

我不认为这是你正在尝试做的事情。这是迭代函数的一种方法,我使用了你的对象名称,这使它有点混乱,但我很确定它有效。请注意,每次都会使用新输出重写datasetfinal5for循环假设10次迭代。

iterationFunc <- function(x){
  datasetfinal6 <- optimizationfunc(x)
  datasetfinal7 <- reversefunc(x, datasetfinal6)
  datasetfinal5 <- datasetfinal7
  return(datasetfinal5)
}

for (i in 1:10){
  iterationFunc(datasetfinal5)
  finalData <- datasetfinal5
}

下面有更好的变量名称:

finalData <- datasetfinal4    

iterationFunc <- function(x){
      optimizedData <- optimizationfunc(x)
      finalData <- reversefunc(x, optimizedData)
      return(finalData)
}

for (i in 1:10){
  iterationFunc(finalData)
}

尝试使用实际提供有关对象的有价值信息的变量名称。调用数据最终的所有内容[1-10]使得很难跟踪每次发生的事情。

答案 1 :(得分:1)

我的建议是使用递归

rf <- function(data, n, threshold) {
           if (n <= threshold) {
                 reverse <- optimizationfunc(data)
                 new <- reversefunc(data, reverse)
                 rf(new, n+1, threshold)
           } else {
                 return(data)
           }
}

datasetfinalX <- rf(datasetfinal,1,5)

您的个人作品opitimizationfuncreversefunc仍会在rf之前和之前宣布

---返回所有反向DF ----

最后添加return(reverse)可能会有效,但我无法测试它...让我知道它是否有效?

rf <- function(data, n, threshold) {
           if (n <= threshold) {
                 reverse <- optimizationfunc(data)
                 new <- reversefunc(data, reverse)
                 rf(new, n+1, threshold)
           } else {
                 return(data)
           }
           return(reverse)
}