Question

我有几个月的数据文件，每个数据文件包含两个25x25x20m养鱼场围栏中40条标记鱼的24小时鱼x，y，z坐标记录，每个标记每6-9秒放置一次。每个文件包含大约365,000个观察值。

我想计算每天被鱼所覆盖的笔的比例。我已经编写了一些R代码来完成这项工作，但是由于文件很大，运行大约需要4个小时。这是我的代码：

xmin <- 8
ymin <- 11.5
xmax <- 33
ymax <- 36.5
boxsize <- 1

# define coverage grid
cov.grid <- matrix(c(xmin,ymin), nrow = 1, ncol = 2, byrow = FALSE)
colnames(cov.grid) <- c('x','y')
x <- xmin
y <- ymin
while(x < xmax)
  {
  while(y < ymax)
    {
    y <- y+boxsize
    cov.grid <- rbind(cov.grid, c(x,y))  
    }
  x <- x+boxsize
  y <- ymin
  cov.grid <- rbind(cov.grid, c(x,y))  
}
cov.grid <- as.data.frame(cov.grid)


# count grid cells occupied by fish
day.row <- 1
grid.row <- 1
bin <- 0
cov.grid$occupied <- NA

for(grid.row in 1:nrow(cov.grid)){
x1 <- cov.grid[grid.row,1]
y1 <- cov.grid[grid.row,2]
x2 <- x1+boxsize
y2 <- cov.grid[grid.row+1,2] 
repeat
  {
  if(dayfile[day.row,'PosX'] > x1 & dayfile[day.row,'PosX'] < x2 &         dayfile[day.row,'PosY'] > y1 & dayfile[day.row,'PosY'] < y2) {bin <- 1} else    {bin <- 0}
  day.row <- day.row+1
  if(bin == 1 | day.row == nrow(dayfile)){break}
  }
cov.grid[grid.row,'occupied'] <- bin
day.row <- 1
}

# return coverage summary

coverage <- matrix(c(length(which(cov.grid$occupied == 1)), nrow(cov.grid),     length(which(cov.grid$occupied == 1))/nrow(cov.grid)), ncol = 3)
colnames(coverage) <- c('occupied', 'total', 'proportion')
coverage

代码的逻辑如下：

创建笔区的矩阵网格。
对于每个网格单元格，查看鱼坐标文件以检查鱼是否占据该单元格;如果是，则为1，否则为0。
在网格矩阵中添加一个新列，以记录每个单元格是否被鱼占用。
计算占用的单元格数并计算笔的比例范围。

理想情况下，我希望网格分辨率为0.1米分辨率，但即使分辨率为1米，也需要4小时才能运行; 25x25m网格阵列= 625个单元格，因此365,000个鱼类观测的坐标文件必须与网格阵列交叉列表625次。如果网格分辨率为0.1米，那么365,000个观测值需要交叉列表625,000次，这可能需要几周时间！

我确信必须有一种更有效的方法来做到这一点。但是，我现在只学习了几个月的R，所以我不确定如何改进代码。

非常感谢任何帮助或建议！

Answer 1

您根本不需要使用循环。以下工作：

compute.coverage <- function(xmin, xmax, ymin, ymax, boxsize, dayfile) {
  x.grid <- floor((dayfile$PosX - xmin) / boxsize) + 1
  y.grid <- floor((dayfile$PosY - ymin) / boxsize) + 1
  x.grid.max <- floor((xmax - xmin) / boxsize) + 1
  y.grid.max <- floor((ymax - ymin) / boxsize) + 1
  t.x <- sort(unique(x.grid))
  t.y <- sort(unique(y.grid))
  tx.range <- c(min(which(t.x > 0)), max(which(t.x <= x.grid.max)))
  ty.range <- c(min(which(t.y > 0)), max(which(t.y <= y.grid.max)))
  t <- table(y.grid, x.grid)[ty.range[1]:ty.range[2],tx.range[1]:tx.range[2]]
  grid.cov <- matrix(0,nrow=y.grid.max,ncol=x.grid.max)
  t.x <- t.x[(t.x > 0) & (t.x <=x.grid.max)]
  t.y <- t.y[(t.y > 0) & (t.y <=y.grid.max)]
  eg <- expand.grid(t.y,t.x)
  grid.cov[cbind(eg$Var1,eg$Var2)] <- as.vector(t)  
  coverage <- matrix(c(length(which(grid.cov > 0)), length(grid.cov), length(which(grid.cov > 0))/length(grid.cov)), ncol = 3)
  colnames(coverage) <- c('occupied', 'total', 'proportion')
  coverage
}

此计算的关键是计算每个观察的网格框位置(x.grid,y.grid)，如Rufo（另一个答案）所做的那样。然而，在这里，这个计算在dayfile的所有观察中矢量化，并且其复杂度是网格分辨率的独立！诀窍是然后使用table计算(x.grid,y.grid)的每个组合的占用频率。这里有两个复杂的因素：

计算出的(xgrid,y.grid)位置可能位于笔(xmin,xmax,ymin,ymax)之外。
并非所有网格框都被占用，因此表中可能存在缺少计数的整行和/或列。

如果您只对覆盖率的百分比感兴趣，那么第二个问题是不相关的，但如果您真正关心哪个盒子位置被占用，那么它是相关的。上面的代码通过以下方式处理：

将表格限制在笔的范围tx.range和ty.range。
将表格（可能带有＆＃34;孔＆＃34;）映射回笔grid.cov的完整网格。这里，grid.cov是笔的矩阵，对应于您的cov.grid变量。它的元素记录了i - 行和j列的框的职业数量，所以这实际上比occupied更多的信息，grid.cv > 0只指定框是否有被占领（至少一次）。为了检测盒子是否已被占用，我们评估dayfile。

在xmin <- 8 ymin <- 11.5 xmax <- 33 ymax <- 36.5 boxsize <- 0.1 ## simulate dayfile set.seed(123) PosX <- runif(365000,xmin-2,xmax+2) PosY <- runif(365000,ymin-2,ymax+2) dayfile <- data.frame(PosX=PosX,PosY=PosY) print(system.time(coverage <- compute.coverage(xmin,xmax,ymin,ymax,boxsize,dayfile))) ## user system elapsed ## 1.096 0.052 1.193 print(coverage) ## occupied total proportion ##[1,] 62168 63001 0.986778上以0.1米分辨率网格运行此计算机，在我的2 GHz Macbook上使用365,000次模拟观测时间不到2秒：

dataSource

Answer 2

这是一个解决方案，您可以使用零来创建表示网格的矩阵，然后将1添加到每条鱼所在的单元格中。然后你区分具有1条或更多鱼类的细胞和没有鱼类的细胞，最后你做了比例。我没有检查效率，但我猜它会更好（没有比较，只有一个for）。

我将解决方案包装在一个函数中（它更优雅，可以在几种情况下更容易应用）

请告诉我这是否对您有用！

dayfile<-data.frame(PosX=c(30.5,25.5,28.5), PosY=c(30,24,20))

xmin <- 8
ymin <- 11.5
xmax <- 33
ymax <- 36.5
boxsize <- 1

coveragefun<-function(xmin, xmax, ymin, ymax, boxsize, dayfile){

  ncols <- ceiling((xmax-xmin)/boxsize)
  nrows <- ceiling((ymax-ymin)/boxsize)

  matspace <- matrix(0,nrow=nrows, ncol=ncols)

  for(i in 1:(dim(dayfile)[1])){
    xpos <- 1 + (dayfile$PosX[i]-(xmin))/boxsize
    ypos <- 1 + (dayfile$PosY[i]-(ymin))/boxsize
    matspace[xpos,ypos]<-matspace[xpos,ypos]+1
  }

  matcount<-matspace>=1

  coverage <- c(sum(matcount), dim(matcount)[1]*dim(matcount)[2], sum(matcount)/(dim(matcount)[1]*dim(matcount)[2]))
  names(coverage) <- c('occupied', 'total', 'proportion')
  return(coverage)
}

coverageres <- coveragefun(xmin, xmax, ymin, ymax, boxsize, dayfile)
coverageres

您也可以从函数中恢复matspace对象，这样您就可以进行摘要并知道网格中的单元格填充量。为此，您可以按如下方式更改代码的最后几行

  return(list(coverage, matspace))
}

coverageres <- coveragefun(xmin, xmax, ymin, ymax, boxsize, dayfile)
coverageres[[1]]
table(coverageres[[2]])

如何根据点数据计算区域的覆盖范围？

2 个答案: