Help with list of subsets for year and month multiplying constant values per row

Hello!

Sometime back I had a query where I was finding it difficult to create list of subsets multiplying with constant values per row and folks were able to help with this query. Thanks again! Here is the link for this topic

Now I am interested in the same thing, but would like to have results for Year and Month instead of just Year and again finding it difficult. I still need subsets for several different years. For solving this problem here, just would like to use 2 subsets 2021 & 2020 to keep it simple. Within each subset, I should be able to have an added variable that can show the sum of last 3 years for any given month. For example, For Feb 2021, we should be able to see sum of last 3 years which would be sum of values from Feb 2021 - March 2018 which would then be multiplied with percentages from perc table in its same sequence from 80% to 55% for each year such as 80 would be used for 2021 year, 40 would be multiplied for 2020 results and 55 would be multiplied with 2018 results. Similarly, for May 2021, sum of values from May 2021 - June 2018 & so on. The same applies for subset with year 2020 as well. I do have several years that need to be in individual subsets. These 3 years sum would then be multiplied by constant values from percentage table just like in the above in its same sequence from 80% to 55% for each year.

In this problem, everything is exactly same, except we would like to perform the same thing while considering each month in a given year.

Help to solve this problem would be highly appreciated.
Thank you in advance!

Adding the sample dataset here with previously solved by folks here for years only & now looking for similar concept for year & month:

library(tidyverse)
library(lubridate)

vol <- data.frame(
  Date = c("2018 Jan","2018 Jan","2018 Jan","2018 Jan",
           "2018 Feb","2018 Feb","2018 Feb","2018 Feb",
           "2018 Mar","2018 Mar","2018 Mar","2018 Mar",
           "2018 Apr","2018 Apr","2018 Apr","2018 Apr",
           "2018 May","2018 May","2018 May","2018 May",
           "2018 Jun","2018 Jun","2018 Jun","2018 Jun",
           "2018 Jul","2018 Jul","2018 Jul","2018 Jul",
           "2018 Aug","2018 Aug","2018 Aug","2018 Aug",
           "2018 Sep","2018 Sep","2018 Sep","2018 Sep",
           "2018 Oct","2018 Oct","2018 Oct","2018 Oct",
           "2018 Nov","2018 Nov","2018 Nov","2018 Nov",
           "2018 Dec","2018 Dec","2018 Dec","2018 Dec",
           "2019 Jan","2019 Jan","2019 Jan","2019 Jan",
           "2019 Feb","2019 Feb","2019 Feb","2019 Feb",
           "2019 Mar","2019 Mar","2019 Mar","2019 Mar",
           "2019 Apr","2019 Apr","2019 Apr","2019 Apr",
           "2019 May","2019 May","2019 May","2019 May",
           "2019 Jun","2019 Jun","2019 Jun","2019 Jun",
           "2019 Jul","2019 Jul","2019 Jul","2019 Jul",
           "2019 Aug","2019 Aug","2019 Aug","2019 Aug",
           "2019 Sep","2019 Sep","2019 Sep","2019 Sep",
           "2019 Oct","2019 Oct","2019 Oct","2019 Oct",
           "2019 Nov","2019 Nov","2019 Nov","2019 Nov",
           "2019 Dec","2019 Dec","2019 Dec","2019 Dec",
           "2020 Jan","2020 Jan","2020 Jan","2020 Jan",
           "2020 Feb","2020 Feb","2020 Feb","2020 Feb",
           "2020 Mar","2020 Mar","2020 Mar","2020 Mar",
           "2020 Apr","2020 Apr","2020 Apr","2020 Apr",
           "2020 May","2020 May","2020 May","2020 May",
           "2020 Jun","2020 Jun","2020 Jun","2020 Jun",
           "2020 Jul","2020 Jul","2020 Jul","2020 Jul",
           "2020 Aug","2020 Aug","2020 Aug","2020 Aug",
           "2020 Sep","2020 Sep","2020 Sep","2020 Sep",
           "2020 Oct","2020 Oct","2020 Oct","2020 Oct",
           "2020 Nov","2020 Nov","2020 Nov","2020 Nov",
           "2020 Dec", "2020 Dec","2020 Dec", "2020 Dec",
           "2021 Jan","2021 Jan","2021 Jan","2021 Jan",
           "2021 Feb","2021 Feb","2021 Feb","2021 Feb",
           "2021 Mar","2021 Mar","2021 Mar","2021 Mar",
           "2021 Apr","2021 Apr","2021 Apr","2021 Apr",
           "2021 May","2021 May","2021 May","2021 May",
           "2021 Jun","2021 Jun","2021 Jun","2021 Jun",
           "2021 Jul","2021 Jul","2021 Jul","2021 Jul",
           "2021 Aug","2021 Aug","2021 Aug","2021 Aug",
           "2021 Sep","2021 Sep","2021 Sep","2021 Sep",
           "2021 Oct","2021 Oct","2021 Oct","2021 Oct",
           "2021 Nov","2021 Nov","2021 Nov","2021 Nov",
           "2021 Dec","2021 Dec", "2021 Dec","2021 Dec"),
  
  Country = c("CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US",
              "CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US",
              "CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US",
              "CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US"),
  
  Type = c("A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B",
           "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B",
           "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B",
           "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B"
  ),
  
  Sales = c(100,110, 120, 130, 140, 150, 160, 170, 180, 190, 200, 210,100,110, 120, 130, 140, 150, 160, 170, 180, 190, 200, 210,100,110, 120, 130, 140, 150, 160, 170, 180, 190, 200, 210,100,110, 120, 130, 140, 150, 160, 170, 180, 190, 200, 210,
            220, 230,240, 250, 260, 270, 280, 290, 300, 310, 320, 330,220, 230,240, 250, 260, 270, 280, 290, 300, 310, 320, 330,20, 230,240, 250, 260, 270, 280, 290, 300, 310, 320, 330,220, 230,240, 250, 260, 270, 280, 290, 300, 310, 320, 330,
            340, 350, 360, 370, 380, 390, 400, 410, 420, 430, 440, 450,340, 350, 360, 370, 380, 390, 400, 410, 420, 430, 440, 450,340, 350, 360, 370, 380, 390, 400, 410, 420, 430, 440, 450,340, 350, 360, 370, 380, 390, 400, 410, 420, 430, 440, 450,
            460, 470, 480, 490, 500, 510, 520, 530, 540, 550, 560, 570, 460, 470, 480, 490, 500, 510, 520, 530, 540, 550, 560, 570, 60, 470, 480, 490, 500, 510, 520, 530, 540, 550, 560, 570, 460, 470, 480, 490, 500, 510, 520, 530, 540, 550, 560, 570)
)

vol$Date <- ym(vol$Date)
vol$year <- year(vol$Date)

perc <- data.frame(
  y = 1:3,
  Percentage = c(80, 40, 55)
)


# Below is where we would need subsets of years with month in a way that it works easily for several years as subsets as I have at least 8-10 years in real data. 

time_periods_of_interest <- c(
  2021,
  2020
)
evaluations <- map(time_periods_of_interest,
                   ~ seq(to = ., by = 1, length.out = 3)
) %>% set_names(time_periods_of_interest)


(step_1 <- map(
  evaluations,
  ~ {
    filter(
      vol,
      year %in% .x
    ) %>%
      group_by(Country,Type,year) %>%
      summarise(sumsales = sum(Sales)) %>%
      ungroup() %>%
      mutate(y=dense_rank(desc(year))) %>% left_join(perc)  })
)

(step_2 <- map(step_1, ~ {
  mutate(.x, per_sum_sales = sumsales * Percentage / 100)
}))

This problem can be split into two parts I guess: 1) filter data within three years, 2) multiply the sales data from specific year with a specific scaler. So, filter and join is efficient to solve the question.

library(tidyverse)
library(lubridate)
library(tidytable)

sum_3_years <- function(Cntry,Tp,recall_date) {
  
  yearly_scaler <- tibble::tribble(
    ~ year, ~ scaler,
    2018, .55,
    2019, 1.,
    2020, .40,
    2021, .80
  )
  
  vol %>% mutate(Date = ym(Date),year = year(Date)) %>% filter(
    Date %in% (ym(recall_date) - years(3)):ym(recall_date),
    Country == Cntry, Type == Tp) %>% 
    left_join(yearly_scaler, by = 'year') %>% 
    summarise(cum_sum = sum(scaler * Sales)) %>% 
    pull(cum_sum) %>% return()
}

vol %>% tidytable::mutate_rowwise.(
  cum_sum = sum_3_years(Cntry = Country,Tp = Type,recall_date = Date)
)

# A tidytable: 192 x 5
   Date     Country Type  Sales cum_sum
   <chr>    <chr>   <chr> <dbl>   <dbl>
 1 2018 Jan CA      A       100    55  
 2 2018 Jan CA      B       110    60.5
 3 2018 Jan US      A       120    66  
 4 2018 Jan US      B       130    71.5
 5 2018 Feb CA      A       140   132  
 6 2018 Feb CA      B       150   143  
 7 2018 Feb US      A       160   154  
 8 2018 Feb US      B       170   165  
 9 2018 Mar CA      A       180   231  
10 2018 Mar CA      B       190   248. 
# ... with 182 more rows

Considering that this problem is essentially a rolling sum of weighted sales for 36 months backward, the following steps can also be considered. I used expand_grid and join to ensure rows of every month for each country and types are presented during 2018~2021:

 yearly_scaler <- tibble::tribble(
    ~ year, ~ scaler,
    2018, .55,
    2019, 1.,
    2020, .40,
    2021, .80
  )

expand_grid(y = 2018:2021,m = 1:12,Country = c('CA', 'US'),Type = c('A', 'B')) %>% 
  unite('Date', c(y,m)) %>% mutate(Date = ym(Date),year = year(Date)) %>% 
  left_join(vol %>% mutate(Date = ym(Date)), by = c('Date','Country','Type')) %>% 
  left_join(yearly_scaler, by = 'year') %>% 
  group_by(Country, Type) %>% 
  mutate(cum_sum_sales = RcppRoll::roll_sum(Sales*scaler,n = 36, align = 'right',fill =0,na.rm = T)) %>%
  ungroup
library(tidyverse)
library(lubridate)

vol <- data.frame(
  Date = c("2018 Jan","2018 Jan","2018 Jan","2018 Jan",
           "2018 Feb","2018 Feb","2018 Feb","2018 Feb",
           "2018 Mar","2018 Mar","2018 Mar","2018 Mar",
           "2018 Apr","2018 Apr","2018 Apr","2018 Apr",
           "2018 May","2018 May","2018 May","2018 May",
           "2018 Jun","2018 Jun","2018 Jun","2018 Jun",
           "2018 Jul","2018 Jul","2018 Jul","2018 Jul",
           "2018 Aug","2018 Aug","2018 Aug","2018 Aug",
           "2018 Sep","2018 Sep","2018 Sep","2018 Sep",
           "2018 Oct","2018 Oct","2018 Oct","2018 Oct",
           "2018 Nov","2018 Nov","2018 Nov","2018 Nov",
           "2018 Dec","2018 Dec","2018 Dec","2018 Dec",
           "2019 Jan","2019 Jan","2019 Jan","2019 Jan",
           "2019 Feb","2019 Feb","2019 Feb","2019 Feb",
           "2019 Mar","2019 Mar","2019 Mar","2019 Mar",
           "2019 Apr","2019 Apr","2019 Apr","2019 Apr",
           "2019 May","2019 May","2019 May","2019 May",
           "2019 Jun","2019 Jun","2019 Jun","2019 Jun",
           "2019 Jul","2019 Jul","2019 Jul","2019 Jul",
           "2019 Aug","2019 Aug","2019 Aug","2019 Aug",
           "2019 Sep","2019 Sep","2019 Sep","2019 Sep",
           "2019 Oct","2019 Oct","2019 Oct","2019 Oct",
           "2019 Nov","2019 Nov","2019 Nov","2019 Nov",
           "2019 Dec","2019 Dec","2019 Dec","2019 Dec",
           "2020 Jan","2020 Jan","2020 Jan","2020 Jan",
           "2020 Feb","2020 Feb","2020 Feb","2020 Feb",
           "2020 Mar","2020 Mar","2020 Mar","2020 Mar",
           "2020 Apr","2020 Apr","2020 Apr","2020 Apr",
           "2020 May","2020 May","2020 May","2020 May",
           "2020 Jun","2020 Jun","2020 Jun","2020 Jun",
           "2020 Jul","2020 Jul","2020 Jul","2020 Jul",
           "2020 Aug","2020 Aug","2020 Aug","2020 Aug",
           "2020 Sep","2020 Sep","2020 Sep","2020 Sep",
           "2020 Oct","2020 Oct","2020 Oct","2020 Oct",
           "2020 Nov","2020 Nov","2020 Nov","2020 Nov",
           "2020 Dec", "2020 Dec","2020 Dec", "2020 Dec",
           "2021 Jan","2021 Jan","2021 Jan","2021 Jan",
           "2021 Feb","2021 Feb","2021 Feb","2021 Feb",
           "2021 Mar","2021 Mar","2021 Mar","2021 Mar",
           "2021 Apr","2021 Apr","2021 Apr","2021 Apr",
           "2021 May","2021 May","2021 May","2021 May",
           "2021 Jun","2021 Jun","2021 Jun","2021 Jun",
           "2021 Jul","2021 Jul","2021 Jul","2021 Jul",
           "2021 Aug","2021 Aug","2021 Aug","2021 Aug",
           "2021 Sep","2021 Sep","2021 Sep","2021 Sep",
           "2021 Oct","2021 Oct","2021 Oct","2021 Oct",
           "2021 Nov","2021 Nov","2021 Nov","2021 Nov",
           "2021 Dec","2021 Dec", "2021 Dec","2021 Dec"),
  
  Country = c("CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US",
              "CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US",
              "CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US",
              "CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US"),
  
  Type = c("A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B",
           "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B",
           "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B",
           "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B"
  ),
  
  Sales = c(100,110, 120, 130, 140, 150, 160, 170, 180, 190, 200, 210,100,110, 120, 130, 140, 150, 160, 170, 180, 190, 200, 210,100,110, 120, 130, 140, 150, 160, 170, 180, 190, 200, 210,100,110, 120, 130, 140, 150, 160, 170, 180, 190, 200, 210,
            220, 230,240, 250, 260, 270, 280, 290, 300, 310, 320, 330,220, 230,240, 250, 260, 270, 280, 290, 300, 310, 320, 330,20, 230,240, 250, 260, 270, 280, 290, 300, 310, 320, 330,220, 230,240, 250, 260, 270, 280, 290, 300, 310, 320, 330,
            340, 350, 360, 370, 380, 390, 400, 410, 420, 430, 440, 450,340, 350, 360, 370, 380, 390, 400, 410, 420, 430, 440, 450,340, 350, 360, 370, 380, 390, 400, 410, 420, 430, 440, 450,340, 350, 360, 370, 380, 390, 400, 410, 420, 430, 440, 450,
            460, 470, 480, 490, 500, 510, 520, 530, 540, 550, 560, 570, 460, 470, 480, 490, 500, 510, 520, 530, 540, 550, 560, 570, 60, 470, 480, 490, 500, 510, 520, 530, 540, 550, 560, 570, 460, 470, 480, 490, 500, 510, 520, 530, 540, 550, 560, 570)
)

vol$Date <- ym(vol$Date)
vol$year <- year(vol$Date)
perc <- data.frame(
  y = 1:3,
  Percentage = c(80, 40, 55)
)


# Below is where we would need subsets of years with month in a way that it works easily for several years as subsets as I have at least 8-10 years in real data. 

#3 years back from Feb 2021
(time_periods_of_interest <- seq.Date(from=ym("2021 Feb"),by="-1 months",
                                length.out=36))


(step_1 <- 
    filter(
      vol,
      Date %in% time_periods_of_interest
    ) %>%
      group_by(Country,Type,year) %>%
      summarise(sumsales = sum(Sales)
                ) %>%
      ungroup() %>%
      mutate(y=dense_rank(desc(year))) %>% left_join(perc)  %>% 
    arrange(y)
)

(step_2 <- 
  mutate(step_1, per_sum_sales = sumsales * Percentage / 100)
)

Thanks for helping out here again @nirgrahamuk !

This is exactly what I am looking for. But how do we use time_periods_of_interest in a way that we don't need to specify a specific year & month here. In other words, we would like to see similar subsets for each year and all months in the output. So, we would like to see similar values for March 2021 & other months & years for entire dataset.

Thanks again!

Thanks @yifanliu!

Never used tidytable and RcppRoll before. Getting errors here
Error: 'num_ansi_colors' is not an exported object from 'namespace:cli'

I can't figure out what happened with this error because num_ansi_colors do comes from package cli

Maybe you can try another rolling algebra from package zoo

library(tidyverse)
library(lubridate)
library(zoo)

vol

yearly_scaler <- tibble::tribble(
    ~ year, ~ scaler,
    2018, .55,
    2019, 1.,
    2020, .40,
    2021, .80
  )

# the templae_table is used to ensure a complete time series of sales data for each country and types are presented.

template_table <- expand_grid(y = 2018:2021,m = 1:12,Country = c('CA', 'US'),Type = c('A', 'B')) %>% 
  unite('Date', c(y,m)) %>% mutate(Date = ym(Date),year = year(Date)) 

template_table %>% 
  left_join(vol %>% mutate(Date = ym(Date)), by = c('Date','Country','Type')) %>% 
  left_join(yearly_scaler, by = 'year') %>% 
  group_by(Country, Type) %>% 
  mutate(cum_sum_sales = rollapplyr(Sales*scaler, width = 36, sum, align = 'right', fill = 0, partial = TRUE)) %>%
  ungroup

# A tibble: 192 x 7
   Date       Country Type   year Sales scaler cum_sum_sales
   <date>     <chr>   <chr> <dbl> <dbl>  <dbl>         <dbl>
 1 2018-01-01 CA      A      2018   100   0.55          55  
 2 2018-01-01 CA      B      2018   110   0.55          60.5
 3 2018-01-01 US      A      2018   120   0.55          66  
 4 2018-01-01 US      B      2018   130   0.55          71.5
 5 2018-02-01 CA      A      2018   140   0.55         132  
 6 2018-02-01 CA      B      2018   150   0.55         143  
 7 2018-02-01 US      A      2018   160   0.55         154  
 8 2018-02-01 US      B      2018   170   0.55         165  
 9 2018-03-01 CA      A      2018   180   0.55         231  
10 2018-03-01 CA      B      2018   190   0.55         248. 
# ... with 182 more rows

Not sure, still getting the same error.

Also, 2021 - 2018 is to understand the concept here. But my dataset is longer and goes to several years. We would need subsets for any chosen year with any of its month.

Thanks!

check if you've installed the cli package? Or what version is it? I checked the upgrade news to find out that 'num_ansi_colors' was introduced since ver3.1.0.

the template_table is also a restrictor here, not necessary. If you're sure that your sales data has a completed time series, you don't have the need to construct it. Directly join your data with the yearly scaler by year, group it by country and type, then do mutate to calculate the rolling sum is fine enough.
i.e.:

your_data %>% 
  mutate(year = year(as_date(Date))) %>% # must specify a column `year` based on date, which is used to join
  left_join(yearly_scaler, by = 'year') %>% 
  group_by(Country, Type) %>% 
  mutate(cum_sum_sales = rollapplyr(Sales*scaler, width = 36, sum, align = 'right', fill = 0, partial = TRUE)) %>%
  ungroup

I really like your approach. Is it possible to create a list of all year & month available in the database and then applying specific time_periods_of_interest relevant to that particular list along with steps 1 & 2 . Results of each list can later be combined as one dataset.

I was trying to do this, but couldn't do it right still.

library(tidyverse)
library(lubridate)

vol <- data.frame(
  Date = c("2018 Jan","2018 Jan","2018 Jan","2018 Jan",
           "2018 Feb","2018 Feb","2018 Feb","2018 Feb",
           "2018 Mar","2018 Mar","2018 Mar","2018 Mar",
           "2018 Apr","2018 Apr","2018 Apr","2018 Apr",
           "2018 May","2018 May","2018 May","2018 May",
           "2018 Jun","2018 Jun","2018 Jun","2018 Jun",
           "2018 Jul","2018 Jul","2018 Jul","2018 Jul",
           "2018 Aug","2018 Aug","2018 Aug","2018 Aug",
           "2018 Sep","2018 Sep","2018 Sep","2018 Sep",
           "2018 Oct","2018 Oct","2018 Oct","2018 Oct",
           "2018 Nov","2018 Nov","2018 Nov","2018 Nov",
           "2018 Dec","2018 Dec","2018 Dec","2018 Dec",
           "2019 Jan","2019 Jan","2019 Jan","2019 Jan",
           "2019 Feb","2019 Feb","2019 Feb","2019 Feb",
           "2019 Mar","2019 Mar","2019 Mar","2019 Mar",
           "2019 Apr","2019 Apr","2019 Apr","2019 Apr",
           "2019 May","2019 May","2019 May","2019 May",
           "2019 Jun","2019 Jun","2019 Jun","2019 Jun",
           "2019 Jul","2019 Jul","2019 Jul","2019 Jul",
           "2019 Aug","2019 Aug","2019 Aug","2019 Aug",
           "2019 Sep","2019 Sep","2019 Sep","2019 Sep",
           "2019 Oct","2019 Oct","2019 Oct","2019 Oct",
           "2019 Nov","2019 Nov","2019 Nov","2019 Nov",
           "2019 Dec","2019 Dec","2019 Dec","2019 Dec",
           "2020 Jan","2020 Jan","2020 Jan","2020 Jan",
           "2020 Feb","2020 Feb","2020 Feb","2020 Feb",
           "2020 Mar","2020 Mar","2020 Mar","2020 Mar",
           "2020 Apr","2020 Apr","2020 Apr","2020 Apr",
           "2020 May","2020 May","2020 May","2020 May",
           "2020 Jun","2020 Jun","2020 Jun","2020 Jun",
           "2020 Jul","2020 Jul","2020 Jul","2020 Jul",
           "2020 Aug","2020 Aug","2020 Aug","2020 Aug",
           "2020 Sep","2020 Sep","2020 Sep","2020 Sep",
           "2020 Oct","2020 Oct","2020 Oct","2020 Oct",
           "2020 Nov","2020 Nov","2020 Nov","2020 Nov",
           "2020 Dec", "2020 Dec","2020 Dec", "2020 Dec",
           "2021 Jan","2021 Jan","2021 Jan","2021 Jan",
           "2021 Feb","2021 Feb","2021 Feb","2021 Feb",
           "2021 Mar","2021 Mar","2021 Mar","2021 Mar",
           "2021 Apr","2021 Apr","2021 Apr","2021 Apr",
           "2021 May","2021 May","2021 May","2021 May",
           "2021 Jun","2021 Jun","2021 Jun","2021 Jun",
           "2021 Jul","2021 Jul","2021 Jul","2021 Jul",
           "2021 Aug","2021 Aug","2021 Aug","2021 Aug",
           "2021 Sep","2021 Sep","2021 Sep","2021 Sep",
           "2021 Oct","2021 Oct","2021 Oct","2021 Oct",
           "2021 Nov","2021 Nov","2021 Nov","2021 Nov",
           "2021 Dec","2021 Dec", "2021 Dec","2021 Dec"),
  
  Country = c("CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US",
              "CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US",
              "CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US",
              "CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US","CA","CA","US","US"),
  
  Type = c("A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B",
           "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B",
           "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B",
           "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B"
  ),
  
  Sales = c(100,110, 120, 130, 140, 150, 160, 170, 180, 190, 200, 210,100,110, 120, 130, 140, 150, 160, 170, 180, 190, 200, 210,100,110, 120, 130, 140, 150, 160, 170, 180, 190, 200, 210,100,110, 120, 130, 140, 150, 160, 170, 180, 190, 200, 210,
            220, 230,240, 250, 260, 270, 280, 290, 300, 310, 320, 330,220, 230,240, 250, 260, 270, 280, 290, 300, 310, 320, 330,20, 230,240, 250, 260, 270, 280, 290, 300, 310, 320, 330,220, 230,240, 250, 260, 270, 280, 290, 300, 310, 320, 330,
            340, 350, 360, 370, 380, 390, 400, 410, 420, 430, 440, 450,340, 350, 360, 370, 380, 390, 400, 410, 420, 430, 440, 450,340, 350, 360, 370, 380, 390, 400, 410, 420, 430, 440, 450,340, 350, 360, 370, 380, 390, 400, 410, 420, 430, 440, 450,
            460, 470, 480, 490, 500, 510, 520, 530, 540, 550, 560, 570, 460, 470, 480, 490, 500, 510, 520, 530, 540, 550, 560, 570, 60, 470, 480, 490, 500, 510, 520, 530, 540, 550, 560, 570, 460, 470, 480, 490, 500, 510, 520, 530, 540, 550, 560, 570)
)

vol$Date <- ym(vol$Date)
vol$year <- year(vol$Date)
perc <- data.frame(
  y = 1:3,
  Percentage = c(80, 40, 55)
)


# Below is where we would need subsets of years with month in a way that it works easily for several years as subsets as I have at least 8-10 years in real data. 

#3 years back from Feb 2021
do_calc <- function(calc_for ){
(time_periods_of_interest <- seq.Date(from=calc_for,by="-1 months",
                                      length.out=36))


(step_1 <- 
    filter(
      vol,
      Date %in% time_periods_of_interest
    ) %>%
    group_by(Country,Type,year) %>%
    summarise(sumsales = sum(Sales),.groups = "drop"
    ) %>%
    mutate(y=dense_rank(desc(year))) %>% left_join(perc,by = "y")  %>% 
    arrange(y)
)

(step_2 <- 
    mutate(step_1, per_sum_sales = sumsales * Percentage / 100,
           calculated_for = calc_for)
)
  step_2 
}


#calculate for all possible dates and combine results

map_dfr(unique(vol$Date),
    ~ do_calc(calc_for = .x))

Thank you so much @nirgrahamuk!
This works great!

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.