将一致性数据框应用于动物园对象

Apply concordance dataframe to zoo objects

我有一个由多个时间序列组成的动物园对象,如下所示:

indices <- seq.Date(as.Date('2000-01-01'),as.Date('2005-01-30'),by="year")
a <- zoo(rnorm(5), order.by=indices)
b <- zoo(rnorm(5), order.by=indices)
c <- zoo(rnorm(5), order.by=indices)
ts_origin <- merge(a,b,c)

我想将 ts_origin 中的每个动物园系列乘以数据框中包含的比率,一个 put 另一个动物园对象 (ts_final) 中包含时间序列 d、e、f 的结果。换一种说法, 数据框是 a,b,c 和 d,e,f 之间的索引文件,比率将以这种方式应用: ts_final$d = ts_origin$a * 10 ; ts_final$e = ts_origin$b * 100 ; ts_final$f = ts_origin$c * 1000.

df <- data.frame(original = c("a","b","c"),
                 final = c("d","e","f"),
                 ratio = c(10,100,1000))


indices <- seq.Date(as.Date('2000-01-01'),as.Date('2005-01-30'),by="year")
d <- zoo(, order.by=indices)
e <- zoo(, order.by=indices)
f <- zoo(, order.by=indices)
ts_final <- merge(d,e,f)

不太确定最好的方法是什么。我正在尝试使用应用功能,但无法做到 它有效...任何帮助将不胜感激!

这是一个one-liner,个最终名字。

ts_final <- t(df$ratio * t(ts_origin))

ts_final
#                   a         b          c
#2000-01-01 -5.382213 -12.64773  -513.6408
#2001-01-01 -9.218280 -98.55123 -1826.6430
#2002-01-01  2.114663 -28.58910   290.8008
#2003-01-01 -3.576460 -23.47314  -166.5473
#2004-01-01  6.490508 -36.29317  -398.0389
#2005-01-01 -5.382213 -12.64773  -513.6408

现在分配最终名称。

colnames(ts_final) <- df$final

1) Map/merge

使用 Map 迭代 finaloriginalratio 执行生成动物园对象列表 L 所需的产品。请注意,Mapfun 之后的第一个参数中获取名称。然后合并列表组件形成动物园对象 ts_final.

fun <- function(f, o, r) ts_origin[, o] * r
L <- with(df, Map(fun, final, original, ratio))
ts_final <- do.call("merge", L)

使用最后注释中显示的输入的结果是这个动物园对象:

> ts_final
                    d          e          f
2000-01-01 -5.6047565   46.09162   400.7715
2001-01-01 -2.3017749 -126.50612   110.6827
2002-01-01 15.5870831  -68.68529  -555.8411
2003-01-01  0.7050839  -44.56620  1786.9131
2004-01-01  1.2928774  122.40818   497.8505
2005-01-01 17.1506499   35.98138 -1966.6172

2) 扫

另一种方法是 sweep 适当地设置名称的比率给出与 (1) 中相同的结果。

with(df, sweep(setNames(ts_origin[, original], final), 2, ratio, "*"))

3) 代表

设置名称并乘以适当重复的比率,得到与 (1) 相同的结果。

nr <- nrow(df)
with(df, setNames(ts_origin[, original], final) * rep(ratio, each = nr))

备注

我们可以这样定义输入:

set.seed(123)
tt <- as.Date(ISOdate(2000:2005, 1, 1))
m <- matrix(rnorm(6*3), 6, dimnames = list(NULL, c("a", "b", "c")))
ts_origin <- zoo(m, tt)

df <- data.frame(original = c("a","b","c"),
                 final = c("d","e","f"),
                 ratio = c(10,100,1000))