Как сопоставить два кадра данных с неточным совпадающим идентификатором (один идентификатор должен находиться в диапазоне другого)

Question

У меня следующая проблема сопоставления: у меня есть два data.frames, один с наблюдением каждый месяц (для идентификатора компании), и один с наблюдением каждый квартал (для идентификатора компании; обратите внимание, что квартал означает финансовый квартал, поэтому 1 квартал= Январь, февраль, март не обязательно верны, а финансовый квартал не обязательно должен длиться 3 месяца).

Для каждого месяца и компании я хочу получить правильное значение этого квартала.Следовательно, несколько месяцев имеют одинаковое значение для одного квартала.В качестве примера см. Код ниже:

monthlyData <- data.frame(ID = rep(c("A", "B"), each = 5),
                  Month = rep(1:5, times = 2),
                  MonValue = 1:10)
monthlyData
   ID Month MonValue
1   A     1        1
2   A     2        2
3   A     3        3
4   A     4        4
5   A     5        5
6   B     1        6
7   B     2        7
8   B     3        8
9   B     4        9
10  B     5       10

#Quarterly data, i.e. the value of every quarter has to be matched to several months in d1
#However, I want to match fiscal quarters, which means that one quarter is not necessarily 3 month long
qtrData <- data.frame(ID = rep(c("A", "B"), each = 2),
                  startMonth = c(1, 4, 1, 3),
                  endMonth   = c(3, 5, 2, 5),
                  QTRValue   = 1:4)
qtrData
  ID startMonth endMonth QTRValue
1  A          1        3        1
2  A          4        5        2
3  B          1        2        3
4  B          3        5        4

#Desired output
   ID Month MonValue QTRValue
1   A     1        1        1
2   A     2        2        1
3   A     3        3        1
4   A     4        4        2
5   A     5        5        2
6   B     1        6        3
7   B     2        7        3
8   B     3        8        4
9   B     4        9        4
10  B     5       10        4

Примечание. Этот вопрос был опубликован в R-help несколько месяцев назад, но я не получил никакого ответа и сам нашел решение (см. R-помощь ).Теперь, однако, я разместил вопрос на stackoverflow, где у меня есть вопрос относительно data.table, где эта проблема также упоминалась, и там Андри попросил меня опубликовать этот вопрос еще раз, потому что у него, очевидно, есть хорошее решение (см. Вопрос по SO )

ОБНОВЛЕНИЕ: См. Комментарий Мэтью Доула: как выглядят реальные данные?

Эти данные более реалистичны.Я добавил несколько строк, но единственной основной частью, которая изменилась, является столбец endMonth в qtrData.Точнее, startMonth - это не обязательно endMonth предыдущего квартала плюс один месяц.Поэтому, используя опцию roll, я думаю, что вам нужна другая строка кода (если нет, вы получите 20 строк назад, но с помощью решения Андри, которое является желаемым, вы получите 17 строк назад).Тогда больше нет разницы в производительности, если я здесь ничего не пропущу.

monthlyData_new <- data.table(ID = rep(c("A", "B"), each = 10),
                  Month = rep(1:10, times = 2),
                  MonValue = 1:20)

qtrData_new <- data.table(ID = rep(c("A", "B"), each = 3),
                  startMonth = c(1, 4, 7, 1, 3, 8),
                  endMonth   = c(3, 5, 10, 2, 5, 10),
                  QTRValue   = 1:6)

setkey(qtrData_new, ID)
setkey(monthlyData_new, ID)

qtrData1 <- qtrData_new
setkey(qtrData1, ID, startMonth)
monthlyData1 <- monthlyData_new
setkey(monthlyData1, ID, Month)

withTable1 <- function(){
  xx <- qtrData1[monthlyData1, roll=TRUE]
  xx <- xx[startMonth <= endMonth]

}

withTable2 <- function(){
  yy <- monthlyData_new[qtrData_new][Month >= startMonth & Month <= endMonth]

}

benchmark(withTable1, withTable2, replications=1e6)
        test replications elapsed relative user.self sys.self user.child sys.child
1 withTable1      1000000   4.244 1.028599     4.232    0.008          0         0
2 withTable2      1000000   4.126 1.000000     4.096    0.028          0         0

Answer 1

Попробуйте:

mD = data.table(monthlyData, key="ID,Month")
qD = data.table(qtrData,key="ID,startMonth")
qD[mD,roll=TRUE]
      ID startMonth endMonth QTRValue MonValue
 [1,]  A          1        3        1        1
 [2,]  A          2        3        1        2
 [3,]  A          3        3        1        3
 [4,]  A          4        5        2        4
 [5,]  A          5        5        2        5
 [6,]  B          1        2        3        6
 [7,]  B          2        2        3        7
 [8,]  B          3        5        4        8
 [9,]  B          4        5        4        9
[10,]  B          5        5        4       10

Это должно быть намного быстрее.

РЕДАКТИРОВАТЬ: Ответ на вопрос о последующем редактировании.Одним из способов является использование NA для хранения там, где пропущены месяцы.Мне легче смотреть на один столбец временного ряда (нерегулярный с пробелами и NA), чем на два, составляющих ряд диапазонов.

> mD <- data.table(ID = rep(c("A", "B"), each = 10),
+                  Month = rep(1:10, times = 2),
+                  MonValue = 1:20,  key="ID,Month")
>                  
> qD <- data.table(ID = rep(c("A", "B"), each = 4),
+                   Month = c(1,4,6,7, 1,3,6,8),
+                   QtrValue = c(1,2,NA,3, 4,5,NA,6),
+                   key="ID,Month")
>                   
> mD
      ID Month MonValue
 [1,]  A     1        1
 [2,]  A     2        2
 [3,]  A     3        3
 [4,]  A     4        4
 [5,]  A     5        5
 [6,]  A     6        6
 [7,]  A     7        7
 [8,]  A     8        8
 [9,]  A     9        9
[10,]  A    10       10
[11,]  B     1       11
[12,]  B     2       12
[13,]  B     3       13
[14,]  B     4       14
[15,]  B     5       15
[16,]  B     6       16
[17,]  B     7       17
[18,]  B     8       18
[19,]  B     9       19
[20,]  B    10       20
> qD
     ID Month QtrValue
[1,]  A     1        1
[2,]  A     4        2
[3,]  A     6       NA     # missing for 1 month  (6)
[4,]  A     7        3
[5,]  B     1        4
[6,]  B     3        5
[7,]  B     6       NA     # missing for 2 months (6 and 7)
[8,]  B     8        6
> qD[mD,roll=TRUE]
      ID Month QtrValue MonValue
 [1,]  A     1        1        1
 [2,]  A     2        1        2
 [3,]  A     3        1        3
 [4,]  A     4        2        4
 [5,]  A     5        2        5
 [6,]  A     6       NA        6
 [7,]  A     7        3        7
 [8,]  A     8        3        8
 [9,]  A     9        3        9
[10,]  A    10        3       10
[11,]  B     1        4       11
[12,]  B     2        4       12
[13,]  B     3        5       13
[14,]  B     4        5       14
[15,]  B     5        5       15
[16,]  B     6       NA       16
[17,]  B     7       NA       17
[18,]  B     8        6       18
[19,]  B     9        6       19
[20,]  B    10        6       20
> qD[mD,roll=TRUE][!is.na(QtrValue)]
      ID Month QtrValue MonValue
 [1,]  A     1        1        1
 [2,]  A     2        1        2
 [3,]  A     3        1        3
 [4,]  A     4        2        4
 [5,]  A     5        2        5
 [6,]  A     7        3        7
 [7,]  A     8        3        8
 [8,]  A     9        3        9
 [9,]  A    10        3       10
[10,]  B     1        4       11
[11,]  B     2        4       12
[12,]  B     3        5       13
[13,]  B     4        5       14
[14,]  B     5        5       15
[15,]  B     8        6       18
[16,]  B     9        6       19
[17,]  B    10        6       20

Answer 2

Вот два решения, использующих Base R и data.table.Поскольку решение data.table примерно на 30% быстрее, чем база R, а также намного проще для чтения, я рекомендую использовать для этого data.table.

---

База R

Поскольку вывыразил желание, чтобы это было эффективным, я использую vapply:

matchData <- function(id, month, data=d2){
  vapply(seq_along(id), 
      function(i)which(
            id[i]==data$ID & 
                month[i] >= data$startMonth & 
                month[i] <= data$endMonth),
      FUN.VALUE=1,
      USE.NAMES=FALSE
      )
}


within(monthlyData, 
    Value <- qtrData$QTRValue[matchData(
               monthlyData$ID, monthlyData$Month, qtrData)]
)

   ID Month MonValue Value
1   A     1        1     1
2   A     2        2     1
3   A     3        3     1
4   A     4        4     2
5   A     5        5     2
6   B     1        6     3
7   B     2        7     3
8   B     3        8     4
9   B     4        9     4
10  B     5       10     4

---

data.table

А также демонстрирую, как это сделать, используя data.table:

mD <- data.table(monthlyData, key="ID")
qD <- data.table(qtrData, key="ID")
mD[qD][Month>=startMonth & Month<=endMonth]


      ID Month MonValue startMonth endMonth QTRValue
 [1,]  A     1        1          1        3        1
 [2,]  A     2        2          1        3        1
 [3,]  A     3        3          1        3        1
 [4,]  A     4        4          4        5        2
 [5,]  A     5        5          4        5        2
 [6,]  B     1        6          1        2        3
 [7,]  B     2        7          1        2        3
 [8,]  B     3        8          3        5        4
 [9,]  B     4        9          3        5        4
[10,]  B     5       10          3        5        4

---

Тест

Мне было интересно, как эти два подхода сравниваются:

library(rbenchmark)

withBase <- function(){
  xx <- within(monthlyData, 
      Value <- qtrData$QTRValue[matchData(monthlyData$ID, monthlyData$Month, qtrData)])

}

withTable <- function(){
  yy <- mD[qD][Month>=startMonth & Month<=endMonth]

}

benchmark(withBase, withTable, replications=1e6)

       test replications elapsed relative user.self sys.self user.child
1  withBase      1000000   10.09 1.296915      7.65     0.21         NA
2 withTable      1000000    7.78 1.000000      6.38     0.16         NA