任何人都可以帮我提高这个R代码的效率吗?
我试图编写一个将字符串列表更改为字符串向量的函数,或者a 数字向量的数字列表,一般类型的向量的类型元素列表。
如果列表具有以下属性,我希望能够将列表更改为特定类型的向量:
它们是均匀打字的。列表中的每个元素都是'字符'或'复杂'或者 上。
列表的每个元素都是长度为一。
as_atomic <- local({
assert_is_valid_elem <- function (elem, mode) {
if (length(elem) != 1 || !is(elem, mode)) {
stop("")
}
TRUE
}
function (coll, mode) {
if (length(coll) == 0) {
vector(mode)
} else {
# check that the generic vector is composed only
# of length-one values, and each value has the correct type.
# uses more memory that 'for', but is presumably faster.
vapply(coll, assert_is_valid_elem, logical(1), mode = mode)
as.vector(coll, mode = mode)
}
}
})
例如,
as_atomic(list(1, 2, 3), 'numeric')
as.numeric(c(1,2,3))
# this fails (mixed types)
as_atomic( list(1, 'a', 2), 'character' )
# ERROR.
# this fails (non-length one element)
as_atomic( list(1, c(2,3,4), 5), 'numeric' )
# ERROR.
# this fails (cannot convert numbers to strings)
as_atomic( list(1, 2, 3), 'character' )
# ERROR.
以上代码运行正常,但速度非常慢,我无法通过任何方式优化它而无需更改 函数的行为。重要的是“as_atomic”功能很重要。表现得像;我无法切换 到我熟悉的基本功能(例如,取消列表),因为我需要为错误列表抛出错误。
require(microbenchmark)
microbenchmark(
as_atomic( as.list(1:1000), 'numeric'),
vapply(1:1000, identity, integer(1)),
unit = 'ns'
)
在我(相当快)的机器上,基准测试的频率约为40Hz,所以这个功能几乎总是在我的代码中限速。 vapply控制基准测试的频率约为1650Hz,但速度仍然很慢。
有没有办法大幅提高此操作的效率?任何建议都表示赞赏。
如果需要进行任何澄清或编辑,请在下面留言。
大家好,
很抱歉这个迟来的回复;在我尝试之前,我需要参加考试 重新实现这一点。
谢谢大家的性能提示。我把表现从可怕的40hz提高到了 使用普通R代码更容易接受600hz。
最大的加速来自使用typeof或mode而不是is;这真的加快了 紧密的内部检查循环。
我可能不得不咬紧牙关并在rcpp中重写它以使其真正具有高性能。
答案 0 :(得分:7)
这个问题分为两部分:
首先,我会避免is()
,因为它已知很慢。这给了:
check_valid <- function (elem, mode) {
if (length(elem) != 1) stop("Must be length 1")
if (mode(elem) != mode) stop("Not desired type")
TRUE
}
现在我们需要弄清楚循环或应用变体是否更快。 我们将以所有输入有效的最坏情况为基准。
worst <- as.list(0:101)
library(microbenchmark)
options(digits = 3)
microbenchmark(
`for` = for(i in seq_along(worst)) check_valid(worst[[i]], "numeric"),
lapply = lapply(worst, check_valid, "numeric"),
vapply = vapply(worst, check_valid, "numeric", FUN.VALUE = logical(1))
)
## Unit: microseconds
## expr min lq median uq max neval
## for 278 293 301 318 1184 100
## lapply 274 282 291 310 1041 100
## vapply 273 284 288 298 1062 100
这三种方法基本相关。 lapply()
非常轻微
更快,可能是因为它使用了特殊的C技巧
现在让我们看一下将列表强制转换为向量的几种方法:
change_mode <- function(x, mode) {
mode(x) <- mode
x
}
microbenchmark(
change_mode = change_mode(worst, "numeric"),
unlist = unlist(worst),
as.vector = as.vector(worst, "numeric")
)
## Unit: microseconds
## expr min lq median uq max neval
## change_mode 19.13 20.83 22.36 23.9 167.51 100
## unlist 2.42 2.75 3.11 3.3 22.58 100
## as.vector 1.79 2.13 2.37 2.6 8.05 100
所以看起来你已经在使用最快的方法和总数了 费用由支票支配。
另一个想法是我们可以通过循环获得更快的速度 在矢量一次,而不是一次检查和一次强制:
as_atomic_for <- function (x, mode) {
out <- vector(mode, length(x))
for (i in seq_along(x)) {
check_valid(x[[i]], mode)
out[i] <- x[[i]]
}
out
}
microbenchmark(
as_atomic_for(worst, "numeric")
)
## Unit: microseconds
## expr min lq median uq max neval
## as_atomic_for(worst, "numeric") 497 524 557 685 1279 100
这肯定更糟。
总而言之,我认为这表明你想要发挥这个功能 更快,你应该尝试在Rcpp中对向量函数进行矢量化。
答案 1 :(得分:4)
尝试:
as_atomic_2 <- function(x, mode) {
if(!length(unique(vapply(x, typeof, ""))) == 1L) stop("mixed types")
as.vector(x, mode)
}
as_atomic_2(list(1, 2, 3), 'numeric')
# [1] 1 2 3
as_atomic_2(list(1, 'a', 2), 'character')
# Error in as_atomic_2(list(1, "a", 2), "character") : mixed types
as_atomic_2(list(1, c(2,3,4), 5), 'numeric' )
# Error in as.vector(x, mode) :
# (list) object cannot be coerced to type 'double'
microbenchmark(
as_atomic( as.list(1:1000), 'numeric'),
as_atomic_2(as.list(1:1000), 'numeric'),
vapply(1:1000, identity, integer(1)),
unit = 'ns'
)
# Unit: nanoseconds
# expr min lq median
# as_atomic(as.list(1:1000), "numeric") 23571781 24059432 24747115.5
# as_atomic_2(as.list(1:1000), "numeric") 1008945 1038749 1062153.5
# vapply(1:1000, identity, integer(1)) 719317 762286 778376.5
答案 2 :(得分:3)
定义自己的函数来进行类型检查似乎是瓶颈。使用其中一个内置函数可以提高速度。但是,调用有所改变(尽管可能会改变它)。以下示例是我能提出的最快版本:
正如使用is.numeric
所述,is.character
提供了最大的加速:
as_atomic2 <- function(l, check_type) {
if (!all(vapply(l, check_type, logical(1)))) stop("")
r <- unlist(l)
if (length(r) != length(l)) stop("")
r
}
以下是我使用原始界面提出的最快速度:
as_atomic3 <- function(l, type) {
if (!all(vapply(l, mode, character(length(type))) == type)) stop("")
r <- unlist(l)
if (length(r) != length(l)) stop("")
r
}
对原文进行基准测试:
res <- microbenchmark(
as_atomic( as.list(1:1000), 'numeric'),
as_atomic2( as.list(1:1000), is.numeric),
as_atomic3( as.list(1:1000), 'numeric'),
unit = 'ns'
)
# expr min lq median uq max neval
# as_atomic(as.list(1:1000), "numeric") 13566275 14399729.0 14793812.0 15093380.5 34037349 100
# as_atomic2(as.list(1:1000), is.numeric) 314328 325977.0 346353.5 369852.5 896991 100
# as_atomic3(as.list(1:1000), "numeric") 856423 899942.5 967705.5 1023238.0 1598593 100