nerd_sniping.R

library(testthat)
nr <- 5
grid <- matrix(seq_len(nr^2), nr, nr, byrow=TRUE)
data <- data.frame(grid=seq_len(nr^2),
                   sp1=runif(nr^2) < .3,
                   sp2=runif(nr^2) < .5,
                   sp3=runif(nr^2) < .7,
                   stringsAsFactors=FALSE)
                   

# Convert from index within the vector to row/column index and v.v:
index_to_rc <- function(i, nr) {
  cbind((i - 1) %/% nr + 1, (i - 1) %% nr + 1)
}
rc_to_index <- function(rc, nr) {
  (rc[,1] - 1) * nr + rc[,2]
}


# Indices of a sub-array with n rows and columns out of a matrix with
# nr rows.
sub_array <- function(i, n, nr) {
  rc <- index_to_rc(i, nr)
  delta <- cbind(rep(seq_len(n), each=n), seq_len(n)) - 1L
  apply(rc, 1, function(x)
        rc_to_index(cbind(x[1] + delta[,1], x[2] + delta[,2]), nr))
}

# Quick sanity check:
library(testthat)
rc <- index_to_rc(seq_len(nr^2), nr)
expect_that(rc, equals(cbind(rep(1:nr, each=nr), 1:nr)))
expect_that(rc_to_index(rc, nr), equals(seq_len(nr^2)))

# Now 2 * 2 subarrays can start at up to the first four rows
i2 <- rc_to_index(rc[rowSums(rc <= 4) == 2,], nr)
# This is a matrix where each column is a set of indices to the grid.
sub2 <- sub_array(i2, 2, nr)

# These are *your* grid IDs (they're transposed but that could
# actually be ignored here)
grid[sub2[,1]]
# Presence absence data for the first grid cell.
data[grid[sub2[,1]],-1]

# Suppose the function you want is 'any present':
f <- function(x) colSums(x) > 0
# This is a matrix where each row corresponds to a subgrid with
# whether a species was present in it at all.
res2 <- t(apply(sub2, 2, function(i) f(data[grid[i],-1])))

# Similarly for the size 3 and 4 subgrids:
i3 <- rc_to_index(rc[rowSums(rc <= 3) == 2,], nr)
i4 <- rc_to_index(rc[rowSums(rc <= 2) == 2,], nr)
sub3 <- sub_array(i3, 3, nr)
sub4 <- sub_array(i4, 4, nr)
res3 <- t(apply(sub3, 2, function(i) f(data[grid[i],-1])))
res4 <- t(apply(sub4, 2, function(i) f(data[grid[i],-1])))