Arrays R：动态替换子阵列

我使用的是相当大的多维数组，我非常喜欢abind包方式（

abind:：asub

），用于从具有可变维度的数组中动态提取子数组

---

但是，我希望找到一种有效的方法来执行相反的操作，即用另一个数组动态替换子数组。感谢@JDL和@alexis_laz的帮助，基本的R方法是将下标与

'[一起使用。解决方案是首先为
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)
}

subarray.arguments这听起来像是
do.call
的工作。你可以看到类似的帖子谢谢JDL和alexis_laz！
do.call
和一个合适的列表（大部分是空元素）似乎是一个很好的方法。
# 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)

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.

# 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

}

# 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!

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)
}

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