Warning: file_get_contents(/data/phpspider/zhask/data//catemap/4/r/81.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
R上下界的快速索引_R - Fatal编程技术网

R上下界的快速索引

R上下界的快速索引,r,R,我试图找到R中上下限的索引。 这与findInterval解决的问题相同,但是findInterval检查它的参数是否已排序,我想避免这种情况,因为我知道它已排序。 我试图直接调用底层的C函数,但我不知道应该调用findInterval还是find_interv_vec。 另外,我试着打电话,但似乎找不到功能 findInterval2 <- function (x, vec, rightmost.closed = FALSE, all.inside = TRUE) { nx &

我试图找到R中上下限的索引。 这与findInterval解决的问题相同,但是findInterval检查它的参数是否已排序,我想避免这种情况,因为我知道它已排序。 我试图直接调用底层的C函数,但我不知道应该调用findInterval还是find_interv_vec。 另外,我试着打电话,但似乎找不到功能

findInterval2 <- function (x, vec, rightmost.closed = FALSE, all.inside = TRUE) 
{
    nx <- length(x)
    index <- integer(nx)
    .C('find_interv_vec', xt=as.double(vec), n=length(vec),
       x=as.double(x), nx=nx, as.logical(rightmost.closed),
       as.logical(all.inside), index, DUP = FALSE, NAOK=T,
       PACKAGE='base')
    index    
}
另一方面,我读到使用.Call比使用old.C更好,特别是因为.C复制,而且我的vec非常大。我应该如何组织对的呼叫。呼叫


谢谢

经过一些研究和@MartinMorgan的非常有用的答案,我决定做一些类似于他的答案的事情。 我创建了一些模拟findInterval的函数,没有检查vec是否已排序。很明显,当x的长度为1时,这会产生很大的不同,你会一遍又一遍地调用它。如果x的长度>>1,并且您可以利用vectorizacion,那么findInterval只检查一次vec是否已排序。 在下面的代码块中,我创建了find interval的一些变体

  • findInterval2,它是在R中作为二进制搜索写入的findInterval,不带排序检查
  • findInterval2comp,它是用cmpfun编译的findInterval2
  • findInterval3,它是用C编写的,作为使用内联包编译的二进制搜索的findInterval
之后,我创建了两个函数进行测试

  • testByOne,它为长度为1的x运行findInterval
  • testVec,它使用矢量化
对于testVec,我创建的所有函数都在带有Vectorize的x参数中进行了矢量化

之后,我用microbenchmark计时执行

代码

一些观察

  • 我的C代码一定有问题,不能那么慢
  • 最好先编译再矢量化,也就是先矢量化再编译
  • 奇怪的是,fi2comp比fi2跑得快
  • 再次编译矢量化编译函数不会提高其性能

你的代码对我有效-
R2.15.1
你认为不检查
vec
是否已排序会让你的通话更快吗?在你的应用程序中,
x
vec
需要多长时间?你在找吗?@flodel我正在处理的
length(vec)>30k
,你认为这不重要吗?(这是一个问题,不是讽刺)如果@MartinMorgan在他的链接答案中回答了你的问题,你能提取出他计时函数的哪种方法作为答案,并将其标记为已回答吗?
Error in .C("find_interv_vec", xt = as.double(vec), n = length(vec), x = as.double(x),  : 
  "find_interv_vec" not available for .C() for package "base"
require(inline)

# findInterval written in R as a binary search
findInterval2 <- function(x,v) {
  n = length(v)
  if (x<v[1])
    return (0)
  if (x>=v[n])
    return (n)
  i=1
  k=n
  while({j = (k-i) %/% 2 + i; !(v[j] <= x && x < v[j+1])}) {
    if (x < v[j])
      k = j
    else
      i = j+1
  }
  return (j)
}

findInterval2Vec = Vectorize(findInterval2,vectorize.args="x")

#findInterval2 compilated with cmpfun
findInterval2Comp <- cmpfun(findInterval2)

findInterval2CompVec <- Vectorize(findInterval2Comp,vectorize.args="x")

findInterval2VecComp <- cmpfun(findInterval2Vec)

findInterval2CompVecComp <- cmpfun(findInterval2CompVec)

sig <-signature(x="numeric",v="numeric",n="integer",idx="integer")
code <- "
  if (*x < v[0]) {
    *idx = -1;
    return;
  }
  if (*x >= v[*n-1]) {
    *idx = *n-1;
    return;
  }
  int i,j,k;
  i = 0;
  k = *n-1;
  while (j = (k-i) / 2 + i, !(v[j] <= *x && *x < v[j+1])) {
    if (*x < v[j]) {
      k = j;
    }
    else {
      i = j+1;
    }
  }
  *idx=j;
  return;
  "

fn <- cfunction(sig=sig,body=code,language="C",convention=".C")

# findInterval written in C
findIntervalC <- function(x,v) {
  idx = as.integer(-1)
  as.integer((fn(x,v,length(v),idx)$idx)+1)
}

findIntervalCVec <- Vectorize(findIntervalC,vectorize.args="x")

# The test case where x is of length 1 and you call findInterval several times
testByOne <- function(f,reps = 100, vlength = 300000, xs = NULL) {
  if (is.null(xs))
    xs = seq(from=1,to=vlength-1,by=vlength/reps)
  v = 1:vlength
  for (x in xs)
      f(x,v)
}

# The test case where you can take advantage of vectorization
testVec <- function(f,reps = 100, vlength = 300000, xs = NULL) {
  if (is.null(xs))
    xs = seq(from=1,to=vlength-1,by=vlength/reps)
  v = 1:vlength
  f(xs,v)
}
microbenchmark(fi=testByOne(findInterval),fi2=testByOne(findInterval2),fi2comp=testByOne(findInterval2Comp),fic=testByOne(findIntervalC))
Unit: milliseconds
    expr        min        lq     median         uq       max neval
      fi 617.536422 648.19212 659.927784 685.726042 754.12988   100
     fi2  11.308138  11.60319  11.734305  12.067857  71.98640   100
 fi2comp   2.293874   2.52145   2.637388   5.036558  62.01111   100
     fic 368.002442 380.81847 416.137318 424.250337 474.31542   100
microbenchmark(fi=testVec(findInterval),fi2=testVec(findInterval2Vec),fi2compVec=testVec(findInterval2CompVec),fi2vecComp=testVec(findInterval2VecComp),fic=testByOne(findIntervalCVec))
Unit: milliseconds
       expr        min         lq     median         uq        max neval
         fi   4.218191   4.986061   6.875732  10.216228   68.51321   100
        fi2  12.982914  13.786563  16.738707  19.102777   75.64573   100
 fi2compVec   4.264839   4.650925   4.902277   9.892413   13.32756   100
 fi2vecComp  13.000124  13.689418  14.072334  18.911659   76.19146   100
        fic 840.446529 893.445185 908.549874 919.152187 1047.84978   100