使用带有自定义功能的reduce [英] Using reduce with custom function

问题描述

这是我先前发布的一个更新(希望简化)的问题.

This is an updated (and hopefully simplified) problem to one I posted earlier.

我有一个自定义功能，其目的是在数周内优化支出，将支出分配给销售旺季.

I have a custom function, the purpose of which is to optimize spend over a number of weeks, where spend is allocated to periods of high sales activity.

我对该功能感到满意，但是需要一种方法可以多次遍历数据.我希望使用减少"功能来完成此操作，但是运气不高.

I'm happy with the function, but need a way to be able to iterate through the data a number of times. I was hoping to use the 'reduce' function to accomplish this but haven't had much luck.

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

Here is the initial data to feed into the function:

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支出的最佳位置...对于每个迭代，我都希望从中排除反向"值花费数据:

And here is a somewhat simplified version of the function (all the function does is identify the best place to put $500 worth of spend based on sales activity...for each iteration I want to exclude the 'reverse' values from the spend data:

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)

现在，我想使用函数的输出，以联接回原始数据，并过滤掉已经分配的支出":

Now I want to use the output of the function, to join back to the original data, and filter out 'spend' that is already allocated:

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次).

This works fine, but I need to repeat the process a number of times (lets say 5) eg.

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

我希望reduce函数在这里可以工作，但是运气不太好.如果我什么也没咬，我会继续简化它.

I was hoping the reduce function would work here but haven't had much luck. If I don't get any bites I'll have a go at simplifying it further.

这里有一个针对此问题的简单版本的解决方案: R:在同一数据帧上多次运行功能

There is a solution for a simple version of this problem here: R: run function over same dataframe multiple times

更新 因此，根据下面和其他地方的答案，这几乎是我想要的.两次运行optimizationfunc似乎效率不高:

UPDATE So based on the answers below and elsewhere, this is pretty much what I want. Seems a little inefficient as running optimizationfunc twice:

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)

推荐答案

我的建议是使用递归

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

Your individual functions opitimizationfunc and reversefunc would still be declared outside of and before rf

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

在末尾添加return(reverse)可能可行，但是我无法对其进行测试...让我知道它是否可行?

Adding return(reverse) at the end might work, but I'm not able to test it...let me know if it works?

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)
}

这篇关于使用带有自定义功能的reduce的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！