lapply - 根据当前变量创建新变量，有条件地基于第二个数据框中的信息

Question

我一直在从事许多新项目，在这些项目中我正在做许多不熟悉的数据准备和管理。

我有两个数据框：1) 非常大，包含数千个观察值和变量 (df1)，以及 2) 一个数据框，其中列出了 df1 (df2) 中变量子集的收集年份范围。我需要在 df1 中为 df1 中的大量变量/列创建一个新变量。为 df1 创建的新变量将检查值是否存在 (1)、值是否存在于收集的年份 (0) 或值不存在且年份超出列出的收集范围在 df2 ('NA') 中。

我花了几天时间阅读了大量的lapply()，但我似乎找不到一个能满足我的需求或处理复杂类型的文章，这样我就不必用蛮力来做这件事了。

这是我可行的起始数据框：

grp <- c('a', 'a', 'a', 'b', 'b')
year <- c(1991, 1992, 1993, 2005, 2010)
v1 <- c(20.5, 30.5, 29.6, 28.7, 26.1)
v2 <- c(100.0, 101.5, 105.1, 'NA', 95.0)
v3 <- c(47.2, 'NA', 'NA', 'NA', 'NA')
df1 <- data.frame(grp = grp, year = year, v1 = v1, v2 = v2, v3 = v3)
df1

grp year   v1    v2   v3
a   1991  20.5   100 47.2
a   1992  30.5 101.5   NA
a   1993  29.6 105.1   NA
b   2005  28.7    NA   NA
b   2010  26.1    95   NA

这是我的参考数据框，其中包含 df1 中的变量：

vars <- c('v1', 'v2', 'v3')
start <- c(1989, 2004, 1980)
end <- c(2015, 2011, 1994)
df2 <- data.frame(vars = vars, start = start, end = end)
df2

vars start  end
 v1  1989 2015
 v2  2004 2011
 v3  1980 1994

我一直在用“lapply()”学习简单的东西，比如：

test <- df1[paste0(vars, '.cov')] <- lapply(df1[vars], function(x) as.integer(x > 0))

我用 R 写出了我认为需要满足的条件类型。我会用书面英语叙述：

1. 收集到的年份存在值 (1)

   if (!is.na(x)) { x <- 1 }
   

2. 在 df2 (0) 中列出的范围内的年份不存在值

   if (is.na(x) & year %in% seq(df2$start[df2$vars == names(df1[x]), ], df2$end[df2$vars == names(df1[x]), ], 1)) { x <- 0 }
   

3. 值不存在且年份超出 df2 ('NA') 中列出的收集范围

   if (is.na(x) & !(year %in% seq(df2$start[df2$vars == names(df1[x]), ], df2$end[df2$vars == names(df1[x]), ], 1))) { x <- 'NA' }
   

我在语法和索引方面尽了最大努力，但我们正在迅速走出我的舒适区。

运行条件检查后，所需的输出/修改后的 df1 应如下所示：

grp year   v1    v2   v3 v1.cov v2.cov v3.cov
  a 1991 20.5   100 47.2      1      1      1
  a 1992 30.5 101.5   NA      1      1      0
  a 1993 29.6 105.1   NA      1      1      0
  b 2005 28.7    NA   NA      1      0     NA
  b 2010 26.1    95   NA      1      1     NA

我对各种解决方案持开放态度，但这似乎是可行的途径。再次感谢所有帮助。我是一位经验丰富的 R 建模师/科学家，但在过去的一个月里，在您的帮助下，我学到了很多数据准备、“data.table”和“dplyr”。

Answer 1

带data.table：

library(data.table)
setDT(df1)
DT = melt(df1, id = c("grp", "year"), meas = patterns("^v"))[, value := type.convert(as.character(value))]

# mark based on whether found or not within collection periods
DT[df2, on=.(variable = vars, year >= start, year <= end), 
  found := as.integer(!is.na(value))]

# also mark if found outside collection periods
DT[!is.na(value) & is.na(found), found := 1L ]

给了

    grp year variable value found
 1:   a 1991       v1  20.5     1
 2:   a 1992       v1  30.5     1
 3:   a 1993       v1  29.6     1
 4:   b 2005       v1  28.7     1
 5:   b 2010       v1  26.1     1
 6:   a 1991       v2 100.0     1
 7:   a 1992       v2 101.5     1
 8:   a 1993       v2 105.1     1
 9:   b 2005       v2    NA     0
10:   b 2010       v2  95.0     1
11:   a 1991       v3  47.2     1
12:   a 1992       v3    NA     0
13:   a 1993       v3    NA     0
14:   b 2005       v3    NA    NA
15:   b 2010       v3    NA    NA

（type.convert 用于覆盖 OP 对缺失数据的编码，字符串为'NA'。）

---

melt 步骤仅在此处有意义，因为变量似乎属于同一类型（数字）。如果不是，则可以通过遍历每一列来完成类似的操作：

setDT(df1)
setDT(df2)
for (v in unique(df2$vars)){
  df1[, (v) := type.convert(as.character(get(v)))]

  fcol = paste0("found.",v)
  df1[df2[vars == v], on=.(year >= start, year <= end), 
    (fcol) := as.integer(!is.na(get(v)))]
  df1[!is.na(get(v)) & is.na(get(fcol)), (fcol) := 1L ]
}

   grp year   v1    v2   v3 found.v1 found.v2 found.v3
1:   a 1991 20.5 100.0 47.2        1        1        1
2:   a 1992 30.5 101.5   NA        1        1        0
3:   a 1993 29.6 105.1   NA        1        1        0
4:   b 2005 28.7    NA   NA        1        0       NA
5:   b 2010 26.1  95.0   NA        1        1       NA