Warning: file_get_contents(/data/phpspider/zhask/data//catemap/4/r/66.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Arrays 如何重新排列R中数组的第一个dim(不知道总dim)_Arrays_R_Indexing_Subset - Fatal编程技术网

Arrays 如何重新排列R中数组的第一个dim(不知道总dim)

Arrays 如何重新排列R中数组的第一个dim(不知道总dim),arrays,r,indexing,subset,Arrays,R,Indexing,Subset,我有一个数组,需要对其第一个维度进行子集/索引/重新排序。例如: arr <- array(1:24, dim=c(4,3,2)) arr[4:1,,] arr我有一个丑陋而低效的解决方案。简单方法的问题是,我不知道如何使用do.call正确地实现[的默认值。也许有人会看到这一点并受到启发 以下是函数: 这是一个多么慢的例子。。。 我很乐意接受一个更优雅/紧凑的解决方案。这里有一个可能的方法,尽管它仍然有点慢 do.call(`[`, c(list(arr, 4:1), lapply(d

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

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

arr我有一个丑陋而低效的解决方案。简单方法的问题是,我不知道如何使用
do.call正确地实现
[
的默认值。也许有人会看到这一点并受到启发

以下是函数: 这是一个多么慢的例子。。。
我很乐意接受一个更优雅/紧凑的解决方案。

这里有一个可能的方法,尽管它仍然有点慢

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

这里有一个奇怪的替代方案。这个想法是基于我在某一点上注意到的一个实现怪癖,即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

刚刚发现有一种更简单的方法可以找到空符号,它似乎一直都是可用的:

substitute();
##
我的
替换(x[])[[3]
技巧现在看起来有点愚蠢

出于好奇,我使用
substitute()
直接与其他解决方案进行了基准测试,与
bgoldst2()
相比,它的性能成本稍低,比
tlm()
稍差一些:


bgoldst3
apply(arr,2:(length(dim(arr))),rev)
maybe?@latemail我喜欢你的头在哪里。将它概括为切换为
rev
函数(x)do.call(“[”,list(x=x,I=ord))
.Idk,我的大脑现在很累。开始工作,回答并显示结果+1的评论,回答!还值得记住的是,这里的平均时差为
0.00005
s。@最近的邮件不确定它的缩放比例,但你是说出于某种原因,你不能查询
length(dim(arr))
?或者只是因为你事先不知道它?@jbaums我不知道要键入多少逗号。我希望我可以只键入
arr[4:1,…]
或其他什么。所以我不知道高级中的
长度(dim(arr))
,但它可以被查询。它也没有那么慢,用
arr Nice试试,比我的要简洁得多(没有检查等;而且我想我不需要命名args hehe;在
seq_len
)上做得很好。我最初尝试了
NULL
而不是整个
seq_len
位,但这不起作用。我只想保留那些其他dim
缺失()
或其他什么…idk。但这看起来是对的。
TRUE
是另一个占位符,当您想将缺少的值传递给
[
时,它会起作用,例如
arr[TRUE,TRUE,1]
do.call(`[`,list(arr,TRUE,TRUE,1))
@thelatemail-nice,我不知道。那也会更有效率。@jbaums-nice edit,即使使用TRUE,我也无法更快地获得它,因为我使
列表和
c
部分复杂化。你已经解决了!太棒了。几乎与
tlm()并列
。我以后可能不得不编辑我的函数,放弃所有的命名和检查等,只是为了看看它是否与其他函数进入相同的范围。关于缺少的东西的符号的超酷信息。我必须考虑一下。尽管你通过使用
替换()和列表在基准外调用。无论如何,这是一个有趣的小调查。@ TeleMemail是的,这是一个公平的点。但是因为在任何R会话中都可以预先计算“代码> LS0 < /代码>,所以我认为在该会话中的解决方案的所有运行中考虑成本是有意义的。但即使如此,我们的时代是如此接近,我们可以基本上认为这是一个领带。你的解决方案的优势在于它完全是自包含的(没有预先计算是必要的),并且它不依赖于语言的模糊实现细节。
as.symbol('');
## Error in as.symbol("") : attempt to use zero-length variable name
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
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
##
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();
##
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