/
module_structure_operators.R
150 lines (139 loc) · 4.96 KB
/
module_structure_operators.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
139
140
141
142
143
144
145
146
147
148
149
150
#' @include module_class.R
NULL
#' Phase operator: move to next phase
#'
#' \code{\link{changePhase}} is an operator for phase values.
#'
#' @param phase a string containing the current phase in the format \code{P?}, where \code{?} is a number.
#' @param assessment_structure an \code{\linkS4class{assessment_structure}} object.
#'
#' @return a string containing the new phase.
#'
#' @examples
#' ## assessment uses two phases
#' changePhase("P1", assessment_structure_math) ## P2
#' changePhase("P2", assessment_structure_math) ## P1
#'
#' @export
changePhase <- function(phase, assessment_structure) {
phase <- valueOf(phase)
phase <- phase + 1
if (phase > assessment_structure@n_phase) {
phase <- 1
}
phase <- sprintf("P%s", phase)
return(phase)
}
#' Grade operator: add or subtract
#'
#' \code{\link{changeGrade}} is an operator for grade values.
#'
#' @param grade a string containing the current grade in the form \code{G?}, where \code{?} is a number.
#' @param delta a number containing the relative change in grade to apply. \code{0} retains the current grade as-is.
#'
#' @return a string containing the new grade.
#'
#' @examples
#' changeGrade("G4", 0) ## G4
#' changeGrade("G4", 1) ## G5
#' changeGrade("G4", -1) ## G3
#' changeGrade("G10", 1) ## G11
#'
#' @export
changeGrade <- function(grade, delta) {
grade_value <- valueOf(grade)
grade_value <- grade_value + delta
grade <- sprintf("G%s", grade_value)
return(grade)
}
#' Grade operator: difference between two grades
#'
#' \code{\link{getRelativeGrade}} is an operator for grade values.
#'
#' @param current_grade a string containing the current grade in the form \code{G?}, where \code{?} is a number.
#' @param initial_grade a string containing the initial grade in the form \code{G?}, where \code{?} is a number.
#'
#' @return the grade difference of the current grade relative to the initial grade.
#'
#' @examples
#' getRelativeGrade("G4", "G3") ## 1
#' getRelativeGrade("G5", "G3") ## 2
#' getRelativeGrade("G2", "G3") ## -1
#'
#' @export
getRelativeGrade <- function(current_grade, initial_grade) {
current_grade_value <- valueOf(current_grade)
initial_grade_value <- valueOf(initial_grade)
return(current_grade_value - initial_grade_value)
}
#' Test operator: move to next phase
#'
#' \code{\link{changeTest}} is an operator for test values.
#'
#' @param test a string containing the current test in the format \code{T?}, where \code{?} is a number.
#' @param phase a string containing the current phase in the format \code{P?}, where \code{?} is a number.
#' @param assessment_structure an \code{\linkS4class{assessment_structure}} object.
#'
#' @return a string containing the new test.
#'
#' @examples
#' ## assessment uses two phases
#' changeTest("T1", "P1", assessment_structure_math) ## T1
#' changeTest("T1", "P2", assessment_structure_math) ## T2
#'
#' @export
changeTest <- function(test, phase, assessment_structure) {
last_phase <- sprintf("P%s", assessment_structure@n_phase)
if (phase == last_phase) {
test_value <- valueOf(test)
test_value <- test_value + 1
test <- sprintf("T%s", test_value)
return(test)
} else {
return(test)
}
}
#' Create an assessment structure
#'
#' \code{\link{createAssessmentStructure}} is a function for creating an
#' \code{\linkS4class{assessment_structure}} object that defines the structure of the assessment.
#'
#' @param n_test a numeric, the number of test administrations.
#' @param n_phase a numeric, the number of phases within each test.
#' @param route_limit_below the number of grades to allow routing below, relative to the grade of record. If the grade of record is G4 and this is 1, then routing to G3 is allowed but not to G2.
#' @param route_limit_above the number of grades to allow routing above, relative to the grade of record. If the grade of record is G4 and this is 2, then routing to G6 is allowed but not to G7.
#' @param test_routing_restrictions the restrictions for between-test routing. (default = \code{c("R1", "R2", "R3")})
#'
#' @return an \code{\linkS4class{assessment_structure}} object.
#'
#' @examples
#' assessment_structure <- createAssessmentStructure(
#' n_test = 3,
#' n_phase = 2,
#' route_limit_below = 1,
#' route_limit_above = 2
#' )
#'
#' @export
createAssessmentStructure <- function(
n_test, n_phase, route_limit_below, route_limit_above,
test_routing_restrictions = c("R1", "R2", "R3")
) {
o <- new("assessment_structure")
o@n_test <- n_test
o@n_phase <- n_phase
o@route_limit_below <- route_limit_below
o@route_limit_above <- route_limit_above
o@test_routing_restrictions <- test_routing_restrictions
validObject(o)
return(o)
}
#' @noRd
getModulePosition <- function(
phase, test, assessment_structure
) {
all_phases <- rep(sprintf("P%s", 1:assessment_structure@n_phase), assessment_structure@n_test)
all_tests <- rep(sprintf("T%s", 1:assessment_structure@n_test), each = assessment_structure@n_phase)
module_position <- which((phase == all_phases) & (test == all_tests))
return(module_position)
}