6

谁能帮我让这个 R 代码更有效率？

我正在尝试编写一个函数，将字符串列表更改为字符串向量，或将数字列表更改为数字向量，将类型化元素列表更改为特定类型的向量。

如果它们具有以下属性，我希望能够将列表更改为特定类型的向量：

  1. 它们是同质类型的。列表中的每个元素都是“字符”或“复杂”等类型。

  2. 列表的每个元素都是长度为一的。

    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”的行为方式。我无法切换到我熟悉的基本函数（例如 unlist），因为我需要为坏列表抛出错误。

require(microbenchmark)

microbenchmark(
    as_atomic( as.list(1:1000), 'numeric'),
    vapply(1:1000, identity, integer(1)),
    unit = 'ns'
)

在我的（相当快的）机器上，基准的频率约为 40Hz，所以这个函数在我的代码中几乎总是速率限制。vapply 控制基准的频率约为 1650Hz，仍然相当慢。

有什么方法可以显着提高此操作的效率吗？任何建议表示赞赏。

如果需要任何澄清或编辑，请在下面发表评论。

编辑：

大家好，

很抱歉很晚才回复；在我可以尝试重新实施之前，我需要参加一些考试。

谢谢大家的性能提示。我使用纯 R 代码将性能从糟糕的 40hz 提高到更可接受的 600hz。

最大的加速来自使用 typeof 或 mode 而不是 is；这确实加快了紧密的内部检查循环。

不过，我可能不得不硬着头皮在 rcpp 中重写它以使其真正发挥作用。

4

3 回答 3

8

这个问题有两个部分：

  1. 检查输入是否有效
  2. 将列表强制为向量

检查有效输入

首先，我会避免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 中的检查函数。

于 2014-03-19T19:09:02.963 回答
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
于 2014-03-19T19:02:03.390 回答
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
于 2014-03-19T19:29:30.883 回答