【问题标题】:How to match two data.frames with an inexact matching identifier (one identifier has to be in the range of the other)如何将两个 data.frames 与不精确的匹配标识符匹配(一个标识符必须在另一个标识符的范围内)
【发布时间】:2011-11-04 15:05:26
【问题描述】:

我有以下匹配问题:我有两个 data.frame,一个每个月都有一次观察(每个公司 ID),一个每个季度都有一个观察(每个公司 ID;请注意,季度表示财政季度;因此 1Q = 一月、二月、三月不一定正确,一个财政季度也不一定是 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-help)。然而,现在,我在 stackoverflow 上发布了一个问题,其中我有一个关于 data.table 的问题,其中也提到了这个问题,Andrie 让我再次发布这个问题,因为他显然有一个很好的解决方案(见 @ 987654322@)

更新:见 Matthew Dowle 的评论:真实数据看起来如何?

这个数据是比较真实的。我添加了几行,但唯一改变的主要部分是qtrData 中的列endMonth。更准确地说,startMonth 不一定是上一季度的endMonth 加上一个月。因此,使用roll 选项,我认为您需要另一行代码(如果不需要,您将获得 20 行,但使用 Andrie 的解决方案,这是所需的解决方案,您将获得 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

【问题讨论】:

  • 我从来没有说过我有一个好的解决方案。你应该自己判断:-)
  • 我对你说实话,@Andrie,这不是一个解决方案......这是一个很棒的解决方案!
  • @Andrie 就在基准(来自 Andrie)上,它重复了一个非常小的操作 100 万次。所有这些时间都是大量的呼叫开销。您需要构建一个 large 表并比较每个方法的 single 运行时间(通常是 3 次运行中最低的一次)。
  • @MatthewDowle 好的,感谢您的关注。我会相应地调整我的代码。

标签: r data.table


【解决方案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

【讨论】:

  • 感谢@Matthew Dowle,这是role 参数的一个很好的例子。但是,在我的真实数据中,我不一定能保证本季度的 startMonth 等于 endMonth 加上前一季度的 1。因此,我仍然需要一行qd[startMonth &lt;= endMonth]。不过,不确定这是否会改变两种方法的性能。
  • @Christoph_J 差距很好。没有+1假设。尝试一下。有关roll 的示例,请参阅?data.table
  • @Christoph_J 或者为了避免混淆,请发布一个更真实的示例数据集,我会看看我能做什么。
  • +1 我仍然不知道为什么会这样,但它非常酷。
  • @Christoph_J 非常感谢。希望最新的编辑能提供更多的想法。
【解决方案2】:

这里有两个解决方案,使用 Base R 和 data.table。由于data.table 解决方案比基础 R 快约 30%,而且更易于阅读,因此我建议为此使用 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

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

【讨论】:

  • data.table 中这是一个非常非常缓慢的方法;)roll=TRUE 是这里的门票。
  • @MatthewDowle 你必须证明这一点,拜托。
猜你喜欢
  • 1970-01-01
  • 2014-09-26
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 2017-11-20
  • 1970-01-01
  • 1970-01-01
相关资源
最近更新 更多