计算所有科目不同的最后两列的平均值

Question

我是 R 初学者，这是我在这里的第一篇文章。我正在努力解决一个问题，并希望得到你的建议。基本上，我有一个包含 3 组列的数据集，我需要完全操纵这些列以获得所需的结果，这是最近两次观察的平均值（并且这些观察必须在截止日期之后发生，例如 3 /15/2018) 是高质量的，但复杂的是，在所有情况下，进入平均值的相关列都不同。

• 第一组数据列与每个案例的观察次数有关，因此受试者一有 2 个观察，受试者二有 3 个，依此类推。

• 第二组列描述了每个观察的数据质量。因此，例如，受试者 1 有两个良好的观察结果，而受试者 2 的第一次观察有 1 个不良数据质量，而后两次观察的数据质量良好，受试者 3 有 3 个质量良好的观察结果和一个观察结果 (obs_3)数据质量差。

• 第三组列指定观察的日期。

    subject_id obs_1 obs_2 obs_3 obs_4 obs_1_dq obs_2_dq obs_3_dq obs_4_dq obs_1_date obs_2_date obs_3_date obs_4_date desired.average
  1          1     5     6    NA    NA     TRUE     TRUE       NA       NA 2018-02-01 2018-03-16       <NA>       <NA>              NA
  2          2     6     8    11    NA    FALSE     TRUE     TRUE       NA 2018-02-18 2018-03-16 2018-04-10       <NA>             9.5
  3          3     7     9    12    15     TRUE     TRUE    FALSE     TRUE 2018-02-15 2018-03-18 2018-04-02 2018-04-10            12.0
  4          4     3     4     8    15     TRUE     TRUE     TRUE     TRUE 2018-02-16 2018-03-08 2018-03-10 2018-03-15              NA
  

为了计算两个具有良好数据质量的最新观测值的平均值：

1. 我必须首先确定哪些观察结果质量好，

2. 然后，计算 3/15 之后发生的平均值（并且必须是 2 个观测值的平均值），并且它们必须是最近的两个观测值。

以下是我的示例数据集。我尝试在 Excel 中手动执行此操作，这真的很辛苦。我希望在 R 中做到这一点，非常感谢您的反馈。谢谢！

Here is my sample dataset: 
> dput(head(df,5))

structure(list(subject_id = c(1, 2, 3, 4), obs_1 = c(5, 6, 7, 
3), obs_2 = c(6, 8, 9, 4), obs_3 = c(NA, 11, 12, 8), obs_4 = c(NA, 
NA, 15, 15), obs_1_dq = c(TRUE, FALSE, TRUE, TRUE), obs_2_dq = c(TRUE, 
TRUE, TRUE, TRUE), obs_3_dq = c(NA, TRUE, FALSE, TRUE), obs_4_dq =    
c(NA, 
NA, TRUE, TRUE), obs_1_date = structure(c(17563, 17580, 17577, 
17578), class = "Date"), obs_2_date = structure(c(17606, 17606, 
17608, 17598), class = "Date"), obs_3_date = structure(c(NA, 
17631, 17623, 17600), class = "Date"), obs_4_date = structure(c(NA, 
NA, 17631, 17605), class = "Date"), desired.average = c(NA, 9.5, 
12, NA)), .Names = c("subject_id", "obs_1", "obs_2", "obs_3", 
"obs_4", "obs_1_dq", "obs_2_dq", "obs_3_dq", "obs_4_dq", "obs_1_date", 
"obs_2_date", "obs_3_date", "obs_4_date", "desired.average"), row.names   
= c(NA, 
4L), class = "data.frame")

Answer 1

看看这是否适合你。代码有简要注释。

df=structure(list(subject_id = c(1, 2, 3, 4), obs_1 = c(5, 6, 7, 
3), obs_2 = c(6, 8, 9, 4), obs_3 = c(NA, 11, 12, 8), obs_4 = c(NA, 
NA, 15, 15), obs_1_dq = c(TRUE, FALSE, TRUE, TRUE), obs_2_dq = c(TRUE, 
TRUE, TRUE, TRUE), obs_3_dq = c(NA, TRUE, FALSE, TRUE), obs_4_dq =    
c(NA, NA, TRUE, TRUE), obs_1_date = structure(c(17563, 17580, 17577, 
17578), class = "Date"), obs_2_date = structure(c(17606, 17606, 
17608, 17598), class = "Date"), obs_3_date = structure(c(NA, 
17631, 17623, 17600), class = "Date"), obs_4_date = structure(c(NA, 
NA, 17631, 17605), class = "Date"), desired.average = c(NA, 9.5, 
12, NA)), .Names = c("subject_id", "obs_1", "obs_2", "obs_3", 
"obs_4", "obs_1_dq", "obs_2_dq", "obs_3_dq", "obs_4_dq", "obs_1_date", 
"obs_2_date", "obs_3_date", "obs_4_date", "desired.average"), row.names   
= c(NA, 4L), class = "data.frame")

# separate each section
obs=df[,2:5]
dq=df[, 6:9]
dt=sapply(df[, 10:13], as.numeric) # for easier calculations
# remove bad quality
obs[dq==F]=NA
# remove dates before 2018-3-15
obs[dt - as.numeric(as.Date("2018-03-15")) <= 0] = NA
# only leave two most recent dates
dt[is.na(obs)]=NA
dt=t(apply(dt,1,function(x){x[x<max(x[x!=max(x, na.rm=T)],na.rm=T)]=NA;x}))
obs[is.na(dt)]=NA
# average
df$avg=apply(obs,1,function(x)ifelse(sum(!is.na(x))>=2, mean(x,na.rm=T), NA))
df

修改： 解释

dt=t(apply(dt,1, function(x){x[x<max(x[x!=max(x, na.rm=T)],na.rm=T)]=NA;x}))

我认为这对x[x<max(x[x!=max(x, na.rm=T)],na.rm=T)]=NA 来说可能有点令人困惑。 na.rm=T 表示删除 NA 值。 max(x[x!=max(x)]) 表示第二大数字。所以x[x < 2nd_largest_num]=NA 只是删除了除最大和第二大之外的任何数字。然后将此函数逐行应用于数据框。最终结果是dt 每行仅包含两个最大的数字（数字格式的最新日期）。所有“丢弃”值（dt 中的 NA）将从下一行 obs[is.na(dt)]=NA 中的 obs 中删除。毕竟，obs 每行只包含两个最近的值。

Answer 2

这也应该有效，虽然有点冗长，但它不依赖于列索引，所以应该很健壮：

library(dplyr)
library(tidyr)

num_date <- as.numeric(as.Date("2018-03-15"))

df <- df[,-ncol(df)]

df_join <- df %>%
  gather(Obs, value, 2:ncol(df)) %>%
  mutate(
    nr = as.numeric(gsub("[^\\d]", "", Obs, perl = TRUE))
  ) %>%
  group_by(subject_id, nr) %>%
  filter(!(is.na(value) | (grepl("_dq", Obs) & value == 0) | any(value[grepl("_date", Obs)] <= num_date))) %>%
  ungroup() %>%
  group_by(subject_id, Obs) %>%
  filter(!row_number() < (max(row_number() - 1))) %>%
  ungroup() %>%
  group_by(subject_id) %>%
  mutate(
    desired.average = mean(value[grepl("_date|_dq", Obs) == FALSE], na.rm = TRUE)
  ) %>%
  filter(!max(row_number()) == 3) %>%
  distinct(subject_id, desired.average)

df <- left_join(df, df_join)

结果：

  subject_id obs_1 obs_2 obs_3 obs_4 obs_1_dq obs_2_dq obs_3_dq obs_4_dq obs_1_date obs_2_date
1          1     5     6    NA    NA     TRUE     TRUE       NA       NA 2018-02-01 2018-03-16
2          2     6     8    11    NA    FALSE     TRUE     TRUE       NA 2018-02-18 2018-03-16
3          3     7     9    12    15     TRUE     TRUE    FALSE     TRUE 2018-02-15 2018-03-18
4          4     3     4     8    15     TRUE     TRUE     TRUE     TRUE 2018-02-16 2018-03-08
  obs_3_date obs_4_date desired.average
1       <NA>       <NA>              NA
2 2018-04-10       <NA>             9.5
3 2018-04-02 2018-04-10            12.0
4 2018-03-10 2018-03-15              NA