正确地将 lapply /apply 应用于 xts 对象并应用 lag.xts - 将结果作为 xts 对象返回答案

【问题标题】：Correctly apply lapply /apply to an xts object and apply lag.xts - return the results as an xts object正确地将 lapply /apply 应用于 xts 对象并应用 lag.xts - 将结果作为 xts 对象返回
【发布时间】：2020-09-13 16:04:43
【问题描述】：

我有一些xts 数据，我想对每一列进行计算。假设我有一些每日收盘价，例如：

           TSLA.Close AMZN.Close MSFT.Close
2017-01-03     216.99     753.67      62.58
2017-01-04     226.99     757.18      62.30
2017-01-05     226.75     780.45      62.30
2017-01-06     229.01     795.99      62.84

我想应用一些函数，如果今天的收盘价高于昨天，则给 1，否则为 0，并将结果存储在新的 xts 对象中。

我有以下 - 将 xts 对象转换为 numeric - 如果我将 apply 更改为 lapply 我会得到一个列表。
但是，我只想返回一个类似于 daily_close xts 对象的 xts 对象。

数据：

library(xts)
library(quantmod)

start_date <- "2017-01-01"
end_date <- "2020-01-01"
symbols = c("TSLA", "AMZN", "MSFT")

dataEnv <- new.env()
getSymbols(symbols, 
           from = start_date, 
           to = end_date, 
           #src = "yahoo", 
           #adjust = TRUE, 
           #env = dataEnv
           )

daily_close <- do.call(merge, lapply(symbols, function(x) Cl(get(x))))

# todays close greater than yesterdays close
x <- apply(daily_close, 2,  FUN = function(x) ifelse (x > lag.xts(x), 1, 0))

【问题讨论】：

标签： r xts

【解决方案1】：

如果我们在分配时做[]，它会保留原来的属性

x <- daily_close
x[] <- apply(daily_close, 2, FUN = function(x) ifelse (x > lag.xts(x), 1, 0))
str(x)
#An ‘xts’ object on 2017-01-03/2019-12-31 containing:
#  Data: num [1:754, 1:3] NA 1 0 1 1 0 0 0 1 0 ...
# - attr(*, "dimnames")=List of 2
#  ..$ : NULL
#  ..$ : chr [1:3] "TSLA.Close" "AMZN.Close" "MSFT.Close"
#  Indexed by objects of class: [Date] TZ: UTC
#...

ifelse 不是必需的

x[] <- apply(daily_close, 2, FUN = function(x) +(x > lag.xts(x)))

【讨论】：