r - 快速 R 查找表

Question

之前也有人问过类似的问题，但没有明确的通用答案。 (Joseph Adler 的实验不再在网上，他的书只说“编写一个 S4 类”。)

假设有一个包含多个索引的大型查找表。假设要查找的值大小适中。即使是 R 合并也很慢。下面是一个例子:

{
    L <- 100000000  ## only 100M entries for 1GB*4 of int data
    lookuptable  <- data.frame( i1=sample(1:L), i2=sample(1:L), v1=rnorm(L), v2=rnorm(L) )
    NLUP <- 10      ## look up only 10+1 values in large table
    vali <- sample(1:L, NLUP)
    lookmeup <- data.frame( i1= c(lookuptable[vali,1], -1),
                       i2= c(lookuptable[vali,2],-1), vA=rnorm(11) )
    rm(vali); rm(L)
}

## I want to speed this up---how?
system.time( merge( lookmeup, lookuptable,  by.x=c("i1","i3"), by.y=c("i1","i2"),
                   all.x=T, all.y=F, sort=F ) )

(试试吧!在我的 2019 iMac 上 500 秒)。那么推荐的方法是什么？

我可以编写代码，首先从列中创建唯一的整数指纹(为了快速比较)，然后我只匹配一列。但这也不容易，因为我需要避免意外的重复指纹，或者为冲突添加更多逻辑。

给定整数指纹，我可以使用 data.table与 setkey在指纹上(或者它也可以封装两列索引？我试过但失败了，可能是因为我不是普通用户)；或者我可以编写一个 C 程序，它接受两个整数指纹列并返回一个。

Answer 1

致 match two data.frames on multiple columns您可以从基础使用 merge或 match结合 interaction , paste或使用 list .也可以到map two integers to one, in a unique and deterministic way .一个简单的扩展名是 fastmatch可以比 match 更快的库从基地。还有 dplyr或 data.table可以是一个选择。也看看:Matching more than 2 conditions , How to join (merge) data frames和 Fast single item lookup .

library(fastmatch)
library(dplyr)
library(microbenchmark)
microbenchmark(times = 10L, setup = gc(), check = "equivalent"
 , merge = merge(lookMeUp, lookupTable, all.x=TRUE, sort=FALSE)
 , dplyr = left_join(lookMeUp, lookupTable, by = c("i1", "i2"))
 , inter = cbind(lookMeUp, lookupTable[match(interaction(lookMeUp[c("i1","i2")])
                 , interaction(lookupTable[c("i1","i2")])), 3:4])
 , paste = cbind(lookMeUp, lookupTable[match(paste(lookMeUp$i1, lookMeUp$i2)
                 , paste(lookupTable$i1, lookupTable$i2)), 3:4])
 , int = cbind(lookMeUp, lookupTable[match(lookMeUp$i1 + lookMeUp$i2 * max(lookupTable$i1)
                 , lookupTable$i1 + lookupTable$i2 * max(lookupTable$i1)), 3:4])
 , fInter = cbind(lookMeUp, lookupTable[fmatch(interaction(lookMeUp[c("i1","i2")])
                 , interaction(lookupTable[c("i1","i2")])), 3:4])
 , fPaste = cbind(lookMeUp, lookupTable[fmatch(paste(lookMeUp$i1, lookMeUp$i2)
                  , paste(lookupTable$i1, lookupTable$i2)), 3:4])
 , fint = cbind(lookMeUp, lookupTable[fmatch(lookMeUp$i1 + lookMeUp$i2 * max(lookMeUp$i1)
                 , lookupTable$i1 + lookupTable$i2 * max(lookMeUp$i1)), 3:4])
)
#Unit: milliseconds
#   expr        min         lq       mean     median         uq        max neval
#  merge 2547.72575 2564.72138 2590.03400 2578.14307 2585.01870 2735.23435    10
#  dplyr  690.55046  695.56161  703.01335  703.95085  707.32141  714.00890    10
#  inter  511.86378  514.36418  528.73905  529.14331  535.33359  552.20183    10
#  paste  750.01340  763.84494  942.47309  777.73232 1273.83380 1377.00192    10
#    int   71.56913   72.15233   73.27748   72.92613   73.89630   77.01510    10
# fInter  447.82012  450.00472  459.51196  455.82473  464.85767  491.52366    10
# fPaste  713.68824  719.60794  796.94680  726.70971  788.36997 1316.64071    10
#   fint   59.04541   59.13039   60.95638   60.59758   62.58539   63.65308    10

您可以将其存储在查找表中，而不是每次查找时都创建唯一标识符，这将使查找更快，但创建它会产生开销。您还可以通过此标识符对查找表进行排序，这将允许在不使用 match 的情况下访问数据行。但是如果缺少某些组合，此方法将添加未定义的行，在创建 matrix 时将等效或 array .您还可以使用内置哈希在 environment 中查找变量。 .还有来自 findInterval 的二分查找可以使用。

system.time({maxLTi1 <- max(lookupTable$i1); lookupTable$id <- lookupTable$i1 + lookupTable$i2 * maxLTi1})
#       User      System verstrichen 
#      0.006       0.000       0.006 

system.time(fmatch(c(lookupTable$id[1], 0), lookupTable$id))  #Create Hash
#       User      System verstrichen 
#      0.056       0.000       0.056 
#system.time(fmatch(lookupTable$id[1], lookupTable$id))  #Create Hash in case you have only matches
#       User      System verstrichen 
#      0.016       0.004       0.020 

system.time({
lookupTableS <- lookupTable[0,]
lookupTableS[lookupTable$id,] <- lookupTable #Sort Table with gaps
})
#       User      System verstrichen 
#      0.080       0.011       0.091 

system.time({
lookupTableS2 <- lookupTable[order(lookupTable$id),] #Sort Table
})
#       User      System verstrichen 
#      0.074       0.000       0.074 

library(Matrix)
system.time({ #Sorted Sparse Vector
  i <- order(lookupTable$id)
  lookupTableS3 <- sparseVector(i, lookupTable$id[i], max(lookupTable$id))})
#       User      System verstrichen 
#      0.057       0.008       0.065 

system.time(lupEnv <- list2env(setNames(as.list(seq_len(nrow(lookupTable))), paste(lookupTable$i1, lookupTable$i2))))
#       User      System verstrichen 
#      4.824       0.056       4.880 

library(data.table);
lookupTableDT <- as.data.table(copy(lookupTable))
lookMeUpDT <- as.data.table(copy(lookMeUp))
system.time(setkey(lookupTableDT, i1, i2))
#       User      System verstrichen 
#      0.094       0.000       0.027 

lookMeUpDT$id <- lookMeUp$i1 + lookMeUp$i2 * max(lookupTable$i1)
lookupTableDTId <- as.data.table(copy(lookupTable))
system.time(setkey(lookupTableDTId, id))
#       User      System verstrichen 
#      0.091       0.000       0.026 

lookMeUpDTId <- copy(lookMeUpDT)
lookMeUpDTId$row <- seq_len(nrow(lookMeUpDTId))
setkey(lookMeUpDTId, id)

microbenchmark(times = 10L, setup = gc(), check = "equivalent"
 , int = cbind(lookMeUp, lookupTable[match(lookMeUp$i1 + lookMeUp$i2 * max(lookupTable$i1)
                 , lookupTable$i1 + lookupTable$i2 * max(lookupTable$i1)), 3:4])
 , fint = cbind(lookMeUp, lookupTable[fmatch(lookMeUp$i1 + lookMeUp$i2 * max(lookMeUp$i1)
                 , lookupTable$i1 + lookupTable$i2 * max(lookMeUp$i1)), 3:4])
 , id = cbind(lookMeUp, lookupTable[match(lookMeUp$i1 + lookMeUp$i2 * maxLTi1
                 , lookupTable$id), 3:4])
 , sparid = {i <- lookMeUp$i1 + lookMeUp$i2 * maxLTi1
   j <- i
   j[i>0] <- as.vector(lookupTableS3[i[i>0]])
   cbind(lookMeUp, lookupTable[ifelse(j>0,j,NA), 3:4])}
 , DT = merge(lookMeUpDT[,1:3], lookupTableDT[,1:4], by=c("i1", "i2"), all.x=TRUE, sort = FALSE)
 , DTid = merge(lookMeUpDT, lookupTableDTId[,-2:-1], by=c("id"), all.x=TRUE, sort = FALSE)[,-1]
 , DiIdKey = merge(lookMeUpDTId, lookupTableDTId[,-2:-1], all.x=TRUE, sort = FALSE)[order(row),][,c(-1,-5)]
 , findInt = {i <- lookMeUp$i1 + lookMeUp$i2 * maxLTi1
    j  <- findInterval(i, lookupTableS2$id)
    j[j==0]  <- NA
    j[i != lookupTableS2$id[j]] <- NA
    cbind(lookMeUp, lookupTableS2[j, 3:4])}
 , envir = cbind(lookMeUp, lookupTable[vapply(paste(lookMeUp$i1, lookMeUp$i2), function(i) {x  <- lupEnv[[i]]; if(is.null(x)) NA else x}, 1), 3:4])
 , fid = cbind(lookMeUp, lookupTable[fmatch(lookMeUp$i1 + lookMeUp$i2 * maxLTi1
                 , lookupTable$id), 3:4])
 , sid = cbind(lookMeUp, lookupTableS[ifelse(lookMeUp$i1 > 0, lookMeUp$i1 + lookMeUp$i2 * maxLTi1, NA), 3:4])
)
#Unit: microseconds
#    expr       min        lq       mean     median        uq       max neval
#     int 75167.977 76446.819 77817.3349 77958.9650 78649.235 80656.715    10
#    fint 63332.436 63948.769 64574.8881 64194.2765 64942.559 66808.193    10
#      id 68198.639 69293.551 70477.6062 70223.0505 71393.354 74951.007    10
#  sparid  9181.928  9217.312  9552.0241  9478.8475  9561.917 10895.649    10
#      DT  4990.075  5000.857  5125.6716  5051.4970  5157.057  5547.220    10
#    DTid  4167.229  4189.703  4250.0804  4232.8955  4289.718  4440.924    10
# DiIdKey  4547.589  4582.915  4626.9514  4597.6790  4634.311  4867.630    10
# findInt  2795.560  2813.100  2854.7069  2815.4890  2857.084  3097.120    10
#   envir   526.971   530.459   537.5767   532.9755   546.402   551.231    10
#     fid   424.790   425.218   433.7295   433.3335   441.673   444.026    10
#     sid   436.135   439.688   445.1770   441.5705   445.331   464.685    10

#In case order and columns need not be like the others
microbenchmark(times = 10L, setup = gc(), unit = "us",
 DiIdKey = merge(lookMeUpDTId, lookupTableDTId, all.x=TRUE, sort = FALSE))
#Unit: microseconds
#    expr      min      lq     mean   median       uq     max neval
# DiIdKey 1692.629 1706.14 1719.556 1717.142 1722.067 1778.88    10

创建唯一标识符并将其存储在查找表中并使用 fmatch可能是 推荐 .在纯基础中，查找表可以按 ID 排序，缺少的组合将用 NA 填充，这允许直接访问匹配行而不使用 match .或者，可以在使用内置哈希搜索的环境中完成查找，但这会产生很多开销。还使用 findInterval显示出良好的结果。

如果列不是(正) integer将它们投给 factor并使用它们的整数值。

数据:

set.seed(7)
sqrtN  <- 1e3
lookupTable <- data.frame(expand.grid(i1=seq_len(sqrtN), i2=seq_len(sqrtN)), v1=seq_len(sqrtN*sqrtN))[sample(sqrtN*sqrtN),]
lookupTable$v2  <- seq_len(sqrtN*sqrtN)

lookMeUp <- rbind(lookupTable[sample(nrow(lookupTable), 10), 1:2], c(-1, -1))
lookMeUp$vA <- letters[1:nrow(lookMeUp)]

具有 5e7 行的查找表的时间:

sqrtN  <- 7.1e3
lookupTable <- data.frame(expand.grid(i1=seq_len(sqrtN), i2=seq_len(sqrtN)), v1=seq_len(sqrtN*sqrtN))[sample(sqrtN*sqrtN),]
lookupTable$v2  <- seq_len(sqrtN*sqrtN)

lookMeUp <- rbind(lookupTable[sample(nrow(lookupTable), 10), 1:2], c(-1, -1))
lookMeUp$vA <- letters[1:nrow(lookMeUp)]

system.time({maxLTi1 <- max(lookupTable$i1); lookupTable$id <- lookupTable$i1 + lookupTable$i2 * maxLTi1})
#       User      System verstrichen 
#      0.312       0.016       0.329 

system.time(lookupTable <- lookupTable[order(lookupTable$id),]) #For findIntervall
#       User      System verstrichen 
#      6.786       0.120       6.905 

system.time({
i <- lookMeUp$i1 + lookMeUp$i2 * maxLTi1
j  <- findInterval(i, lookupTable$id)
j[j==0]  <- NA
j[i != lookupTable$id[j]] <- NA
cbind(lookMeUp, lookupTable[j, 3:4])
})
#       User      System verstrichen 
#      0.099       0.048       0.147 

system.time(fmatch(c(lookupTable$id[1], 0), lookupTable$id)) #Create Hash
#       User      System verstrichen 
#      2.642       0.120       2.762 

system.time(cbind(lookMeUp, lookupTable[fmatch(lookMeUp$i1 + lookMeUp$i2 * maxLTi1, lookupTable$id), 3:4]))
#       User      System verstrichen 
#          0           0           0