R foreach loops on 3D array data - r

Question

Some background: I need to work out the distance from some point to each cell in a 3D grid, then apply a function to this distance. I need to do this for multiple points, and add the functions values in each cell for all the points. I can do this using the following code for points located at (x,y,z):
x <- c(1,2,3,4,5)
y <- x
z <- x
radius <- c(0.4,0.5,0.6,0.7,0.8)
numsphere <- length(x)
radius_buffer <- 0.2
xvox <- seq((min(x)-1),(max(x)+2),0.5)
yvox <- xvox
zvox <- xvox
probability_array <<- array(0,dim=c(length(xvox),length(yvox),length(zvox)))
for (j in 1:length(yvox)){ # for every y element
for (i in 1:length(xvox)){ # for every x element
for (k in length(zvox):1){ # for every z element
for (n in 1:numsphere){ # for the total number of points
dist_sd <- ((xvox[i]-x[n])^2+(yvox[j]-y[n])^2+(zvox[k]-z[n])^2)^0.5
probability_array[i,j,k] <- probability_array[i,j,k] +
round(exp(-1*(dist_sd-radius[n])^2/(2*radius_buffer^2)),3)
}
}
}
}
The output is an array and the plotted result looks like this:
probability_array <- probability_array/max(probability_array)
contour3d(probability_array,level=c(0.2,0.8,0.9),x=xvox,y=yvox,z=zvox,color = c("aquamarine","gold","darkorange"),alpha = c(0.1,0.2,0.5),add=T)
I have tried to parallelise this because it seems ideal for it, but can't get it to work.
I've tried:
cl<-makeCluster(detectCores(),type="SOCK")
registerDoSNOW(cl)
for (j in 1:length(yvox)){
for (i in 1:length(xvox)){
for(k in length(zvox):1){
probability_array[i,j,k] <- foreach(n=1:numsphere, .combine='+') %dopar% {
dist_sd <- ((xvox[i]-x[n])^2+(yvox[j]-y[n])^2+(zvox[k]-z[n])^2)^0.5
round(exp(-1*(dist_sd-radius[n])^2/(2*radius_buffer^2)),3)
}
}
}
}
and things like:
r <- foreach(j=1:length(yvox)) %:% foreach(i=1:length(xvox)) %:% foreach(k=length(zvox):1) %:% foreach(n=1:numsphere, .combine='+') %do% {
dist_sd <- ((xvox[i]-x[n])^2+(yvox[j]-y[n])^2+(zvox[k]-z[n])^2)^0.5
probability_array[i,j,k] <- probability_array[i,j,k] + round(exp(-1*(dist_sd-radius[n])^2/(2*radius_buffer^2)),3)
probability_array[i,j,k]
}
But I'm missing something important. Any help would be greatly appreciated.
Cheers

Answer 1

When parallelizing computations, because of the overhead it introduces,
it is preferable to run large pieces of computations in parallel,
rather than small -- outer loops, rather than inner loops.
In this case, however, there is no need to parallelize the computations:
you can just vectorize them.
# 3-dimensional analogue of row() and col()
dim3 <- function( a, i ) {
stopifnot( length(dim(a)) == 3 )
r <- a
if( i == 1 ) { r[] <- rep(1:dim(a)[1], dim(a)[2] * dim(a)[3]) }
if( i == 2 ) { r[] <- rep(1:dim(a)[2], each = dim(a)[1], times = dim(a)[3]) }
if( i == 3 ) { r[] <- rep(1:dim(a)[3], each = dim(a)[1] * dim(a)[2]) }
r
}
probability_array <- array(0,dim=c(length(xvox),length(yvox),length(zvox)))
i <- dim3(probability_array,1)
j <- dim3(probability_array,2)
k <- dim3(probability_array,3)
for (n in 1:numsphere){
dist_sd <- sqrt(
(xvox[i]-x[n])^2 + (yvox[j]-y[n])^2 + (zvox[k]-z[n])^2
)
probability_array <- probability_array +
# Rounding intermediate results looks suspicious
round(exp(-1*(dist_sd-radius[n])^2/(2*radius_buffer^2)),3)
}