purrr pmap命令查找具有以下课程的课程 [英] 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)

这应该标记:

第1周(星期三)第1课(开始10:15)与第2课(开始11:35开始)

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

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

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

，但目前它标记了以下课程，例如第1周，星期三，课程 2

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

我一直在弄乱 following_lesson()中的filter命令，但是没有运气

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

推荐答案

您可以这样做:

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)

这篇关于purrr pmap命令查找具有以下课程的课程的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！