0

I'm working with rather large multi-dimensional arrays and I really like the abind-package way (abind::asub) for dynamically extracting a sub-array from an array with variable dimensions.

However, I'd like to find an efficient way to do the opposite operation, i.e. dynamically replace a sub-array with another array. The base R way of using subscripts with the '[<-'-function is fast enough 

library(abind) # just to show the wanted dynamical indexing
library(microbenchmark) # speed is essential

array.goal<-array.test<-array.original<-array(rnorm(100000),dim=c(10,10,10,10,10))
array.replacement<-array(1,dim=c(10,10,5,10,10)) 

microbenchmark(array.goal[,,3:7,,]<-array.replacement) #  mean 507.9323 microseconds

but it is not dynamic - i want to be able to set the target dimensions with variables and not write down a fixed number of commas. The same style as asub uses for extraction:

# the variables to control the replacement location:
dims<-3
idx<-list(3:7)
# i.e. want to be able to use the same kind of notation that abind::asub
# uses for extracting the sub arrays, as in:
identical(asub(array.goal,dims=dims,idx=idx),array.replacement)

the following works by generating a matrix of subarray indices, but it is too slow for my taste:

findsubi<-function(x,idx,dims){
  dim.x<-dim(x)
  dim.length<-length(dim.x)
  stopifnot(all(dims>=0) & all(dims<=dim.length),class(idx)=="list")
  stopifnot(dim.x[dims]>=lapply(idx,max))
  allowed<-lapply(dim.x,FUN=function(x){1:x})
  allowed[dims]<-idx
  index.space<-as.matrix(expand.grid(allowed))
  return(index.space)
}

# slooower: mean 4.259752 milliseconds!
microbenchmark(array.test[findsubi(array.test,dims=dims,idx=idx)]<-array.replacement)
identical(array.test,array.goal) # i know they are.

the standard subreplacement function '[<-' used in the beginning to generate the goal is fast enough for me, so i'd like to be able to write a wrapper that quickly generates the necessary arguments/subscripts (for example ,,3:7,,) for it, to avoid having to create the vector of individual indices that would define the wanted sub-array

so in essence i would like to have a wrapper with dynamical abind::asub style dynamical indexing

# let's go back to square one:
array.test<-array.original


asubassi<-function(x,dims,idx,y){
  # steps to generate ",,3:7,,"
  #argum<-something.to.generate.them(x,dims,idx)
  # i'd like to be able to efficiently generate the subscripts dynamically,
  # but I don't know how
  # you can't just generate a string and use that: 
  # argum<-',,3:7,,' the line '[<-'(x,argum,y) would fail

 '[<-'(x,,,3:7,,,y) # now just an example with a fixed subarray

}

hopefully it would still be fast enough

# mean 620.7229 microseconds
microbenchmark(array.test<-
asubassi(x=array.test,dims=dims,idx=idx,y=array.replacement)) 

identical(array.test,array.goal) # the truth is out there!

Is there a way to dynamically generate and pass the necessary subscript-arguments to the basic [<-replacement function? Or any other way to achieve the stated goal of fast dynamical replacement of multi-dimensional sub-arrays.

lohisoturi
  • 11
  • 4
  • this sounds like a job for `do.call`. – JDL Dec 13 '17 at 09:57
  • You could see [here](https://stackoverflow.com/questions/17750893/how-to-pass-nothing-as-an-argument-to-for-subsetting) a similar post – alexis_laz Dec 13 '17 at 10:22
  • Thank you JDL and alexis_laz! `do.call` and a suitable list (of mostly empty elements) seem like a very good way to do this. – lohisoturi Dec 13 '17 at 11:09

1 Answers1

1

Thanks to @JDL and @alexis_laz for their help. A solution is to first dynamically generate a proper list for the do.call

subarray.argument<-function(x,dims,idx){
  dim.x<-dim(x)
  dim.length<-length(dim.x)
  stopifnot(all(dims>=0) & all(dims<=dim.length),class(idx)=="list")
  stopifnot(dim.x[dims]>=lapply(idx,max))
  # first a suitable empty list
  argument<-rep(list(bquote()),dim.length)
  argument[dims]<-idx #  insert the wanted dimension slices
 return(argument)
}

asubassi<-function(x,dims,idx,y){
  argum<-c(alist(x),subarray.argument(x,dims,idx),alist(y))
  do.call('[<-',argum)
}

the speed is good enough: 

# mean 773.6759 microseconds
microbenchmark(array.test<-
asubassi(x=array.test,dims=dims,idx=idx,y=array.replacement)) 
identical(array.test,array.goal) # yep

Thank you!

lohisoturi
  • 11
  • 4