Эффективное преобразование в векторы в R

Может ли кто-нибудь помочь мне сделать этот код 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 вела себя так, как она; Я не могу переключиться на знакомую мне базовую функцию (например, удалить список), так как мне нужно выдать ошибку для плохих списков.

require(microbenchmark)

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

На моей (довольно быстрой) машине тест имеет частоту около 40 Гц, поэтому эта функция почти всегда ограничивает скорость в моем коде. Бенчмарк vapply control имеет частоту около 1650 Гц, что все еще довольно медленно.

Есть ли способ резко повысить эффективность этой операции? Любые советы приветствуются.

Если необходимы какие-либо разъяснения или правки, пожалуйста, оставьте комментарий ниже.

Редактировать:

Всем здравствуйте,

Извините за очень запоздалый ответ; У меня были экзамены, которые мне нужно было пройти, прежде чем я мог попытаться повторно реализовать это.

Спасибо всем за советы по производительности. Я поднял производительность с ужасных 40 Гц до более приемлемых 600 Гц, используя простой код R.

Наибольшее ускорение было от использования typeof или режима вместо is; это действительно ускорило тесный внутренний цикл проверки.

Мне, вероятно, придется стиснуть зубы и переписать это в rcpp, чтобы сделать его действительно производительным.


r performance benchmarking microbenchmark
person Róisín Grannell    schedule 19.03.2014    source источник
comment
Почему бы не использовать as.numeric(list(1,2,3))? или as.character...   -  person agstudy    schedule 19.03.2014
comment
Эти функции попытаются преобразовать коллекции смешанного типа. Они принуждают элементы других типов к значениям NA, а не выдают ошибку, если список имеет смешанный тип. as.numeric(список(1,2, 'a')) c(1, 2, NA)   -  person Róisín Grannell    schedule 19.03.2014
comment
каков ожидаемый результат с list(1, 'a', 2)?   -  person agstudy    schedule 19.03.2014
comment
извините, сейчас отредактирую....   -  person Róisín Grannell    schedule 19.03.2014
comment
К сожалению нет. unlist не проверяет, что каждый элемент его ввода имеет длину один или что они имеют определенный режим.   -  person Róisín Grannell    schedule 19.03.2014

Ответы (3)


arrow_upward
8
arrow_downward

Эта проблема состоит из двух частей:

  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.

person hadley    schedule 19.03.2014

arrow_upward
4
arrow_downward

Пытаться:

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
person BrodieG    schedule 19.03.2014

arrow_upward
3
arrow_downward

Определение собственной функции для проверки типов кажется узким местом. Использование одной из встроенных функций дает большое ускорение. Однако вызов несколько меняется (хотя, возможно, это можно изменить). Ниже приведены примеры самых быстрых версий, которые я смог придумать:

Как упоминалось при использовании 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
person Jan van der Laan    schedule 19.03.2014