R：具有给定坐标的快速滑动窗口

我有一个数据表，nrow大约是100万或200，ncol大约是200

行中的每个条目都有一个与其关联的坐标

数据的一小部分：

[1,] -2.80331471  -0.8874522 -2.34401863   -3.811584   -2.1292443
[2,]  0.03177716   0.2588624  0.82877467    1.955099    0.6321881
[3,] -1.32954665  -0.5433407 -2.19211837   -2.342554   -2.2142461
[4,] -0.60771429  -0.9758734  0.01558774    1.651459   -0.8137684

前4行的坐标：

9928202 9928251 9928288 9928319

我想要的是一个函数，给定数据和窗口大小，它将返回一个大小相同的数据表，每个列上应用一个平均滑动窗口。或者换句话说，对于每一行条目i，它将找到坐标在coords[i]-windsize和coords[i]+windsize之间的条目，并用该间隔内的值的平均值替换初始值（分别针对每一列）

速度是这里的主要问题

这是我第一次使用这种函数

doSlidingWindow <- function(intensities, coords, windsize) {
windHalfSize <- ceiling(windsize/2)
### whole range inds
RANGE <- integer(max(coords)+windsize)
RANGE[coords] <- c(1:length(coords)[1])

### get indeces of rows falling in each window
COORDS <- as.list(coords)
WINDOWINDS <- sapply(COORDS, function(crds){ unique(RANGE[(crds-windHalfSize):
    (crds+windHalfSize)]) })

### do windowing

wind_ints <- intensities
wind_ints[] <- 0
for(i in 1:length(coords)) {
    wind_ints[i,] <- apply(as.matrix(intensities[WINDOWINDS[[i]],]), 2, mean)
}
return(wind_ints)
}

doSlidingWindow数据生成：

N <- 1e5 # rows
M <- 200 # columns
W <- 10  # window size

set.seed(1)
intensities <- matrix(rnorm(N*M), nrow=N, ncol=M)
coords <- 8000000 + sort(sample(1:(5*N), N))


2）foreach+doSNOW

基本例程易于并行运行，因此，我们可以从中受益：

require(doSNOW)
doSlidingWindow2 <- function(intensities, coords, windsize) {
  NC <- 2 # number of nodes in cluster
  cl <- makeCluster(rep("localhost", NC), type="SOCK")
  registerDoSNOW(cl)

  N <- ncol(intensities) # total number of columns
  chunk <- ceiling(N/NC) # number of columns send to the single node

  result <- foreach(i=1:NC, .combine=cbind, .export=c("doSlidingWindow")) %dopar% {
    start <- (i-1)*chunk+1
    end   <- ifelse(i!=NC, i*chunk, N)
    doSlidingWindow(intensities[,start:end], coords, windsize)    
  }

  stopCluster(cl)
  return (result)
}

当然，在R开始使用交换后，一切都会变慢。对于那些不适合内存的大数据，你应该考虑<代码> SqLDF，<代码> FF或<代码> BigStime。
 < P> Rollapply用一个小数据集工作得很好。然而，如果你要处理几百万行（基因组学），它的速度相当慢

以下功能超快速：

data <- c(runif(100000, min=0, max=.1),runif(100000, min=.05, max=.1),runif(10000, min=.05, max=1), runif(100000, min=0, max=.2))
slideFunct <- function(data, window, step){
  total <- length(data)
  spots <- seq(from=1, to=(total-window), by=step)
  result <- vector(length = length(spots))
  for(i in 1:length(spots)){
    result[i] <- mean(data[spots[i]:(spots[i]+window)])
  }
  return(result)
}

数据我不是专家w/
zoo
，但是你确定使用
rollmean（data，fill=NA）
不够快吗？如果你将数据存储在数据库中：使用PostgreSQL的数据库中的sqldf可以运行窗口统计。对Carl:rollmean肯定足够快。但它不能处理任意坐标上的间隔。它只是在时间序列上使用固定的窗口大小，并且时间序列具有固定的间隔。在这种情况下，间隔不是规则的，两点之间的空间可以是任意的。所以如果我用零来填补所有的空白，我会得到一个长度约为5亿的向量。在数据帧上使用rollmean是一件痛苦的事情，特别是当我只需要使用rollmean计算的500个数据中的几百万个时。在最后一个循环中，最好将行更改为：
wind\u ints[I，]您是否打算让第1节声明
data.table
在子集设置方面不快，并声明，虽然
data.table
很优雅，但实际上并不快？该基准似乎也使用了
plyr
，并乘以组合。它似乎将行号向量传递给
数据。table
单独复制多个副本。这是一个更准确的链接：。@Matthew Dowle，我知道
数据。table
在子集设置方面非常快，这就是我尝试的原因。但它似乎不是滚动窗口的正确工具（或者至少，我没有正确使用
数据表
来加速计算）。@Matthew Dowle，顺便说一句，你认为从答案中删除第1节更好吗？没关系，这些评论涵盖了它。在线使用data.table也是一件好事。
require(doSNOW)
doSlidingWindow2 <- function(intensities, coords, windsize) {
  NC <- 2 # number of nodes in cluster
  cl <- makeCluster(rep("localhost", NC), type="SOCK")
  registerDoSNOW(cl)

  N <- ncol(intensities) # total number of columns
  chunk <- ceiling(N/NC) # number of columns send to the single node

  result <- foreach(i=1:NC, .combine=cbind, .export=c("doSlidingWindow")) %dopar% {
    start <- (i-1)*chunk+1
    end   <- ifelse(i!=NC, i*chunk, N)
    doSlidingWindow(intensities[,start:end], coords, windsize)    
  }

  stopCluster(cl)
  return (result)
}

system.time(res <- doSlidingWindow(intensities, coords, W))
#    user  system elapsed 
# 306.259   0.204 307.770
system.time(res2 <- doSlidingWindow2(intensities, coords, W))
#  user  system elapsed 
# 1.377   1.364 177.223
all.equal(res, res2, check.attributes=FALSE)
# [1] TRUE

require(Rcpp)
require(inline)
doSlidingWindow3 <- cxxfunction(signature(intens="matrix", crds="numeric", wsize="numeric"), plugin="Rcpp", body='
  #include <vector>
  Rcpp::NumericMatrix intensities(intens);
  const int N = intensities.nrow();
  const int M = intensities.ncol();
  Rcpp::NumericMatrix wind_ints(N, M);

  std::vector<int> coords = as< std::vector<int> >(crds);
  int windsize = ceil(as<double>(wsize)/2);  

  for(int i=0; i<N; i++){
    // Simple search for window range (begin:end in coords)
    // Assumed that coords are non-decreasing
    int begin = (i-windsize)<0?0:(i-windsize);
    while(coords[begin]<(coords[i]-windsize)) ++begin;
    int end = (i+windsize)>(N-1)?(N-1):(i+windsize);
    while(coords[end]>(coords[i]+windsize)) --end;

    for(int j=0; j<M; j++){
      double result = 0.0;
      for(int k=begin; k<=end; k++){
        result += intensities(k,j);
      }
      wind_ints(i,j) = result/(end-begin+1);
    }
  }

  return wind_ints;
')

system.time(res <- doSlidingWindow(intensities, coords, W))
#    user  system elapsed 
# 306.259   0.204 307.770
system.time(res3 <- doSlidingWindow3(intensities, coords, W))
#  user  system elapsed 
# 0.328   0.020   0.351
all.equal(res, res3, check.attributes=FALSE)
# [1] TRUE

   user  system elapsed 
  2.873   0.076   2.951

data <- c(runif(100000, min=0, max=.1),runif(100000, min=.05, max=.1),runif(10000, min=.05, max=1), runif(100000, min=0, max=.2))
slideFunct <- function(data, window, step){
  total <- length(data)
  spots <- seq(from=1, to=(total-window), by=step)
  result <- vector(length = length(spots))
  for(i in 1:length(spots)){
    result[i] <- mean(data[spots[i]:(spots[i]+window)])
  }
  return(result)
}