Adjust function to not calculate the same thing multiple times

General
1

I would like to take a doubt with you, as well as adjust, if necessary. See that I generate a result value for each Id, Category and Week in the function. To find this result value I use the median, which is med variable. After inserting the function, I do:

df1 %>%
  rowwise %>%
  mutate(example(df1,Id,Category, Week)) %>%
  select(-c(6:20,))%>%
  data.frame()

In this case it generates values for all id/category and week. So, my question is: When executing this line above, it means that I want to generate values for all id/date/week, so the function will be executed several times. But notice that med does not vary, it is always the same, so it could only be done once. What possibilities do I have for adjustments so I don't keep repeating it several times?

Executable code:

library(tidyverse)
library(lubridate)
library(data.table)

df1 <- structure(
  list(Id=c("1","1","1","1","1","1","1","1"),
       date1= c("2021-06-28","2021-06-28","2021-06-28","2021-06-28","2021-06-28",
                "2021-06-28","2021-06-28","2021-06-28"),
       date2 = c("2021-06-30","2021-06-30","2021-07-02","2021-07-04","2021-07-04","2021-07-09","2021-07-09","2021-07-09"),
       Category = c("FDE","ABC","ABC","ABC","CDE","FGE","ABC","CDE"),
       Week= c("Wednesday","Wednesday","Friday","Wednesday","Wednesday","Friday","Friday","Friday"),
       DR1 = c(4,1,4,3,3,4,3,5),
       DRM01 = c(4,1,4,3,3,4,3,6), DRM02= c(4,2,6,7,3,2,7,4),DRM03= c(9,5,4,3,3,2,1,5),
       DRM04 = c(5,4,3,3,6,2,1,9),DRM05 = c(5,4,5,3,6,2,1,9),
       DRM06 = c(2,4,3,3,5,6,7,8),DRM07 = c(2,5,4,4,9,4,7,8),
       DRM08 = c(0,0,0,1,2,0,0,0),DRM09 = c(0,0,0,0,0,0,0,0),DRM010 = c(0,0,0,0,0,0,0,0),DRM011 = c(4,0,0,0,0,0,0,0), 
       DRM012 = c(0,0,0,3,0,0,0,5),DRM013 = c(0,0,1,0,0,0,2,0),DRM014 = c(0,0,0,0,0,2,0,0)),
  class = "data.frame", row.names = c(NA, -8L))


example <- function (df1,idd, CategoryChosse,WK) {

  dt1 <- as.data.table(df1)
  
  cols <- grep("^DRM0", colnames(dt1), value = TRUE)
  
  med <- 
    dt1[, (paste0(cols, "_PV")) := DR1 - .SD, .SDcols = cols
    ][, lapply(.SD, median), by = .(Id, Category, Week), .SDcols = paste0(cols, "_PV") ]
  
  result<-med %>%
    filter(Id==idd, Category == CategoryChosse,Week == WK)
 
  return(result)
  
}



 df1 %>%
  rowwise %>%
  mutate(example(df1,Id,Category, Week)) %>%
  select(-c(6:20,))%>%
  data.frame()

  Id      date1      date2 Category      Week DRM01_PV DRM02_PV DRM03_PV DRM04_PV DRM05_PV DRM06_PV DRM07_PV DRM08_PV DRM09_PV DRM010_PV DRM011_PV DRM012_PV DRM013_PV
1  1 2021-06-28 2021-06-30      FDE Wednesday        0      0.0       -5     -1.0     -1.0      2.0      2.0      4.0      4.0       4.0       0.0       4.0         4
2  1 2021-06-28 2021-06-30      ABC Wednesday        0     -2.5       -2     -1.5     -1.5     -1.5     -2.5      1.5      2.0       2.0       2.0       0.5         2
3  1 2021-06-28 2021-07-02      ABC    Friday        0     -3.0        1      1.5      0.5     -1.5     -2.0      3.5      3.5       3.5       3.5       3.5         2
4  1 2021-06-28 2021-07-04      ABC Wednesday        0     -2.5       -2     -1.5     -1.5     -1.5     -2.5      1.5      2.0       2.0       2.0       0.5         2
5  1 2021-06-28 2021-07-04      CDE Wednesday        0      0.0        0     -3.0     -3.0     -2.0     -6.0      1.0      3.0       3.0       3.0       3.0         3
6  1 2021-06-28 2021-07-09      FGE    Friday        0      2.0        2      2.0      2.0     -2.0      0.0      4.0      4.0       4.0       4.0       4.0         4
7  1 2021-06-28 2021-07-09      ABC    Friday        0     -3.0        1      1.5      0.5     -1.5     -2.0      3.5      3.5       3.5       3.5       3.5         2
8  1 2021-06-28 2021-07-09      CDE    Friday       -1      1.0        0     -4.0     -4.0     -3.0     -3.0      5.0      5.0       5.0       5.0       0.0         5
  DRM014_PV
1       4.0
2       2.0
3       3.5
4       2.0
5       3.0
6       2.0
7       3.5
8       5.0
2

It looks to me like using the function example() is not helping you. Below I repeat your calculation and then do the same thing in a single pass. Comparing the two objects shows they are identical.

df1 <- structure(
  list(Id=c("1","1","1","1","1","1","1","1"),
       date1= c("2021-06-28","2021-06-28","2021-06-28","2021-06-28","2021-06-28",
                "2021-06-28","2021-06-28","2021-06-28"),
       date2 = c("2021-06-30","2021-06-30","2021-07-02","2021-07-04","2021-07-04","2021-07-09","2021-07-09","2021-07-09"),
       Category = c("FDE","ABC","ABC","ABC","CDE","FGE","ABC","CDE"),
       Week= c("Wednesday","Wednesday","Friday","Wednesday","Wednesday","Friday","Friday","Friday"),
       DR1 = c(4,1,4,3,3,4,3,5),
       DRM01 = c(4,1,4,3,3,4,3,6), DRM02= c(4,2,6,7,3,2,7,4),DRM03= c(9,5,4,3,3,2,1,5),
       DRM04 = c(5,4,3,3,6,2,1,9),DRM05 = c(5,4,5,3,6,2,1,9),
       DRM06 = c(2,4,3,3,5,6,7,8),DRM07 = c(2,5,4,4,9,4,7,8),
       DRM08 = c(0,0,0,1,2,0,0,0),DRM09 = c(0,0,0,0,0,0,0,0),DRM010 = c(0,0,0,0,0,0,0,0),DRM011 = c(4,0,0,0,0,0,0,0), 
       DRM012 = c(0,0,0,3,0,0,0,5),DRM013 = c(0,0,1,0,0,0,2,0),DRM014 = c(0,0,0,0,0,2,0,0)),
  class = "data.frame", row.names = c(NA, -8L))

library(dplyr)
library(data.table)

#Original calculation
example <- function (df1,idd, CategoryChosse,WK) {
  
  dt1 <- as.data.table(df1)
  
  cols <- grep("^DRM0", colnames(dt1), value = TRUE)
  
  med <- 
    dt1[, (paste0(cols, "_PV")) := DR1 - .SD, .SDcols = cols
        ][, lapply(.SD, median), by = .(Id, Category, Week), .SDcols = paste0(cols, "_PV") ]
  
  result<-med %>%
    filter(Id==idd, Category == CategoryChosse,Week == WK)
  
  return(result)
  
}



orig <- df1 %>%
  rowwise %>%
  mutate(example(df1,Id,Category, Week)) %>%
  select(-c(6:20,))%>%
  data.frame()


#No function
dt1 <- as.data.table(df1)
cols <- grep("^DRM0", colnames(dt1), value = TRUE)

Result <-   dt1[, (paste0(cols, "_PV")) := DR1 - .SD, .SDcols = cols
                ][, lapply(.SD, median), by = .(Id, Category, Week), .SDcols = paste0(cols, "_PV") ] 

New <- inner_join(df1[,1:5], Result, by = c("Id", "Category", "Week"))

identical(orig, New)
#> [1] TRUE

Created on 2022-04-22 by the reprex package (v0.2.1)

1 Like
3

Thank you very much for replying @FJCC You're absolutely right. This example I made was very simple seeing now. But see this function below. Note that med and SPV do not vary. What varies is only the value of coef. In this sense, when I run to calculate for all coef, med and SPV are calculated every time, right?! however, is it possible to calculate only once, so as not to keep repeating?

library(tidyverse)
library(lubridate)
library(data.table)


set.seed(0)

df1 <- data.frame( Id = rep(1:5, length=900),
                   date1 =  as.Date( "2021-12-01"),
                   date2= rep(seq( as.Date("2021-01-01"), length.out=450, by=1), each = 2),
                   Category = rep(c("ABC", "EFG"), length.out = 900),
                   Week = rep(c("Monday", "Tuesday", "Wednesday", "Thursday", "Friday",
                                "Saturday", "Sunday"), length.out = 900),
                   DR1 = sample( 200:250, 900, repl=TRUE),  
                   setNames( replicate(365, { sample(0:900, 900)}, simplify=FALSE),
                             paste0("DRM0", formatC(1:365, width = 2, format = "d", flag = "0"))))


return_values <- function (df1,idd,dmda, CategoryChosse) {
  
  # First idea: Calculate the median of the values resulting from the subtraction between DR1 and the values of the DRM columns
  
  dt1 <- as.data.table(df1)
  
  cols <- grep("^DRM0", colnames(dt1), value = TRUE)
  
  med <- 
    dt1[, (paste0(cols, "_PV")) := DR1 - .SD, .SDcols = cols
    ][, lapply(.SD, median), by = .(Id, Category, Week), .SDcols = paste0(cols, "_PV") ]
  
  # Second idea: After obtaining the median, I add the values found with the values of the DRM columns of my df1 database.
  
  f2 <- function(nm, pat) grep(pat, nm, value = TRUE)
  nm1 <- f2(names(df1), "^DRM0\\d+$")
  nm2 <- f2(names(med), "_PV")
  nm3 <- paste0("i.", nm2)
  setDT(df1)[med,(nm2) := Map(`+`, mget(nm1), mget(nm3)), on = .(Id, Category, Week)]
  SPV <- df1[, c('Id','date1', 'date2', 'Week','Category', nm2), with = FALSE]#%>%data.frame
  
  # Third idea: Coef values
  
  coef<-SPV %>%
    filter(Id==idd, date2 == ymd(dmda), Category == CategoryChosse) %>%
    pull(as.numeric(ymd(dmda)-ymd(min(df1$date1)))+6)
  
  return(coef)
  
}
#Calculating for all coef.

subset_df1 <- subset(df1, date2 > date1)

subset_df1 %>%
  rowwise %>%
  mutate(return_values(df1,Id, date2, Category)) %>%
  select(-c(Week,starts_with('DR')))


      Id date1      date2      Category `return_values(df1, Id, date2, Category~
   <int> <date>     <date>     <chr>                                       <dbl>
 1     1 2021-12-01 2021-12-02 ABC                                          -336
 2     2 2021-12-01 2021-12-02 EFG                                           -85
 3     3 2021-12-01 2021-12-03 ABC                                           671
 4     4 2021-12-01 2021-12-03 EFG                                          -110
 5     5 2021-12-01 2021-12-04 ABC                                           562
 6     1 2021-12-01 2021-12-04 EFG                                           508
 7     2 2021-12-01 2021-12-05 ABC                                           144
 8     3 2021-12-01 2021-12-05 EFG                                           -33
 9     4 2021-12-01 2021-12-06 ABC                                          -218
10     5 2021-12-01 2021-12-06 EFG                                           237
 ... with 220 more rows
4

I made separate functions for the calculation of med and SPV. The code seems to be significantly faster based on my simply watching it run. As before, I did the original calculation and a new calculation and compared the objects returned by each.


library(lubridate)
library(data.table)

library(dplyr)

set.seed(0)

df1 <- data.frame( Id = rep(1:5, length=900),
                   date1 =  as.Date( "2021-12-01"),
                   date2= rep(seq( as.Date("2021-01-01"), length.out=450, by=1), each = 2),
                   Category = rep(c("ABC", "EFG"), length.out = 900),
                   Week = rep(c("Monday", "Tuesday", "Wednesday", "Thursday", "Friday",
                                "Saturday", "Sunday"), length.out = 900),
                   DR1 = sample( 200:250, 900, repl=TRUE),  
                   setNames( replicate(365, { sample(0:900, 900)}, simplify=FALSE),
                             paste0("DRM0", formatC(1:365, width = 2, format = "d", flag = "0"))))
#####
return_values <- function (df1,idd,dmda, CategoryChosse) {
  
  # First idea: Calculate the median of the values resulting from the subtraction between DR1 and the values of the DRM columns
  
  dt1 <- as.data.table(df1)
  
  cols <- grep("^DRM0", colnames(dt1), value = TRUE)
  
  med <- 
    dt1[, (paste0(cols, "_PV")) := DR1 - .SD, .SDcols = cols
        ][, lapply(.SD, median), by = .(Id, Category, Week), .SDcols = paste0(cols, "_PV") ]
  
  # Second idea: After obtaining the median, I add the values found with the values of the DRM columns of my df1 database.
  
  f2 <- function(nm, pat) grep(pat, nm, value = TRUE)
  nm1 <- f2(names(df1), "^DRM0\\d+$")
  nm2 <- f2(names(med), "_PV")
  nm3 <- paste0("i.", nm2)
  setDT(df1)[med,(nm2) := Map(`+`, mget(nm1), mget(nm3)), on = .(Id, Category, Week)]
  SPV <- df1[, c('Id','date1', 'date2', 'Week','Category', nm2), with = FALSE]#%>%data.frame
  
  # Third idea: Coef values
  
  coef<-SPV %>%
    filter(Id==idd, date2 == ymd(dmda), Category == CategoryChosse) %>%
    pull(as.numeric(ymd(dmda)-ymd(min(df1$date1)))+6)
  
  return(coef)
}
#Calculating for all coef.

subset_df1 <- subset(df1, date2 > date1)

orig <- subset_df1 %>%
  rowwise %>%
  mutate(Coef = return_values(df1,Id, date2, Category)) %>%
  select(-c(Week,starts_with('DR')))


###### New Calc
MedFunc <-  function(df1) {
  dt1 <- as.data.table(df1)

cols <- grep("^DRM0", colnames(dt1), value = TRUE)

med <- dt1[, (paste0(cols, "_PV")) := DR1 - .SD, .SDcols = cols
           ][, lapply(.SD, median), by = .(Id, Category, Week), .SDcols = paste0(cols, "_PV") ]
return(med)
}

SPVfunc <- function() {
  f2 <- function(nm, pat) grep(pat, nm, value = TRUE)
  nm1 <- f2(names(df1), "^DRM0\\d+$")
  nm2 <- f2(names(MED), "_PV")
  nm3 <- paste0("i.", nm2)
  setDT(df1)[MED,(nm2) := Map(`+`, mget(nm1), mget(nm3)), on = .(Id, Category, Week)]
  SPV <- df1[, c('Id','date1', 'date2', 'Week','Category', nm2), with = FALSE]#
  return(SPV)
}

CoefFunc <- function(DF1, SPV, idd, dmda, CategoryChosse) {
  coef <- SPV %>%
    filter(Id==idd, date2 == ymd(dmda), Category == CategoryChosse) %>%
    pull(as.numeric(ymd(dmda)-ymd(min(DF1$date1)))+6)
  
  return(coef)
}
MED <- df1 %>% MedFunc() 
SPV <-  SPVfunc()
New <- subset_df1 %>%
  rowwise %>%
  mutate(Coef = CoefFunc(df1, SPV, Id, date2, Category)) %>%
  select(-c(Week,starts_with('DR')))

identical(New, orig)
#> [1] TRUE

Created on 2022-04-22 by the reprex package (v0.2.1)

1 Like
6

Excellent @FJCC, Thank you so much! =)

7

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.