计算所有主题不同的最后两列的平均值

Question

我是 R 初学者，这是我的第一个 post。我正在为一个问题而苦苦挣扎，希望得到你的建议。基本上，我有一个包含 3 组列的数据集，我需要一起操作这些列以获得所需的结果，这是 2 个最近观察值的平均值（并且这些观察值必须在截止日期之后发生，比如 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

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

我必须先判断哪些观测值质量好，
然后，计算 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 每行只包含两个最大的数字（数字格式的最近日期）。所有 "discarded" 值（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

计算所有主题不同的最后两列的平均值

compute an average of the last two columns which differ for all subjects

conditional

average

r