我有一个数组，其第一个维度需要子集/索引/重新排序。例如：
arr <- array(1:24, dim=c(4,3,2))
arr[4:1,,]
简单，就像一个魅力。
但是，当我不确定数组有多少维度时，有没有办法做到这一点？要清楚，我将始终知道第一维的大小（即，我知道dim(arr)[1]），我只是不知道length(dim(arr))。
答案 0 :(得分：3)
这是一种可能的方式，虽然它仍然有点慢。
do.call(`[`, c(list(arr, 4:1), lapply(dim(arr)[-1], seq_len)))
## , , 1
##
## [,1] [,2] [,3]
## [1,] 4 8 12
## [2,] 3 7 11
## [3,] 2 6 10
## [4,] 1 5 9
##
## , , 2
##
## [,1] [,2] [,3]
## [1,] 16 20 24
## [2,] 15 19 23
## [3,] 14 18 22
## [4,] 13 17 21
do.call需要一个参数列表（如果未命名）将按照它们提供的顺序传递给指定的函数（在本例中为[）。
在上面，我们将一个列表list(arr, 4:1, 1:3, 1:2)传递给[，这相当于：`[`(arr, 4:1, 1:3, 1:2)（反过来，相当于arr[4:1, 1:3, 1:2]）。
定时：
microbenchmark(subset=arr[4:1,,],
jb=do.call(`[`, c(list(arr, 4:1), lapply(dim(arr)[-1], seq_len))),
times=1E3)
## Unit: microseconds
## expr min lq mean median uq max neval
## subset 1.140 1.711 1.765575 1.711 1.711 15.395 1000
## jb 9.693 10.834 11.464768 11.404 11.974 96.365 1000
（忽略绝对时间 - 我的系统目前处于紧张状态。）
因此，它需要大约十倍于直接子集的时间。这里可能还有改进的余地，但正如@thelatemail评论的那样，时间在大型阵列上更具可比性。
修改
正如@thelatemail所建议的那样，索引序列可以被TRUE取代，这会加快速度。
do.call(`[`, c(list(arr, 4:1), rep(TRUE, length(dim(arr))-1)))
再次计时：
microbenchmark(subset=arr[4:1,,],
jb=do.call(`[`, c(list(arr, 4:1), lapply(dim(arr)[-1], seq_len))),
tlm=do.call(`[`, c(list(arr, 4:1), rep(TRUE, length(dim(arr)) - 1))),
times=1E3)
## Unit: microseconds
## expr min lq mean median uq max neval
## subset 1.140 1.711 2.146474 1.711 2.281 124.875 1000
## jb 10.834 11.974 13.455343 12.545 13.685 293.086 1000
## tlm 6.272 7.413 8.348592 7.983 8.553 95.795 1000
答案 1 :(得分：3)
这是一个奇怪的选择。这个想法是基于我在某一点上注意到的一个实现怪癖，R似乎将“缺失”的函数参数表示为symbols，其名称为零长度。其中一个很奇怪的原因是R通常不允许您创建零长度名称的符号：
as.symbol('');
## Error in as.symbol("") : attempt to use zero-length variable name
但是通过一些搞乱，我发现你可以通过访问涉及“缺失”参数的表达式的解析树来跳过R的防御，并索引出包含“缺失”参数的解析树的元素。以下是您从这件事中获得的一些奇怪行为的演示：
substitute(x[]); ## parse tree involving missing argument
## x[]
as.list(substitute(x[])); ## show list representation; third component is the guy
## [[1]]
## `[`
##
## [[2]]
## x
##
## [[3]]
##
##
substitute(x[])[[3]]; ## prints nothing!
##
(function(x) c(typeof(x),mode(x),class(x)))(substitute(x[])[[3]]); ## it's a symbol alright
## [1] "symbol" "name" "name"
as.character(substitute(x[])[[3]]); ## gets the name of the symbol: the empty string!
## [1] ""
i.dont.exist <- substitute(x[])[[3]]; ## store in variable
i.dont.exist; ## wha??
## Error: argument "i.dont.exist" is missing, with no default
无论如何，这是解决OP问题的解决方案：
arr <- array(1:24,4:2);
do.call(`[`,c(list(arr,4:1),rep(list(substitute(x[])[[3]]),length(dim(arr))-1)));
## , , 1
##
## [,1] [,2] [,3]
## [1,] 4 8 12
## [2,] 3 7 11
## [3,] 2 6 10
## [4,] 1 5 9
##
## , , 2
##
## [,1] [,2] [,3]
## [1,] 16 20 24
## [2,] 15 19 23
## [3,] 14 18 22
## [4,] 13 17 21
##
我希望它能胜过所有其他解决方案，但是@thelatemail，你赢了这一轮：啊哈！我意识到我们可以预先计算一个空符号的列表（在一个变量中自己存储一个空符号，即列表中的不，不可用，如上所示）和{{1}解决方案中列出的那个列表，而不是招致rep()的所有开销在解析的每次调用中解析出一个虚拟表达式。看看表演：
substitute()刚刚发现有一种更容易获得空符号的方法，似乎一直都可用：
straight <- function() arr[4:1,,];
jb <- function() do.call(`[`,c(list(arr,4:1),lapply(dim(arr)[-1],seq_len)));
tlm <- function() do.call(`[`,c(list(arr,4:1),rep(TRUE,length(dim(arr))-1)));
orderD1 <- function(x,ord) { dims <- dim(x); ndim <- length(dims); stopifnot(ndim>0); if (ndim==1) return(x[ord]); wl_i <- which(letters=="i"); dimLetters <- letters[wl_i:(wl_i+ndim-1)]; dimList <- structure(vector("list",ndim),.Names=dimLetters); dimList[[1]] <- ord; for (i in 2:ndim) dimList[[i]] <- 1:dims[i]; do.call("[",c(list(x=x),dimList)); };
rbatt <- function() orderD1(arr,4:1);
bgoldst <- function() do.call(`[`,c(list(arr,4:1),rep(list(substitute(x[])[[3]]),length(dim(arr))-1)));
ls0 <- list(substitute(x[])[[3]]);
ls0;
## [[1]]
##
##
bgoldst2 <- function() do.call(`[`,c(list(arr,4:1),rep(ls0,length(dim(arr))-1)));
microbenchmark(straight(),jb(),tlm(),rbatt(),bgoldst(),bgoldst2(),times=1e5);
## Unit: nanoseconds
## expr min lq mean median uq max neval
## straight() 428 856 1161.038 856 1284 998142 1e+05
## jb() 4277 5988 7136.534 6843 7271 1629357 1e+05
## tlm() 2566 3850 4622.668 4277 4705 1704196 1e+05
## rbatt() 24804 28226 31975.583 29509 31219 34970873 1e+05
## bgoldst() 3421 4705 5601.300 5132 5560 1918878 1e+05
## bgoldst2() 2566 3850 4533.383 4277 4705 1034065 1e+05
我的substitute();
##
技巧现在看起来很愚蠢。
出于好奇，我使用substitute(x[])[[3]]直接针对其他解决方案进行基准测试，与substitute()相比，它会产生轻微的性能成本，使其比bgoldst2()略差：
tlm()答案 2 :(得分：2)
我有一个丑陋而低效的解决方案。更简单方法的问题是我不知道如何使用[正确实现do.call的默认值。也许有人会看到这一点并受到启发。
orderD1 <- function(x, ord){
dims <- dim(x)
ndim <- length(dims)
stopifnot(ndim>0)
if(ndim==1){
return(x[ord])
}
wl_i <- which(letters=="i")
dimLetters <- letters[wl_i:(wl_i+ndim-1)]
dimList <- structure(vector("list",ndim), .Names=dimLetters)
dimList[[1]] <- ord
for(i in 2:ndim){
dimList[[i]] <- 1:dims[i]
}
do.call("[",c(list(x=x),dimList))
}
orderD1(arr, 4:1)
, , 1
[,1] [,2] [,3]
[1,] 4 8 12
[2,] 3 7 11
[3,] 2 6 10
[4,] 1 5 9
, , 2
[,1] [,2] [,3]
[1,] 16 20 24
[2,] 15 19 23
[3,] 14 18 22
[4,] 13 17 21
library(microbenchmark)
microbenchmark(arr[4:1,,], orderD1(arr, 4:1), times=1E3)
Unit: nanoseconds
expr min lq mean median uq max neval
arr[4:1, , ] 864 1241 1445.876 1451 1596.0 17191 1000
orderD1(arr, 4:1) 52020 54061 56286.856 54909 56194.5 179363 1000
我很乐意接受更优雅/更紧凑的解决方案。