Как сократить время обработки кода в R

Не могли бы вы помочь мне придумать способ сократить время вычислений кода, генерирующего определенное значение, которое в данном случае я называю coef, которое будет зависеть от id/date/category? Лучшее объяснение ниже.

Я сделал две функции, которые генерируют один и тот же результат. Как вы можете видеть в benchmark, первая функция (return_values) требует в два раза больше времени, чем вторая функция (return_valuesX), чтобы получить те же результаты. Обратите внимание, что во второй функции я делаю небольшие изменения при вычислении переменной coef. Однако я твердо верю, что есть возможность улучшить код, как вы можете видеть во второй функции, мне удалось улучшить 50% времени обработки по сравнению с первой только с небольшими изменениями. Но у меня нет идей для новых настроек, поэтому я хотел бы получить ваше ценное мнение.

Объяснение кода:

В общем, целью кода является вычисление значения, которое я называю coef для каждой группы id, date и category. Для этого сначала вычисляется медиана значений, полученных в результате вычитания между DR1 и значениями столбцов DRM0 базы данных df1. После получения медианы (переменной med) я складываю найденные значения со значениями DRM0 столбцов моей df1 базы данных. Этот расчет является моей SPV переменной. В обоих случаях я использовал функцию data.table, которая, как мне кажется, работает быстрее, чем использование dplyr. После того, как я получу SPV, мне нужно вычислить переменную coef для каждого id/date/category.

Ниже я вставлю простой для понимания пример расчета coef. Если, например, я хочу рассчитать coef из idd<-"3", dmda<-"2021-12-03", CategoryChosse<-"ABC", и у меня есть следующее:

> 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
 
        

Так что coef будет ymd(dmda) - ymd(min(df1$date1)). То есть, если я сделаю это id/date/category, о котором я упоминал, я получу разницу в 2 дня, поэтому значение, которое я хочу, это DRM003_PV . Таким образом, значение для этого случая равно 198. Поэтому я сделал:

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

Эта проблема была решена здесь: Настройте код для выбора определенного столбца в зависимости от разницы между датами.

Библиотеки и базы данных

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"))))

Первая функция

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)
  
}

Результаты с использованием первой функции

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
...........

Вторая функция

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)
  
}

Результаты с использованием второй функции

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
...............

Сравнивая два результата:

identical(a, b)
[1] TRUE

Рассчитайте время обработки с помощью бенчмарка

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)


 # A tibble: 2 x 13
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]>

Проверить df1 базу данных enter image description here

Можно ли заставить ваш пример использовать образцы данных? Вы объясняете сценарий с помощью таких столбцов, как «DR00_DR00_PV», но в вашем образце данных есть такие столбцы, как «DRM001».

Jon Spring 22.04.2022 19:36

Да, это был просто пример, чтобы показать идею, но я делаю пример своей базы данных df1 и вставлю в вопрос. Спасибо за ответ.

user16774617 22.04.2022 19:40

Пожалуйста, добавьте set.seed(0) (или номер по вашему выбору), чтобы образцы данных, которые мы делаем, совпадали с вашими.

Jon Spring 22.04.2022 20:00

Я предполагаю, что ваша цель — вычислить coef для каждой строки ваших данных, как в вашем бенчмаркинге? Я думаю, что более идиоматический подход R будет изменять данные один раз, вычислять медианы и различия один раз, а затем фильтровать в каждой группе идентификаторов/категорий на основе разницы дат. Я предполагаю, что это будет в 10-100 раз быстрее, поскольку это устранит множество избыточных пересчетов.

Jon Spring 22.04.2022 20:12

Спасибо за ответ! Думаю будет хорошей альтернативой. Вы бы знали, как это сделать? Что касается расчета coef, то он только для date2>date1, который является моим subset_df1. Что касается set.seed, вы хотите, чтобы я создал базу данных без генерации случайных чисел, а только с фиксированными значениями, верно?

user16774617 22.04.2022 20:18

Вы проделали большую работу, показав, как создавать поддельные данные и продемонстрировав свои расчеты, но без set.seed() мы не сможем сгенерировать поддельные данные такой же, как вы, поэтому сложнее следовать вашему примеру и проверить возможность решения.

Jon Spring 22.04.2022 20:29

Понял! Я устрою это тогда, и дам вам знать, когда это будет сделано. Спасибо.

user16774617 22.04.2022 20:54

Привет, @Jon Spring, я внес изменения, о которых ты просил. Кроме того, я скорректировал этот пример расчета coef для этой «новой» базы данных, а также вставил результаты, показывающие первую функцию, а также вторую функцию, и вижу, что они дали одинаковые результаты, причем вторая функция намного лучше, чем первый по времени обработки. Однако я считаю, что этот ваш подход, который вы прокомментировали, может улучшить еще больше. Было бы здорово, если бы вы могли попробовать.

user16774617 22.04.2022 23:56

Давайте продолжить обсуждение в чате.

Jon Spring 23.04.2022 04:03
3 метода стилизации элементов HTML
3 метода стилизации элементов HTML
Когда дело доходит до применения какого-либо стиля к нашему HTML, существует три подхода: встроенный, внутренний и внешний. Предпочтительным обычно...
Формы c голосовым вводом в React с помощью Speechly
Формы c голосовым вводом в React с помощью Speechly
Пытались ли вы когда-нибудь заполнить веб-форму в области электронной коммерции, которая требует много кликов и выбора? Вас попросят заполнить дату,...
Стилизация и валидация html-формы без использования JavaScript (только HTML/CSS)
Стилизация и валидация html-формы без использования JavaScript (только HTML/CSS)
Будучи разработчиком веб-приложений, легко впасть в заблуждение, считая, что приложение без JavaScript не имеет права на жизнь. Нам становится удобно...
Flatpickr: простой модуль календаря для вашего приложения на React
Flatpickr: простой модуль календаря для вашего приложения на React
Если вы ищете пакет для быстрой интеграции календаря с выбором даты в ваше приложения, то библиотека Flatpickr отлично справится с этой задачей....
В чем разница между Promise и Observable?
В чем разница между Promise и Observable?
Разберитесь в этом вопросе, и вы значительно повысите уровень своей компетенции.
Что такое cURL в PHP? Встроенные функции и пример GET запроса
Что такое cURL в PHP? Встроенные функции и пример GET запроса
Клиент для URL-адресов, cURL, позволяет взаимодействовать с множеством различных серверов по множеству различных протоколов с синтаксисом URL.
0
9
117
1
Перейти к ответу Данный вопрос помечен как решенный

Ответы 1

Ответ принят как подходящий

Вот подход, который примерно в 20/10 раз быстрее, чем ваши функции для примера данных, и будет еще быстрее для больших наборов данных. (Когда я запускаю 100 тыс. строк в df1, это в 572 раза быстрее.) Надеюсь, вам будет легче понять и отладить этот подход.

Это написано с использованием функций tidyverse, таких как tidyr::pivot_longer и dplyr::group_by. Если вы хотите выжать немного больше скорости, пакеты data.table и collapse предлагают более быстрые альтернативы для многих функций, особенно для групповых вычислений. Но основное улучшение скорости здесь связано с реструктуризацией, позволяющей избежать повторения одних и тех же вычислений снова и снова и позволить R больше полагаться на векторизованные вычисления. https://www.noamross.net/archives/2014-04-16-vectorization-in-r-why/

pre_calc <- function(df) {
  pre_calc <- df1 %>%   # this calculates once on the full data
    select(!ends_with("_PV")) %>%
    pivot_longer(-c(1:6), values_to = "DRM", names_to = "day") %>%
    mutate(day = parse_number(day)) %>%
    group_by(Id, Category, Week, day) %>%
    mutate(med = median(DR1 - DRM), Result = DRM + med) %>%
    ungroup() 
    
  df %>%   # starts from the subsetted data and joins to results from above
    select(1:5) %>%
    left_join(pre_calc) %>%
    filter(day == date2 - date1 + 1) %>%
    select(Id, date1, date2, Category, Result)
}

c <- subset_df1 %>% pre_calc()

c matches a and b from your tests, with the one difference that date2 (originally date-integer, which is a nonstandard type) has in my approach been coerced into a typical date-double, like date1. We can use typeof(df1$date1) & typeof(df1$date2) to see this. waldo::compare(b, c) confirms the results otherwise match. I opened an issue with tidyrhere since the subtle change seems to have been caused by the pivot_longer step.

UPDATE: Apparently the creation of a date-integer object is a bug in base R's seq.Date / seq function, which was fixed in R 4.2: https://github.com/tidyverse/tidyr/issues/1356#issuecomment-1111078891

В приведенном выше подходе я предварительно вычисляю все результаты один раз, беря исходный набор данных df1, отбрасывая существующие столбцы _PV (думаю, они перезаписываются?) и — вот откуда берется выигрыш в скорости — изменяя форму к длинному формату. Хотя эта единственная операция является дорогостоящей в вычислительном отношении, это означает, что мы можем более эффективно применять одни и те же вычисления ко всем столбцам DRM_* одновременно, и мы можем полагаться на быструю фильтрацию вместо медленного подмножества для извлечения нашего результата.

Строка group_by(Id, Category, Week, day) и следующая строка mutate(... позволяют нам рассчитать медианную разницу между DR1 и DRM этого дня для каждой комбинации идентификатор-категория-неделя, чтобы мы могли рассчитать все результаты сразу.

Последняя часть берет строки df (например, подмножество данных в вашем примере, где date2 > date1) и прикрепляет их к предварительно рассчитанным результатам, фильтруя, чтобы получить правильный день (ранее закодированный по имени/позиции столбца).

Большое спасибо за ответ и отличное объяснение @Jon Spring. Действительно оптимизировал расчет с помощью вашего кода. Я тестировал его как для тестовой базы данных, так и для реальной, которая у меня есть. Большое спасибо, что нашли время, чтобы решить эту проблему.

user16774617 25.04.2022 15:30

Обновление - по-видимому, с R 4.2 исправлена ​​​​ошибка, которая создавала целые числа даты.

Jon Spring 27.04.2022 18:44

Другие вопросы по теме