R: Multiplying elements of data frame with neighbours - r

Question

I have a data frame of 300x300 elements. Each of them are either -1 or +1:
[,1] [,2] [,3]
[1,] 1 -1 -1
[2,] 1 1 1
[3,] -1 -1 1
[4,] 1 1 -1
What I want is to iterate over my data frame, and multiply each value with every neighbouring value.
I.e:
For element [1,1] in my original data frame I want the product of [1,1], [1,2] and [2,1]
For element [2,2] in my original data frame I want the product of [2,2], [1,2], [2,1], [2,3] and [3,2].
I have tried to create 4 new data frames, each shifted 1 element to the right, left, up and down, respectively:
x_up <- shift(x, 1, dir='up')
x_up <- as.array(x_up)
dim(x_up) <- dims
x_down <- shift(x, 1, dir='down')
x_down <- as.array(x_down)
dim(x_down) <- dims
x_left <- shift(x, 1, dir='left')
x_left <- as.array(x_left)
dim(x_left) <- dims
x_right <- shift(x, 1, dir='right')
x_right <- as.array(x_right)
dim(x_right) <- dims
where x is my original data frame.
I can see when I used this approach, the new data frames are not rightfully shiftet; more of them are identical. I checked this with identical().
Is there another approach to my problem?
Edit:
shift() is of the 'binhf' library

Answer 1

I think there's probably a smarter way to do this, but the standard approach would be iterating over each element and multiplying its surroundings.
Starting with:
mat <- matrix(c(1, 1, -1, 1, -1, 1, -1, 1, -1, 1, 1, -1), ncol=3)
In order to avoid problems on positive margins, you must add a column and a row of 1's as margins (positive 1 won't be a problem when multiplying, if you were summing it would have to be 0's, for example).
mat2 <- addmargins(mat, FUN=function(x) 1)
Now you create an empty matrix to hold the output, and then iterate over the elements and multiply the neighbors.
out <- matrix(nrow=nrow(mat), ncol=ncol(mat))
for (i in 1:nrow(mat)) {
for (j in 1:ncol(mat)) {
out[i,j] <- prod(mat[i,j], mat2[i-1, j], mat2[i, j-1], mat2[i+1, j], mat2[i, j+1])
}
}
Resulting in:
> out
[,1] [,2] [,3]
[1,] -1 1 1
[2,] -1 1 -1
[3,] 1 1 1
[4,] -1 1 -1
This took less than a second for a 300x300 matrix, so it might be enough for you.

Answer 2

This should do the trick:
ind <- which(x==x, arr.ind=TRUE) # index matrix
# find distances (need distances of 1 or 0)
dist.mat <- as.matrix(dist(ind))
inds2mult <- apply(dist.mat, 1, function(ii) which(ii <= 1))
# get product of each list element in inds2mult
# and reform into appropriate matrix
matrix(
sapply(inds2mult, function(ii) prod(unlist(x)[ii])),
ncol=ncol(x))
# [,1] [,2] [,3]
#[1,] -1 1 1
#[2,] -1 1 -1
#[3,] 1 1 1
#[4,] -1 1 -1
To get around memory issues with large matrices in the call to dist, you can try the fields.rdist.near function (with a delta value of 1) from the fields package:
x <- matrix(rep(-1, 300*300), ncol=300)
ind <- which(x==x, arr.ind=TRUE) # index matrix
library(fields)
ind.list <- fields.rdist.near(ind, delta=1) # took my computer ~ 15 - 20 seconds
inds2mult <- tapply(ind.list$ind[,2], ind.list$ind[,1], list)
matrix(
sapply(inds2mult, function(ii) prod(unlist(x)[ii])),
ncol=ncol(x))
The delta argument from the fields.rdist.near help page:
Threshhold distance. All pairs of points that separated by more
than delta in distance are ignored.