1grid2nb <- function(grid, d = grid@cells.dim, 2 queen = TRUE, nb = TRUE, self = FALSE) { 3### supply either a grid (GridTopology) 4### or d (number of cells in each dimention) 5### choose queen and nb (see the poly2nb() function) 6 n <- as.integer(prod(d)) 7 if (n==1) { 8 if (nb) { 9 nn <- list(self*1L) 10 class(nn) <- 'nb' 11 return(nn) 12 } else return(matrix(0L, 1, 1)) 13 } 14 nd <- as.integer(length(d)) 15 if (nd==1) { 16 nn <- cbind(c(0L, 1L:(n-1)), 17 c(2L:n, 0L)) 18 } else { 19 if (queen) { 20 exd <- expand.grid( 21 lapply(1L:nd, function(j) 22 c(1,d)[j]^(j-1)*(-1L:1L))) 23 ll <- as.integer(rowSums(exd)) 24 gc(reset=TRUE) 25 nn <- matrix(1L:n, n, length(ll)) 26 for (j in 1:ncol(nn)) 27 nn[, j] <- nn[, j] + ll[j] 28 for (j in 1:nd) { 29 ii <- rep(rep(1:d[j], 30 each=prod(c(1,d)[1:j]) 31 ), prod(d[-(1:j)])) 32 id <- which(ii==1) 33 for (jj in which(exd[,j]<0)) 34 nn[id, jj] <- 0L 35 id <- which(ii==d[j]) 36 for (jj in which(exd[,j]>0)) 37 nn[id, jj] <- 0L 38 } 39 if (!self) 40 nn[, which(ll==0)] <- 0L 41 } else { 42 nn <- matrix(0L, n, self + 2*nd) 43 id <- 1L:n 44 if (self) nn[, 1] <- id 45 for (j in 1:nd) { 46 ii <- rep(rep(1L:d[j], 47 each=prod(c(1,d)[1:j]) 48 ), prod(d[-(1:j)])) 49 nn[, self + 2*(j-1)+1] <- as.integer(( 50 id-c(1,d)[j]^(j-1))*(ii!=1)) 51 nn[, self + 2*(j-1)+2] <- as.integer(( 52 id+c(1,d)[j]^(j-1))*(ii!=d[j])) 53 } 54 } 55 } 56 if (nb) { 57 nn <- lapply(1L:n, function(i) 58 nn[i, nn[i,]>0L]) 59 class(nn) <- 'nb' 60 return(nn) 61 } else { 62 if (self) return(nn) 63 else return(nn[, -which(ll==0)]) 64 } 65} 66