R：如何跨行应用 xts 对象？

Question

我有以下 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) 的行的平均值，这样它 returns 像这样的单个列？

                               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 而是使用其他函数。但是，按照这个answer，其实vapply是最快的。那么这里哪个 apply 函数最好？

Answer 1

你可以转置它并调用 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)

希望有用。

Answer 2

然而，更简单快捷的方法是使用普通的 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)

创建一个数据框

Answer 3

如果您想要每一行的列的平均值，我不会使用 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 用于没有专门实现的通用函数。请注意，如果函数 returns 超过一个值，您将需要转置结果。

(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

为了解决 "why not use vapply()" 的评论，这里有一些基准（使用来自链接到 OP 的代码审查 Q/A 的数据）：

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() 版本更冗长，并且不清楚如果您可以控制对象的类型和被调用的函数，那么 'pre-specified return value' 的安全性有多大好处。也就是说，使用 vapply() 不会造成任何伤害。对于这种情况，我只是更喜欢 apply()。

R：如何跨行应用 xts 对象？

R: how to vapply across rows for xts object?

r

apply

xts