在R中加速while循环

Question

我正在尝试使用以下代码获取一些统计信息：

library(data.table)

df <- fread("input.xyz", header=F, sep = " ", stringsAsFactors = F)
df2 <- read.table("input2.xyz", header=F, sep = " ", stringsAsFactors = F)

df2 <- df2[-which(df2$V3 == 0),]

long <- df2$V1
lat <- df2$V2
fin_mtx <- matrix(NA, nrow=18976, ncol=8)
colnames(fin_mtx) <- c("Longitude", "Latitude", "Mean", "Median", "Std Dev",
                       "Max", "Min", "No. of NA")
fin_mtx <- as.data.frame(fin_mtx)

i = 1
while (i < 18976)
{
  px_vl <- subset(df$V3, (df$V1 > long[i] - 0.125/2) & (df$V1 < long[i] + 0.125/2) & 
                         (df$V2 < lat[i] + 0.125/2) & (df$V2 > lat[i] - 0.125/2))
  frq <- as.data.frame(table(px_vl))

  if (frq[1,1] == -32768) {
     fin_mtx[i,8] <- frq[which(frq$px_vl==-32768),2]
     px_vl[px_vl == -32768] <- NA
  }

  fin_mtx[i,1] <- long[i]
  fin_mtx[i,2] <- lat[i]
  fin_mtx[i,3] <- mean(px_vl, na.rm = T)
  fin_mtx[i,4] <- median(px_vl, na.rm = T)
  fin_mtx[i,5] <- sd(px_vl, na.rm = T)
  fin_mtx[i,6] <- max(px_vl, na.rm = T)
  fin_mtx[i,7] <- min(px_vl, na.rm = T)
  i = i + 1
}

df 有近 1.72 亿行和三列，而 df2 有 18,976 行。运行代码需要很长时间（我的意思是几天）。此外，使用了大量的内存。我想减少这个时间和计算负载。我参考了一些建议，例如预先定义向量并在不同的教程中使用data.table，但它们并没有太大帮助。

Answer 1

尝试在循环外计算longHigh <- long + 0.125/2 和longLow <- long - 0.125/2 以及latHigh 和latLow，因为这是一个固定计算，而您只是使用i 从每个列表中调用元素。

这样可以减少

 px_vl <- subset(df$V3, (df$V1 > long[i] - 0.125/2) & (df$V1 < long[i] + 0.125/2) & 
                         (df$V2 < lat[i] + 0.125/2) & (df$V2 > lat[i] - 0.125/2))

到

px_vl <- subset(df$V3, (df$V1 > longLow[i]) & (df$V1 < longHigh[i]) &
                        (df$V2 < latHigh[i]) & df$V2 > latLow[i]))

这会从循环的每次迭代中删除四个计算。

另外，我认为你可以简化

 if (frq[1,1] == -32768) {
     fin_mtx[i,8] <- frq[which(frq$px_vl==-32768),2]
     px_vl[px_vl == -32768] <- NA
  }

通过将na.strings 参数添加到fread(..., na.strings = "-32768")，并且至少不必为NA 分配px_vl[px_vl == -32768] <- NA

Answer 2

我花了一些时间思考这个问题，并提出了一些改进：

1）由于你没有给出一些示例数据，我自己创建了一些：

n1 <- 1.72e8
n2 <- 19000

set.seed(21)
df <- data.frame(V1 = rnorm(n1), V2 = rnorm(n1), V3 = rnorm(n1))
df2 <- data.frame(V1 = rnorm(n2), V2 = rnorm(n2))
df$V3[seq(10, n1, 100)] <- 0 # lets assume 0 as missing value

2) 在我的测试中，我发现使用向量比data.frame 或data.table 更有效。所以我们将必要的列强制转换为向量：

long <- df2$V1
lat <- df2$V2
x3 <- df$V3
x2 <- df$V2
x1 <- df$V1
rm(df) # remove large dataset from memmory
gc()

3) 现在我们可以找到缺失值（在您的情况下为 -32768）并将其替换为 NA

x3[x3 == 0] <- NA

4) 看起来使用summary 函数可以提高计算几乎所有所需统计数据的速度，因此我们将使用它：

rez2 <- matrix(NA, nrow = n2, ncol = 10)
colnames(rez2) <- c("Longitude", "Latitude",
                   names(summary(c(1, NA))), "Std Dev")


i <- 1
k <- 1

5) 这个计算可能不会影响循环的速度，但是在循环之外进行计算会更干净：

lokn <- long - k
lokp <- long + k
lakn <- lat - k
lakp <- lat + k

6) 循环测试，10 次迭代：

tt <- proc.time()
while (i < 11) {
  lo_i <- long[i]
  la_i <- lat[i]

  w2 <- between(x1, lokn[i], lokp[i], incbounds = F) &
    between(x2, lakn[i], lakp[i], incbounds = F)
  px_vl <- x3[w2]

  if (length(px_vl) == 0) px_vl <- 0 ## added for caching empty px_vl,
  #probably you dont have this kind of problem in your data

  r2 <- c(lo_i, la_i,
          summary(px_vl),
          sd(px_vl, na.rm = T))

  rez2[i,] <- r2
  i = i + 1
}
rez
tt2 <- proc.time() - tt
tt2
# 55 sek for 10 iterations, so for 19k:
19000/10 *55 /60/60 # approx ~29 h

我发现使用data.table 中的between 可以很好地提高速度，以选择必要的值。使用它，我们从x1 向量中获取要选择的元素的索引（真/假）。正如我之前提到的，使用summary gives 也提高了一些速度。我鼓励您对此进行测试，并提供一些反馈。

另外，你有多少内存？如果不是限制，那么可能还有其他解决方案。