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倍，但一次搜索仍然需要1ms。由于我必须在模拟(大约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上，您需要安装https://cran.r-project.org/bin/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

注：

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