Question

我已经尝试了很多东西，而且我在渲染这段代码时遇到了很多麻烦。我已经设法找到一种方法，用lapply做这个，但它比下面的代码略慢。请注意，数据按err排序，其中err随行增加。

mySlowFunction <- function(data, vectorizedFunc){
  #data is a data.frame
  #vectorizedFunc is a function
  n <- d <- array(0, dim = c(nrow(data),1))
  for (i in 1:nrow(data)){
      err.i <- data$err[i]
      wt <- vectorizedFunc(data$X[i:nrow(data)] + err.i)
      n[i] <- sum(data$Y[i:nrow(data)] / wt)
      d[i] <- sum(1 / wt)
  }
  data$N.wt <- n
  data$D.wt <- d
  data
}

data <- data.frame(X = rnorm(10000), Y = rnorm(10000), err = rnorm(10000))
data <- data[order(data$err),]
system.time(mySlowFunction(data, exp))

我稍慢的lapply版本：

myEvenSlowerFunction <- function(data, vectorizedFunc){
  #data is a data.frame
  res <- unlist(lapply(data$err, function(x) {
    idx <- which(data$err >= x)
    wt <- vectorizedFunc(data$X[idx] + x)
    c(sum(data$Y[idx] / wt), sum(1 / wt))
  }))
  idx <- seq(1,length(res) - 1,by=2)
  data$N.wt <- res[idx]
  data$D.wt <- res[idx + 1]
  data
}

谢谢！

Answer 1

EDITED

等待。是不是R只是使用单线程？据我所知，矢量化是用于并行计算.... 如果您愿意使用＆＃39;展开＆＃39;，这将大大减少计算时间。

myFunction <- function(data, vectorizedFunc){
  #data is a data.frame
  #vectorizedFunc is a function
  len=nrow(data)        ## if you are going to compute something over and over,  
                        ## justsave          them
  n = d = numeric(len)
  for (i in 1:len){
    err.i <- data$err[i]
    temp=data$X[i:len]   ## changed
    wt <- vectorizedFunc( temp+ err.i)
    n[i] <- sum(temp / wt)
    d[i] <- sum(1 / wt)
  }
  data$N.wt <- n
  data$D.wt <- d
  data
}

system.time(myFunction(data, exp))
#   user  system elapsed 
#   5.01    0.00    5.04 

#while your function gives

#   user  system elapsed 
#   6.15    0.02    6.20

Answer 2

我认为你的解决方案可能和它一样好。你已经在对内部函数调用进行向量化，并且进一步调整似乎没有任何重大收益。事实恰恰相反。

这是一个完全矢量化的“解决方案”，使用outer生成wt变量。这比你的代码慢，主要是因为1）它需要在内存中创建一个NxN矩阵，其中N = nrow(data); 2）这些矩阵元素中的一半不是必需的。把它放在那里，看看其他人是否可以改进它。

vecf <- function(data, vectorizedFunc)
{
    wt <- outer(data$e, data$X, "+")
    wt[lower.tri(wt)] <- NA
    wt <- vectorizedFunc(wt)
    data$N.wt <- rowSums(rep(data$Y, each=nrow(data))/wt, na.rm=TRUE)
    data$D.wt <- rowSums(1/wt, na.rm=TRUE)
    data
}

矢量化和提高R函数的速度

2 个答案: