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亿行和3列，而 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")，并至少跳过必须使用px_vl[px_vl == -32768] <- NA分配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

我发现使用between中的data.table可以提高速度，从而选择必要的值。使用它我们得到元素的索引（true / false）以从x1向量中选择。正如我之前提到的那样，使用summary gives也可以提高速度。我鼓励你测试一下，并提供一些反馈。

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

在R中循环加速

2 个答案: