这是我之前发布的更新(并且希望简化)的问题。
我有一个自定义功能,其目的是优化花费数周,花费分配到高销售活动期间。
我对该功能感到满意,但需要一种能够多次遍历数据的方法。我本来希望使用' 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)
答案 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
我不认为这是你正在尝试做的事情。这是迭代函数的一种方法,我使用了你的对象名称,这使它有点混乱,但我很确定它有效。请注意,每次都会使用新输出重写datasetfinal5
,for
循环假设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)
您的个人作品opitimizationfunc
和reversefunc
仍会在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)
}