时间戳

首页 > 解决方案 > 基于比较行中的日期以及列的标题计算列中的多个变量

r - 基于比较行中的日期以及列的标题计算列中的多个变量

问题描述

我想不出一个简单的方法来做到这一点。

样本数据是：

set.seed(101)
b=sample(seq(as.Date("2010/1/1"), as.Date("2010/1/10"), "days"), 3)
f1=data.frame(a=1:length(b), b=b)
col_names=paste(c('x', 'y'), sort(rep(seq(as.Date("2010/1/1"), as.Date("2010/1/10"), "days"), 2)), sep = '')
set.seed((102))
f2 <- data.frame(matrix(sample(0:5,30, replace = T), ncol = length(col_names), nrow = nrow(f1)))
names(f2)=col_names
f3=data.frame(f1, f2)

或者

dput(f3)
structure(list(a = 1:3, b = structure(c(14613, 14610, 14615), class = "Date"), 
    x2010.01.01 = c(3L, 2L, 4L), y2010.01.01 = c(3L, 0L, 2L), 
    x2010.01.02 = c(5L, 1L, 5L), y2010.01.02 = c(2L, 5L, 4L), 
    x2010.01.03 = c(4L, 2L, 3L), y2010.01.03 = c(5L, 4L, 2L), 
    x2010.01.04 = c(5L, 5L, 5L), y2010.01.04 = c(3L, 3L, 3L), 
    x2010.01.05 = c(1L, 2L, 0L), y2010.01.05 = c(2L, 2L, 2L), 
    x2010.01.06 = c(3L, 2L, 4L), y2010.01.06 = c(3L, 0L, 2L), 
    x2010.01.07 = c(5L, 1L, 5L), y2010.01.07 = c(2L, 5L, 4L), 
    x2010.01.08 = c(4L, 2L, 3L), y2010.01.08 = c(5L, 4L, 2L), 
    x2010.01.09 = c(5L, 5L, 5L), y2010.01.09 = c(3L, 3L, 3L), 
    x2010.01.10 = c(1L, 2L, 0L), y2010.01.10 = c(2L, 2L, 2L)), class = "data.frame", row.names = c(NA, 
-3L))

我试图根据将 b 日期与列标题进行比较来创建新列。我正在计算 1 天平均值、3 天平均值等等。

在第一种情况下，日期是 1 月 4 日，这意味着 1 天 col 将是 x2010.01.04，3 天平均将包括 (x2010.01.04,x2010.01.03,x2010.01.02) 等等。这需要对 x 和 y 变量都进行。

最后 op 应该看起来像

a          b      oneday_avg_x oneday_avg_y threeday_avg_x threeday_avg_y
1 1 2010-01-04          5           3   (5+4+5)/3=4.6            3.3
2 2 2010-01-01          2           0              2              0
3 3 2010-01-06          4           2              3             2.3

让我知道是否缺少任何东西。

标签： r

解决方案

我们可以使用applyfor"x"和"y"values。我们从列名中删除第一个前导"x"和"y"，将其转换为 Date 和match它的b值。从调用中返回该索引以及mean前 3 个索引。apply由于apply将所有内容转换为字符，我们使用type.convert将列转换为适当的类。

x_cols <- grep("^x", names(f3))
y_cols <- grep("^y", names(f3))

out <- f3[1:2]
out[c("oneday_avg_x", "threeday_avg_x")] <- t(apply(f3[c(2, x_cols)], 1, function(x) {
  inds <- match(as.Date(x[[1]]), as.Date(sub("^x", "", names(x)), "%Y.%m.%d"))
  c(x[inds], mean(as.numeric(x[(inds - 2) : inds]), na.rm = TRUE))
}))

out[c("oneday_avg_y", "threeday_avg_y")] <- t(apply(f3[c(2, y_cols)], 1, function(x) {
   inds <- match(as.Date(x[[1]]), as.Date(sub("^y", "", names(x)), "%Y.%m.%d"))
   c(x[inds], mean(as.numeric(x[(inds - 2) : inds]), na.rm = TRUE))
}))

out <- type.convert(out)

out
#  a          b oneday_avg_x threeday_avg_x oneday_avg_y threeday_avg_y
#1 1 2010-01-04            5         4.6667            3         3.3333
#2 2 2010-01-01            2         2.0000            0         0.0000
#3 3 2010-01-06            4         3.0000            2         2.3333

编辑

一种更具可扩展性的解决方案，可以通过使用单个apply

x_cols <- grep("^x", names(f3))
y_cols <- grep("^y", names(f3))
names(f3)[-(1:2)] <- gsub("\\.", "-", sub(".{1}", "", names(f3)[-(1:2)]))
out <- f3[1:2]
num <- c(1, 3)
new_cols  <- c(outer(num, c("x", "y"), function(x, y) paste0(x, "_day_avg_", y)))

out[new_cols] <- t(apply(f3, 1, function(x) {
     x_ind <- match(x[[2]], names(x)[x_cols])
     x_vals <- sapply(num, function(y) 
       mean(as.numeric(x[x_cols][max((x_ind - y + 1), 1):x_ind])))
     y_ind <- match(x[[2]], names(x)[y_cols])
     y_vals <- sapply(num, function(y) 
       mean(as.numeric(x[y_cols][max((y_ind - y + 1), 1):y_ind])))
     c(x_vals, y_vals)
}))


out
#  a          b 1_day_avg_x 3_day_avg_x 1_day_avg_y 3_day_avg_y
#1 1 2010-01-04           5    4.666667           3    3.333333
#2 2 2010-01-01           2    2.000000           0    0.000000
#3 3 2010-01-06           4    3.000000           2    2.333333

推荐阅读