purrr pmap command to find lessons that have following lessons

问题

I have a dataset of school classes:

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

I want to find out which lessons I can organise an observation in. This means observing a teacher and then feeding back to them over the course of an hour after the lesson. Obviously I can't schedule an observation for when a teacher is teaching next lesson, so I need to flag up lessons that have a 'Following lesson'. My code is this (from 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)

This should flag up:

A Week 1, Wednesday, Lesson 1 (10:15 start) clashes with Lesson 2 (11:35 start)

T Week 0, Friday, Lesson 1 (09:00 start) clashes with Lesson 2 (10:00 start)

but at the moment it flags up the following lessons, e.g. A Week 1, Wednesday, Lesson 2

I've been messing around with the filter command in following_lesson() but having no luck

回答1:

you could do:

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

It seems that what you actually need can be reduced to:

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

来源：https://stackoverflow.com/questions/58915458/purrr-pmap-command-to-find-lessons-that-have-following-lessons

标签

dplyr

purrr