R: Применение функции к XTS объекта

Question

У меня есть объект XTS:

Anchor_Date <- as.Date("2016-04-19") 
End_Date <- as.Date(Anchor_Date + years(5)) 
Number_Days <- End_Date - Anchor_Date 
Xts_Object <- xts(rep(NA, Number_Days + 1), as.Date(Anchor_Date) + 0:Number_Days) 

У меня также есть функция, которая принимает квадрат времени между датой и датой начала в годы:

Time_Squared_Func <- function(Start_Date, Date) { 
    Time_Squared <- as.numeric(((Date - Start_Date)/365)^2) 
    Return (Time_Squared) 
} 

Я хочу применить функцию к объекту xts, используя константу Start_Date = первый день в серии, но аргумент Date - это дата в этой строке объекта xts. Результат должен быть 0, в первом ряду, постепенно увеличивая до 1 на 2017-04-19, 4 на 2018-04-19 и т.д ...

https://codereview.stackexchange.com/questions/39180/best-way-to-apply-across-an-xts-object

Это говорит о том, что vapply гораздо быстрее, чем применять или, если возможно, использование vapply было бы идеальным, но все работает нормально.

спасибо.

Answer 1

Используя lapply и rbind

require(lubridate) 

Anchor_Date <- as.Date("2016-04-19") 
End_Date <- as.Date(Anchor_Date + years(5)) 
Number_Days <- End_Date - Anchor_Date 
Xts_Object <- xts(rep(NA, Number_Days + 1), as.Date(Anchor_Date) + 0:Number_Days) 

Time_Squared_Func <- function(Start_Date, Date) { 
    Time_Diff = as.numeric(Date - Start_Date) 
    Time_Squared <- (Time_Diff/365)^2 
    return (Time_Squared) 
} 

Pass первую дату и каждый индекс строки (дата) к функции Time_Squared_Func и rbind выход для конечного результата

first_date = as.Date(index(first(Xts_Object))) 

ts_lapply = do.call(rbind,lapply(as.Date(index(Xts_Object)),function(x) Time_Squared_Func(first_date ,x))) 

ts_xts = xts(ts_lapply,as.Date(index(Xts_Object))) 

for(i in 1:5) print(ts_xts[Anchor_Date+years(i)]) 
      # [,1] 
# 2017-04-19 1 
      # [,1] 
# 2018-04-19 4 
      # [,1] 
# 2019-04-19 9 
       # [,1] 
# 2020-04-19 16.02193 
       # [,1] 
# 2021-04-19 25.0274