Я работаю с данными о пропускной способности в университете. Для каждого студента мне нужно рассчитать процент полученных академических c кредитов по отношению к тому, сколько кредитов должен был получить этот студент, учитывая текущий срок его или ее программы.
Поскольку в моем университете отсутствуют исторические данные, мне нужно будет сделать это путем создания справочной таблицы. Я использую числовой вектор академических c кредитов (представляющих структуру программы) и уникальные даты начала этой программы (представляющие дату начала для "2001 года", "года 2002" и т. Д.) ,
Отсюда я вычисляю значения start_date_point и end_date_point для разных точек в программе. Если Sys.date находится между значениями start_date_points и end_date_points для этого года и программы, тогда ожидаемое количество академических c кредитов - это сумма в этой строке.
Для программы «Экономика» я использую следующий код:
#Extracting unique start dates from fulldata, containing information for each student
sd<-fulldata%>%dplyr::select(UTBILDNINGSTILLFALLE_STARTDATUM)%>%drop_na()%>%unique()
sd<-sd$UTBILDNINGSTILLFALLE_STARTDATUM
#Creating vector with structure of programme
points_ekon<-c(15,15,15,15,7.5,7.5,15,7.5,7.5,15,15,15,30,0)
#taking summer breaks into account
summer_break_ekon<-c(0,0,0,0,1,1,1,1,1,1,2,2,2,2)
ekon_program<-cbind(points_ekon,summer_break_ekon)
ekon_program<-as.data.frame(ekon_program)
#One academic credit equals 1,5 weeks in my country
ekon_program<-ekon_program%>%mutate(weeks_course=points_ekon/1.5)
ekon_program<-ekon_program%>%mutate(points_expected=lag(cumsum(points_ekon)))
ekon_program<-ekon_program%>%mutate(points_expected=ifelse(is.na(points_expected),0,points_expected))
ekon_program<-ekon_program%>%mutate(order=1:n())
ekon_program<-crossing(sd, ekon_program)
ekon_program<-ekon_program%>%arrange(sd, order)
ekon_program<-ekon_program%>%mutate(starttermin=ifelse(order==1,1,0))
ekon_program$kull<-cumsum(ekon_program$starttermin)
#We set start_date to sd-1 since we want to include the first day of school in our calculations
ekon_program<-ekon_program%>%mutate(start_date=sd-1)
ekon_program<-ekon_program%>%group_by(kull)%>%mutate(start_date_points=start_date+lag(cumsum(weeks_course)*7+3*7+summer_break_ekon*12*7))
ekon_program<-ekon_program%>%group_by(kull)%>%mutate(end_date_points=start_date+cumsum(weeks_course)*7+3*7+summer_break_ekon*12*7-1)
ekon_program<-ekon_program%>%mutate(start_date_points=if_else(is.na(start_date_points),start_date,as.Date(start_date_points)))
ekon_program<-ekon_program%>%group_by(start_date)%>%mutate(finished_date=max(start_date_points))
ekon_program<-ekon_program%>%mutate(finished=ifelse(lead(kull, default=0)==kull,0,1))
#Joining with student data, calculating the expected credits for each year
fulldata<-ekon_program%>%
filter((Sys.Date()>finished_date & finished==1)|(Sys.Date()>=start_date_points & Sys.Date()<=end_date_points))%>%
dplyr::select(sd,points_expected)%>%
full_join(fulldata, by=c("sd"="UTBILDNINGSTILLFALLE_STARTDATUM"))
и получаю следующий вывод (справочная таблица, а не данные об ученике):
sd points_ekon summer_break_ekon weeks_course points_expected order starttermin kull start_date start_date_points end_date_points finished_date finished
2016-08-29 7.5 1 5 97.5 9 0 5 2016-08-28 2018-03-11 2018-04-14 2019-06-23 0
2016-08-29 15.0 1 10 105.0 10 0 5 2016-08-28 2018-04-15 2018-06-23 2019-06-23 0
2016-08-29 15.0 2 10 120.0 11 0 5 2016-08-28 2018-06-24 2018-11-24 2019-06-23 0
2016-08-29 15.0 2 10 135.0 12 0 5 2016-08-28 2018-11-25 2019-02-02 2019-06-23 0
2016-08-29 30.0 2 20 150.0 13 0 5 2016-08-28 2019-02-03 2019-06-22 2019-06-23 0
2016-08-29 0.0 2 0 180.0 14 0 5 2016-08-28 2019-06-23 2019-06-22 2019-06-23 1
2017-08-28 15.0 0 10 0.0 1 1 6 2017-08-27 2017-08-27 2017-11-25 2020-06-21 0
2017-08-28 15.0 0 10 15.0 2 0 6 2017-08-27 2017-11-26 2018-02-03 2020-06-21 0
2017-08-28 15.0 0 10 30.0 3 0 6 2017-08-27 2018-02-04 2018-04-14 2020-06-21 0
2017-08-28 15.0 0 10 45.0 4 0 6 2017-08-27 2018-04-15 2018-06-23 2020-06-21 0
2017-08-28 7.5 1 5 60.0 5 0 6 2017-08-27 2018-06-24 2018-10-20 2020-06-21 0
2017-08-28 7.5 1 5 67.5 6 0 6 2017-08-27 2018-10-21 2018-11-24 2020-06-21 0
2017-08-28 15.0 1 10 75.0 7 0 6 2017-08-27 2018-11-25 2019-02-02 2020-06-21 0
2017-08-28 7.5 1 5 90.0 8 0 6 2017-08-27 2019-02-03 2019-03-09 2020-06-21 0
2017-08-28 7.5 1 5 97.5 9 0 6 2017-08-27 2019-03-10 2019-04-13 2020-06-21 0
2017-08-28 15.0 1 10 105.0 10 0 6 2017-08-27 2019-04-14 2019-06-22 2020-06-21 0
2017-08-28 15.0 2 10 120.0 11 0 6 2017-08-27 2019-06-23 2019-11-23 2020-06-21 0
2017-08-28 15.0 2 10 135.0 12 0 6 2017-08-27 2019-11-24 2020-02-01 2020-06-21 0
2017-08-28 30.0 2 20 150.0 13 0 6 2017-08-27 2020-02-02 2020-06-20 2020-06-21 0
2017-08-28 0.0 2 0 180.0 14 0 6 2017-08-27 2020-06-21 2020-06-20 2020-06-21 1
2018-09-03 15.0 0 10 0.0 1 1 7 2018-09-02 2018-09-02 2018-12-01 2021-06-27 0
.... Так, например, ожидается, что у студента-экономиста 2017 года (дата начала 2017-08-27) будет 135 кредитов на сегодняшнюю дату.
Это все хорошо, но мне нужно обобщить это на несколько разных программ, поэтому мне нужно превратить мой код в функцию.
Я попробовал следующее, которое должно извлечь даты начала программы из полных данных, при условии, что я называю векторы кредитов так же, как программы в полных данных:
start_dates<-function(x){
sd<-fulldata%>%
filter(program == as.character(rlang::enexpr(x))) %>%
distinct(UTBILDNINGSTILLFALLE_STARTDATUM)%>%drop_na()
sd<-sd$UTBILDNINGSTILLFALLE_STARTDATUM
}
sdEkonom<-start_dates(Ekonom)
sdMakekonom<-start_dates(Maklarekonom)
sdDititalamedier<-start_dates(Digitala_Medier)
Затем я попробуйте использовать эти значения во второй функции (только с первой частью кода):
reference_table<-function(x,y){
summer_break<-ifelse(cumsum(x)<=60, 0, ifelse(cumsum(x)>60 & cumsum(x)<=120 , 1,2))
program<-cbind(x,summer_break)
program<-as.data.frame(program)
program<-program%>%rename(points=x)
program<-program%>%mutate(weeks_course=points/1.5)
program<-program%>%mutate(points_expected=lag(cumsum(points)))
program<-program%>%mutate(points_expected=ifelse(is.na(points_expected),0,points_expected))
program<-program%>%mutate(order=1:n())
program<-crossing(y, program)
program<-program%>%arrange(sd, order)
}
Я печатаю:
reference_table(Ekonom,sdEkonom)
И сценарий становится бесполезным, заявляя либо " неверный размер (8) в позиции 1, ожидание: 112 "или что мой первый аргумент - это фрейм данных, который явно не является.
Что я делаю неправильно и как я могу заставить эту работу работать?
Входные данные:
Вектор академических c кредитов:
Ekonom<-c(15,15,15,15,7.5,7.5,15,7.5,7.5,15,15,15,30,0)
Выдержка начальных уникальных значений в полных данных:
structure(list(UTBILDNINGSTILLFALLE_STARTDATUM = structure(c(15586,
15586, NA, NA, 15950, 15950, 16314, 16314, 16678, 16678, NA,
16678, 16678, 17042, 17042, 17042, 17042, 17406, 17406, 17406,
17406, 17777, 17777, 17777, 18141, 18141, 18141), class = "Date"),
program = c("Ekonom", "Maklarekonom", "Maklarekonom", "Ekonom",
"Ekonom", "Maklarekonom", "Maklarekonom", "Ekonom", "Maklarekonom",
"Digitala_Medier", "Digitala_Medier", "Ekonom", "Ekonomi COOP",
"Maklarekonom", "Ekonom", "Digitala_Medier", "Ekonomi COOP",
"Ekonom", "Digitala_Medier", "Maklarekonom", "Ekonomi COOP",
"Maklarekonom", "Ekonom", "Digitala_Medier", "Maklarekonom",
"Ekonom", "Digitala_Medier")), class = c("tbl_df", "tbl",
"data.frame"), row.names = c(NA, -27L))