R:行重采样环路速度提高

Question

我正在从具有c("x"，"y"，"密度")列的数据框中对各种c("s_size"，"reps")的行进行子采样。Reps=复制，s_size=从整个数据框中抽样的行数。

> head(data_xyz)
   x y density
1  6 1       0
2  7 1   17600
3  8 1   11200
4 12 1   14400
5 13 1       0
6 14 1    8000

 #Subsampling###################
    subsample_loop <- function(s_size, reps, int) {
      tm1 <- system.time( #start timer
    {
      subsample_bound = data.frame()
    #Perform Subsampling of the general 
    for (s_size in seq(1,s_size,int)){
      for (reps in 1:reps) {
        subsample <- sample.df.rows(s_size, data_xyz)
         assign(paste("sample" ,"_","n", s_size, "_", "r", reps , sep=""), subsample)
        subsample_replicate <- subsample[,] #temporary variable
        subsample_replicate <- cbind(subsample, rep(s_size,(length(subsample_replicate[,1]))),
                                     rep(reps,(length(subsample_replicate[,1]))))
        subsample_bound <- rbind(subsample_bound, subsample_replicate)
      }
    }
    }) #end timer
      colnames(subsample_bound) <- c("x","y","density","s_size","reps")
    subsample_bound
    } #end function
Here's the function call:
    source("R/functions.R")
    subsample_data <- subsample_loop(s_size=206, reps=5, int=10)

下面是行子样例函数:

# Samples a number of rows in a dataframe, outputs a dataframe of the same # of columns
# df Data Frame
# N number of samples to be taken
sample.df.rows <- function (N, df, ...) 
  { 
    df[sample(nrow(df), N, replace=FALSE,...), ] 
  } 

它太慢了，我已经尝试了几次应用函数，没有运气。我将为每个s_size从1:250做大约1,000-10,000个复制。

让我知道你的想法!提前谢谢。

=========================================================================更新编辑:样本数据从中取样:https://www.dropbox.com/s/47mpo36xh7lck0t/density.csv

Joran在一个函数中的代码(在一个源函数中)。R文件):

foo <- function(i,j,data){
  res <- data[sample(nrow(data),i,replace = FALSE),]
  res$s_size <- i
  res$reps <- rep(j,i)
  res
}
resampling_custom <- function(dat, s_size, int, reps) {
  ss <- rep(seq(1,s_size,by = int),each = reps)
  id <- rep(seq_len(reps),times = s_size/int)
  out <- do.call(rbind,mapply(foo,i = ss,j = id,MoreArgs = list(data = dat),SIMPLIFY = FALSE))
}

调用函数

set.seed(2)
out <- resampling_custom(dat=retinal_xyz, s_size=206, int=5, reps=10)

输出数据，不幸的是这个警告消息:

Warning message:
In mapply(foo, i = ss, j = id, MoreArgs = list(data = dat), SIMPLIFY = FALSE) :
  longer argument not a multiple of length of shorter

Answer 1

我很少考虑实际优化这一点，我只是专注于做一些至少合理的，同时匹配您的过程。

您最大的问题是您正在通过rbind和cbind生长对象。基本上，任何时候你看到有人写data.frame()或c()，并使用rbind, cbind或c扩展该对象，你可以非常肯定的是，结果代码本质上是做任何任务的最慢的可能方式。

这个版本大约快了12-13倍，我相信如果你真正思考一下，你可以从中挤出更多的东西:

s_size <- 200
int <- 10
reps <- 30
ss <- rep(seq(1,s_size,by = int),each = reps)
id <- rep(seq_len(reps),times = s_size/int)
foo <- function(i,j,data){
    res <- data[sample(nrow(data),i,replace = FALSE),]
    res$s_size <- i
    res$reps <- rep(j,i)
    res
}
out <- do.call(rbind,mapply(foo,i = ss,j = id,MoreArgs = list(data = dat),SIMPLIFY = FALSE))

R最好的地方在于它不仅更快，而且代码更少。