如何在 R 中重新排序数组的第一个暗淡（不知道总暗淡）答案

【问题标题】：How to reorder 1st dim of array in R (don't know total dims)如何在 R 中重新排序数组的第一个暗淡（不知道总暗淡）
【发布时间】：2015-11-07 03:19:42
【问题描述】：

我有一个数组，我需要对其第一个维度进行子集/索引/重新排序。例如：

arr <- array(1:24, dim=c(4,3,2))
arr[4:1,,]

简单，就像一个魅力。

但是，当我不确定数组有多少维时，有没有办法做到这一点？需要明确的是，我总是知道第一个维度的大小（即，我知道dim(arr)[1])，我就是不知道length(dim(arr))。

【问题讨论】：

你的意思是因为某些原因不能查询length(dim(arr))？还是只是你事先不知道？
@jbaums 我不知道要输入多少个逗号。我希望我能做arr[4:1,...] 或其他什么。所以我不知道高级length(dim(arr))，但可以查询。

标签： arrays r indexing subset

【解决方案1】：

这是一个奇怪的选择。这个想法是基于我在某一时刻注意到的一个实现怪癖，即 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，你赢了这一轮：~~啊哈！我意识到我们可以预先计算一个空符号的列表（将一个空符号单独存储在一个变量中，即 not 在列表中，不可用，如上所示）和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() 稍差：

bgoldst3 <- function() do.call(`[`,c(list(arr,4:1),rep(list(substitute()),length(dim(arr))-1)));
microbenchmark(straight(),jb(),tlm(),rbatt(),bgoldst(),bgoldst2(),bgoldst3(),times=1e5);
## Unit: nanoseconds
##        expr   min    lq      mean median    uq      max neval
##  straight()   428   856  1069.340    856  1284   850603 1e+05
##        jb()  4277  5988  6916.899   6416  7270  2978180 1e+05
##       tlm()  2566  3849  4307.979   4277  4704  3138122 1e+05
##     rbatt() 24377 28226 30882.666  29508 30364 36768360 1e+05
##   bgoldst()  2994  4704  5165.019   5132  5560  2050171 1e+05
##  bgoldst2()  2566  3849  4232.816   4277  4278  1085813 1e+05
##  bgoldst3()  2566  3850  4545.508   4277  4705  1004131 1e+05

【讨论】：

太棒了。该死的几乎与tlm()捆绑在一起。稍后我可能不得不编辑我的函数以删除所有命名和检查等，只是为了看看它是否与其他人进入同一个球场。关于丢失东西的符号的超级酷信息。我得考虑一下。
尽管通过在基准测试之外调用substitute() 和list 获得了微小的优势。无论如何，这是一个有趣的小调查。
@thelatemail 是的，这很公平。但由于可以在任何 R 会话中只预先计算一次 ls0，我认为考虑将该成本摊销到该会话中解决方案的所有运行中是有意义的。但即便如此，我们的时代已经如此接近，我们基本上可以认为这是平局。而且您的解决方案具有完全独立的优势（无需预先计算），并且不依赖于语言的模糊实现细节。

【解决方案2】：

这是一种可能的方法，虽然它仍然有点慢。

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 cmets，时间在更大的阵列上更具可比性。

编辑

正如@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

【讨论】：

也没有那么慢，用arr <- arr[,,rep(1,1e4)]试试吧，相对优势大多会溜走。
很好，比我的简洁得多（没有检查等；我想我也不需要命名 args 呵呵；在seq_len 上做得很好）。我最初尝试做一个NULL 而不是整个seq_len 位，但这没有用。我只想留下那些其他暗淡missing() 或其他东西...... idk。但这看起来〜对。
TRUE 是另一个占位符，当您想将缺失值传递给 [ 时，它会起作用，例如arr[TRUE,TRUE,1] 或 do.call(`[`, list(arr,TRUE,TRUE,1) )
@thelatemail - 很好，我不知道。这样也会更有效率。
@jbaums - 很好的编辑，即使使用 TRUE 我也无法更快地获得它，因为我使 list 和 c 部分复杂化。你已经解决了！

【解决方案3】：

我有一个丑陋且低效的解决方案。更简单方法的问题是我不知道如何使用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

我很乐意接受更优雅/紧凑的解决方案。

【讨论】：

apply(arr, 2:(length(dim(arr))), rev) 也许？
@thelatemail 我喜欢你的头在哪里。将其概括为将rev 切换为function(x)do.call("[",list(x=x,i=ord)) 之类的东西。 Idk，我的大脑现在很累。工作并回答并显示结果+1评论，回答！
另外值得记住的是，这里的平均时差为 0.00005 秒。
@thelatemail 不确定它是如何扩展的