1
\$\begingroup\$

Can you help me think of some way to reduce the computational time of a code that generates a certain value, which in this case I call coef, which will depend on id/date/category? Better explanations below.

I made two functions that generate the same result. As you can see in benchmark, the first function (return_values) takes twice as long as the second function (return_valuesX) to generate the same results. See that in the second function, I make some brief changes when calculating the coef variable. However, I strongly believe that there is a possibility of improving the code, as you can see in the second function, I managed to improve 50% of processing time compared to the first just with brief changes. But I'm out of ideas for new adjustments, so I would like your valuable opinion.

Code Explanations:

In general, the purpose of the code is to calculate a value, which I call a coef for each group of id, date and category. For this, the median of the values ​​resulting from the subtraction between DR1 and the values ​​of the DRM0 columns of the df1 database is first calculated. After obtaining the median (med variable), I add the values ​​found with the values ​​of the DRM0 columns of my df1 database. This calculation is my SPV variable. In both cases, I used the data.table function, which I believe is faster than using dplyr. After I get SPV, I need to calculate the coef variable for each id/date/category.

Below I will insert an example real easy to understand of the coef calculation. If for example I want to calculate coef of idd<-"3", dmda<-"2021-12-03", CategoryChosse<-"ABC", and I have the following:

> SPV %>% filter(Id==idd, date2 == ymd(dmda), Category == CategoryChosse)

 Id      date1      date2   Week Category DRM001_PV DRM002_PV DRM003_PV DRM004_PV DRM005_PV DRM006_PV DRM007_PV DRM008_PV DRM009_PV DRM010_PV DRM011_PV DRM012_PV
1:  3 2021-12-01 2021-12-03 Monday      ABC        -3       374       198        17       537       -54       330      -136      -116       534        18      -199
   DRM013_PV DRM014_PV DRM015_PV DRM016_PV DRM017_PV DRM018_PV DRM019_PV DRM020_PV DRM021_PV DRM022_PV DRM023_PV DRM024_PV DRM025_PV DRM026_PV DRM027_PV DRM028_PV
1:       106       106       349        76       684       390       218       146       141        20       435       218       372       321       218       218
   DRM029_PV DRM030_PV DRM031_PV DRM032_PV DRM033_PV DRM034_PV DRM035_PV DRM036_PV DRM037_PV DRM038_PV DRM039_PV DRM040_PV DRM041_PV DRM042_PV DRM043_PV DRM044_PV
1:        55       455        46       411       262       449       325       467        43      -114       191       167        63      -123       252       218
   DRM045_PV DRM046_PV DRM047_PV DRM048_PV DRM049_PV DRM050_PV DRM051_PV DRM052_PV DRM053_PV DRM054_PV DRM055_PV DRM056_PV DRM057_PV DRM058_PV DRM059_PV DRM060_PV
1:       305       420      -296       596       200       218       190       203       607       218       442       -72       463       129       -39       333
   DRM061_PV DRM062_PV DRM063_PV DRM064_PV DRM065_PV DRM066_PV DRM067_PV DRM068_PV DRM069_PV DRM070_PV DRM071_PV DRM072_PV DRM073_PV DRM074_PV DRM075_PV DRM076_PV
1:       -26       160       -91       326       218       369       317       476       224        61       195       613       342       218       204       521
   DRM077_PV DRM078_PV DRM079_PV DRM080_PV DRM081_PV DRM082_PV DRM083_PV DRM084_PV DRM085_PV DRM086_PV DRM087_PV DRM088_PV DRM089_PV DRM090_PV DRM091_PV DRM092_PV
1:       588       218       449       340        51       508       -72        42       492       510       328       818      -132      -105       210      -102
   DRM093_PV DRM094_PV DRM095_PV DRM096_PV DRM097_PV DRM098_PV DRM099_PV DRM0100_PV DRM0101_PV DRM0102_PV DRM0103_PV DRM0104_PV DRM0105_PV DRM0106_PV DRM0107_PV
1:      -137        94       639       265       -64       512        32        -53        414        340        -16        471        434        150        267
   DRM0108_PV DRM0109_PV DRM0110_PV DRM0111_PV DRM0112_PV DRM0113_PV DRM0114_PV DRM0115_PV DRM0116_PV DRM0117_PV DRM0118_PV DRM0119_PV DRM0120_PV DRM0121_PV DRM0122_PV
1:        383       -162        434       -134        -39        450        212        146        -26          8        222        341        601        239         57
   DRM0123_PV DRM0124_PV DRM0125_PV DRM0126_PV DRM0127_PV DRM0128_PV DRM0129_PV DRM0130_PV DRM0131_PV DRM0132_PV DRM0133_PV DRM0134_PV DRM0135_PV DRM0136_PV DRM0137_PV
1:        484        239        502        415        504         62        487        168        101        319        365         37        218        -50        230
   DRM0138_PV DRM0139_PV DRM0140_PV DRM0141_PV DRM0142_PV DRM0143_PV DRM0144_PV DRM0145_PV DRM0146_PV DRM0147_PV DRM0148_PV DRM0149_PV DRM0150_PV DRM0151_PV DRM0152_PV
1:        493        159        150        132         58         21        468        -81         27        345        107        148        -66       -146       -185
   DRM0153_PV DRM0154_PV DRM0155_PV DRM0156_PV DRM0157_PV DRM0158_PV DRM0159_PV DRM0160_PV DRM0161_PV DRM0162_PV DRM0163_PV DRM0164_PV DRM0165_PV DRM0166_PV DRM0167_PV
1:        -14        562         68        140        353        120        130        301         76        441        218        370        218        378        -22
   DRM0168_PV DRM0169_PV DRM0170_PV DRM0171_PV DRM0172_PV DRM0173_PV DRM0174_PV DRM0175_PV DRM0176_PV DRM0177_PV DRM0178_PV DRM0179_PV DRM0180_PV DRM0181_PV DRM0182_PV
1:       -279        563        628        600        152        218        445        246        420         94        495        509        356        183        326
   DRM0183_PV DRM0184_PV DRM0185_PV DRM0186_PV DRM0187_PV DRM0188_PV DRM0189_PV DRM0190_PV DRM0191_PV DRM0192_PV DRM0193_PV DRM0194_PV DRM0195_PV DRM0196_PV DRM0197_PV
1:        493       -190        -65       -123        376        357        473        112        -69        471        452        221        165        -44         87
   DRM0198_PV DRM0199_PV DRM0200_PV DRM0201_PV DRM0202_PV DRM0203_PV DRM0204_PV DRM0205_PV DRM0206_PV DRM0207_PV DRM0208_PV DRM0209_PV DRM0210_PV DRM0211_PV DRM0212_PV
1:        239        285        521        -65        158        223        160        223        269         57        218        218        102        329        218
   DRM0213_PV DRM0214_PV DRM0215_PV DRM0216_PV DRM0217_PV DRM0218_PV DRM0219_PV DRM0220_PV DRM0221_PV DRM0222_PV DRM0223_PV DRM0224_PV DRM0225_PV DRM0226_PV DRM0227_PV
1:        769        215        -68        218        347         18        218        547        759        278        -80        -37        629        -16        774
   DRM0228_PV DRM0229_PV DRM0230_PV DRM0231_PV DRM0232_PV DRM0233_PV DRM0234_PV DRM0235_PV DRM0236_PV DRM0237_PV DRM0238_PV DRM0239_PV DRM0240_PV DRM0241_PV DRM0242_PV
1:        364        113       -132         31        536        118        248        385        218        202        218         41         23        218        379
   DRM0243_PV DRM0244_PV DRM0245_PV DRM0246_PV DRM0247_PV DRM0248_PV DRM0249_PV DRM0250_PV DRM0251_PV DRM0252_PV DRM0253_PV DRM0254_PV DRM0255_PV DRM0256_PV DRM0257_PV
1:       -158        462        600        221        218        221        442        218         53        218        176        504        -61         78         68
   DRM0258_PV DRM0259_PV DRM0260_PV DRM0261_PV DRM0262_PV DRM0263_PV DRM0264_PV DRM0265_PV DRM0266_PV DRM0267_PV DRM0268_PV DRM0269_PV DRM0270_PV DRM0271_PV DRM0272_PV
1:        493        403        218        339        299        749        -18        465        686       -215        579        307        366        279         94
   DRM0273_PV DRM0274_PV DRM0275_PV DRM0276_PV DRM0277_PV DRM0278_PV DRM0279_PV DRM0280_PV DRM0281_PV DRM0282_PV DRM0283_PV DRM0284_PV DRM0285_PV DRM0286_PV DRM0287_PV
1:        138         56        459        613        219        400         35        -74        516        218        -80        317        310       -231        229
   DRM0288_PV DRM0289_PV DRM0290_PV DRM0291_PV DRM0292_PV DRM0293_PV DRM0294_PV DRM0295_PV DRM0296_PV DRM0297_PV DRM0298_PV DRM0299_PV DRM0300_PV DRM0301_PV DRM0302_PV
1:        345        -70        619        235        122         61        337       -163        210        586        127       -112        368        365        476
   DRM0303_PV DRM0304_PV DRM0305_PV DRM0306_PV DRM0307_PV DRM0308_PV DRM0309_PV DRM0310_PV DRM0311_PV DRM0312_PV DRM0313_PV DRM0314_PV DRM0315_PV DRM0316_PV DRM0317_PV
1:        240        270        497         97        420       -184        212        -28        151        527        186        -32         60         96        -86
   DRM0318_PV DRM0319_PV DRM0320_PV DRM0321_PV DRM0322_PV DRM0323_PV DRM0324_PV DRM0325_PV DRM0326_PV DRM0327_PV DRM0328_PV DRM0329_PV DRM0330_PV DRM0331_PV DRM0332_PV
1:        454        321        300        552        319        134        -63        622        441        297        507        578        198        360        542
   DRM0333_PV DRM0334_PV DRM0335_PV DRM0336_PV DRM0337_PV DRM0338_PV DRM0339_PV DRM0340_PV DRM0341_PV DRM0342_PV DRM0343_PV DRM0344_PV DRM0345_PV DRM0346_PV DRM0347_PV
1:        153        318         68        763        370        337        633        469        453        146        428        418        169        468        526
   DRM0348_PV DRM0349_PV DRM0350_PV DRM0351_PV DRM0352_PV DRM0353_PV DRM0354_PV DRM0355_PV DRM0356_PV DRM0357_PV DRM0358_PV DRM0359_PV DRM0360_PV DRM0361_PV DRM0362_PV
1:        441        674         21       -182        174        153       -158        268        191        460         10         82        543       -193        218
   DRM0363_PV DRM0364_PV DRM0365_PV
1:       -203        269        479
> SPV %>% filter(Id==idd, date2 == ymd(dmda), Category == CategoryChosse)
   Id      date1      date2   Week Category DRM001_PV DRM002_PV DRM003_PV DRM004_PV DRM005_PV DRM006_PV DRM007_PV DRM008_PV DRM009_PV DRM010_PV DRM011_PV DRM012_PV
1:  3 2021-12-01 2021-12-03 Monday      ABC        -3       374       198        17       537       -54       330      -136      -116       534        18      -199
   DRM013_PV DRM014_PV DRM015_PV DRM016_PV DRM017_PV DRM018_PV DRM019_PV DRM020_PV DRM021_PV DRM022_PV DRM023_PV DRM024_PV DRM025_PV DRM026_PV DRM027_PV DRM028_PV
1:       106       106       349        76       684       390       218       146       141        20       435       218       372       321       218       218
   DRM029_PV DRM030_PV DRM031_PV DRM032_PV DRM033_PV DRM034_PV DRM035_PV DRM036_PV DRM037_PV DRM038_PV DRM039_PV DRM040_PV DRM041_PV DRM042_PV DRM043_PV DRM044_PV
1:        55       455        46       411       262       449       325       467        43      -114       191       167        63      -123       252       218
   DRM045_PV DRM046_PV DRM047_PV DRM048_PV DRM049_PV DRM050_PV DRM051_PV DRM052_PV DRM053_PV DRM054_PV DRM055_PV DRM056_PV DRM057_PV DRM058_PV DRM059_PV DRM060_PV
1:       305       420      -296       596       200       218       190       203       607       218       442       -72       463       129       -39       333
   DRM061_PV DRM062_PV DRM063_PV DRM064_PV DRM065_PV DRM066_PV DRM067_PV DRM068_PV DRM069_PV DRM070_PV DRM071_PV DRM072_PV DRM073_PV DRM074_PV DRM075_PV DRM076_PV
1:       -26       160       -91       326       218       369       317       476       224        61       195       613       342       218       204       521
   DRM077_PV DRM078_PV DRM079_PV DRM080_PV DRM081_PV DRM082_PV DRM083_PV DRM084_PV DRM085_PV DRM086_PV DRM087_PV DRM088_PV DRM089_PV DRM090_PV DRM091_PV DRM092_PV
1:       588       218       449       340        51       508       -72        42       492       510       328       818      -132      -105       210      -102
   DRM093_PV DRM094_PV DRM095_PV DRM096_PV DRM097_PV DRM098_PV DRM099_PV DRM0100_PV DRM0101_PV DRM0102_PV DRM0103_PV DRM0104_PV DRM0105_PV DRM0106_PV DRM0107_PV
1:      -137        94       639       265       -64       512        32        -53        414        340        -16        471        434        150        267
   DRM0108_PV DRM0109_PV DRM0110_PV DRM0111_PV DRM0112_PV DRM0113_PV DRM0114_PV DRM0115_PV DRM0116_PV DRM0117_PV DRM0118_PV DRM0119_PV DRM0120_PV DRM0121_PV DRM0122_PV
1:        383       -162        434       -134        -39        450        212        146        -26          8        222        341        601        239         57
   DRM0123_PV DRM0124_PV DRM0125_PV DRM0126_PV DRM0127_PV DRM0128_PV DRM0129_PV DRM0130_PV DRM0131_PV DRM0132_PV DRM0133_PV DRM0134_PV DRM0135_PV DRM0136_PV DRM0137_PV
1:        484        239        502        415        504         62        487        168        101        319        365         37        218        -50        230
   DRM0138_PV DRM0139_PV DRM0140_PV DRM0141_PV DRM0142_PV DRM0143_PV DRM0144_PV DRM0145_PV DRM0146_PV DRM0147_PV DRM0148_PV DRM0149_PV DRM0150_PV DRM0151_PV DRM0152_PV
1:        493        159        150        132         58         21        468        -81         27        345        107        148        -66       -146       -185
   DRM0153_PV DRM0154_PV DRM0155_PV DRM0156_PV DRM0157_PV DRM0158_PV DRM0159_PV DRM0160_PV DRM0161_PV DRM0162_PV DRM0163_PV DRM0164_PV DRM0165_PV DRM0166_PV DRM0167_PV
1:        -14        562         68        140        353        120        130        301         76        441        218        370        218        378        -22
   DRM0168_PV DRM0169_PV DRM0170_PV DRM0171_PV DRM0172_PV DRM0173_PV DRM0174_PV DRM0175_PV DRM0176_PV DRM0177_PV DRM0178_PV DRM0179_PV DRM0180_PV DRM0181_PV DRM0182_PV
1:       -279        563        628        600        152        218        445        246        420         94        495        509        356        183        326
   DRM0183_PV DRM0184_PV DRM0185_PV DRM0186_PV DRM0187_PV DRM0188_PV DRM0189_PV DRM0190_PV DRM0191_PV DRM0192_PV DRM0193_PV DRM0194_PV DRM0195_PV DRM0196_PV DRM0197_PV
1:        493       -190        -65       -123        376        357        473        112        -69        471        452        221        165        -44         87
   DRM0198_PV DRM0199_PV DRM0200_PV DRM0201_PV DRM0202_PV DRM0203_PV DRM0204_PV DRM0205_PV DRM0206_PV DRM0207_PV DRM0208_PV DRM0209_PV DRM0210_PV DRM0211_PV DRM0212_PV
1:        239        285        521        -65        158        223        160        223        269         57        218        218        102        329        218
   DRM0213_PV DRM0214_PV DRM0215_PV DRM0216_PV DRM0217_PV DRM0218_PV DRM0219_PV DRM0220_PV DRM0221_PV DRM0222_PV DRM0223_PV DRM0224_PV DRM0225_PV DRM0226_PV DRM0227_PV
1:        769        215        -68        218        347         18        218        547        759        278        -80        -37        629        -16        774
   DRM0228_PV DRM0229_PV DRM0230_PV DRM0231_PV DRM0232_PV DRM0233_PV DRM0234_PV DRM0235_PV DRM0236_PV DRM0237_PV DRM0238_PV DRM0239_PV DRM0240_PV DRM0241_PV DRM0242_PV
1:        364        113       -132         31        536        118        248        385        218        202        218         41         23        218        379
   DRM0243_PV DRM0244_PV DRM0245_PV DRM0246_PV DRM0247_PV DRM0248_PV DRM0249_PV DRM0250_PV DRM0251_PV DRM0252_PV DRM0253_PV DRM0254_PV DRM0255_PV DRM0256_PV DRM0257_PV
1:       -158        462        600        221        218        221        442        218         53        218        176        504        -61         78         68
   DRM0258_PV DRM0259_PV DRM0260_PV DRM0261_PV DRM0262_PV DRM0263_PV DRM0264_PV DRM0265_PV DRM0266_PV DRM0267_PV DRM0268_PV DRM0269_PV DRM0270_PV DRM0271_PV DRM0272_PV
1:        493        403        218        339        299        749        -18        465        686       -215        579        307        366        279         94
   DRM0273_PV DRM0274_PV DRM0275_PV DRM0276_PV DRM0277_PV DRM0278_PV DRM0279_PV DRM0280_PV DRM0281_PV DRM0282_PV DRM0283_PV DRM0284_PV DRM0285_PV DRM0286_PV DRM0287_PV
1:        138         56        459        613        219        400         35        -74        516        218        -80        317        310       -231        229
   DRM0288_PV DRM0289_PV DRM0290_PV DRM0291_PV DRM0292_PV DRM0293_PV DRM0294_PV DRM0295_PV DRM0296_PV DRM0297_PV DRM0298_PV DRM0299_PV DRM0300_PV DRM0301_PV DRM0302_PV
1:        345        -70        619        235        122         61        337       -163        210        586        127       -112        368        365        476
   DRM0303_PV DRM0304_PV DRM0305_PV DRM0306_PV DRM0307_PV DRM0308_PV DRM0309_PV DRM0310_PV DRM0311_PV DRM0312_PV DRM0313_PV DRM0314_PV DRM0315_PV DRM0316_PV DRM0317_PV
1:        240        270        497         97        420       -184        212        -28        151        527        186        -32         60         96        -86
   DRM0318_PV DRM0319_PV DRM0320_PV DRM0321_PV DRM0322_PV DRM0323_PV DRM0324_PV DRM0325_PV DRM0326_PV DRM0327_PV DRM0328_PV DRM0329_PV DRM0330_PV DRM0331_PV DRM0332_PV
1:        454        321        300        552        319        134        -63        622        441        297        507        578        198        360        542
   DRM0333_PV DRM0334_PV DRM0335_PV DRM0336_PV DRM0337_PV DRM0338_PV DRM0339_PV DRM0340_PV DRM0341_PV DRM0342_PV DRM0343_PV DRM0344_PV DRM0345_PV DRM0346_PV DRM0347_PV
1:        153        318         68        763        370        337        633        469        453        146        428        418        169        468        526
   DRM0348_PV DRM0349_PV DRM0350_PV DRM0351_PV DRM0352_PV DRM0353_PV DRM0354_PV DRM0355_PV DRM0356_PV DRM0357_PV DRM0358_PV DRM0359_PV DRM0360_PV DRM0361_PV DRM0362_PV
1:        441        674         21       -182        174        153       -158        268        191        460         10         82        543       -193        218
   DRM0363_PV DRM0364_PV DRM0365_PV
1:       -203        269        479
 
        

So coef will be ymd(dmda) - ymd(min(df1$date1)). That is, if I do to this id/date/category that I mentioned I get a difference of 2 days, so the value I want is the DRM003_PV . So the value for this case is 198. Therefore, I made:

coef<-SPV %>%
    filter(Id==idd, date2 == ymd(dmda), Category == CategoryChosse) %>%
    pull(as.numeric(ymd(dmda)-ymd(min(df1$date1)))+6)
> coef
[1] 198

This issue has been resolved here: https://stackoverflow.com/questions/71835280/adjust-code-to-choose-a-specific-column-depending-on-the-difference-between-date

Libraries and database

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

set.seed(123)

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

First function

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 DRM0 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: Calculate the coef values
  
  coef<-SPV %>%
    filter(Id==idd, date2 == ymd(dmda), Category == CategoryChosse) %>%
    pull(as.numeric(ymd(dmda)-ymd(min(df1$date1)))+6)
  
  return(coef)
  
}

Results using first function

subset_df1 <- subset(df1, date2 > date1)

a<-subset_df1 %>%
  rowwise %>%
  select(-c(Week,starts_with('DR')))%>%
  mutate(Result=return_values(df1,Id, date2, Category)) %>%
  data.frame()  
    > a
    Id      date1      date2 Category Result
1    1 2021-12-01 2021-12-02      ABC    4.0
2    2 2021-12-01 2021-12-02      EFG  238.0
3    3 2021-12-01 2021-12-03      ABC  198.0
4    4 2021-12-01 2021-12-03      EFG  163.0
5    5 2021-12-01 2021-12-04      ABC  462.0
...........

Second function

return_valuesX <- 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)
  
  num_to_pull <- as.numeric(ymd(dmda)-ymd(min(df1$date1)))+6

  cols <- grep("^DRM0", colnames(dt1), value = TRUE)[1:num_to_pull]
  
  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+$")[1:num_to_pull]
  nm2 <- f2(names(med), "_PV")[1:num_to_pull]
  nm3 <- paste0("i.", nm2)[1:num_to_pull]
  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: Calculate the coef values
  
  coef<-SPV %>%
    filter(Id==idd, date2 == ymd(dmda), Category == CategoryChosse) %>%
    pull(num_to_pull)
  
  return(coef)
  
}

Results using second function

b<-subset_df1 %>%
  rowwise %>%
  select(-c(Week,starts_with('DR')))%>%
  mutate(Result = return_valuesX(df1,Id, date2, Category)) %>%
  data.frame()
> b
    Id      date1      date2 Category Result
1    1 2021-12-01 2021-12-02      ABC    4.0
2    2 2021-12-01 2021-12-02      EFG  238.0
3    3 2021-12-01 2021-12-03      ABC  198.0
4    4 2021-12-01 2021-12-03      EFG  163.0
5    5 2021-12-01 2021-12-04      ABC  462.0
...............

Comparing the two results:

identical(a, b)
[1] TRUE

Calculate processing time using benchmark

subset_df1 <- subset(df1, date2 > date1)

 
bench::mark(a=subset_df1 %>%
              rowwise %>%
              select(-c(Week,starts_with('DR')))%>%
              mutate(Result=return_values(df1,Id, date2, Category)),

            b=subset_df1 %>% 
              rowwise %>%
              select(-c(Week,starts_with('DR')))%>%
              mutate(Result=return_valuesX(df1,Id, date2, Category)),iterations = 1)


expression      min   median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc total_time result                 memory                   time           gc              
  <bch:expr> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl> <int> <dbl>   <bch:tm> <list>                 <list>                   <list>         <list>          
1 a             53.7s    53.7s    0.0186    4.54GB    0.634     1    34      53.7s <rowwise_df [130 x 5]> <Rprofmem [981,580 x 3]> <bench_tm [1]> <tibble [1 x 3]>
2 b               21s      21s    0.0477  913.77MB    0.382     1     8        21s <rowwise_df [130 x 5]> <Rprofmem [278,340 x 3]> <bench_tm [1]> <tibble [1 x 3]>
\$\endgroup\$
0

1 Answer 1

2
\$\begingroup\$

Consider the following tips:

  • Keep data in long format (i.e., tidy data) and not wide format as you have it with data elements stored in column headers. Long format usually works optimally for cleaning, aggregating, modeling, and plotting data. As shown below, you can avoid the hidden looping with lapply or Map (wrapper to mapply) across hundreds of columns.

    Fortunately, data.table maintains reshaping methods including melt to transform wide to long format and conversely dcast to transform from long to wide format.

  • Stay consistent in one flavor. In R, three main flavors include: base, tidyverse, and data.table. Many of the accompanying methods to these flavors work best with their own objects. Mixing signatures can make code hard to follow and maintain. Additionally, you only have one area to focus documentation and troubleshooting.

  • Avoid excessive iterations. Currently, you run exactly the same calculation and aggregation on all rows but only filter on last step. (This is more vividly seen in first function). Instead, consider as shown below splitting functions to run calculation and aggregation once to generate SPV and filter across all rows in subsequent step.

Below is a refactored process with split functions entirely in the data.table flavor:

Functions

calculate_SPV <- function (df1) {  
  # First idea: Calculate the median of the values resulting 
  #    from the subtraction between DR1 and the values of the DRM0 columns
  long_dt <- melt(
    setDT(df1), id.vars=names(df1)[1:6], 
    variable.name = "DRM0_Num", value.name = "DRM0_Value"
  )
  
  # Second idea: After obtaining the median, I add the values found with 
  #    the values of the DRM columns of my df1 database.
  agg <- long_dt[,
            DRM_PV := as.numeric(DR1 - DRM0_Value),
         ][,
           DRM_PV := median(DRM_PV),
            by=.(Id, Category, Week, DRM0_Num)
         ][,
           DRM_PV := DRM_PV + DRM0_Value
         ]
  
  wide_dt <- dcast(
    agg, Id + date1 + date2 + Week + Category ~ DRM0_Num, value.var="DRM_PV"
  )
  
  return(wide_dt)
}

filter_SPV <- function(SPV, idd, dmda, CategoryChosse) {
  # Third idea: Calculate the coef values
  setDT(SPV)[
    Id==idd & date2 == ymd(dmda) & Category == CategoryChosse,
  ][[as.integer(ymd(dmda)-ymd(min(df1$date1)))+6]]
}

Calls

SPV_dt <- calculate_SPV(df1)

output_dt <- setDT(subset_df1)[,
  Result:=mapply(
    filter_SPV, idd=Id, dmda=date2, CategoryChosse=Category, 
    MoreArgs=list(SPV=SPV_dt))
][,.(Id, date1, date2, Category, Result)]


identical(a, data.frame(output_dt))
[1] TRUE

identical(b, data.frame(output_dt))
[1] TRUE

In fact, you do not even need the iteration on filter_SPV() via mapply. Rather than traversing the wide format to select corresponding column with each row filter, merge the two sets of data and filter by row in long format:

Single Function (keeping long format output)

calculate_SPV <- function (df1) {  
  # First idea: Calculate the median of the values resulting 
  #    from the subtraction between DR1 and the values of the DRM0 columns
  long_dt <- melt(
    setDT(df1), id.vars=names(df1)[1:6], 
    variable.name = "DRM0_Num", value.name = "DRM0_Value"
  )
  
  # Second idea: After obtaining the median, I add the values found with 
  #    the values of the DRM columns of my df1 database.
  agg <- long_dt[,
            DRM_PV := as.numeric(DR1 - DRM0_Value),
         ][,
           DRM_PV := median(DRM_PV),
            by=.(Id, Category, Week, DRM0_Num)
         ][,
           DRM_PV := DRM_PV + DRM0_Value
         ]
  
  return(agg)
}

Single Call (merge in long format)

SPV_dt <- calculate_SPV(df1)

# MERGE AND FILTER ON GROUP ROW MATCHING POSITION
output_dt2 <- merge(
  setDT(subset_df1)[,.(Id, date1, date2, Week, Category)],
  SPV_dt,
  by=c("Id", "date1", "date2", "Week", "Category")
)[, `:=`(Pos=as.integer(ymd(date2)-ymd(min(df1$date1)))+1,
         Result=DRM_PV)
 ][, Grp:=1:.N, by=.(Id, date2, Category)
 ][Grp==Pos, .(Id, date1, date2, Category, Result)]


identical(
  output_dt[order(Id, date2, Category)],
  output_dt2[order(Id, date2, Category)]
)
[1] TRUE

identical(
  # RE-ORDER ALL COLUMNS AND RESET ROW NAMES
  data.frame(a[do.call(order, a),], row.names=NULL),  
  data.frame(output_dt2)
)
[1] TRUE
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.