Verwenden von reduzieren mit benutzerdefinierten Funktion

Question

Dies ist ein aktualisiertes (und hoffentlich vereinfachtes) Problem zu einem, das ich zuvor gepostet habe.

Ich habe eine benutzerdefinierte Funktion, deren Zweck es ist, Ausgaben über eine Anzahl von Wochen zu optimieren, wo die Ausgaben Perioden mit hoher Verkaufsaktivität zugeordnet werden.

Ich bin mit der Funktion zufrieden, brauche aber eine Möglichkeit, die Daten mehrmals durchlaufen zu können. Ich hatte gehofft, die "Reduzieren" -Funktion zu benutzen, um das zu erreichen, aber ich hatte nicht viel Glück.

Hier ist die Anfangsdaten in die Funktion zu füttern:

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) 

Und hier ist eine etwas vereinfachte Version der Funktion (die ganze Funktion ist der beste Ort, identifiziert sich auf $ 500 im Wert setzen von Ausgaben basiert Verkaufsaktivitäten ... für jede Iteration ich die ‚umgekehrte‘ Werte aus der Ausgabendaten ausschließen möchten:

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

Lassen Sie uns die Funktion auszuführen:

datasetfinal4 <- optimizationfunc(datasetfinal) 

Jetzt möchte ich die Ausgabe der Funktion nutzen, um die ursprünglichen Daten zu kommen zurück, und herauszufiltern ‚ausgeben‘, die bereits zugeordnet ist:

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) 

Dies funktioniert gut, aber ich muss das wiederholen mehrere Male verarbeiten (sagen wir 5) z.

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

Ich hatte gehofft, die Reduce-Funktion würde hier funktionieren, aber nicht viel Glück gehabt haben. Wenn ich keine Bisse bekomme, werde ich es weiter vereinfachen.

Es gibt eine Lösung für eine einfache Version dieses Problem hier ist: R: run function over same dataframe multiple times

UPDATE auf die Antworten So basiert unten und anderswo, das ist ziemlich viel, was ich will. Scheint ein wenig ineffizient, da läuft optimizationfunc zweimal:

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) 

Answer 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 

Ich glaube nicht, das ist wirklich, was Sie versuchen, obwohl zu tun. Hier ist eine Möglichkeit, die Funktion zu wiederholen, ich habe Ihre Objektnamen verwendet, was es etwas verwirrend macht, aber ich bin mir ziemlich sicher, dass es funktioniert. Beachten Sie, dass datasetfinal5 jedes Mal mit der neuen Ausgabe neu geschrieben wird und for Schleife 10 Iterationen annimmt.

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

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

Unten mit besseren Variablennamen:

finalData <- datasetfinal4  

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

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

Try Variablennamen zu verwenden, die tatsächlich wertvolle Informationen über das Objekt geben. Wenn man alles Datasetfinal aufruft [1-10], ist es wirklich schwierig, den Überblick zu behalten, was jedes Mal passiert.

Answer 2

Meine Empfehlung ist, eine Rekursion

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) 

Ihre individuelle Funktionen opitimizationfunc und reversefunc würde noch außerhalb und vor rf

deklariert werden verwenden --- alle REVERSE DFs RÜCKKEHR ----

Hinzufügen von return(reverse) am Ende könnte funktionieren, aber ich bin nicht in der Lage, es zu testen ... lassen Sie es mich wissen, wenn es funktioniert?

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