如何在特定工作日开始的7天间隔内对数据进行分组

时间:2014-03-21 12:51:33

标签: r group-by

我一直在努力解决这个问题。我怎样才能在7天的时间间隔内对数据进行分组?

基本上我正在尝试分组#34;周"从星期五开始。在星期五和下周四之间的时段内随机挑选日期。由于人为错误,每个时期的观测数量可能不完全相同,但通常情况下应该是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中)。

如何生成数据:我们正在研究医院病例中的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。

5 个答案:

答案 0 :(得分:3)

这是一个基本解决方案:

# 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))
) )

答案 1 :(得分:2)

结合库巴的建议,我认为您希望汇总每周反对日常的观察结果?

library(lubridate)
library(plyr)
data <- ...

# this defaults to Sunday, but adding 5 will push it to Friday
data$week_starting_friday <- week(data$Assm_Date) + 5

# isolate non-question columns
notQuestionColumns <- data[, !grepl('q_', names(data))]

# convert Yes/No answers to binary
data <- ifelse(data[, grepl('q_', names(data))] == 'Yes', 1, 0)

# combine non-question columns and data
data <- data.frame(notQuestionColumns, data)

# aggregate answers by week
ddply(data, .(week_starting_friday), numcolwise(sum))

答案 2 :(得分:2)

感谢Llopis建议,我看了一个最初看起来很难理解的例子。一旦我明白了,它就非常简单而优雅。解决我的问题:

data$Assmt_Week <- 1+ as.numeric(data$Assm_Date - as.Date("2014-01-03")) %/% 7

结果我在我的数据集中得到另一个变量,它给出了每个观察的正确周数。以上操作是从评估日期中减去期间开始日期,我们得到这些日期之间的天数。然后我们进行整数除法,并知道评估日期和原始开始日期之间已经过了整整几周。我们还加1,这样第一周从1开始,而不是0.就像魅力一样。

可以找到原始问题/解决方案here

dvec <- as.Date("2001-04-01")+0:90
dweek <- as.numeric(dvec-dvec[1]) %/% 7

感谢大家的建议和帮助。

答案 3 :(得分:1)

您的意思是,您在Assm_Date中有七个不同的日期,并且您想要为每个日期和每个问题总结所有“Yeses”吗?在这种情况下,您可以使用daply包中的plyr

require(plyr)
dapply(data, .(Assm_Date), summarize, 
  q1 = sum(q_0001 == "Yes", na.rm = TRUE),
  q2 = sum(q_0002 == "Yes", na.rm = TRUE))

答案 4 :(得分:1)

假设您在数据框df中有一堆随机日期:

  #Create random dates
  df <- data.frame(date=rep(seq.POSIXt(as.POSIXct("2011-11-01 11:23"), by="day", length.out=4), each=4), var=rnorm(4))
  df <- rbind(df,data.frame(date=rep(seq.POSIXt(as.POSIXct("2011-11-02 01:20"), by="day", length.out=4), each=4), var=rnorm(4)))
  df <- rbind(df,data.frame(date=rep(seq.POSIXt(as.POSIXct("2011-11-02 05:13"), by="day", length.out=4), each=4), var=rnorm(4)))
  df <- rbind(df,data.frame(date=rep(seq.POSIXt(as.POSIXct("2011-11-03 18:22"), by="day", length.out=4), each=4), var=rnorm(4)))
  df <- rbind(df,data.frame(date=rep(seq.POSIXt(as.POSIXct("2011-11-11 16:44"), by="day", length.out=4), each=4), var=rnorm(4)))
  df <- rbind(df, data.frame(date=rep(seq.POSIXt(as.POSIXct("2011-11-11 02:26"), by="day", length.out=4), each=4), var=rnorm(4)))
  df <- rbind(df,data.frame(date=rep(seq.POSIXt(as.POSIXct("2011-11-12 13:13"), by="day", length.out=4), each=4), var=rnorm(4)))
  df <- rbind(df,data.frame(date=rep(seq.POSIXt(as.POSIXct("2011-11-13 19:33"), by="day", length.out=4), each=4), var=rnorm(4)))

您可以按照以下方式将其拆分为7天:

   split(df, cut(strptime(paste(df$date, df$time), format="%F %R"),"7 day")) 

在你的例子中尝试这样的事情:

  split(data, cut(strptime(paste(df$Assm_Date), format="%F"),"7 day"))