R: как vapply через строки для объекта XTS? - PullRequest
Новая
       45

R: как vapply через строки для объекта XTS?

0 голосов
/ 11 мая 2018

У меня есть следующий объект XTS. 

x <- structure(c(30440.5, 30441, 30441.5, 30441.5, 30441, 30439.5, 30440.5, 30441,
                 30441.5, NA, NA, 30439.5, NA, NA, NA, 30441.5, 30441, NA), .indexTZ = "",
               class = c("xts", "zoo"), .indexCLASS = c("POSIXct", "POSIXt"), 
               tclass = c("POSIXct", "POSIXt"), tzone = "", 
               index = structure(c(1519866931.1185, 1519866931.1255, 1519866931.1255, 
                                   1519866931.1905, 1519866931.1905, 1519866931.1915), 
                                 tzone = "", tclass = c("POSIXct", "POSIXt")), 
               .indexFormat = "%Y-%m-%d %H:%M:%OS",
               .Dim = c(6L, 3L), .Dimnames = list(NULL, c("x", "y", "z")))
#                              x        y        z
# 2018-03-01 09:15:31.118  30440.5  30440.5       NA
# 2018-03-01 09:15:31.125  30441.0  30441.0       NA
# 2018-03-01 09:15:31.125  30441.5  30441.5       NA
# 2018-03-01 09:15:31.190  30441.5       NA  30441.5
# 2018-03-01 09:15:31.190  30441.0       NA  30441.0
# 2018-03-01 09:15:31.191  30439.5  30439.5       NA

Как мне написать vapply, чтобы получить среднее значение по строкам с mean(..., na.rm = TRUE), чтобы он возвращал один столбец, подобный этому? 

                               w       
2018-03-01 09:15:31.118  30440.5
2018-03-01 09:15:31.125  30441.0 
2018-03-01 09:15:31.125  30441.5
2018-03-01 09:15:31.190  30441.5 
2018-03-01 09:15:31.190  30441.0 
2018-03-01 09:15:31.191  30439.5

Я просто не мог заставить его работать.

Я заметил, что многие ответы рекомендуют мне не использовать vapply и использовать вместо этого другие функции. Однако, согласно этому ответу , vapply на самом деле самый быстрый. Итак, какая функция apply здесь лучшая?

Ответы [ 3 ]

0 голосов
/ 11 мая 2018

Однако более простой и быстрый способ сделать это - просто использовать обычную функцию apply.

ОБНОВЛЕНИЕ: rowMeans намного быстрее 

fun1<-function(){
  vapply(as.data.frame(t(xxx)), mean,   na.rm=TRUE,  FUN.VALUE = numeric(length = 1L))
}

fun2<-function(){
  apply(xxx,1,mean,na.rm=TRUE)  
}



fun3<-function(){
   rowMeans(xxx,na.rm=TRUE)
 }
microbenchmark::microbenchmark(fun1(),fun2(),fun3())
Unit: microseconds
   expr     min       lq      mean   median       uq      max neval
 fun1() 288.396 303.4080 413.70495 341.1360 380.6420 5039.409   100
 fun2() 242.173 253.6300 327.49453 266.6665 319.0125 3305.878   100
 fun3()   7.506  10.6665  38.83471  18.7655  23.7035 1950.025   100

В любом случае, чтобы получить желаемый результат, я бы назвал результат w и создал бы кадр данных с data.frame(dttm<-index(xxx),w)

0 голосов
/ 11 мая 2018

Я бы не использовал vapply, если вы хотите среднее значение столбцов для каждой строки. Я бы использовал rowMeans, и обратите внимание, что вы должны преобразовать результат обратно в xts. 

(xmean <- xts(rowMeans(x, na.rm = TRUE), index(x)))
#                        [,1]
# 2018-02-28 19:15:31 30440.5
# 2018-02-28 19:15:31 30441.0
# 2018-02-28 19:15:31 30441.5
# 2018-02-28 19:15:31 30441.5
# 2018-02-28 19:15:31 30441.0
# 2018-02-28 19:15:31 30439.5

И я бы использовал apply для универсальной функции, которая не имеет специализированной реализации. Обратите внимание, что вам нужно будет транспонировать результат, если функция возвращает более одного значения. 

(xmin <- as.xts(apply(x, 1, min, na.rm = TRUE), dateFormat = "POSIXct"))
#                        [,1]
# 2018-02-28 19:15:31 30440.5
# 2018-02-28 19:15:31 30441.0
# 2018-02-28 19:15:31 30441.5
# 2018-02-28 19:15:31 30441.5
# 2018-02-28 19:15:31 30441.0
# 2018-02-28 19:15:31 30439.5
(xrange <- as.xts(t(apply(x, 1, range, na.rm = TRUE)), dateFormat = "POSIXct"))
#                        [,1]    [,2]
# 2018-02-28 19:15:31 30440.5 30440.5
# 2018-02-28 19:15:31 30441.0 30441.0
# 2018-02-28 19:15:31 30441.5 30441.5
# 2018-02-28 19:15:31 30441.5 30441.5
# 2018-02-28 19:15:31 30441.0 30441.0
# 2018-02-28 19:15:31 30439.5 30439.5

Чтобы ответить на комментарий «почему бы не использовать vapply()», вот несколько тестов (используя данные из обзора кода Q / A, с которым связан OP): 

set.seed(21)
xz <- xts(replicate(6, sample(c(1:100), 1000, rep = TRUE)),
          order.by = Sys.Date() + 1:1000)
xrowmean <- function(x) { xts(rowMeans(x, na.rm = TRUE), index(x)) }
xapply <- function(x) { as.xts(apply(x, 1, mean, na.rm = TRUE), dateFormat = "POSIXct") }
xvapply <- function(x) { xts(vapply(seq_len(nrow(x)), function(i) {
    mean(x[i,], na.rm = TRUE) }, FUN.VALUE = numeric(1)), index(x)) }

library(microbenchmark)
microbenchmark(xrowmean(xz), xapply(xz), xvapply(xz))
# Unit: microseconds
#          expr       min         lq       mean     median         uq       max neval
#  xrowmean(xz)   169.496   188.8505   207.1931   204.2455   219.4945   285.329   100
#    xapply(xz) 33477.542 34203.3260 35698.0503 35076.4655 36821.1320 43910.353   100
#   xvapply(xz) 32709.238 35010.1920 37514.7557 35884.3585 37972.7085 84409.961   100

Так почему бы не использовать vapply()? Это не сильно увеличивает производительность. Это немного более многословно, чем версия apply(), и не ясно, есть ли много преимуществ для безопасности «предварительно определенного возвращаемого значения», если у вас есть контроль над типом объекта и вызываемой функцией. Тем не менее, вы не будете причинять никакого вреда, используя vapply(). Я просто предпочитаю apply() для этого случая.

0 голосов
/ 11 мая 2018

Вы можете транспонировать его и вызывать vapply: 

xxx_row_means <- vapply(
  as.data.frame(t(xxx)), 
  function(x) mean(x, na.rm = T), 
  FUN.VALUE = numeric(length = 1L)
)

Или вы можете просто использовать функцию rowMeans (): 

xxx_row_means <- rowMeans(xxx)

Надеюсь, что это работает.

...