purrr命令，以查找有以下课程的课程

Question

我有一个学校课程的数据集：

students <- structure(list(Name = c("A", "A", "A", "A", "A", "A", "A", "A", 
"A", "A", "A", "A", "T", "T", "T", "T", "T", "T", "T"), Week = c(1, 
1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 0, 0, 0, 0, 0, 0, 0), Day = c("Friday", 
"Friday", "Thursday", "Thursday", "Tuesday", "Wednesday", "Wednesday", 
"Friday", "Thursday", "Thursday", "Tuesday", "Tuesday", "Friday", 
"Friday", "Friday", "Thursday", "Thursday", "Tuesday", "Wednesday"
), Start = c("09:15", "11:35", "09:15", "11:35", "12:35", "10:15", 
"11:35", "14:20", "09:15", "12:35", "10:15", "12:35", "09:00", 
"10:00", "12:25", "09:00", "11:25", "10:00", "10:00"), End = c("10:15", 
"12:35", "10:15", "12:35", "13:35", "11:15", "12:35", "15:20", 
"10:15", "13:35", "11:15", "13:35", "10:00", "11:00", "13:25", 
"10:00", "12:25", "11:00", "11:00")), class = c("tbl_df", "tbl", 
"data.frame"), row.names = c(NA, -19L))

我想找出我能组织观察的课程。这意味着观察一位老师，然后在课后一小时内反馈给他们。显然，我不能安排一个观察，当一个老师正在教下一节课，所以我需要标记有一个‘下一课’的课程。我的代码如下(来自help here)：

set_hm <- function(time){
  time <- strptime(time, "%H:%M")
  return(time)
}

students_count <- students %>%
  count(Name, Week, Day, End, Start)


following_lesson<- function(.Name, .Week, .Day, .End, .Start){
  students_count %>%
    filter(Name == .Name, Week == .Week, Day == .Day, 
           (set_hm(End) + (60*25) >= set_hm(.Start)),  # check no lesson starting 25 minutes after end of observation lesson
            (set_hm(End) <= set_hm(.Start))) %>%
    pull(n) %>% sum
}

students_count %>% 
  mutate(Flagged = pmap_int(list(Name, Week, Day, End, Start), following_lesson)) %>%
  left_join(students, ., by = c("Name", "Week", "Day", "End", "Start")) %>%
  arrange(Name, Week, Day)

这应标志着：

第一周，星期三，第一课(10:15开始)与第2课(11:35开始)发生冲突

第0周，星期五，第1课(09:00开始)与第2课(10:00开始)发生冲突

但是现在它显示了下面的课程，例如，第一周，星期三，第二课( 2 )

我一直在使用following_lesson()中的filter命令，但没有任何进展

Answer 1

你可以这样做：

library(lubridate)
library(tidyverse)
students%>%
  mutate(End = ymd_hm(paste(today(),End)),
         Start = ymd_hm(paste(today(),Start)))%>%
  group_by(Name, Week, Day)%>%
  mutate(s = lead(Start)-minutes(25)-End <0,
         Start = format(Start,"%H:%M"),
         End = format(End,"%H:%M"))%>%
  filter(s|lag(s))%>%
  mutate(s = NULL)

# A tibble: 4 x 5
# Groups:   Name, Week, Day [2]
  Name   Week Day       Start End  
  <chr> <dbl> <chr>     <chr> <chr>
1 A         1 Wednesday 10:15 11:15
2 A         1 Wednesday 11:35 12:35
3 T         0 Friday    09:00 10:00
4 T         0 Friday    10:00 11:00

看来你真正需要的东西可以减少到：

students%>%
  group_by(Name, Week, Day)%>%
  filter(lead(ymd_hm(paste(today(),Start)))-minutes(25) - ymd_hm(paste(today(),End))<0)