R：列表中的快速哈希搜索（环境）

Question

我想进行快速搜索，似乎使用哈希（通过环境）是最好的方法。现在，我得到了一个在环境中运行的示例，但它没有返回我需要的内容。

这是一个例子：

a <- data.table::data.table(a=c(1, 3, 5), b=c(2, 4, 6), time=c(10, 20, 30))  
my_env <- list2env(a)  
x <- a[2, .(a, b)] # x=c(3,4)  
found <- get("x", envir = my_env)  

我期待found = c(3, 4, 20) 但收到found = c(3, 4) （我希望返回整行而不是未知的行子集）

背景：我有一个巨大的列表，其中包含使用 osrm 计算的路线的来源和目的地，例如

lattitude1, longitude1, lattitude2, longitude2, travel-time  
46.12, 8.32, 47.87, 9.92, 1036  
...  

在第一个示例中，该列表包含大约 100000 行。在 data.table 中使用二进制搜索将我的代码加速了 100 倍，但一次搜索仍然需要 1 毫秒。由于我必须在模拟过程中搜索许多路线（大约 2e5 次搜索），所以我想更快。
@Gregor：我是 R 的初学者，但我不认为我的问题是重复的：

1. 我知道第二个链接，这是专家列出可能性的抽象概述。此外，它是 4 岁。
2. 我不知道第一个链接，但从这些答案中我看不出我是否应该切换到环境以及实现如何工作。也没有关于搜索庞大列表的一部分的讨论。

总结（感谢 DigEmAll 提供下面的运行示例）：

• 对整数使用 Rcpp，搜索占用的内存更少，而且质量没有任何损失。此外，它的速度大约提高了 3 倍。
• 当您要查找双精度（必须转换为字符串）时，不要使用散列环境。
• 在现有代码中的实现应该很容易。

Answer 1

这是一个使用环境和 data.table 的示例，代码非常不言自明：

library(data.table)

# create a big random example (160k rows)
set.seed(123)
fromTo <- expand.grid(1:400,1:400)
colnames(fromTo) <- c('a','b')
DF <- as.data.frame(cbind(fromTo,time=as.integer(runif(nrow(fromTo), min = 1, max=500))))

# setup the environment to use it as hashtable:
# we simply put the times inside an enviroment using 
# a|b (concatenation of a with b) as key
timesList <- as.list(DF$time)
names(timesList) <- paste(DF$a,DF$b,sep='|')
timesEnv <- list2env(timesList)  

# setup the data.table to use it as hashtable
DT <- setDT(DF,key=c('a','b'))

# create search functions
searchUsingEnv <- function(a,b){
  time <- get(paste(a,b,sep='|'),envir=timesEnv,inherits=FALSE)  
  return(time)
}
searchUsingDataTable <- function(from,to){
  time <- DT[.(from,to),time]
  return(time)
}

基准测试：

# benchmark functions
# i.e. we try to search ~16K rows in ourtwo kind of hashtables
benchEnv <- function(){
  n <- nrow(fromTo)
  s <- as.integer(n * 0.9)
  for(i in s:n){
    searchUsingEnv(fromTo[i,'a'],fromTo[i,'b'])
  }
}
benchDT <- function(){
  n <- nrow(fromTo)
  s <- as.integer(n * 0.9)
  for(i in s:n){
    searchUsingDataTable(fromTo[i,'a'],fromTo[i,'b'])
  }
}

# let's measure the performances
> system.time(benchEnv(), gcFirst = TRUE)
user  system elapsed 
2.26    0.00    2.30 
> system.time(benchDT(), gcFirst = TRUE)
user  system elapsed 
42.34    0.00   42.56 

结论：
对于重复单键访问，环境似乎比data.table快得多，所以你可以尝试使用它。

---

编辑：

环境可以快速访问，但它们只能有字符串键，这比双精度键占用更多的内存。因此，我添加了一个使用 Rcpp 和 std::map<> 的示例，其中包含多值映射：
（注意：如果您使用的是 Windows，则需要安装 RTools 以使 Rcpp 工作）

library(data.table)
library(Rcpp)
library(inline)

nRows <- 1e7

############# create data.table "DT" containing coordinates and times
generate_routes_dt <- function(nmax) {
  set.seed(123)
  routes <- data.table(lat1 = numeric(nmax),
    lng1 = numeric(nmax),
    lat2 = numeric(nmax),
    lng2 = numeric(nmax),
    time = numeric(nmax))
  tmp <- sample(seq(46, 49, length.out = nmax), nmax)
  routes$lat1 <- tmp
  tmp <- sample(seq(8, 10, length.out = nmax), nmax)
  routes$lng1 <- tmp
  tmp <- sample(seq(46, 49, length.out = nmax), nmax)
  routes$lat2 <- tmp
  tmp <- sample(seq(8, 10, length.out = nmax), nmax)
  routes$lng2 <- tmp
  tmp <- sample(seq(0, 1e7, length.out = nmax), nmax)
  routes$time <- as.integer(tmp)
  data.table::setkey(routes, lat1, lng1, lat2, lng2)
  return(routes)
}

DT <- generate_routes_dt(nRows)

############# create data.table search function
searchUsingDataTable <- function(lat_1,lng_1,lat_2,lng_2){
  time <- DT[.(lat_1,lng_1,lat_2,lng_2),time]
  return(time)
}
#############

############# create Rcpp search function
# the following code create 2 functions: createMap and getTime
# usage:
#   map <- createMap(lat1Vec,lng1Vec,lat2Vec,lng2Vec,timesVec)
#   t <- getTime(map,lat1,lng1,lat2,lng2)
sourceCpp(code=
'
#include <Rcpp.h>

  class MultiKey {
  public:
    double  lat1;
    double  lng1;
    double  lat2;
    double  lng2;

    MultiKey(double la1, double ln1, double la2, double ln2)
      : lat1(la1), lng1(ln1), lat2(la2), lng2(ln2) {}  

    bool operator<(const MultiKey &right) const 
    {
      if ( lat1 == right.lat1 ) {
            if ( lng1 == right.lng1 ) {
                if ( lat2 == right.lat2 ) {
                    return lng2 < right.lng2;
                }
                else {
                    return lat2 < right.lat2;
                }
            }
            else {
                return lng1 < right.lng1;
            }
        }
        else {
            return lat1 < right.lat1;
        }
    }    
  };


  // [[Rcpp::export]]
  SEXP createMap(Rcpp::NumericVector lat1, 
                 Rcpp::NumericVector lng1, 
                 Rcpp::NumericVector lat2, 
                 Rcpp::NumericVector lng2, 
                 Rcpp::NumericVector times){
    std::map<MultiKey, double>* map = new std::map<MultiKey, double>;
    int n1 = lat1.size();
    int n2 = lng1.size();
    int n3 = lat2.size();
    int n4 = lng2.size();
    int n5 = times.size();
    if(!(n1 == n2 && n2 == n3 && n3 == n4 && n4 == n5)){
      throw std::range_error("input vectors lengths are different");
    }
    for(int i = 0; i < n1; i++){
      MultiKey key(lat1[i],lng1[i],lat2[i],lng2[i]);
      map->insert(std::pair<MultiKey, double>(key, times[i]));
    }
    Rcpp::XPtr< std::map<MultiKey, double> > p(map, true);
    return( p );
  }

  // [[Rcpp::export]]
  Rcpp::NumericVector getTime(SEXP mapPtr, 
                              double lat1, 
                              double lng1, 
                              double lat2, 
                              double lng2){
    Rcpp::XPtr< std::map<MultiKey, double> > ptr(mapPtr);
    MultiKey key(lat1,lng1,lat2,lng2);
    std::map<MultiKey,double>::iterator it = ptr->find(key);
    if(it == ptr->end())
        return R_NilValue;

    return Rcpp::wrap(it->second);
  }

')

map <- createMap(DT$lat1,DT$lng1,DT$lat2,DT$lng2,DT$time)

searchUsingRcpp <- function(lat_1,lng_1,lat_2,lng_2){
  time <- getTime(map,lat_1,lng_1,lat_2,lng_2)
  return(time)
}
#############

############# benchmark
set.seed(1234)
rowsToSearchOneByOne <- DT[sample.int(nrow(DT),size=nrow(DT),replace=FALSE),]

bench <- function(searchFun2Use){
  for(i in nrow(rowsToSearchOneByOne)){
    key <- rowsToSearchOneByOne[i,]
    searchFun2Use(key$lat1,key$lng1,key$lat2,key$lng2)
  }
}

microbenchmark::microbenchmark(
  bench(searchUsingRcpp),
  bench(searchUsingDataTable),
  times=100)
#############

基准测试结果：

Unit: microseconds
                        expr      min        lq      mean   median        uq      max neval
      bench(searchUsingRcpp)  360.959  381.7585  400.4466  391.999  403.9985  665.597   100
 bench(searchUsingDataTable) 1103.034 1138.0740 1214.3008 1163.514 1224.9530 2035.828   100

注意：

我真的不认为使用双精度作为键是一个好主意...浮点值应该用于使用特定容差或范围内进行搜索，而不是在地图内查找完美匹配。