r - 如何从特定工作日开始以 7 天为间隔对数据进行分组

Question

我一直在为此苦苦挣扎。如何以 7 天为间隔对数据进行分组？

基本上我正在尝试 按周五开始的“周”分组 .日期是在周五和下周四之间随机挑选的。由于人为错误，每个时期的观测数量可能不完全相同，尽管通常应该有 7 个。可能会丢失一两个完整时期。

理想的方法似乎是确定每个日期的周期(即从周五开始的周)编号，然后将其添加到另一列的数据集中。

> str(data)
'data.frame':   55 obs. of  15 variables:

 $ id           : num  7 8 9 10 11 12 13 16 17 18 ... 
 $ q_0001       : Factor w/ 2 levels "Yes","No": 1 1 1 1 1 1 2 1 1 1 ...
 $ q_0002       : Factor w/ 2 levels "Yes","No": 2 1 1 1 2 2 2 2 2 2 ...
 $ q_0003       : Factor w/ 2 levels "Yes","No": 2 2 2 1 2 2 2 2 2 2 ...
 $ q_0004       : Factor w/ 2 levels "Yes","No": 1 1 1 1 1 1 2 2 2 2 ...
 $ Assm_Date    : Date, format: "2014-01-04" "2014-01-08" "2014-01-08" ...

为了清楚起见，我删去了不相关的变量。

背景:我们正在做一个健康服务改善项目。我们在从周五到下一个周四期间进行了 7 次随机观察，包括。所以我需要在这 7 天的时间内对问题的答案进行分组(即在问题 1 到 4 中计算"is")。

数据是如何产生的:我们正在研究医院病例的 4 个质量参数(每周大约 40 到 50 个病例)。在前 7 天的案例中，使用 RNG 选择了 7 个。从逻辑上讲，我们可以在周五执行此操作，因此时间段 - 前周五至周四(即昨天)。我们通过 LimeSurvey 界面输入数据。对于每个选定的案例，我们输入案例日期 (Assm_Date) 和 4 个问题(q_0001 到 q_0004)的是/否答案。我需要每周做一次手术，因为我们会做每周进度表。
*lubridate* week()下面建议的方法会很棒

data$week_starting_friday <- week(data$Assm_Date)+5 

但不幸的是，即使我修改它也不起作用(见下文)。我相信这是因为该方法仍然根据 Sun-Mon 或 Mon-Sun 确定日期属于某个周，我想不出一种方法让 lubridate 将周视为周五-周四。

由于项目仍然很小，我可以选择每次在电子表格程序中手动添加周期间编号，我最终可能会采用。但是，如果能在 R 中找到一种可靠地自动化流程的方法，那就太好了。 谢谢大家的回答 - 他们一直非常鼓舞人心，并且在我刚刚学习 R 时就如何使用 R 提出了新的想法。

Answer 1

这是一个基本的解决方案:

# Assumes data is sorted by date
data$week <- cumsum(weekdays(data$Assm_Date) == "Friday")  # highlight week
aggregate(. ~ week, data, function(x) sum(x==1))[-ncol(data)]

计数 Yes的数量按周和问题:

  week q_0001 q_0002 q_0003 q_0004
1    0      1      2      1      1
2    1      4      1      3      3
3    2      2      2      1      4
4    3      4      3      3      4
5    4      5      3      3      2
6    5      5      4      2      2
7    6      4      4      5      5
8    7      6      4      3      5
9    8      2      1      1      3

非基础可能性:

如果你使用像 data.table 这样的附加包(或 dplyr )，你可以得到更好的:

library(data.table)
data.table(data)[, 
  c(
    list(Dates=paste(range(format(Assm_Date, "%b-%d")), collapse=" to ")),
    lapply(
      .SD[, -5, with=F], 
      function(x) paste(names(table(x)), table(x), collapse=";"))
  ),
  by=week
]

产生:

   week            Dates     q_0001     q_0002     q_0003     q_0004
1:    0 Jan-01 to Jan-02 No 1;Yes 1 No 2;Yes 0 No 1;Yes 1 No 1;Yes 1
2:    1 Jan-03 to Jan-09 No 4;Yes 3 No 1;Yes 6 No 3;Yes 4 No 3;Yes 4
3:    2 Jan-10 to Jan-16 No 2;Yes 5 No 2;Yes 5 No 1;Yes 6 No 4;Yes 3
4:    3 Jan-17 to Jan-23 No 4;Yes 3 No 3;Yes 4 No 3;Yes 4 No 4;Yes 3
5:    4 Jan-24 to Jan-30 No 5;Yes 2 No 3;Yes 4 No 3;Yes 4 No 2;Yes 5
6:    5 Feb-01 to Jan-31 No 5;Yes 2 No 4;Yes 3 No 2;Yes 5 No 2;Yes 5
7:    6 Feb-07 to Feb-13 No 4;Yes 3 No 4;Yes 3 No 5;Yes 2 No 5;Yes 2
8:    7 Feb-14 to Feb-20 No 6;Yes 1 No 4;Yes 3 No 3;Yes 4 No 5;Yes 2
9:    8 Feb-21 to Feb-24 No 2;Yes 2 No 1;Yes 3 No 1;Yes 3 No 3;Yes 1

这是我使用的数据:

set.seed(1)
data <- as.data.frame(
  c(
    setNames(replicate(4, sample(c("Yes", "No"), 55, r=T), s=F), paste0("q_000", 1:4)),
    Assm_Date=list(seq(as.Date("2014-01-01"), by="+1 day", len=55))
) )