Creating a new accumulative column in a data frame based on existing columns

Admin 1
Viewed 130

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
purrr dplyr dataframe r
1 Answers

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
user_37322710
Related