Reputation:
I created this topic: Calculating new column in a data frame based on existing columns a while ago. I am looking now for something similar with a little distinction. I, again, have this dataset..
df=tibble(article=rep("article one",5),
week=c(1,2,3,4,5),
sales=20,
purchase=c(5,0,5,5,0),
stock=c(50))
# A tibble: 5 x 5
article week sales purchase stock
<chr> <dbl> <dbl> <dbl> <dbl>
1 article one 1 20 5 50
2 article one 2 20 0 50
3 article one 3 20 5 50
4 article one 4 20 5 50
5 article one 5 20 0 50
.. wherenmy desired outcome would look like the following:
# A tibble: 5 x 6
article week sales purchase stock stock_over_time
<chr> <dbl> <dbl> <dbl> <dbl> <dbl>
1 article one 1 20 5 50 50
2 article one 2 20 0 50 30
3 article one 3 20 5 50 15
4 article one 4 20 5 50 0
5 article one 5 20 0 50 -5
so stock_over_time is calculated as follows, where whenever stock_over_time
would go beneath 0
, sales is subtracted, but only a ratio of sales (here .25 of sales).
50 - 20 + 0 = 30
30 - 20 + 5 = 15
15 - 20 + 5 = 0
0 - (20 * 1/4) + 0 = -5
Upvotes: 3
Views: 223
Reputation: 887223
We could use cumsum
with lag
library(dplyr)
df %>%
group_by(article) %>%
mutate(stock_over_time = lag(stock + cumsum(lead(purchase) - sales),
default = first(stock)),
stock_over_time = case_when(stock_over_time < 0
~ 0 - (sales * 1/4) + purchase, TRUE ~ stock_over_time)) %>%
ungroup
-output
# A tibble: 5 x 6
# article week sales purchase stock stock_over_time
# <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
#1 article one 1 20 5 50 50
#2 article one 2 20 0 50 30
#3 article one 3 20 5 50 15
#4 article one 4 20 5 50 0
#5 article one 5 20 0 50 -5
As @JonSpring mentioned, it may be recursive action, in that case we can create a function to do this
f1 <- function(dat) {
dat$stock_over_time <- NA_real_
dat$stock_over_time[1] <- dat$stock[1]
for(i in 2:nrow(dat)) {
dat$stock_over_time[i] <- dat$stock_over_time[i-1] -
dat$sales[i] + dat$purchase[i]
if(dat$stock_over_time[i] < 0 ) {
dat$stock_over_time[i] <- dat$stock_over_time[i-1] -
(dat$sales[i]* 1/4) + dat$purchase[i]
}
}
return(dat)
}
unsplit(lapply(split(df, df$article), f1), df$article)
# A tibble: 5 x 6
# article week sales purchase stock stock_over_time
# <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
#1 article one 1 20 5 50 50
#2 article one 2 20 0 50 30
#3 article one 3 20 5 50 15
#4 article one 4 20 5 50 0
#5 article one 5 20 0 50 -5
or can use accumulate
from purrr
library(purrr)
f1 <- function(x, y, z) {
tmp <- x - y + z
if(tmp < 0) {
tmp <- x - (y* 1/4) + z
}
return(tmp)
}
}
df %>%
group_by(article) %>%
mutate(stock_over_time = accumulate2(sales,
lead(purchase, default = last(purchase)), f1, .init = first(stock)) %>%
flatten_dbl() %>%
head(-1)) %>%
ungroup
# A tibble: 5 x 6
# article week sales purchase stock stock_over_time
# <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
#1 article one 1 20 5 50 50
#2 article one 2 20 0 50 30
#3 article one 3 20 5 50 15
#4 article one 4 20 5 50 0
#5 article one 5 20 0 50 -5
Upvotes: 2