-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy path4 Additional grade adjustments - AS_r.R
138 lines (106 loc) · 7.18 KB
/
4 Additional grade adjustments - AS_r.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
#####################################################################################################
##### Code for assigning grades to small centres and private candidates AS - updated 06/07/20 ######
#####################################################################################################
#load libraries
library(zoo)
#Small centres thresholds
Nthresh<-5
Nsmall<-15
#run small centre function
currentyear_nonprivate_imputedgrades_small<-Imputegrades_smallcentres(currentyear_nonprivate_imputedgrades, outputs=FALSE)
#run private cand function
currentyear_imputedgrades_private<-Imputegrades_privatecentres(currentyear_private, currentyear_nonprivate_imputedgrades_small, outputs=TRUE)
######################## FUNCTIONS - RUN FIRST ###################################################
#small centre function
Imputegrades_smallcentres<-function(currentdata, outputs=FALSE){
#split small and not small centres
smallcentres<-subset(currentdata, Harmoniccands<=Nsmall)
notsmallcentres<-subset(currentdata, Harmoniccands>Nsmall)
#calculate centre level distributions based on CAGs and imputed grades
smallCAGs<-smallcentres%>%group_by(SubjectGroup, CentreNo)%>%
summarise(totalcands=length(CentreAssessedGrade),
Harmoniccands=max(Harmoniccands),
ImputedA=length(UniqueCandidateIdentifier[ImputedGrade%in%c("A")])/totalcands,
ImputedB=length(UniqueCandidateIdentifier[ImputedGrade%in%c("A", "B")])/totalcands,
ImputedC=length(UniqueCandidateIdentifier[ImputedGrade%in%c("A","B","C")])/totalcands,
ImputedD=length(UniqueCandidateIdentifier[ImputedGrade%in%c("A","B","C","D")])/totalcands,
ImputedE=length(UniqueCandidateIdentifier[ImputedGrade%in%c("A","B","C","D","E")])/totalcands,
ImputedU=length(UniqueCandidateIdentifier[ImputedGrade%in%c("A","B","C","D","E","U")])/totalcands,
CAGA=length(UniqueCandidateIdentifier[CentreAssessedGrade%in%c("A")])/totalcands,
CAGB=length(UniqueCandidateIdentifier[CentreAssessedGrade%in%c("A", "B")])/totalcands,
CAGC=length(UniqueCandidateIdentifier[CentreAssessedGrade%in%c("A","B","C")])/totalcands,
CAGD=length(UniqueCandidateIdentifier[CentreAssessedGrade%in%c("A","B","C","D")])/totalcands,
CAGE=length(UniqueCandidateIdentifier[CentreAssessedGrade%in%c("A","B","C","D","E")])/totalcands,
CAGU=length(UniqueCandidateIdentifier[CentreAssessedGrade%in%c("A","B","C","D","E","U")])/totalcands,
Threshmod=ifelse(Harmoniccands<=Nthresh, 1, (Nsmall-Harmoniccands)/(Nsmall-Nthresh))
)%>%ungroup()
#calculate adjusted distributions for small centres
smallmodel<-smallCAGs %>%group_by(SubjectGroup, CentreNo, totalcands)%>%
summarise(PredAsmall=(Threshmod*CAGA)+((1-Threshmod)*(ImputedA)),
PredBsmall=(Threshmod*CAGB)+((1-Threshmod)*(ImputedB)),
PredCsmall=(Threshmod*CAGC)+((1-Threshmod)*(ImputedC)),
PredDsmall=(Threshmod*CAGD)+((1-Threshmod)*(ImputedD)),
PredEsmall=(Threshmod*CAGE)+((1-Threshmod)*(ImputedE)),
PredUsmall=(Threshmod*CAGU)+((1-Threshmod)*(ImputedU))
)%>%ungroup()
smalldata<-left_join(smallcentres, smallmodel, by = c("SubjectGroup", "CentreNo"))
#assign grades to candidates based on rank order and adjusted centre predicted outcomes
smalldata<-smalldata%>%mutate(rankperc=(rank_noprivate-0.5)/totalcands,
maxgrade = case_when(
rankperc <= PredAsmall ~ 5,
rankperc <= PredBsmall ~ 4,
rankperc <= PredCsmall ~ 3,
rankperc <= PredDsmall ~ 2,
rankperc <= PredEsmall ~ 1,
rankperc <= PredUsmall ~ 0,
TRUE ~ NA_real_),
ImputedGrade=dplyr::recode(maxgrade, "5"="A","4"="B","3"="C", "2"="D", "1"="E", "0"="U")
)
#bind back together all centres
alldata<-plyr::rbind.fill(smalldata, notsmallcentres)
#remove variables
alldata<-alldata%>%select(-c(totalcands, rankperc, maxgrade, Harmoniccands,
PredAsmall,PredBsmall,PredCsmall,PredDsmall,PredEsmall,PredUsmall,
rank_noprivate))
#output D17 with small centre adjustment
if (outputs==TRUE){
write_csv(alldata, paste(AwardingOrganisation, QualificationLevel, "outputD17_small.csv", sep="_"))
}
return(alldata)
}
########################## Private candidate function ########################################
Imputegrades_privatecentres<-function(currentdata_private, currentdata, outputs=FALSE){
#bind in private candidate data
allcanddata<-plyr::rbind.fill(currentdata, currentdata_private)
#create rank order including private candidates
allcanddata<-allcanddata%>%group_by(SubjectGroup, CentreNo)%>%
arrange(factor(CentreAssessedGrade, levels=c("A", "B", "C", "D", "E","U")), CentreRankOrder)%>%
mutate(fullrank=1:n())%>%
ungroup()
#create numeric imputed grades an CAGs
allcanddata$NumericImputed<-as.numeric(dplyr::recode(allcanddata$ImputedGrade, "A"=5,"B"=4,"C"=3, "D"=2, "E"=1, "U"=0))
allcanddata$NumericCAG<-as.numeric(dplyr::recode(allcanddata$CentreAssessedGrade, "A"=5,"B"=4,"C"=3, "D"=2, "E"=1, "U"=0))
#impute grades for private candidates
allcanddata<-allcanddata %>% group_by(SubjectGroup, CentreNo)%>%arrange(SubjectGroup, CentreNo, fullrank)%>%
mutate(Nextvalue=na.locf0(NumericImputed, fromLast=TRUE),
Previousvalue=na.locf0(NumericImputed),
Privategrade = case_when(
PrivateCandidate == 1 & Previousvalue==Nextvalue ~ Previousvalue,
PrivateCandidate == 1 & Previousvalue!=Nextvalue & NumericCAG>=Previousvalue ~ Previousvalue,
PrivateCandidate == 1 & Previousvalue!=Nextvalue & NumericCAG<=Nextvalue ~ Nextvalue,
PrivateCandidate == 1 & Previousvalue!=Nextvalue & NumericCAG>Nextvalue & NumericCAG<Previousvalue ~ NumericCAG,
PrivateCandidate == 1 & is.na(Previousvalue) & NumericCAG>=Nextvalue ~ NumericCAG,
PrivateCandidate == 1 & is.na(Previousvalue) & NumericCAG<Nextvalue ~ Nextvalue,
PrivateCandidate == 1 & is.na(Nextvalue) & NumericCAG<=Previousvalue ~ NumericCAG,
PrivateCandidate == 1 & is.na(Nextvalue) & NumericCAG>Previousvalue ~ Previousvalue,
PrivateCandidate == 1 & is.na(Nextvalue) & is.na(Previousvalue) ~ NumericCAG,
TRUE ~ NumericImputed
))%>%ungroup()%>%mutate(
ImputedGrade=dplyr::recode(Privategrade, `5`="A",`4`="B",`3`="C", `2`="D", `1`="E", `0`="U"))%>%
select(-c(NumericImputed, NumericCAG, Nextvalue, Previousvalue, Privategrade, fullrank))
#output D17 with private candidates
if (outputs==TRUE){
write_csv(allcanddata, paste(AwardingOrganisation, QualificationLevel, "outputD17_final.csv", sep="_"))
}
return(allcanddata)
}