logo标签列表

如何在R中重新排序数组的第一维（不知道总维数）

arraysrindexingsubset
4
我有一个数组，我需要对它的第一个维度进行子集/索引/重新排序。例如：
arr <- array(1:24, dim=c(4,3,2))
arr[4:1,,]

简单易用，操作流畅。

不过，如果我不确定数组的维度数量是否有方法可以完成此操作？ 澄清一下，我总是知道第一维的大小（即我知道dim(arr)[1]），只是不知道length(dim(arr))。

дҪ зҡ„ж„ҸжҖқжҳҜз”ұдәҺжҹҗдәӣеҺҹеӣ дҪ ж— жі•жҹҘиҜўlength(dim(arr))еҗ—пјҹиҝҳжҳҜиҜҙдҪ дәӢе…ҲдёҚзҹҘйҒ“е®ғзҡ„й•ҝеәҰпјҹ - jbaums
@jbaums 我不知道要输入多少个逗号。我希望我可以只输入 arr[4:1,...] 或者类似的东西。所以我不知道 length(dim(arr)) 提前是多少，但是可以查询。 - rbatt
3个回答
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
它也不是那么慢，请尝试使用 arr <- arr[,,rep(1,1e4)]，相对优势大多会消失。 - thelatemail
很好，比我的简洁多了（没有检查等等；我猜我不需要命名参数哈哈；seq_len 做得很好）。我最初尝试使用 NULL 而不是整个 seq_len 部分，但那行不通。我只想让其他维度缺失或者什么的...我不知道。但这看起来 没问题 。 - rbatt
2
TRUE是另一个可以在想要将缺失值传递给 [ 的情况下使用的占位符，例如 arr[TRUE, TRUE, 1] 或 do.call(\[`, list(arr, TRUE, TRUE, 1))`。 - thelatemail
@jbaums - 很好的编辑，即使我使用TRUE也无法更快，因为我在复杂化“list”和“c”部分。你已经解决了这个问题！ - thelatemail
@rbatt - 这就是我们的想法，但对于 (1:10)[TRUE]，你只有一个单一的向量，而我们有一个未知数量的向量，其中 TRUE 将被循环使用。我们需要通过 do.call 传递一个 n 个 TRUE 的列表给 [，其中 n 是 length(dim(arr)) - 1。(tl;dr ... 它不会跨维度循环使用) - jbaums
显示剩余3条评论
3

这里有一个奇怪的替代方案。这个想法基于我在某个时候注意到的一种实现技巧，即R似乎将“缺失”的函数参数表示为具有零长度名称的符号。其中一个原因是这么奇怪的是，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 ，你赢了这一局: 啊哈！我意识到我们可以预先计算一个空符号列表（将一个空符号存储在变量中，而不是列表中，就像我上面展示的那样是不可用的），并在解决方案中使用 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
1
太棒了。几乎与 tlm() 并列。我可能需要稍后编辑我的函数，删除所有的命名和检查等内容，只是为了看看它是否能够达到与其他函数相同的水平。关于缺失值符号的超酷信息。我得好好想一想。 - rbatt
иҷҪ然е°Ҷsubstitute()е’Ңlistи°ғз”Ёж”ҫеңЁеҹәеҮҶжөӢиҜ•д№ӢеӨ–еҸҜд»ҘиҺ·еҫ—еҫ®е°Ҹзҡ„дјҳеҠҝпјҢдҪҶиҝҷжҳҜдёҖдёӘжңүи¶Јзҡ„е°Ҹ研究гҖӮ - thelatemail
@thelatemail 是的，这是一个公平的观点。但由于在任何R会话中只需预计算一次ls0，因此我认为考虑将该成本分摊到该会话中的所有解决方案运行中是有意义的。但即使如此，我们的时间也非常接近，基本上可以认为这是一种平局。而您的解决方案具有完全自包含的优势（无需预先计算），并且不依赖于语言的晦涩实现细节。 - bgoldst
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

我很乐意接受更优雅/紧凑的解决方案。
2
应该是 apply(arr, 2:(length(dim(arr))), rev) 吧？ - thelatemail
@thelatemail，我喜欢你的想法。将其概括为使用类似于function(x)do.call("[",list(x=x,i=ord))的东西来替换rev。我不知道，我的大脑现在相当疲惫。努力工作并回答问题，展示结果+1给评论和答案！ - rbatt
1
同样值得注意的是，这里的平均时间差为 0.00005 秒。 - thelatemail
@thelatemail 不确定它如何扩展 - rbatt
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接