Nothing
R/combineSGP.R
In SGP: Student Growth Percentiles & Percentile Growth Trajectories
Defines functions
`combineSGP`
`combineSGP` <-
function(
sgp_object,
state=NULL,
years=NULL,
content_areas=NULL,
sgp.percentiles=TRUE,
sgp.percentiles.baseline=TRUE,
sgp.projections=TRUE,
sgp.projections.baseline=TRUE,
sgp.projections.lagged=TRUE,
sgp.projections.lagged.baseline=TRUE,
sgp.target.scale.scores=FALSE,
sgp.target.scale.scores.only=FALSE,
sgp.target.scale.scores.merge=FALSE,
sgp.target.content_areas=NULL,
max.sgp.target.years.forward=3,
update.all.years=FALSE,
sgp.config=NULL,
sgp.percentiles.equated=NULL,
SGPt=NULL,
fix.duplicates=NULL,
parallel.config=NULL) {
started.at <- proc.time()
messageSGP(paste("Started combineSGP", prettyDate()))
ID <- CONTENT_AREA <- YEAR <- GRADE <- YEAR_INTEGER_TMP <- ACHIEVEMENT_LEVEL <- CATCH_UP_KEEP_UP_STATUS_INITIAL <- MOVE_UP_STAY_UP_STATUS_INITIAL <- VALID_CASE <- N <- SGP <- NULL
MOVE_UP_STAY_UP_STATUS <- CATCH_UP_KEEP_UP_STATUS <- ACHIEVEMENT_LEVEL_PRIOR <- target.type <- SGP_PROJECTION_GROUP <- DUPS_FLAG <- i.DUPS_FLAG <- SCALE_SCORE <- SGP_NORM_GROUP_SCALE_SCORES <- NULL
SGP_NORM_GROUP_BASELINE_SCALE_SCORES <- SGP_NORM_GROUP_EQUATED_SCALE_SCORES <- NULL
tmp.messages <- NULL
### Create slot.data from sgp_object@Data
slot.data <- copy(sgp_object@Data)
### Create state (if missing) from sgp_object (if possible)
if (is.null(state)) {
tmp.name <- toupper(gsub("_", " ", deparse(substitute(sgp_object))))
state <- getStateAbbreviation(tmp.name, "combineSGP")
}
if (is.null(state)) {
tmp.name <- toupper(gsub("_", " ", deparse(substitute(sgp_object))))
tmp.name.position <- sapply(c(datasets::state.name, "AOB", "DEMONSTRATION"), function(x) regexpr(toupper(x), tmp.name))
if (any(tmp.name.position!=-1)) {
state <- c(datasets::state.abb, "AOB", "DEMO")[which(names(sort(tmp.name.position[tmp.name.position!=-1])[1L])==c(datasets::state.name, "AOB", "DEMONSTRATION"))]
} else {
tmp.messages <- c(tmp.messages, "\tNOTE: argument 'state' required for target SGP calculation. Target SGPs will not be calculated.\n")
sgp.projections.lagged <- sgp.projections.lagged.baseline <- FALSE
}
}
### SGP_Configuration arguments
### Create SGP_TARGET_CONTENT_AREA in certain cases
if (is.null(sgp.target.content_areas) & any(sapply(SGP::SGPstateData[[state]][["SGP_Configuration"]][["content_area.projection.sequence"]], function(x) uniqueN(x)) > 1)) {
sgp.target.content_areas <- TRUE
tmp.messages <- c(tmp.messages, "\tNOTE: Multiple content areas detected for student growth targets. 'sgp.target.content_areas set to TRUE.\n")
}
### Check to see if max.sgp.target.years.forward is configured in SGPstateData
if (!is.null(SGP::SGPstateData[[state]][['SGP_Configuration']][['max.sgp.target.years.forward']])) {
max.sgp.target.years.forward <- SGP::SGPstateData[[state]][['SGP_Configuration']][['max.sgp.target.years.forward']]
}
if (!is.null(SGP::SGPstateData[[state]][['SGP_Configuration']][['sgp.projections.projection.unit.label']])) {
projection.unit.label <- SGP::SGPstateData[[state]][['SGP_Configuration']][['sgp.projections.projection.unit.label']]
} else {
projection.unit.label <- "YEAR"
}
### Setup for equated SGPs and scale score targets
preequated <- SGP::SGPstateData[[state]][["Assessment_Program_Information"]][["Assessment_Transition"]][["Preequated_by_Contractor"]]
if (!is.null(year.for.equate <- SGP::SGPstateData[[state]][["Assessment_Program_Information"]][["Assessment_Transition"]][["Year"]])) {
sgp.projections.equated <- NULL
tmp.assessment.years <- sort(unique(sgp_object@Data, by='YEAR')[['YEAR']])
tmp.last.year <- tail(tmp.assessment.years, 1); tmp.first.year <- head(tmp.assessment.years, 1)
if (year.for.equate!=tmp.last.year) { ### Equated percentiles/projections not necessary
sgp.percentiles.equated <- FALSE
} else { ### Equated percentiles/projections necessary
if (!is.null(sgp_object@SGP[['Linkages']])) {
if (!identical(sgp.percentiles.equated, FALSE)) {
sgp.percentiles.equated <- TRUE
if (sgp.target.scale.scores) sgp.projections.equated <- list(Year=tmp.last.year, Linkages=sgp_object@SGP[['Linkages']])
}
} else {
if (!identical(sgp.percentiles.equated, FALSE) && is.null(preequated)) {
messageSGP(paste0("\tNOTE: ", state, " SGPstate meta-data indicates assessment transition in current year but no linkages found in current data. sgp.percentiles.equated set to FALSE."))
sgp.percentiles.equated <- FALSE
}
}
}
} else {
if (identical(sgp.percentiles.equated, TRUE)) {
messageSGP("\tNOTE: 'sgp.percentiles.equated' has been set to TRUE but no meta-data exists in SGPstateData associated with the assessment transition. Equated/linked SGP analyses require meta-data embedded in 'SGPstateData' to correctly work. Contact package administrators on how such data can be added to the package.")
}
sgp.percentiles.equated <- FALSE
sgp.projections.equated <- NULL
}
if (identical(preequated, TRUE)) sgp.percentiles.equated <- TRUE
### fix.duplicates
if (is.null(fix.duplicates) & !is.null(SGP::SGPstateData[[state]][["SGP_Configuration"]][["fix.duplicates"]])) {
fix.duplicates <- SGP::SGPstateData[[state]][["SGP_Configuration"]][["fix.duplicates"]]
}
### Check sgp.target.scale.scores.merge
if (!is.null(SGP::SGPstateData[[state]][["SGP_Configuration"]][["sgp.target.scale.scores.merge"]])) {
sgp.target.scale.scores.merge <- SGP::SGPstateData[[state]][["SGP_Configuration"]][["sgp.target.scale.scores.merge"]]
}
### Check return.target.num.years
if (!is.null(SGP::SGPstateData[[state]][["SGP_Configuration"]][["return.sgp.target.num.years"]])) {
return.sgp.target.num.years <- SGP::SGPstateData[[state]][["SGP_Configuration"]][["return.sgp.target.num.years"]]
} else return.sgp.target.num.years <- FALSE
### Check whether to calculate current year lagged targets
if (1 %in% max.sgp.target.years.forward || identical(SGP::SGPstateData[[state]][["SGP_Configuration"]][['current.year.lagged.target']], TRUE)) current.year.lagged.target <- TRUE else current.year.lagged.target <- FALSE
### Utility functions
get.target.arguments <- function(system.type, target.type=NULL, projection.unit.label, year.for.equate) {
tmp.list <- list()
if (is.null(system.type)) {
if (identical(target.type, c("sgp.projections", "sgp.projections.lagged"))) system.type <- "Cohort Referenced"
if (identical(target.type, c("sgp.projections.baseline", "sgp.projections.lagged.baseline"))) system.type <- "Baseline Referenced"
if (identical(target.type, c("sgp.projections", "sgp.projections.baseline", "sgp.projections.lagged", "sgp.projections.lagged.baseline"))) {
system.type <- "Cohort and Baseline Referenced"
}
}
if (!is.null(target.type)) {
if (identical(target.type, "sgp.projections.lagged")) system.type <- "Cohort Referenced"
if (identical(target.type, "sgp.projections.lagged.baseline")) system.type <- "Baseline Referenced"
if (identical(target.type, c("sgp.projections.lagged", "sgp.projections.lagged.baseline"))) system.type <- "Cohort and Baseline Referenced"
}
if (identical(system.type, "Cohort Referenced")) {
tmp.list[['target.type']] <- intersect(target.type, c("sgp.projections", "sgp.projections.lagged"))
tmp.list[['my.sgp']] <- "SGP"
if (!is.null(year.for.equate) && tmp.first.year < year.for.equate && !sgp.percentiles.equated) {
tmp.variable.name <- paste("SGP_FROM", year.for.equate, sep="_")
messageSGP(paste0("\tNOTE: Due to assessment transition in ", year.for.equate, " SGP_TARGET will be compared to ", tmp.variable.name, ".\n"))
tmp.list[['my.sgp']] <- tmp.variable.name
}
if (!is.null(year.for.equate) && tmp.last.year==year.for.equate && sgp.percentiles.equated) {
messageSGP(paste0("\tNOTE: Due to test transition in ", year.for.equate, " SGP_TARGET will be compared to SGP_EQUATED.\n"))
tmp.list[['my.sgp']] <- "SGP_EQUATED"
}
tmp.list[['my.sgp.target']] <- paste("SGP_TARGET", max.sgp.target.years.forward, projection.unit.label, sep="_")
tmp.list[['my.sgp.target.content_area']] <- paste("SGP_TARGET", max.sgp.target.years.forward, projection.unit.label, "CONTENT_AREA", sep="_")
tmp.list[['my.sgp.target.move.up.stay.up']] <- paste("SGP_TARGET_MOVE_UP_STAY_UP", max.sgp.target.years.forward, projection.unit.label, sep="_")
if (sgp.target.scale.scores) tmp.list[['sgp.target.scale.scores.types']] <- intersect(target.type, c("sgp.projections", "sgp.projections.lagged"))
}
if (identical(system.type, "Baseline Referenced")) {
tmp.list[['target.type']] <- intersect(target.type, c("sgp.projections.baseline", "sgp.projections.lagged.baseline"))
tmp.list[['my.sgp']] <- "SGP_BASELINE"
tmp.list[['my.sgp.target']] <- paste("SGP_TARGET_BASELINE", max.sgp.target.years.forward, projection.unit.label, sep="_")
tmp.list[['my.sgp.target.content_area']] <- paste("SGP_TARGET_BASELINE", max.sgp.target.years.forward, projection.unit.label, "CONTENT_AREA", sep="_")
tmp.list[['my.sgp.target.move.up.stay.up']] <- paste("SGP_TARGET_BASELINE_MOVE_UP_STAY_UP", max.sgp.target.years.forward, projection.unit.label, sep="_")
if (sgp.target.scale.scores) tmp.list[['sgp.target.scale.scores.types']] <- intersect(target.type, c("sgp.projections.baseline", "sgp.projections.lagged.baseline"))
}
if (identical(system.type, "Cohort and Baseline Referenced")) {
tmp.list[['target.type']] <- intersect(target.type, c("sgp.projections", "sgp.projections.baseline", "sgp.projections.lagged", "sgp.projections.lagged.baseline"))
tmp.list[['my.sgp']] <- c("SGP", "SGP_BASELINE")[c(sgp.percentiles, sgp.percentiles.baseline)]
if (!is.null(year.for.equate) && !sgp.percentiles.equated) {
tmp.year.diff <- as.numeric(unlist(strsplit(tail(sort(unique(sgp_object@Data, by='YEAR')[['YEAR']]), 1), "_"))[1L]) - as.numeric(unlist(strsplit(year.for.equate, "_"))[1L])
messageSGP(paste0("\tNOTE: Due to test transition in ", year.for.equate, " SGP_TARGET will utilize ", paste("SGP_MAX_ORDER", tmp.year.diff, sep="_"), ".\n"))
tmp.list[['my.sgp']] <- c(paste("SGP_MAX_ORDER", tmp.year.diff, sep="_"), "SGP_BASELINE")[c(sgp.percentiles, sgp.percentiles.baseline)]
}
if (!is.null(year.for.equate) && tmp.last.year==year.for.equate && sgp.percentiles.equated) {
messageSGP(paste0("\tNOTE: Due to test transition in ", year.for.equate, " SGP_TARGET will be compared to SGP_EQUATED.\n"))
tmp.list[['my.sgp']] <- "SGP_EQUATED"
}
tmp.list[['my.sgp.target']] <- c(paste("SGP_TARGET", max.sgp.target.years.forward, projection.unit.label, sep="_"),
paste("SGP_TARGET_BASELINE", max.sgp.target.years.forward, projection.unit.label, sep="_"))
tmp.list[['my.sgp.target.content_area']] <- c(paste("SGP_TARGET", max.sgp.target.years.forward, projection.unit.label, "CONTENT_AREA", sep="_"),
paste("SGP_TARGET_BASELINE", max.sgp.target.years.forward, projection.unit.label, "CONTENT_AREA", sep="_"))
tmp.list[['my.sgp.target.move.up.stay.up']] <- c(paste("SGP_TARGET_MOVE_UP_STAY_UP", max.sgp.target.years.forward, projection.unit.label, sep="_"),
paste("SGP_TARGET_BASELINE_MOVE_UP_STAY_UP", max.sgp.target.years.forward, projection.unit.label, sep="_"))
if (sgp.target.scale.scores) tmp.list[['sgp.target.scale.scores.types']] <-
intersect(target.type, c("sgp.projections", "sgp.projections.baseline", "sgp.projections.lagged", "sgp.projections.lagged.baseline"))
}
tmp.list[['target.level']] <- c("CATCH_UP_KEEP_UP", "MOVE_UP_STAY_UP")
if (!is.null(SGP::SGPstateData[[state]][["Achievement"]][["Levels"]][["Proficient"]]) &&
length(which(SGP::SGPstateData[[state]][["Achievement"]][["Levels"]][["Proficient"]]=="Proficient")) <= 1) {
tmp.list[['target.level']] <- "CATCH_UP_KEEP_UP"
}
if (!is.null(SGP::SGPstateData[[state]][["SGP_Configuration"]][['sgp.target.types']]) &&
!any(grepl("MUSU", SGP::SGPstateData[[state]][["SGP_Configuration"]][['sgp.target.types']]))) {
tmp.list[['target.level']] <- "CATCH_UP_KEEP_UP"
}
return(tmp.list)
} ### END get.target.arguments
catch_keep_move_functions <- c(min, max)
getTargetData <- function(tmp.target.data, projection_group.iter, tmp.target.level.names) {
if ("YEAR_WITHIN" %in% names(tmp.target.data)) {
tmp.var.names <- c("ID", "CONTENT_AREA", "YEAR", "YEAR_WITHIN", intersect(names(tmp.target.data), c("GRADE", "SGP_PROJECTION_GROUP_SCALE_SCORES")))
} else tmp.var.names <- c("ID", "CONTENT_AREA", "YEAR", intersect(names(tmp.target.data), c("GRADE", "SGP_PROJECTION_GROUP_SCALE_SCORES")))
tmp.data <- tmp.target.data[SGP_PROJECTION_GROUP==projection_group.iter, c(tmp.var.names, tmp.target.level.names), with=FALSE]
na.omit(tmp.data, cols=grep("MOVE_UP_STAY_UP", tmp.target.level.names, invert=TRUE, value=TRUE))
}
############################################################################
### Check update.all.years
############################################################################
if (update.all.years) {
variables.to.null.out <- c(
"SGP", "SGP_NOTE", "SGP_LEVEL", "SGP_STANDARD_ERROR", "SCALE_SCORE_PRIOR", "SCALE_SCORE_PRIOR_STANDARDIZED", "SGP_BASELINE", "SGP_LEVEL_BASELINE",
"SGP_TARGET", "SGP_TARGET_MU", "SGP_TARGET_MU_BASELINE", "SGP_TARGET_MOVE_UP_STAY_UP", "SGP_TARGET_MOVE_UP_STAY_UP_BASELINE", "ACHIEVEMENT_LEVEL_PRIOR",
"CATCH_UP_KEEP_UP_STATUS_INITIAL", "SGP_TARGET_BASELINE", "CATCH_UP_KEEP_UP_STATUS", "CATCH_UP_KEEP_UP_STATUS_BASELINE",
"MOVE_UP_STATUS", "MOVE_UP_STAY_UP_STATUS", "MOVE_UP_STAY_UP_STATUS_BASELINE",
"SGP_NORM_GROUP", "SGP_NORM_GROUP_BASELINE", "SGP_BASELINE_STANDARD_ERROR", "SGP_NORM_GROUP_SCALE_SCORES", "SGP_NORM_GROUP_BASELINE_SCALE_SCORES",
grep("SGP_ORDER", names(slot.data), value=TRUE), grep("SGP_BASELINE_ORDER", names(slot.data), value=TRUE),
grep("SGP_SIMEX", names(slot.data), value=TRUE), grep("SGP_SIMEX_RANKED", names(slot.data), value=TRUE),
grep("PERCENTILE_CUT", names(slot.data), value=TRUE), grep("CONFIDENCE_BOUND", names(slot.data), value=TRUE),
paste("SGP_TARGET", max.sgp.target.years.forward, projection.unit.label, sep="_"),
paste("SGP_TARGET_MOVE_UP_STAY_UP", max.sgp.target.years.forward, projection.unit.label, sep="_"),
paste("SGP_TARGET", max.sgp.target.years.forward, projection.unit.label, "CURRENT", sep="_"),
paste("SGP_TARGET_MOVE_UP_STAY_UP", max.sgp.target.years.forward, projection.unit.label, "CURRENT", sep="_"),
paste("SGP_TARGET_BASELINE", max.sgp.target.years.forward, projection.unit.label, sep="_"),
paste("SGP_TARGET_BASELINE_MOVE_UP_STAY_UP", max.sgp.target.years.forward, projection.unit.label, sep="_"),
paste("SGP_TARGET_BASELINE", max.sgp.target.years.forward, projection.unit.label, "CURRENT", sep="_"),
paste("SGP_TARGET_BASELINE_MOVE_UP_STAY_UP", max.sgp.target.years.forward, projection.unit.label, "CURRENT", sep="_"),
grep("SCALE_SCORE_SGP_TARGET", names(slot.data), value=TRUE))
for (tmp.variables.to.null.out in intersect(names(slot.data), variables.to.null.out)) {
slot.data[,(tmp.variables.to.null.out):=NULL]
}
}
############################################################################
### sgp.percentiles: Merge Cohort Referenced SGPs with student data
############################################################################
## Determine names of Cohort Referenced SGPs
if (!sgp.target.scale.scores.only && length(tmp.names <- getPercentileTableNames(sgp_object, content_areas, state, years, "sgp.percentiles", sgp.percentiles.equated=FALSE)) == 0 && sgp.percentiles) {
tmp.messages <- c(tmp.messages, "\tNOTE: No cohort referenced SGP results available in SGP slot. No cohort referenced SGP results will be merged.\n")
sgp.percentiles <- FALSE
}
if (sgp.percentiles & !sgp.target.scale.scores.only) {
tmp.list <- list()
for (i in tmp.names) {
tmp.list[[i]] <- data.table(
CONTENT_AREA=unlist(strsplit(i, "[.]"))[1L],
YEAR=getTableNameYear(i),
sgp_object@SGP[["SGPercentiles"]][[i]])
}
tmp.data <- data.table(rbindlist(tmp.list, fill=TRUE), VALID_CASE="VALID_CASE", key=key(slot.data))
if (any(duplicated(tmp.data, by=key(tmp.data)))) {
tmp.data <- getPreferredSGP(tmp.data, state)
}
if (!is.null(fix.duplicates) & any(grepl("_DUPS_[0-9]*", tmp.data[["ID"]]))) {
## Strip ID of the _DUPS_ Flag, but keep in a seperate variable (used to merge subsequently)
invisible(tmp.data[, DUPS_FLAG := gsub(".*_DUPS_", "", ID)])
invisible(tmp.data[!grepl("_DUPS_[0-9]*", ID), DUPS_FLAG := NA])
invisible(tmp.data[, ID := gsub("_DUPS_[0-9]*", "", ID)])
## Extend the slot.data if any new rows are required (e.g. dups in prior years) - if not still merge in DUPS_FLAG.
slot.data.extension <- tmp.data[!is.na(DUPS_FLAG), c(key(slot.data), "SGP_NORM_GROUP_SCALE_SCORES", "DUPS_FLAG"), with=FALSE]
tmp.split <- strsplit(as.character(slot.data.extension[["SGP_NORM_GROUP_SCALE_SCORES"]]), "; ")
invisible(slot.data.extension[, SCALE_SCORE := as.numeric(sapply(tmp.split, function(x) rev(x)[1L]))])
invisible(slot.data.extension[, SGP_NORM_GROUP_SCALE_SCORES := NULL])
if ("DUPS_FLAG" %in% names(slot.data)) flag.fix <- TRUE else flag.fix <- FALSE
slot.data <- slot.data.extension[slot.data, on=c(key(slot.data),"SCALE_SCORE"), allow.cartesian=TRUE]
if (flag.fix) { # Merge together DUPS_FLAG from previous years
invisible(slot.data[!is.na(i.DUPS_FLAG) & is.na(DUPS_FLAG), DUPS_FLAG := i.DUPS_FLAG])
invisible(slot.data[, i.DUPS_FLAG := NULL])
}
## Get the row index for variable merge.
tmp.index <- slot.data[tmp.data[, c(getKey(slot.data), "GRADE", "DUPS_FLAG"), with=FALSE], which=TRUE, on=c(getKey(slot.data), "GRADE", "DUPS_FLAG")]
} else {
tmp.index <- slot.data[tmp.data[, key(tmp.data), with=FALSE], which=TRUE, on=key(tmp.data)]
}
variables.to.merge <- setdiff(names(tmp.data), c(getKey(slot.data), "GRADE"))
invisible(slot.data[tmp.index, (variables.to.merge):=tmp.data[, variables.to.merge, with=FALSE]])
setkeyv(slot.data, getKey(slot.data))
}
###################################################################################
### sgp.percentiles.baseline: Merge baseline referenced SGPs with student data
###################################################################################
## Determine names of Baseline Referenced SGPs
if (!sgp.target.scale.scores.only && length(tmp.names <- getPercentileTableNames(sgp_object, content_areas, state, years, "sgp.percentiles.baseline", sgp.percentiles.equated=FALSE))==0 && sgp.percentiles.baseline) {
tmp.messages <- c(tmp.messages, "\tNOTE: No baseline referenced SGP results available in SGP slot. No baseline referenced SGP results will be merged.\n")
sgp.percentiles.baseline <- FALSE
}
if (sgp.percentiles.baseline & !sgp.target.scale.scores.only) {
tmp.list <- list()
for (i in tmp.names) {
tmp.list[[i]] <- data.table(
CONTENT_AREA=unlist(strsplit(i, "[.]"))[1L],
YEAR=getTableNameYear(i),
sgp_object@SGP[["SGPercentiles"]][[i]])
if (is.na(unlist(strsplit(i, "[.]"))[3])) { ### If cohort referenced SGP are to be included in baseline SGP (e.g., Georgia)
setnames(tmp.list[[i]], "SGP", "SGP_BASELINE")
if ("SGP_LEVEL" %in% names(tmp.list[[i]])) setnames(tmp.list[[i]], "SGP_LEVEL", "SGP_LEVEL_BASELINE")
if ("SGP_NORM_GROUP" %in% names(tmp.list[[i]])) setnames(tmp.list[[i]], "SGP_NORM_GROUP", "SGP_NORM_GROUP_BASELINE")
if ("SGP_NORM_GROUP_SCALE_SCORES" %in% names(tmp.list[[i]])) setnames(tmp.list[[i]], "SGP_NORM_GROUP_SCALE_SCORES", "SGP_NORM_GROUP_BASELINE_SCALE_SCORES")
if ("SGP_SIMEX" %in% names(tmp.list[[i]])) setnames(tmp.list[[i]], "SGP_SIMEX", "SGP_SIMEX_BASELINE")
}
}
tmp.data <- data.table(rbindlist(tmp.list, fill=TRUE), VALID_CASE="VALID_CASE", key=key(slot.data))
if (any(duplicated(tmp.data, by=key(tmp.data)))) {
tmp.data <- getPreferredSGP(tmp.data, state, type="BASELINE")
}
if (!is.null(fix.duplicates) & any(grepl("_DUPS_[0-9]*", tmp.data[["ID"]]))) {
## Strip ID of the _DUPS_ Flag, but keep in a seperate variable (used to merge subsequently)
invisible(tmp.data[, DUPS_FLAG := gsub(".*_DUPS_", "", ID)])
invisible(tmp.data[!grepl("_DUPS_[0-9]*", ID), DUPS_FLAG := NA])
invisible(tmp.data[, ID := gsub("_DUPS_[0-9]*", "", ID)])
## Extend the slot.data if any new rows are required (e.g. dups in prior years) - if not still merge in DUPS_FLAG.
slot.data.extension <- tmp.data[!is.na(DUPS_FLAG), c(key(slot.data), "SGP_NORM_GROUP_BASELINE_SCALE_SCORES", "DUPS_FLAG"), with=FALSE]
tmp.split <- strsplit(as.character(slot.data.extension[["SGP_NORM_GROUP_BASELINE_SCALE_SCORES"]]), "; ")
invisible(slot.data.extension[, SCALE_SCORE := as.numeric(sapply(tmp.split, function(x) rev(x)[1L]))])
invisible(slot.data.extension[, SGP_NORM_GROUP_BASELINE_SCALE_SCORES := NULL])
if ("DUPS_FLAG" %in% names(slot.data)) flag.fix <- TRUE else flag.fix <- FALSE
slot.data <- slot.data.extension[slot.data, on=c(key(slot.data),"SCALE_SCORE"), allow.cartesian=TRUE]
if (flag.fix) { # Merge together DUPS_FLAG from previous years
invisible(slot.data[!is.na(i.DUPS_FLAG) & is.na(DUPS_FLAG), DUPS_FLAG := i.DUPS_FLAG])
invisible(slot.data[, i.DUPS_FLAG := NULL])
}
## Get the row index for variable merge.
tmp.index <- slot.data[tmp.data[, c(getKey(slot.data), "GRADE", "DUPS_FLAG"), with=FALSE], which=TRUE, on=c(getKey(slot.data), "GRADE", "DUPS_FLAG")] #
} else {
tmp.index <- slot.data[tmp.data[, key(tmp.data), with=FALSE], which=TRUE, on=key(tmp.data)]
}
variables.to.merge <- setdiff(names(tmp.data), c(getKey(slot.data), "GRADE"))
invisible(slot.data[tmp.index, (variables.to.merge):=tmp.data[, variables.to.merge, with=FALSE]])
setkeyv(slot.data, getKey(slot.data))
}
###################################################################################
### sgp.percentiles.equated: Merge equated SGPs in transition year
###################################################################################
## Determine names of Equated SGPs
if (!sgp.target.scale.scores.only && length(tmp.names <- getPercentileTableNames(sgp_object, content_areas, state, years, "sgp.percentiles", sgp.percentiles.equated=TRUE))==0 && sgp.percentiles.equated) {
tmp.messages <- c(tmp.messages, "\tNOTE: No equated SGP results available in SGP slot. No equated SGP results will be merged.\n")
sgp.percentiles.equated <- FALSE
}
if (sgp.percentiles.equated & !sgp.target.scale.scores.only) {
tmp.list <- list()
for (i in tmp.names) {
tmp.list[[i]] <- data.table(
CONTENT_AREA=unlist(strsplit(i, "[.]"))[1L],
YEAR=getTableNameYear(i),
sgp_object@SGP[["SGPercentiles"]][[i]])
}
tmp.data <- data.table(rbindlist(tmp.list, fill=TRUE), VALID_CASE="VALID_CASE", key=key(slot.data))
if (any(duplicated(tmp.data, by=key(tmp.data)))) {
tmp.data <- getPreferredSGP(tmp.data, state, type="BASELINE")
}
if (!is.null(fix.duplicates) & any(grepl("_DUPS_[0-9]*", tmp.data[["ID"]]))) {
## Strip ID of the _DUPS_ Flag, but keep in a seperate variable (used to merge subsequently)
invisible(tmp.data[, DUPS_FLAG := gsub(".*_DUPS_", "", ID)])
invisible(tmp.data[!grepl("_DUPS_[0-9]*", ID), DUPS_FLAG := NA])
invisible(tmp.data[, ID := gsub("_DUPS_[0-9]*", "", ID)])
## Extend the slot.data if any new rows are required (e.g. dups in prior years) - if not still merge in DUPS_FLAG.
slot.data.extension <- tmp.data[!is.na(DUPS_FLAG), c(key(slot.data), "SGP_NORM_GROUP_EQUATED_SCALE_SCORES", "DUPS_FLAG"), with=FALSE]
tmp.split <- strsplit(as.character(slot.data.extension[["SGP_NORM_GROUP_EQUATED_SCALE_SCORES"]]), "; ")
invisible(slot.data.extension[, SCALE_SCORE := as.numeric(sapply(tmp.split, function(x) rev(x)[1L]))])
invisible(slot.data.extension[, SGP_NORM_GROUP_EQUATED_SCALE_SCORES := NULL])
if ("DUPS_FLAG" %in% names(slot.data)) flag.fix <- TRUE else flag.fix <- FALSE
slot.data <- slot.data.extension[slot.data, on=c(key(slot.data),"SCALE_SCORE"), allow.cartesian=TRUE]
if (flag.fix) { # Merge together DUPS_FLAG from previous years
invisible(slot.data[!is.na(i.DUPS_FLAG) & is.na(DUPS_FLAG), DUPS_FLAG := i.DUPS_FLAG])
invisible(slot.data[, i.DUPS_FLAG := NULL])
}
## Get the row index for variable merge.
tmp.index <- slot.data[tmp.data[, c(getKey(slot.data), "GRADE", "DUPS_FLAG"), with=FALSE], which=TRUE, on=c(getKey(slot.data), "GRADE", "DUPS_FLAG")] #
} else {
tmp.index <- slot.data[tmp.data[, key(tmp.data), with=FALSE], which=TRUE, on=key(tmp.data)]
}
variables.to.merge <- setdiff(names(tmp.data), c(getKey(slot.data), "GRADE"))
invisible(slot.data[tmp.index, (variables.to.merge):=tmp.data[, variables.to.merge, with=FALSE]])
setkeyv(slot.data, getKey(slot.data))
}
######################################################################################
### Create SGP targets (Cohort and Baseline referenced) and merge with student data
######################################################################################
if (!sgp.target.scale.scores.only && length(getPercentileTableNames(sgp_object, content_areas, state, years, "sgp.projections"))==0 && sgp.projections) {
tmp.messages <- c(tmp.messages, "\tNOTE: No SGP projections available in SGP slot. No current year student growth projection targets will be produced.\n")
sgp.projections <- FALSE;
}
if (!sgp.target.scale.scores.only && length(getPercentileTableNames(sgp_object, content_areas, state, years, "sgp.projections.baseline"))==0 && sgp.projections.baseline) {
tmp.messages <- c(tmp.messages, "\tNOTE: No SGP baseline projections available in SGP slot. No current year baseline student growth projection targets will be produced.\n")
sgp.projections.baseline <- FALSE;
}
if (!sgp.target.scale.scores.only && length(getPercentileTableNames(sgp_object, content_areas, state, years, "sgp.projections.lagged"))==0 && sgp.projections.lagged) {
tmp.messages <- c(tmp.messages, "\tNOTE: No SGP lagged projections available in SGP slot. No student growth projection targets will be produced.\n")
sgp.projections.lagged <- FALSE;
}
if (!sgp.target.scale.scores.only && length(getPercentileTableNames(sgp_object, content_areas, state, years, "sgp.projections.lagged.baseline"))==0 && sgp.projections.lagged.baseline) {
tmp.messages <- c(tmp.messages, "\tNOTE: No SGP lagged baseline projections available in SGP slot. No baseline referenced student growth projection targets will be produced.\n")
sgp.projections.lagged.baseline <- FALSE;
}
target.type <- c("sgp.projections", "sgp.projections.baseline", "sgp.projections.lagged", "sgp.projections.lagged.baseline")[
c(sgp.projections, sgp.projections.baseline, sgp.projections.lagged, sgp.projections.lagged.baseline)]
### Calculate Targets
if ((sgp.projections | sgp.projections.baseline | sgp.projections.lagged | sgp.projections.lagged.baseline) & !sgp.target.scale.scores.only) {
target.args <- get.target.arguments(SGP::SGPstateData[[state]][["Growth"]][["System_Type"]], target.type, projection.unit.label, year.for.equate)
for (target.type.iter in target.args[['target.type']]) {
for (target.level.iter in target.args[['target.level']]) {
if (!is.null(fix.duplicates)) {
if (!sgp.percentiles & !sgp.percentiles.baseline) messageSGP("The fix.duplicates='KEEP.ALL' functionality requires that sgp.percentiles = TRUE or percentiles results have already been merged into @Data.")
## Seperate out prior score history of slot.data
if (grepl(".baseline", target.type.iter)) {
tmp.split <-
strsplit(as.character(slot.data[["SGP_NORM_GROUP_BASELINE_SCALE_SCORES"]]), "; ")
} else {
tmp.split <- strsplit(as.character(slot.data[["SGP_NORM_GROUP_SCALE_SCORES"]]), "; ")
}
num.scores <- max(sapply(seq_along(tmp.split), function(f) length(tmp.split[[f]])))
if (num.scores > 2) {
for (tmp.prior in tail(seq(num.scores), -2)) {
invisible(slot.data[, paste0("SCALE_SCORE_PRIOR_", tmp.prior-1L) := as.numeric(sapply(tmp.split, function(x) rev(x)[tmp.prior]))])
}}}
tmp.data <- getTargetSGP(sgp_object, slot.data, content_areas, state, years, target.type.iter, target.level.iter, current.year.lagged.target, max.sgp.target.years.forward, fix.duplicates=fix.duplicates, return.sgp.target.num.years=return.sgp.target.num.years)
if (dim(tmp.data)[1] > 0) {
if (!is.null(fix.duplicates)) dup.by <- c(key(tmp.data), grep("SCALE_SCORE$|SCALE_SCORE_PRIOR", names(tmp.data), value=TRUE)) else dup.by <- key(tmp.data)
if (any(duplicated(tmp.data, by=dup.by))) {
duplicated.projections.tf <- TRUE
tmp.data <- getPreferredSGP(tmp.data, state, type="TARGET", dup.by)
} else duplicated.projections.tf <- FALSE
if (!is.null(fix.duplicates) & any(grepl("_DUPS_[0-9]*", tmp.data[["ID"]]))) {
## Strip ID of the _DUPS_ Flag, Don't use this as DUPS_FLAG (merge in later from SGPercentiles)
invisible(tmp.data[, ID := gsub("_DUPS_[0-9]*", "", ID)])
## Get the row index for variable merge.
if (grepl('lagged', target.type.iter)) {
tmp.index <- slot.data[
tmp.data[, c(intersect(getKey(slot.data), names(tmp.data)), "DUPS_FLAG", grep("SCALE_SCORE_PRIOR", names(tmp.data), value=TRUE)), with=FALSE, nomatch=NA],
which=TRUE, on=c(getKey(slot.data), "DUPS_FLAG", grep("SCALE_SCORE_PRIOR", names(tmp.data), value=TRUE))]
no_match <- tmp.data[which(is.na(tmp.index)),] # usually current year score is NA - still get a lagged projection, but no SGP (& therefore no prior score to merge on)
if (nrow(no_match) > 0) {
no_match.index <- slot.data[no_match[, intersect(getKey(slot.data), names(no_match)), with=FALSE, nomatch=NA], which=TRUE, on=getKey(slot.data)]
if (length(no_match.index) == length(tmp.index[which(is.na(tmp.index))])) {
tmp.index[which(is.na(tmp.index))] <- no_match.index
} else stop("Error in matching LAGGED projections with duplicates in data (most likely student records with a current year SCALE_SCORE == NA).")
}
} else {
setnames(tmp.data, "SGP_PROJECTION_GROUP_SCALE_SCORES", "SGP_PROJECTION_GROUP_SCALE_SCORES_CURRENT")
tmp.index <- slot.data[
tmp.data[, c(intersect(getKey(slot.data), names(tmp.data)), "DUPS_FLAG", grep("SCALE_SCORE$|SCALE_SCORE_PRIOR", names(tmp.data), value=TRUE)), with=FALSE, nomatch=NA],
which=TRUE, on=c(getKey(slot.data), "DUPS_FLAG", grep("SCALE_SCORE$|SCALE_SCORE_PRIOR", names(tmp.data), value=TRUE))]
no_match <- tmp.data[which(is.na(tmp.index)),] # usually current year score is NA - still get a lagged projection, but no SGP (& therefore no prior score to merge on)
if (nrow(no_match) > 0) {
no_match.index <- slot.data[no_match[, intersect(getKey(slot.data), names(no_match)), with=FALSE, nomatch=NA], which=TRUE, on=intersect(getKey(slot.data), names(no_match))]
if (length(no_match.index) == length(tmp.index[which(is.na(tmp.index))])) {
tmp.index[which(is.na(tmp.index))] <- no_match.index
} else stop("Error in matching STRAIGHT (CURRENT) projections with duplicates in data (most likely student records with a current year SCALE_SCORE == NA).")
}
}
} else {
tmp.index <- slot.data[tmp.data[, intersect(dup.by, names(tmp.data)), with=FALSE], which=TRUE, on=dup.by]
}
variables.to.merge <- setdiff(names(tmp.data), c(getKey(slot.data), "DUPS_FLAG", grep("SCALE_SCORE$|SCALE_SCORE_PRIOR", names(tmp.data), value=TRUE)))
invisible(slot.data[tmp.index, (variables.to.merge):=tmp.data[, variables.to.merge, with=FALSE]])
} ### END dim(tmp.data)[1] > 0
}
}
if (duplicated.projections.tf) {
tmp.messages <- c(tmp.messages, paste0(
"\tNOTE: Multiple Projections exist for individual students. Unique SGP Targets will be created using SGP Progression Preference Table for ", state, ".\n"))
}
### SGP_TARGET_CONTENT_AREA calculation
terminal.content_areas <- unique(slot.data[!slot.data[,all(is.na(.SD)), .SDcols=grep("SGP_TARGET", grep(paste(max(max.sgp.target.years.forward), "YEAR", sep="_"), names(slot.data), value=TRUE), value=TRUE), by=seq_len(nrow(slot.data))][['V1']]][['CONTENT_AREA']])
if (!is.null(SGP::SGPstateData[[state]][["SGP_Configuration"]][["content_area.projection.sequence"]])) {
terminal.content_areas <- intersect(terminal.content_areas, sapply(SGP::SGPstateData[[state]][["SGP_Configuration"]][["content_area.projection.sequence"]], tail, 1))
}
if (identical(sgp.target.content_areas, TRUE)) {
for (my.sgp.target.content_area.iter in seq_along(target.args[['my.sgp.target.content_area']])) {
slot.data[!is.na(get(target.args[['my.sgp.target']][my.sgp.target.content_area.iter])), target.args[['my.sgp.target.content_area']][my.sgp.target.content_area.iter] :=
getTargetSGPContentArea(GRADE[1L], CONTENT_AREA[1L], state, my.sgp.target.content_area.iter, target.args[['my.sgp.target.content_area']][my.sgp.target.content_area.iter]),
by=list(GRADE, CONTENT_AREA)]
}
}
### CATCH_UP_KEEP_UP_STATUS Calculation
if ("CATCH_UP_KEEP_UP" %in% target.args[['target.level']] & (sgp.projections.lagged | sgp.projections.lagged.baseline) & "CATCH_UP_KEEP_UP_STATUS_INITIAL" %in% names(slot.data)) {
catch.up.keep.up.levels <- getTargetAchievementLevels(state, "CATCH_UP_KEEP_UP")
slot.data[,CATCH_UP_KEEP_UP_STATUS_INITIAL:=getTargetInitialStatus(ACHIEVEMENT_LEVEL_PRIOR, state, status.type="CATCH_UP_KEEP_UP")]
for (i in seq_along(target.args[['my.sgp']])) {
for (target.years.iter in max.sgp.target.years.forward) {
if (!grepl("BASELINE", target.args[['my.sgp']][i])) {
my.label <- paste("CATCH_UP_KEEP_UP_STATUS", target.years.iter, "YEAR", sep="_")
my.target.label <- paste("SGP_TARGET", target.years.iter, "YEAR", sep="_")
} else {
my.label <- paste("CATCH_UP_KEEP_UP_STATUS_BASELINE", target.years.iter, "YEAR", sep="_")
my.target.label <- paste("SGP_TARGET_BASELINE", target.years.iter, "YEAR", sep="_")
}
if (grepl("FROM", target.args[['my.sgp']][i])) slot.data[YEAR <= year.for.equate, target.args[['my.sgp']][i]:=SGP] ### Get comparison values from before transition
if (my.label %in% names(slot.data)) slot.data[,(my.label):=NULL]
slot.data[,(my.label):=rep(as.character(NA), dim(slot.data)[1L])]
slot.data[CATCH_UP_KEEP_UP_STATUS_INITIAL == "Keeping Up" & get(target.args[['my.sgp']][i]) >= get(my.target.label),
(my.label):="Keep Up: Yes"]
slot.data[CATCH_UP_KEEP_UP_STATUS_INITIAL == "Keeping Up" & get(target.args[['my.sgp']][i]) < get(my.target.label),
(my.label):="Keep Up: No"]
slot.data[CATCH_UP_KEEP_UP_STATUS_INITIAL == "Catching Up" & get(target.args[['my.sgp']][i]) >= get(my.target.label),
(my.label):="Catch Up: Yes"]
slot.data[CATCH_UP_KEEP_UP_STATUS_INITIAL == "Catching Up" & get(target.args[['my.sgp']][i]) < get(my.target.label),
(my.label):="Catch Up: No"]
### CATCH_UP_KEEP_UP clean up based upon reality
slot.data[CATCH_UP_KEEP_UP_STATUS_INITIAL == "Keeping Up" & get(my.label) == "Keep Up: Yes" &
ACHIEVEMENT_LEVEL %in% catch.up.keep.up.levels[['NO']], (my.label):="Keep Up: No"]
slot.data[CATCH_UP_KEEP_UP_STATUS_INITIAL == "Catching Up" & get(my.label) == "Catch Up: No" &
ACHIEVEMENT_LEVEL %in% catch.up.keep.up.levels[['YES']], (my.label):="Catch Up: Yes"]
slot.data[CATCH_UP_KEEP_UP_STATUS_INITIAL == "Catching Up" & get(my.label) == "Catch Up: Yes" &
ACHIEVEMENT_LEVEL %in% catch.up.keep.up.levels[['NO']] &
GRADE == max(type.convert(GRADE[!is.na(get(my.target.label))], as.is=TRUE)) &
CONTENT_AREA %in% terminal.content_areas, (my.label):="Catch Up: No"]
slot.data[CATCH_UP_KEEP_UP_STATUS_INITIAL == "Keeping Up" & get(my.label) == "Keep Up: No" &
ACHIEVEMENT_LEVEL %in% catch.up.keep.up.levels[['YES']] &
GRADE == max(type.convert(GRADE[!is.na(get(my.target.label))], as.is=TRUE)) &
CONTENT_AREA %in% terminal.content_areas, (my.label):="Keep Up: Yes"]
slot.data[,(my.label):=as.factor(get(my.label))]
if (grepl("FROM", target.args[['my.sgp']][i])) slot.data[YEAR <= year.for.equate, target.args[['my.sgp']][i]:=NA]
}
}
}
### MOVE_UP_STAY_UP_STATUS Calculation
if ("MOVE_UP_STAY_UP" %in% target.args[['target.level']] & (sgp.projections.lagged | sgp.projections.lagged.baseline) & "MOVE_UP_STAY_UP_STATUS_INITIAL" %in% names(slot.data)) {
move.up.stay.up.levels <- getTargetAchievementLevels(state, "MOVE_UP_STAY_UP")
slot.data[,MOVE_UP_STAY_UP_STATUS_INITIAL:=getTargetInitialStatus(ACHIEVEMENT_LEVEL_PRIOR, state, status.type="MOVE_UP_STAY_UP")]
for (i in seq_along(target.args[['my.sgp']])) {
for (target.years.iter in max.sgp.target.years.forward) {
if (!grepl("BASELINE", target.args[['my.sgp']][i])) {
my.label <- paste("MOVE_UP_STAY_UP_STATUS", target.years.iter, "YEAR", sep="_")
my.target.label <- paste("SGP_TARGET_MOVE_UP_STAY_UP", target.years.iter, "YEAR", sep="_")
} else {
my.label <- paste("MOVE_UP_STAY_UP_STATUS_BASELINE", target.years.iter, "YEAR", sep="_")
my.target.label <- paste("SGP_TARGET_BASELINE_MOVE_UP_STAY_UP", target.years.iter, "YEAR", sep="_")
}
if (!grepl("BASELINE", target.args[['my.sgp']][i])) my.label <- paste("MOVE_UP_STAY_UP_STATUS", target.years.iter, "YEAR", sep="_") else my.label <- paste("MOVE_UP_STAY_UP_STATUS_BASELINE", target.years.iter, "YEAR", sep="_")
if (grepl("FROM", target.args[['my.sgp']][i])) slot.data[YEAR <= year.for.equate, target.args[['my.sgp']][i]:=SGP]
if (my.label %in% names(slot.data)) slot.data[,(my.label):=NULL]
slot.data[,(my.label):=rep(as.character(NA), dim(slot.data)[1L])]
slot.data[MOVE_UP_STAY_UP_STATUS_INITIAL == "Staying Up" & get(target.args[['my.sgp']][i]) >= get(my.target.label),
(my.label):="Stay Up: Yes"]
slot.data[MOVE_UP_STAY_UP_STATUS_INITIAL == "Staying Up" & get(target.args[['my.sgp']][i]) < get(my.target.label),
(my.label):="Stay Up: No"]
slot.data[MOVE_UP_STAY_UP_STATUS_INITIAL == "Moving Up" & get(target.args[['my.sgp']][i]) >= get(my.target.label),
(my.label):="Move Up: Yes"]
slot.data[MOVE_UP_STAY_UP_STATUS_INITIAL == "Moving Up" & get(target.args[['my.sgp']][i]) < get(my.target.label),
(my.label):="Move Up: No"]
### MOVE_UP_STAY_UP clean up based upon reality
slot.data[MOVE_UP_STAY_UP_STATUS_INITIAL == "Staying Up" & get(my.label) == "Stay Up: Yes" &
ACHIEVEMENT_LEVEL %in% move.up.stay.up.levels[['NO']], (my.label):="Stay Up: No"]
slot.data[MOVE_UP_STAY_UP_STATUS_INITIAL == "Moving Up" & get(my.label) == "Move Up: No" &
ACHIEVEMENT_LEVEL %in% move.up.stay.up.levels[['YES']], (my.label):="Move Up: Yes"]
slot.data[MOVE_UP_STAY_UP_STATUS_INITIAL == "Moving Up" & get(my.label) == "Move Up: Yes" &
ACHIEVEMENT_LEVEL %in% move.up.stay.up.levels[['NO']] &
GRADE == max(type.convert(GRADE[!is.na(get(my.target.label))], as.is=TRUE)) &
CONTENT_AREA %in% terminal.content_areas, (my.label):="Move Up: No"]
slot.data[MOVE_UP_STAY_UP_STATUS_INITIAL == "Staying Up" & get(my.label) == "Stay Up: No" &
ACHIEVEMENT_LEVEL %in% move.up.stay.up.levels[['YES']] &
GRADE == max(type.convert(GRADE[!is.na(get(my.target.label))], as.is=TRUE)) &
CONTENT_AREA %in% terminal.content_areas, (my.label):="Stay Up: Yes"]
slot.data[,(my.label):=as.factor(get(my.label))]
if (grepl("FROM", target.args[['my.sgp']][i])) slot.data[YEAR <= year.for.equate, target.args[['my.sgp']][i]:=NA]
}
}
}
for (i in intersect(names(slot.data), c("CATCH_UP_KEEP_UP_STATUS_INITIAL", "MOVE_UP_STAY_UP_STATUS_INITIAL"))) {
slot.data[,(i):=NULL]
}
} ## END sgp.projections.lagged | sgp.projections.lagged.baseline
###################################################################################################
### Create SGP Scale Score targets (Cohort and Baseline referenced) if requested
###################################################################################################
if (sgp.target.scale.scores) {
if (!exists("target.args")) target.args <- get.target.arguments(SGP::SGPstateData[[state]][["Growth"]][["System_Type"]], target.type, projection.unit.label, year.for.equate)
tmp.target.list <- list()
for (target.type.iter in target.args[['sgp.target.scale.scores.types']]) {
for (target.level.iter in target.args[['target.level']]) {
tmp.target.list[[paste(target.type.iter, target.level.iter)]] <-
data.table(getTargetSGP(sgp_object, slot.data, content_areas, state, years, target.type.iter, target.level.iter, current.year.lagged.target, max.sgp.target.years.forward, return.lagged.status=FALSE, fix.duplicates=fix.duplicates, return.sgp.target.num.years=TRUE),
key=c(getKey(sgp_object), "SGP_PROJECTION_GROUP"))
}
}
tmp.target.data <- data.table(Reduce(function(x, y) merge(x, y, all=TRUE, by=intersect(names(y), names(x))), tmp.target.list[!sapply(tmp.target.list, function(x) dim(x)[1L]==0L)],
accumulate=FALSE), key=getKey(slot.data))
if (!is.null(fix.duplicates)) {
if (any(grepl("_DUPS_[0-9]*", tmp.target.data[["ID"]]))) {
invisible(tmp.target.data[, ID := gsub("_DUPS_[0-9]*", "", ID)])
invisible(tmp.target.data[!is.na(DUPS_FLAG), N := seq.int(.N), by=c(getKey(tmp.target.data))])
}
}
for (projection_group.iter in unique(tmp.target.data[['SGP_PROJECTION_GROUP']])) {
for (target.type.iter in target.args[['sgp.target.scale.scores.types']]) {
if (target.type.iter %in% c("sgp.projections.lagged", "sgp.projections.lagged.baseline")) {
max.sgp.target.years.forward.tmp <- max.sgp.target.years.forward + 1L
if (current.year.lagged.target) max.sgp.target.years.forward.tmp <- c(1, max.sgp.target.years.forward.tmp)
max.sgp.target.years.forward.tmp <- max.sgp.target.years.forward.tmp - 1L
} else max.sgp.target.years.forward.tmp <- max.sgp.target.years.forward
for (target.years.iter in max.sgp.target.years.forward.tmp) {
tmp.target.level.names <- as.character(sapply(target.args[['target.level']], function(x) getTargetName(state, target.type.iter, x, target.years.iter, "SGP_TARGET", projection.unit.label, projection_group.iter)))
if (any(!tmp.target.level.names %in% names(tmp.target.data))) {
tmp.target.data[,tmp.target.level.names[!tmp.target.level.names %in% names(tmp.target.data)]:=as.integer(NA)]
}
tmp.target.level.names.years.to.target <- paste(tmp.target.level.names, "NUM_YEARS_TO_TARGET", sep="_")
targetData <- getTargetData(tmp.target.data, projection_group.iter, c(tmp.target.level.names, tmp.target.level.names.years.to.target))
if (dim(targetData)[1] > 0) {
sgp_object <- getTargetScaleScore(
sgp_object,
state,
targetData,
target.type.iter,
tmp.target.level.names,
tmp.target.level.names.years.to.target,
getYearsContentAreasGrades(state, years=unique(tmp.target.data[SGP_PROJECTION_GROUP==projection_group.iter], by='YEAR')[['YEAR']], content_areas=unique(tmp.target.data[SGP_PROJECTION_GROUP==projection_group.iter], by='CONTENT_AREA')[['CONTENT_AREA']]),
sgp.config=sgp.config,
projection_group.identifier=projection_group.iter,
sgp.projections.equated=if (grepl("baseline", target.type.iter)) NULL else sgp.projections.equated,
SGPt=SGPt,
fix.duplicates=fix.duplicates,
parallel.config=parallel.config)
}
}
}
}
if (length(max.sgp.target.years.forward) > 1) {
for (names.iter in grep("TARGET_SCALE_SCORES", names(sgp_object@SGP$SGProjections), value=TRUE)) {
sgp_object@SGP$SGProjections[[names.iter]] <- sgp_object@SGP$SGProjections[[names.iter]][,lapply(.SD, mean_nan), by=c("ID", "GRADE", "SGP_PROJECTION_GROUP", "SGP_PROJECTION_GROUP_SCALE_SCORES")]
}
}
if (!identical(sgp.target.scale.scores.merge, FALSE)) {
slot.data <- mergeScaleScoreTarget(sgp_object, state, slot.data, years, sgp.target.scale.scores.merge)
}
} ### END if (sgp.target.scale.scores)
### Final clean and put slot.data into @Data slot
if ("DUPS_FLAG" %in% names(slot.data)) invisible(slot.data[, DUPS_FLAG := NULL])
if (any(grepl("SCALE_SCORE_PRIOR_[0-9]", names(slot.data)))) invisible(slot.data[, grep("SCALE_SCORE_PRIOR_[0-9]", names(slot.data), value=TRUE) := NULL])
setkeyv(slot.data, getKey(slot.data))
sgp_object@Data <- slot.data
messageSGP(c(tmp.messages, paste("Finished combineSGP", prettyDate(), "in", convertTime(timetakenSGP(started.at)), "\n")))
return(sgp_object)
} ## END combineSGP Function
Try the SGP package in your browser
Any scripts or data that you put into this service are public.
SGP documentation built on Oct. 23, 2023, 5:08 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions `combineSGP`
`combineSGP` <-
function(
sgp_object,
state=NULL,
years=NULL,
content_areas=NULL,
sgp.percentiles=TRUE,
sgp.percentiles.baseline=TRUE,
sgp.projections=TRUE,
sgp.projections.baseline=TRUE,
sgp.projections.lagged=TRUE,
sgp.projections.lagged.baseline=TRUE,
sgp.target.scale.scores=FALSE,
sgp.target.scale.scores.only=FALSE,
sgp.target.scale.scores.merge=FALSE,
sgp.target.content_areas=NULL,
max.sgp.target.years.forward=3,
update.all.years=FALSE,
sgp.config=NULL,
sgp.percentiles.equated=NULL,
SGPt=NULL,
fix.duplicates=NULL,
parallel.config=NULL) {
started.at <- proc.time()
messageSGP(paste("Started combineSGP", prettyDate()))
ID <- CONTENT_AREA <- YEAR <- GRADE <- YEAR_INTEGER_TMP <- ACHIEVEMENT_LEVEL <- CATCH_UP_KEEP_UP_STATUS_INITIAL <- MOVE_UP_STAY_UP_STATUS_INITIAL <- VALID_CASE <- N <- SGP <- NULL
MOVE_UP_STAY_UP_STATUS <- CATCH_UP_KEEP_UP_STATUS <- ACHIEVEMENT_LEVEL_PRIOR <- target.type <- SGP_PROJECTION_GROUP <- DUPS_FLAG <- i.DUPS_FLAG <- SCALE_SCORE <- SGP_NORM_GROUP_SCALE_SCORES <- NULL
SGP_NORM_GROUP_BASELINE_SCALE_SCORES <- SGP_NORM_GROUP_EQUATED_SCALE_SCORES <- NULL
tmp.messages <- NULL
### Create slot.data from sgp_object@Data
slot.data <- copy(sgp_object@Data)
### Create state (if missing) from sgp_object (if possible)
if (is.null(state)) {
tmp.name <- toupper(gsub("_", " ", deparse(substitute(sgp_object))))
state <- getStateAbbreviation(tmp.name, "combineSGP")
}
if (is.null(state)) {
tmp.name <- toupper(gsub("_", " ", deparse(substitute(sgp_object))))
tmp.name.position <- sapply(c(datasets::state.name, "AOB", "DEMONSTRATION"), function(x) regexpr(toupper(x), tmp.name))
if (any(tmp.name.position!=-1)) {
state <- c(datasets::state.abb, "AOB", "DEMO")[which(names(sort(tmp.name.position[tmp.name.position!=-1])[1L])==c(datasets::state.name, "AOB", "DEMONSTRATION"))]
} else {
tmp.messages <- c(tmp.messages, "\tNOTE: argument 'state' required for target SGP calculation. Target SGPs will not be calculated.\n")
sgp.projections.lagged <- sgp.projections.lagged.baseline <- FALSE
}
}
### SGP_Configuration arguments
### Create SGP_TARGET_CONTENT_AREA in certain cases
if (is.null(sgp.target.content_areas) & any(sapply(SGP::SGPstateData[[state]][["SGP_Configuration"]][["content_area.projection.sequence"]], function(x) uniqueN(x)) > 1)) {
sgp.target.content_areas <- TRUE
tmp.messages <- c(tmp.messages, "\tNOTE: Multiple content areas detected for student growth targets. 'sgp.target.content_areas set to TRUE.\n")
}
### Check to see if max.sgp.target.years.forward is configured in SGPstateData
if (!is.null(SGP::SGPstateData[[state]][['SGP_Configuration']][['max.sgp.target.years.forward']])) {
max.sgp.target.years.forward <- SGP::SGPstateData[[state]][['SGP_Configuration']][['max.sgp.target.years.forward']]
}
if (!is.null(SGP::SGPstateData[[state]][['SGP_Configuration']][['sgp.projections.projection.unit.label']])) {
projection.unit.label <- SGP::SGPstateData[[state]][['SGP_Configuration']][['sgp.projections.projection.unit.label']]
} else {
projection.unit.label <- "YEAR"
}
### Setup for equated SGPs and scale score targets
preequated <- SGP::SGPstateData[[state]][["Assessment_Program_Information"]][["Assessment_Transition"]][["Preequated_by_Contractor"]]
if (!is.null(year.for.equate <- SGP::SGPstateData[[state]][["Assessment_Program_Information"]][["Assessment_Transition"]][["Year"]])) {
sgp.projections.equated <- NULL
tmp.assessment.years <- sort(unique(sgp_object@Data, by='YEAR')[['YEAR']])
tmp.last.year <- tail(tmp.assessment.years, 1); tmp.first.year <- head(tmp.assessment.years, 1)
if (year.for.equate!=tmp.last.year) { ### Equated percentiles/projections not necessary
sgp.percentiles.equated <- FALSE
} else { ### Equated percentiles/projections necessary
if (!is.null(sgp_object@SGP[['Linkages']])) {
if (!identical(sgp.percentiles.equated, FALSE)) {
sgp.percentiles.equated <- TRUE
if (sgp.target.scale.scores) sgp.projections.equated <- list(Year=tmp.last.year, Linkages=sgp_object@SGP[['Linkages']])
}
} else {
if (!identical(sgp.percentiles.equated, FALSE) && is.null(preequated)) {
messageSGP(paste0("\tNOTE: ", state, " SGPstate meta-data indicates assessment transition in current year but no linkages found in current data. sgp.percentiles.equated set to FALSE."))
sgp.percentiles.equated <- FALSE
}
}
}
} else {
if (identical(sgp.percentiles.equated, TRUE)) {
messageSGP("\tNOTE: 'sgp.percentiles.equated' has been set to TRUE but no meta-data exists in SGPstateData associated with the assessment transition. Equated/linked SGP analyses require meta-data embedded in 'SGPstateData' to correctly work. Contact package administrators on how such data can be added to the package.")
}
sgp.percentiles.equated <- FALSE
sgp.projections.equated <- NULL
}
if (identical(preequated, TRUE)) sgp.percentiles.equated <- TRUE
### fix.duplicates
if (is.null(fix.duplicates) & !is.null(SGP::SGPstateData[[state]][["SGP_Configuration"]][["fix.duplicates"]])) {
fix.duplicates <- SGP::SGPstateData[[state]][["SGP_Configuration"]][["fix.duplicates"]]
}
### Check sgp.target.scale.scores.merge
if (!is.null(SGP::SGPstateData[[state]][["SGP_Configuration"]][["sgp.target.scale.scores.merge"]])) {
sgp.target.scale.scores.merge <- SGP::SGPstateData[[state]][["SGP_Configuration"]][["sgp.target.scale.scores.merge"]]
}
### Check return.target.num.years
if (!is.null(SGP::SGPstateData[[state]][["SGP_Configuration"]][["return.sgp.target.num.years"]])) {
return.sgp.target.num.years <- SGP::SGPstateData[[state]][["SGP_Configuration"]][["return.sgp.target.num.years"]]
} else return.sgp.target.num.years <- FALSE
### Check whether to calculate current year lagged targets
if (1 %in% max.sgp.target.years.forward || identical(SGP::SGPstateData[[state]][["SGP_Configuration"]][['current.year.lagged.target']], TRUE)) current.year.lagged.target <- TRUE else current.year.lagged.target <- FALSE
### Utility functions
get.target.arguments <- function(system.type, target.type=NULL, projection.unit.label, year.for.equate) {
tmp.list <- list()
if (is.null(system.type)) {
if (identical(target.type, c("sgp.projections", "sgp.projections.lagged"))) system.type <- "Cohort Referenced"
if (identical(target.type, c("sgp.projections.baseline", "sgp.projections.lagged.baseline"))) system.type <- "Baseline Referenced"
if (identical(target.type, c("sgp.projections", "sgp.projections.baseline", "sgp.projections.lagged", "sgp.projections.lagged.baseline"))) {
system.type <- "Cohort and Baseline Referenced"
}
}
if (!is.null(target.type)) {
if (identical(target.type, "sgp.projections.lagged")) system.type <- "Cohort Referenced"
if (identical(target.type, "sgp.projections.lagged.baseline")) system.type <- "Baseline Referenced"
if (identical(target.type, c("sgp.projections.lagged", "sgp.projections.lagged.baseline"))) system.type <- "Cohort and Baseline Referenced"
}
if (identical(system.type, "Cohort Referenced")) {
tmp.list[['target.type']] <- intersect(target.type, c("sgp.projections", "sgp.projections.lagged"))
tmp.list[['my.sgp']] <- "SGP"
if (!is.null(year.for.equate) && tmp.first.year < year.for.equate && !sgp.percentiles.equated) {
tmp.variable.name <- paste("SGP_FROM", year.for.equate, sep="_")
messageSGP(paste0("\tNOTE: Due to assessment transition in ", year.for.equate, " SGP_TARGET will be compared to ", tmp.variable.name, ".\n"))
tmp.list[['my.sgp']] <- tmp.variable.name
}
if (!is.null(year.for.equate) && tmp.last.year==year.for.equate && sgp.percentiles.equated) {
messageSGP(paste0("\tNOTE: Due to test transition in ", year.for.equate, " SGP_TARGET will be compared to SGP_EQUATED.\n"))
tmp.list[['my.sgp']] <- "SGP_EQUATED"
}
tmp.list[['my.sgp.target']] <- paste("SGP_TARGET", max.sgp.target.years.forward, projection.unit.label, sep="_")
tmp.list[['my.sgp.target.content_area']] <- paste("SGP_TARGET", max.sgp.target.years.forward, projection.unit.label, "CONTENT_AREA", sep="_")
tmp.list[['my.sgp.target.move.up.stay.up']] <- paste("SGP_TARGET_MOVE_UP_STAY_UP", max.sgp.target.years.forward, projection.unit.label, sep="_")
if (sgp.target.scale.scores) tmp.list[['sgp.target.scale.scores.types']] <- intersect(target.type, c("sgp.projections", "sgp.projections.lagged"))
}
if (identical(system.type, "Baseline Referenced")) {
tmp.list[['target.type']] <- intersect(target.type, c("sgp.projections.baseline", "sgp.projections.lagged.baseline"))
tmp.list[['my.sgp']] <- "SGP_BASELINE"
tmp.list[['my.sgp.target']] <- paste("SGP_TARGET_BASELINE", max.sgp.target.years.forward, projection.unit.label, sep="_")
tmp.list[['my.sgp.target.content_area']] <- paste("SGP_TARGET_BASELINE", max.sgp.target.years.forward, projection.unit.label, "CONTENT_AREA", sep="_")
tmp.list[['my.sgp.target.move.up.stay.up']] <- paste("SGP_TARGET_BASELINE_MOVE_UP_STAY_UP", max.sgp.target.years.forward, projection.unit.label, sep="_")
if (sgp.target.scale.scores) tmp.list[['sgp.target.scale.scores.types']] <- intersect(target.type, c("sgp.projections.baseline", "sgp.projections.lagged.baseline"))
}
if (identical(system.type, "Cohort and Baseline Referenced")) {
tmp.list[['target.type']] <- intersect(target.type, c("sgp.projections", "sgp.projections.baseline", "sgp.projections.lagged", "sgp.projections.lagged.baseline"))
tmp.list[['my.sgp']] <- c("SGP", "SGP_BASELINE")[c(sgp.percentiles, sgp.percentiles.baseline)]
if (!is.null(year.for.equate) && !sgp.percentiles.equated) {
tmp.year.diff <- as.numeric(unlist(strsplit(tail(sort(unique(sgp_object@Data, by='YEAR')[['YEAR']]), 1), "_"))[1L]) - as.numeric(unlist(strsplit(year.for.equate, "_"))[1L])
messageSGP(paste0("\tNOTE: Due to test transition in ", year.for.equate, " SGP_TARGET will utilize ", paste("SGP_MAX_ORDER", tmp.year.diff, sep="_"), ".\n"))
tmp.list[['my.sgp']] <- c(paste("SGP_MAX_ORDER", tmp.year.diff, sep="_"), "SGP_BASELINE")[c(sgp.percentiles, sgp.percentiles.baseline)]
}
if (!is.null(year.for.equate) && tmp.last.year==year.for.equate && sgp.percentiles.equated) {
messageSGP(paste0("\tNOTE: Due to test transition in ", year.for.equate, " SGP_TARGET will be compared to SGP_EQUATED.\n"))
tmp.list[['my.sgp']] <- "SGP_EQUATED"
}
tmp.list[['my.sgp.target']] <- c(paste("SGP_TARGET", max.sgp.target.years.forward, projection.unit.label, sep="_"),
paste("SGP_TARGET_BASELINE", max.sgp.target.years.forward, projection.unit.label, sep="_"))
tmp.list[['my.sgp.target.content_area']] <- c(paste("SGP_TARGET", max.sgp.target.years.forward, projection.unit.label, "CONTENT_AREA", sep="_"),
paste("SGP_TARGET_BASELINE", max.sgp.target.years.forward, projection.unit.label, "CONTENT_AREA", sep="_"))
tmp.list[['my.sgp.target.move.up.stay.up']] <- c(paste("SGP_TARGET_MOVE_UP_STAY_UP", max.sgp.target.years.forward, projection.unit.label, sep="_"),
paste("SGP_TARGET_BASELINE_MOVE_UP_STAY_UP", max.sgp.target.years.forward, projection.unit.label, sep="_"))
if (sgp.target.scale.scores) tmp.list[['sgp.target.scale.scores.types']] <-
intersect(target.type, c("sgp.projections", "sgp.projections.baseline", "sgp.projections.lagged", "sgp.projections.lagged.baseline"))
}
tmp.list[['target.level']] <- c("CATCH_UP_KEEP_UP", "MOVE_UP_STAY_UP")
if (!is.null(SGP::SGPstateData[[state]][["Achievement"]][["Levels"]][["Proficient"]]) &&
length(which(SGP::SGPstateData[[state]][["Achievement"]][["Levels"]][["Proficient"]]=="Proficient")) <= 1) {
tmp.list[['target.level']] <- "CATCH_UP_KEEP_UP"
}
if (!is.null(SGP::SGPstateData[[state]][["SGP_Configuration"]][['sgp.target.types']]) &&
!any(grepl("MUSU", SGP::SGPstateData[[state]][["SGP_Configuration"]][['sgp.target.types']]))) {
tmp.list[['target.level']] <- "CATCH_UP_KEEP_UP"
}
return(tmp.list)
} ### END get.target.arguments
catch_keep_move_functions <- c(min, max)
getTargetData <- function(tmp.target.data, projection_group.iter, tmp.target.level.names) {
if ("YEAR_WITHIN" %in% names(tmp.target.data)) {
tmp.var.names <- c("ID", "CONTENT_AREA", "YEAR", "YEAR_WITHIN", intersect(names(tmp.target.data), c("GRADE", "SGP_PROJECTION_GROUP_SCALE_SCORES")))
} else tmp.var.names <- c("ID", "CONTENT_AREA", "YEAR", intersect(names(tmp.target.data), c("GRADE", "SGP_PROJECTION_GROUP_SCALE_SCORES")))
tmp.data <- tmp.target.data[SGP_PROJECTION_GROUP==projection_group.iter, c(tmp.var.names, tmp.target.level.names), with=FALSE]
na.omit(tmp.data, cols=grep("MOVE_UP_STAY_UP", tmp.target.level.names, invert=TRUE, value=TRUE))
}
############################################################################
### Check update.all.years
############################################################################
if (update.all.years) {
variables.to.null.out <- c(
"SGP", "SGP_NOTE", "SGP_LEVEL", "SGP_STANDARD_ERROR", "SCALE_SCORE_PRIOR", "SCALE_SCORE_PRIOR_STANDARDIZED", "SGP_BASELINE", "SGP_LEVEL_BASELINE",
"SGP_TARGET", "SGP_TARGET_MU", "SGP_TARGET_MU_BASELINE", "SGP_TARGET_MOVE_UP_STAY_UP", "SGP_TARGET_MOVE_UP_STAY_UP_BASELINE", "ACHIEVEMENT_LEVEL_PRIOR",
"CATCH_UP_KEEP_UP_STATUS_INITIAL", "SGP_TARGET_BASELINE", "CATCH_UP_KEEP_UP_STATUS", "CATCH_UP_KEEP_UP_STATUS_BASELINE",
"MOVE_UP_STATUS", "MOVE_UP_STAY_UP_STATUS", "MOVE_UP_STAY_UP_STATUS_BASELINE",
"SGP_NORM_GROUP", "SGP_NORM_GROUP_BASELINE", "SGP_BASELINE_STANDARD_ERROR", "SGP_NORM_GROUP_SCALE_SCORES", "SGP_NORM_GROUP_BASELINE_SCALE_SCORES",
grep("SGP_ORDER", names(slot.data), value=TRUE), grep("SGP_BASELINE_ORDER", names(slot.data), value=TRUE),
grep("SGP_SIMEX", names(slot.data), value=TRUE), grep("SGP_SIMEX_RANKED", names(slot.data), value=TRUE),
grep("PERCENTILE_CUT", names(slot.data), value=TRUE), grep("CONFIDENCE_BOUND", names(slot.data), value=TRUE),
paste("SGP_TARGET", max.sgp.target.years.forward, projection.unit.label, sep="_"),
paste("SGP_TARGET_MOVE_UP_STAY_UP", max.sgp.target.years.forward, projection.unit.label, sep="_"),
paste("SGP_TARGET", max.sgp.target.years.forward, projection.unit.label, "CURRENT", sep="_"),
paste("SGP_TARGET_MOVE_UP_STAY_UP", max.sgp.target.years.forward, projection.unit.label, "CURRENT", sep="_"),
paste("SGP_TARGET_BASELINE", max.sgp.target.years.forward, projection.unit.label, sep="_"),
paste("SGP_TARGET_BASELINE_MOVE_UP_STAY_UP", max.sgp.target.years.forward, projection.unit.label, sep="_"),
paste("SGP_TARGET_BASELINE", max.sgp.target.years.forward, projection.unit.label, "CURRENT", sep="_"),
paste("SGP_TARGET_BASELINE_MOVE_UP_STAY_UP", max.sgp.target.years.forward, projection.unit.label, "CURRENT", sep="_"),
grep("SCALE_SCORE_SGP_TARGET", names(slot.data), value=TRUE))
for (tmp.variables.to.null.out in intersect(names(slot.data), variables.to.null.out)) {
slot.data[,(tmp.variables.to.null.out):=NULL]
}
}
############################################################################
### sgp.percentiles: Merge Cohort Referenced SGPs with student data
############################################################################
## Determine names of Cohort Referenced SGPs
if (!sgp.target.scale.scores.only && length(tmp.names <- getPercentileTableNames(sgp_object, content_areas, state, years, "sgp.percentiles", sgp.percentiles.equated=FALSE)) == 0 && sgp.percentiles) {
tmp.messages <- c(tmp.messages, "\tNOTE: No cohort referenced SGP results available in SGP slot. No cohort referenced SGP results will be merged.\n")
sgp.percentiles <- FALSE
}
if (sgp.percentiles & !sgp.target.scale.scores.only) {
tmp.list <- list()
for (i in tmp.names) {
tmp.list[[i]] <- data.table(
CONTENT_AREA=unlist(strsplit(i, "[.]"))[1L],
YEAR=getTableNameYear(i),
sgp_object@SGP[["SGPercentiles"]][[i]])
}
tmp.data <- data.table(rbindlist(tmp.list, fill=TRUE), VALID_CASE="VALID_CASE", key=key(slot.data))
if (any(duplicated(tmp.data, by=key(tmp.data)))) {
tmp.data <- getPreferredSGP(tmp.data, state)
}
if (!is.null(fix.duplicates) & any(grepl("_DUPS_[0-9]*", tmp.data[["ID"]]))) {
## Strip ID of the _DUPS_ Flag, but keep in a seperate variable (used to merge subsequently)
invisible(tmp.data[, DUPS_FLAG := gsub(".*_DUPS_", "", ID)])
invisible(tmp.data[!grepl("_DUPS_[0-9]*", ID), DUPS_FLAG := NA])
invisible(tmp.data[, ID := gsub("_DUPS_[0-9]*", "", ID)])
## Extend the slot.data if any new rows are required (e.g. dups in prior years) - if not still merge in DUPS_FLAG.
slot.data.extension <- tmp.data[!is.na(DUPS_FLAG), c(key(slot.data), "SGP_NORM_GROUP_SCALE_SCORES", "DUPS_FLAG"), with=FALSE]
tmp.split <- strsplit(as.character(slot.data.extension[["SGP_NORM_GROUP_SCALE_SCORES"]]), "; ")
invisible(slot.data.extension[, SCALE_SCORE := as.numeric(sapply(tmp.split, function(x) rev(x)[1L]))])
invisible(slot.data.extension[, SGP_NORM_GROUP_SCALE_SCORES := NULL])
if ("DUPS_FLAG" %in% names(slot.data)) flag.fix <- TRUE else flag.fix <- FALSE
slot.data <- slot.data.extension[slot.data, on=c(key(slot.data),"SCALE_SCORE"), allow.cartesian=TRUE]
if (flag.fix) { # Merge together DUPS_FLAG from previous years
invisible(slot.data[!is.na(i.DUPS_FLAG) & is.na(DUPS_FLAG), DUPS_FLAG := i.DUPS_FLAG])
invisible(slot.data[, i.DUPS_FLAG := NULL])
}
## Get the row index for variable merge.
tmp.index <- slot.data[tmp.data[, c(getKey(slot.data), "GRADE", "DUPS_FLAG"), with=FALSE], which=TRUE, on=c(getKey(slot.data), "GRADE", "DUPS_FLAG")]
} else {
tmp.index <- slot.data[tmp.data[, key(tmp.data), with=FALSE], which=TRUE, on=key(tmp.data)]
}
variables.to.merge <- setdiff(names(tmp.data), c(getKey(slot.data), "GRADE"))
invisible(slot.data[tmp.index, (variables.to.merge):=tmp.data[, variables.to.merge, with=FALSE]])
setkeyv(slot.data, getKey(slot.data))
}
###################################################################################
### sgp.percentiles.baseline: Merge baseline referenced SGPs with student data
###################################################################################
## Determine names of Baseline Referenced SGPs
if (!sgp.target.scale.scores.only && length(tmp.names <- getPercentileTableNames(sgp_object, content_areas, state, years, "sgp.percentiles.baseline", sgp.percentiles.equated=FALSE))==0 && sgp.percentiles.baseline) {
tmp.messages <- c(tmp.messages, "\tNOTE: No baseline referenced SGP results available in SGP slot. No baseline referenced SGP results will be merged.\n")
sgp.percentiles.baseline <- FALSE
}
if (sgp.percentiles.baseline & !sgp.target.scale.scores.only) {
tmp.list <- list()
for (i in tmp.names) {
tmp.list[[i]] <- data.table(
CONTENT_AREA=unlist(strsplit(i, "[.]"))[1L],
YEAR=getTableNameYear(i),
sgp_object@SGP[["SGPercentiles"]][[i]])
if (is.na(unlist(strsplit(i, "[.]"))[3])) { ### If cohort referenced SGP are to be included in baseline SGP (e.g., Georgia)
setnames(tmp.list[[i]], "SGP", "SGP_BASELINE")
if ("SGP_LEVEL" %in% names(tmp.list[[i]])) setnames(tmp.list[[i]], "SGP_LEVEL", "SGP_LEVEL_BASELINE")
if ("SGP_NORM_GROUP" %in% names(tmp.list[[i]])) setnames(tmp.list[[i]], "SGP_NORM_GROUP", "SGP_NORM_GROUP_BASELINE")
if ("SGP_NORM_GROUP_SCALE_SCORES" %in% names(tmp.list[[i]])) setnames(tmp.list[[i]], "SGP_NORM_GROUP_SCALE_SCORES", "SGP_NORM_GROUP_BASELINE_SCALE_SCORES")
if ("SGP_SIMEX" %in% names(tmp.list[[i]])) setnames(tmp.list[[i]], "SGP_SIMEX", "SGP_SIMEX_BASELINE")
}
}
tmp.data <- data.table(rbindlist(tmp.list, fill=TRUE), VALID_CASE="VALID_CASE", key=key(slot.data))
if (any(duplicated(tmp.data, by=key(tmp.data)))) {
tmp.data <- getPreferredSGP(tmp.data, state, type="BASELINE")
}
if (!is.null(fix.duplicates) & any(grepl("_DUPS_[0-9]*", tmp.data[["ID"]]))) {
## Strip ID of the _DUPS_ Flag, but keep in a seperate variable (used to merge subsequently)
invisible(tmp.data[, DUPS_FLAG := gsub(".*_DUPS_", "", ID)])
invisible(tmp.data[!grepl("_DUPS_[0-9]*", ID), DUPS_FLAG := NA])
invisible(tmp.data[, ID := gsub("_DUPS_[0-9]*", "", ID)])
## Extend the slot.data if any new rows are required (e.g. dups in prior years) - if not still merge in DUPS_FLAG.
slot.data.extension <- tmp.data[!is.na(DUPS_FLAG), c(key(slot.data), "SGP_NORM_GROUP_BASELINE_SCALE_SCORES", "DUPS_FLAG"), with=FALSE]
tmp.split <- strsplit(as.character(slot.data.extension[["SGP_NORM_GROUP_BASELINE_SCALE_SCORES"]]), "; ")
invisible(slot.data.extension[, SCALE_SCORE := as.numeric(sapply(tmp.split, function(x) rev(x)[1L]))])
invisible(slot.data.extension[, SGP_NORM_GROUP_BASELINE_SCALE_SCORES := NULL])
if ("DUPS_FLAG" %in% names(slot.data)) flag.fix <- TRUE else flag.fix <- FALSE
slot.data <- slot.data.extension[slot.data, on=c(key(slot.data),"SCALE_SCORE"), allow.cartesian=TRUE]
if (flag.fix) { # Merge together DUPS_FLAG from previous years
invisible(slot.data[!is.na(i.DUPS_FLAG) & is.na(DUPS_FLAG), DUPS_FLAG := i.DUPS_FLAG])
invisible(slot.data[, i.DUPS_FLAG := NULL])
}
## Get the row index for variable merge.
tmp.index <- slot.data[tmp.data[, c(getKey(slot.data), "GRADE", "DUPS_FLAG"), with=FALSE], which=TRUE, on=c(getKey(slot.data), "GRADE", "DUPS_FLAG")] #
} else {
tmp.index <- slot.data[tmp.data[, key(tmp.data), with=FALSE], which=TRUE, on=key(tmp.data)]
}
variables.to.merge <- setdiff(names(tmp.data), c(getKey(slot.data), "GRADE"))
invisible(slot.data[tmp.index, (variables.to.merge):=tmp.data[, variables.to.merge, with=FALSE]])
setkeyv(slot.data, getKey(slot.data))
}
###################################################################################
### sgp.percentiles.equated: Merge equated SGPs in transition year
###################################################################################
## Determine names of Equated SGPs
if (!sgp.target.scale.scores.only && length(tmp.names <- getPercentileTableNames(sgp_object, content_areas, state, years, "sgp.percentiles", sgp.percentiles.equated=TRUE))==0 && sgp.percentiles.equated) {
tmp.messages <- c(tmp.messages, "\tNOTE: No equated SGP results available in SGP slot. No equated SGP results will be merged.\n")
sgp.percentiles.equated <- FALSE
}
if (sgp.percentiles.equated & !sgp.target.scale.scores.only) {
tmp.list <- list()
for (i in tmp.names) {
tmp.list[[i]] <- data.table(
CONTENT_AREA=unlist(strsplit(i, "[.]"))[1L],
YEAR=getTableNameYear(i),
sgp_object@SGP[["SGPercentiles"]][[i]])
}
tmp.data <- data.table(rbindlist(tmp.list, fill=TRUE), VALID_CASE="VALID_CASE", key=key(slot.data))
if (any(duplicated(tmp.data, by=key(tmp.data)))) {
tmp.data <- getPreferredSGP(tmp.data, state, type="BASELINE")
}
if (!is.null(fix.duplicates) & any(grepl("_DUPS_[0-9]*", tmp.data[["ID"]]))) {
## Strip ID of the _DUPS_ Flag, but keep in a seperate variable (used to merge subsequently)
invisible(tmp.data[, DUPS_FLAG := gsub(".*_DUPS_", "", ID)])
invisible(tmp.data[!grepl("_DUPS_[0-9]*", ID), DUPS_FLAG := NA])
invisible(tmp.data[, ID := gsub("_DUPS_[0-9]*", "", ID)])
## Extend the slot.data if any new rows are required (e.g. dups in prior years) - if not still merge in DUPS_FLAG.
slot.data.extension <- tmp.data[!is.na(DUPS_FLAG), c(key(slot.data), "SGP_NORM_GROUP_EQUATED_SCALE_SCORES", "DUPS_FLAG"), with=FALSE]
tmp.split <- strsplit(as.character(slot.data.extension[["SGP_NORM_GROUP_EQUATED_SCALE_SCORES"]]), "; ")
invisible(slot.data.extension[, SCALE_SCORE := as.numeric(sapply(tmp.split, function(x) rev(x)[1L]))])
invisible(slot.data.extension[, SGP_NORM_GROUP_EQUATED_SCALE_SCORES := NULL])
if ("DUPS_FLAG" %in% names(slot.data)) flag.fix <- TRUE else flag.fix <- FALSE
slot.data <- slot.data.extension[slot.data, on=c(key(slot.data),"SCALE_SCORE"), allow.cartesian=TRUE]
if (flag.fix) { # Merge together DUPS_FLAG from previous years
invisible(slot.data[!is.na(i.DUPS_FLAG) & is.na(DUPS_FLAG), DUPS_FLAG := i.DUPS_FLAG])
invisible(slot.data[, i.DUPS_FLAG := NULL])
}
## Get the row index for variable merge.
tmp.index <- slot.data[tmp.data[, c(getKey(slot.data), "GRADE", "DUPS_FLAG"), with=FALSE], which=TRUE, on=c(getKey(slot.data), "GRADE", "DUPS_FLAG")] #
} else {
tmp.index <- slot.data[tmp.data[, key(tmp.data), with=FALSE], which=TRUE, on=key(tmp.data)]
}
variables.to.merge <- setdiff(names(tmp.data), c(getKey(slot.data), "GRADE"))
invisible(slot.data[tmp.index, (variables.to.merge):=tmp.data[, variables.to.merge, with=FALSE]])
setkeyv(slot.data, getKey(slot.data))
}
######################################################################################
### Create SGP targets (Cohort and Baseline referenced) and merge with student data
######################################################################################
if (!sgp.target.scale.scores.only && length(getPercentileTableNames(sgp_object, content_areas, state, years, "sgp.projections"))==0 && sgp.projections) {
tmp.messages <- c(tmp.messages, "\tNOTE: No SGP projections available in SGP slot. No current year student growth projection targets will be produced.\n")
sgp.projections <- FALSE;
}
if (!sgp.target.scale.scores.only && length(getPercentileTableNames(sgp_object, content_areas, state, years, "sgp.projections.baseline"))==0 && sgp.projections.baseline) {
tmp.messages <- c(tmp.messages, "\tNOTE: No SGP baseline projections available in SGP slot. No current year baseline student growth projection targets will be produced.\n")
sgp.projections.baseline <- FALSE;
}
if (!sgp.target.scale.scores.only && length(getPercentileTableNames(sgp_object, content_areas, state, years, "sgp.projections.lagged"))==0 && sgp.projections.lagged) {
tmp.messages <- c(tmp.messages, "\tNOTE: No SGP lagged projections available in SGP slot. No student growth projection targets will be produced.\n")
sgp.projections.lagged <- FALSE;
}
if (!sgp.target.scale.scores.only && length(getPercentileTableNames(sgp_object, content_areas, state, years, "sgp.projections.lagged.baseline"))==0 && sgp.projections.lagged.baseline) {
tmp.messages <- c(tmp.messages, "\tNOTE: No SGP lagged baseline projections available in SGP slot. No baseline referenced student growth projection targets will be produced.\n")
sgp.projections.lagged.baseline <- FALSE;
}
target.type <- c("sgp.projections", "sgp.projections.baseline", "sgp.projections.lagged", "sgp.projections.lagged.baseline")[
c(sgp.projections, sgp.projections.baseline, sgp.projections.lagged, sgp.projections.lagged.baseline)]
### Calculate Targets
if ((sgp.projections | sgp.projections.baseline | sgp.projections.lagged | sgp.projections.lagged.baseline) & !sgp.target.scale.scores.only) {
target.args <- get.target.arguments(SGP::SGPstateData[[state]][["Growth"]][["System_Type"]], target.type, projection.unit.label, year.for.equate)
for (target.type.iter in target.args[['target.type']]) {
for (target.level.iter in target.args[['target.level']]) {
if (!is.null(fix.duplicates)) {
if (!sgp.percentiles & !sgp.percentiles.baseline) messageSGP("The fix.duplicates='KEEP.ALL' functionality requires that sgp.percentiles = TRUE or percentiles results have already been merged into @Data.")
## Seperate out prior score history of slot.data
if (grepl(".baseline", target.type.iter)) {
tmp.split <-
strsplit(as.character(slot.data[["SGP_NORM_GROUP_BASELINE_SCALE_SCORES"]]), "; ")
} else {
tmp.split <- strsplit(as.character(slot.data[["SGP_NORM_GROUP_SCALE_SCORES"]]), "; ")
}
num.scores <- max(sapply(seq_along(tmp.split), function(f) length(tmp.split[[f]])))
if (num.scores > 2) {
for (tmp.prior in tail(seq(num.scores), -2)) {
invisible(slot.data[, paste0("SCALE_SCORE_PRIOR_", tmp.prior-1L) := as.numeric(sapply(tmp.split, function(x) rev(x)[tmp.prior]))])
}}}
tmp.data <- getTargetSGP(sgp_object, slot.data, content_areas, state, years, target.type.iter, target.level.iter, current.year.lagged.target, max.sgp.target.years.forward, fix.duplicates=fix.duplicates, return.sgp.target.num.years=return.sgp.target.num.years)
if (dim(tmp.data)[1] > 0) {
if (!is.null(fix.duplicates)) dup.by <- c(key(tmp.data), grep("SCALE_SCORE$|SCALE_SCORE_PRIOR", names(tmp.data), value=TRUE)) else dup.by <- key(tmp.data)
if (any(duplicated(tmp.data, by=dup.by))) {
duplicated.projections.tf <- TRUE
tmp.data <- getPreferredSGP(tmp.data, state, type="TARGET", dup.by)
} else duplicated.projections.tf <- FALSE
if (!is.null(fix.duplicates) & any(grepl("_DUPS_[0-9]*", tmp.data[["ID"]]))) {
## Strip ID of the _DUPS_ Flag, Don't use this as DUPS_FLAG (merge in later from SGPercentiles)
invisible(tmp.data[, ID := gsub("_DUPS_[0-9]*", "", ID)])
## Get the row index for variable merge.
if (grepl('lagged', target.type.iter)) {
tmp.index <- slot.data[
tmp.data[, c(intersect(getKey(slot.data), names(tmp.data)), "DUPS_FLAG", grep("SCALE_SCORE_PRIOR", names(tmp.data), value=TRUE)), with=FALSE, nomatch=NA],
which=TRUE, on=c(getKey(slot.data), "DUPS_FLAG", grep("SCALE_SCORE_PRIOR", names(tmp.data), value=TRUE))]
no_match <- tmp.data[which(is.na(tmp.index)),] # usually current year score is NA - still get a lagged projection, but no SGP (& therefore no prior score to merge on)
if (nrow(no_match) > 0) {
no_match.index <- slot.data[no_match[, intersect(getKey(slot.data), names(no_match)), with=FALSE, nomatch=NA], which=TRUE, on=getKey(slot.data)]
if (length(no_match.index) == length(tmp.index[which(is.na(tmp.index))])) {
tmp.index[which(is.na(tmp.index))] <- no_match.index
} else stop("Error in matching LAGGED projections with duplicates in data (most likely student records with a current year SCALE_SCORE == NA).")
}
} else {
setnames(tmp.data, "SGP_PROJECTION_GROUP_SCALE_SCORES", "SGP_PROJECTION_GROUP_SCALE_SCORES_CURRENT")
tmp.index <- slot.data[
tmp.data[, c(intersect(getKey(slot.data), names(tmp.data)), "DUPS_FLAG", grep("SCALE_SCORE$|SCALE_SCORE_PRIOR", names(tmp.data), value=TRUE)), with=FALSE, nomatch=NA],
which=TRUE, on=c(getKey(slot.data), "DUPS_FLAG", grep("SCALE_SCORE$|SCALE_SCORE_PRIOR", names(tmp.data), value=TRUE))]
no_match <- tmp.data[which(is.na(tmp.index)),] # usually current year score is NA - still get a lagged projection, but no SGP (& therefore no prior score to merge on)
if (nrow(no_match) > 0) {
no_match.index <- slot.data[no_match[, intersect(getKey(slot.data), names(no_match)), with=FALSE, nomatch=NA], which=TRUE, on=intersect(getKey(slot.data), names(no_match))]
if (length(no_match.index) == length(tmp.index[which(is.na(tmp.index))])) {
tmp.index[which(is.na(tmp.index))] <- no_match.index
} else stop("Error in matching STRAIGHT (CURRENT) projections with duplicates in data (most likely student records with a current year SCALE_SCORE == NA).")
}
}
} else {
tmp.index <- slot.data[tmp.data[, intersect(dup.by, names(tmp.data)), with=FALSE], which=TRUE, on=dup.by]
}
variables.to.merge <- setdiff(names(tmp.data), c(getKey(slot.data), "DUPS_FLAG", grep("SCALE_SCORE$|SCALE_SCORE_PRIOR", names(tmp.data), value=TRUE)))
invisible(slot.data[tmp.index, (variables.to.merge):=tmp.data[, variables.to.merge, with=FALSE]])
} ### END dim(tmp.data)[1] > 0
}
}
if (duplicated.projections.tf) {
tmp.messages <- c(tmp.messages, paste0(
"\tNOTE: Multiple Projections exist for individual students. Unique SGP Targets will be created using SGP Progression Preference Table for ", state, ".\n"))
}
### SGP_TARGET_CONTENT_AREA calculation
terminal.content_areas <- unique(slot.data[!slot.data[,all(is.na(.SD)), .SDcols=grep("SGP_TARGET", grep(paste(max(max.sgp.target.years.forward), "YEAR", sep="_"), names(slot.data), value=TRUE), value=TRUE), by=seq_len(nrow(slot.data))][['V1']]][['CONTENT_AREA']])
if (!is.null(SGP::SGPstateData[[state]][["SGP_Configuration"]][["content_area.projection.sequence"]])) {
terminal.content_areas <- intersect(terminal.content_areas, sapply(SGP::SGPstateData[[state]][["SGP_Configuration"]][["content_area.projection.sequence"]], tail, 1))
}
if (identical(sgp.target.content_areas, TRUE)) {
for (my.sgp.target.content_area.iter in seq_along(target.args[['my.sgp.target.content_area']])) {
slot.data[!is.na(get(target.args[['my.sgp.target']][my.sgp.target.content_area.iter])), target.args[['my.sgp.target.content_area']][my.sgp.target.content_area.iter] :=
getTargetSGPContentArea(GRADE[1L], CONTENT_AREA[1L], state, my.sgp.target.content_area.iter, target.args[['my.sgp.target.content_area']][my.sgp.target.content_area.iter]),
by=list(GRADE, CONTENT_AREA)]
}
}
### CATCH_UP_KEEP_UP_STATUS Calculation
if ("CATCH_UP_KEEP_UP" %in% target.args[['target.level']] & (sgp.projections.lagged | sgp.projections.lagged.baseline) & "CATCH_UP_KEEP_UP_STATUS_INITIAL" %in% names(slot.data)) {
catch.up.keep.up.levels <- getTargetAchievementLevels(state, "CATCH_UP_KEEP_UP")
slot.data[,CATCH_UP_KEEP_UP_STATUS_INITIAL:=getTargetInitialStatus(ACHIEVEMENT_LEVEL_PRIOR, state, status.type="CATCH_UP_KEEP_UP")]
for (i in seq_along(target.args[['my.sgp']])) {
for (target.years.iter in max.sgp.target.years.forward) {
if (!grepl("BASELINE", target.args[['my.sgp']][i])) {
my.label <- paste("CATCH_UP_KEEP_UP_STATUS", target.years.iter, "YEAR", sep="_")
my.target.label <- paste("SGP_TARGET", target.years.iter, "YEAR", sep="_")
} else {
my.label <- paste("CATCH_UP_KEEP_UP_STATUS_BASELINE", target.years.iter, "YEAR", sep="_")
my.target.label <- paste("SGP_TARGET_BASELINE", target.years.iter, "YEAR", sep="_")
}
if (grepl("FROM", target.args[['my.sgp']][i])) slot.data[YEAR <= year.for.equate, target.args[['my.sgp']][i]:=SGP] ### Get comparison values from before transition
if (my.label %in% names(slot.data)) slot.data[,(my.label):=NULL]
slot.data[,(my.label):=rep(as.character(NA), dim(slot.data)[1L])]
slot.data[CATCH_UP_KEEP_UP_STATUS_INITIAL == "Keeping Up" & get(target.args[['my.sgp']][i]) >= get(my.target.label),
(my.label):="Keep Up: Yes"]
slot.data[CATCH_UP_KEEP_UP_STATUS_INITIAL == "Keeping Up" & get(target.args[['my.sgp']][i]) < get(my.target.label),
(my.label):="Keep Up: No"]
slot.data[CATCH_UP_KEEP_UP_STATUS_INITIAL == "Catching Up" & get(target.args[['my.sgp']][i]) >= get(my.target.label),
(my.label):="Catch Up: Yes"]
slot.data[CATCH_UP_KEEP_UP_STATUS_INITIAL == "Catching Up" & get(target.args[['my.sgp']][i]) < get(my.target.label),
(my.label):="Catch Up: No"]
### CATCH_UP_KEEP_UP clean up based upon reality
slot.data[CATCH_UP_KEEP_UP_STATUS_INITIAL == "Keeping Up" & get(my.label) == "Keep Up: Yes" &
ACHIEVEMENT_LEVEL %in% catch.up.keep.up.levels[['NO']], (my.label):="Keep Up: No"]
slot.data[CATCH_UP_KEEP_UP_STATUS_INITIAL == "Catching Up" & get(my.label) == "Catch Up: No" &
ACHIEVEMENT_LEVEL %in% catch.up.keep.up.levels[['YES']], (my.label):="Catch Up: Yes"]
slot.data[CATCH_UP_KEEP_UP_STATUS_INITIAL == "Catching Up" & get(my.label) == "Catch Up: Yes" &
ACHIEVEMENT_LEVEL %in% catch.up.keep.up.levels[['NO']] &
GRADE == max(type.convert(GRADE[!is.na(get(my.target.label))], as.is=TRUE)) &
CONTENT_AREA %in% terminal.content_areas, (my.label):="Catch Up: No"]
slot.data[CATCH_UP_KEEP_UP_STATUS_INITIAL == "Keeping Up" & get(my.label) == "Keep Up: No" &
ACHIEVEMENT_LEVEL %in% catch.up.keep.up.levels[['YES']] &
GRADE == max(type.convert(GRADE[!is.na(get(my.target.label))], as.is=TRUE)) &
CONTENT_AREA %in% terminal.content_areas, (my.label):="Keep Up: Yes"]
slot.data[,(my.label):=as.factor(get(my.label))]
if (grepl("FROM", target.args[['my.sgp']][i])) slot.data[YEAR <= year.for.equate, target.args[['my.sgp']][i]:=NA]
}
}
}
### MOVE_UP_STAY_UP_STATUS Calculation
if ("MOVE_UP_STAY_UP" %in% target.args[['target.level']] & (sgp.projections.lagged | sgp.projections.lagged.baseline) & "MOVE_UP_STAY_UP_STATUS_INITIAL" %in% names(slot.data)) {
move.up.stay.up.levels <- getTargetAchievementLevels(state, "MOVE_UP_STAY_UP")
slot.data[,MOVE_UP_STAY_UP_STATUS_INITIAL:=getTargetInitialStatus(ACHIEVEMENT_LEVEL_PRIOR, state, status.type="MOVE_UP_STAY_UP")]
for (i in seq_along(target.args[['my.sgp']])) {
for (target.years.iter in max.sgp.target.years.forward) {
if (!grepl("BASELINE", target.args[['my.sgp']][i])) {
my.label <- paste("MOVE_UP_STAY_UP_STATUS", target.years.iter, "YEAR", sep="_")
my.target.label <- paste("SGP_TARGET_MOVE_UP_STAY_UP", target.years.iter, "YEAR", sep="_")
} else {
my.label <- paste("MOVE_UP_STAY_UP_STATUS_BASELINE", target.years.iter, "YEAR", sep="_")
my.target.label <- paste("SGP_TARGET_BASELINE_MOVE_UP_STAY_UP", target.years.iter, "YEAR", sep="_")
}
if (!grepl("BASELINE", target.args[['my.sgp']][i])) my.label <- paste("MOVE_UP_STAY_UP_STATUS", target.years.iter, "YEAR", sep="_") else my.label <- paste("MOVE_UP_STAY_UP_STATUS_BASELINE", target.years.iter, "YEAR", sep="_")
if (grepl("FROM", target.args[['my.sgp']][i])) slot.data[YEAR <= year.for.equate, target.args[['my.sgp']][i]:=SGP]
if (my.label %in% names(slot.data)) slot.data[,(my.label):=NULL]
slot.data[,(my.label):=rep(as.character(NA), dim(slot.data)[1L])]
slot.data[MOVE_UP_STAY_UP_STATUS_INITIAL == "Staying Up" & get(target.args[['my.sgp']][i]) >= get(my.target.label),
(my.label):="Stay Up: Yes"]
slot.data[MOVE_UP_STAY_UP_STATUS_INITIAL == "Staying Up" & get(target.args[['my.sgp']][i]) < get(my.target.label),
(my.label):="Stay Up: No"]
slot.data[MOVE_UP_STAY_UP_STATUS_INITIAL == "Moving Up" & get(target.args[['my.sgp']][i]) >= get(my.target.label),
(my.label):="Move Up: Yes"]
slot.data[MOVE_UP_STAY_UP_STATUS_INITIAL == "Moving Up" & get(target.args[['my.sgp']][i]) < get(my.target.label),
(my.label):="Move Up: No"]
### MOVE_UP_STAY_UP clean up based upon reality
slot.data[MOVE_UP_STAY_UP_STATUS_INITIAL == "Staying Up" & get(my.label) == "Stay Up: Yes" &
ACHIEVEMENT_LEVEL %in% move.up.stay.up.levels[['NO']], (my.label):="Stay Up: No"]
slot.data[MOVE_UP_STAY_UP_STATUS_INITIAL == "Moving Up" & get(my.label) == "Move Up: No" &
ACHIEVEMENT_LEVEL %in% move.up.stay.up.levels[['YES']], (my.label):="Move Up: Yes"]
slot.data[MOVE_UP_STAY_UP_STATUS_INITIAL == "Moving Up" & get(my.label) == "Move Up: Yes" &
ACHIEVEMENT_LEVEL %in% move.up.stay.up.levels[['NO']] &
GRADE == max(type.convert(GRADE[!is.na(get(my.target.label))], as.is=TRUE)) &
CONTENT_AREA %in% terminal.content_areas, (my.label):="Move Up: No"]
slot.data[MOVE_UP_STAY_UP_STATUS_INITIAL == "Staying Up" & get(my.label) == "Stay Up: No" &
ACHIEVEMENT_LEVEL %in% move.up.stay.up.levels[['YES']] &
GRADE == max(type.convert(GRADE[!is.na(get(my.target.label))], as.is=TRUE)) &
CONTENT_AREA %in% terminal.content_areas, (my.label):="Stay Up: Yes"]
slot.data[,(my.label):=as.factor(get(my.label))]
if (grepl("FROM", target.args[['my.sgp']][i])) slot.data[YEAR <= year.for.equate, target.args[['my.sgp']][i]:=NA]
}
}
}
for (i in intersect(names(slot.data), c("CATCH_UP_KEEP_UP_STATUS_INITIAL", "MOVE_UP_STAY_UP_STATUS_INITIAL"))) {
slot.data[,(i):=NULL]
}
} ## END sgp.projections.lagged | sgp.projections.lagged.baseline
###################################################################################################
### Create SGP Scale Score targets (Cohort and Baseline referenced) if requested
###################################################################################################
if (sgp.target.scale.scores) {
if (!exists("target.args")) target.args <- get.target.arguments(SGP::SGPstateData[[state]][["Growth"]][["System_Type"]], target.type, projection.unit.label, year.for.equate)
tmp.target.list <- list()
for (target.type.iter in target.args[['sgp.target.scale.scores.types']]) {
for (target.level.iter in target.args[['target.level']]) {
tmp.target.list[[paste(target.type.iter, target.level.iter)]] <-
data.table(getTargetSGP(sgp_object, slot.data, content_areas, state, years, target.type.iter, target.level.iter, current.year.lagged.target, max.sgp.target.years.forward, return.lagged.status=FALSE, fix.duplicates=fix.duplicates, return.sgp.target.num.years=TRUE),
key=c(getKey(sgp_object), "SGP_PROJECTION_GROUP"))
}
}
tmp.target.data <- data.table(Reduce(function(x, y) merge(x, y, all=TRUE, by=intersect(names(y), names(x))), tmp.target.list[!sapply(tmp.target.list, function(x) dim(x)[1L]==0L)],
accumulate=FALSE), key=getKey(slot.data))
if (!is.null(fix.duplicates)) {
if (any(grepl("_DUPS_[0-9]*", tmp.target.data[["ID"]]))) {
invisible(tmp.target.data[, ID := gsub("_DUPS_[0-9]*", "", ID)])
invisible(tmp.target.data[!is.na(DUPS_FLAG), N := seq.int(.N), by=c(getKey(tmp.target.data))])
}
}
for (projection_group.iter in unique(tmp.target.data[['SGP_PROJECTION_GROUP']])) {
for (target.type.iter in target.args[['sgp.target.scale.scores.types']]) {
if (target.type.iter %in% c("sgp.projections.lagged", "sgp.projections.lagged.baseline")) {
max.sgp.target.years.forward.tmp <- max.sgp.target.years.forward + 1L
if (current.year.lagged.target) max.sgp.target.years.forward.tmp <- c(1, max.sgp.target.years.forward.tmp)
max.sgp.target.years.forward.tmp <- max.sgp.target.years.forward.tmp - 1L
} else max.sgp.target.years.forward.tmp <- max.sgp.target.years.forward
for (target.years.iter in max.sgp.target.years.forward.tmp) {
tmp.target.level.names <- as.character(sapply(target.args[['target.level']], function(x) getTargetName(state, target.type.iter, x, target.years.iter, "SGP_TARGET", projection.unit.label, projection_group.iter)))
if (any(!tmp.target.level.names %in% names(tmp.target.data))) {
tmp.target.data[,tmp.target.level.names[!tmp.target.level.names %in% names(tmp.target.data)]:=as.integer(NA)]
}
tmp.target.level.names.years.to.target <- paste(tmp.target.level.names, "NUM_YEARS_TO_TARGET", sep="_")
targetData <- getTargetData(tmp.target.data, projection_group.iter, c(tmp.target.level.names, tmp.target.level.names.years.to.target))
if (dim(targetData)[1] > 0) {
sgp_object <- getTargetScaleScore(
sgp_object,
state,
targetData,
target.type.iter,
tmp.target.level.names,
tmp.target.level.names.years.to.target,
getYearsContentAreasGrades(state, years=unique(tmp.target.data[SGP_PROJECTION_GROUP==projection_group.iter], by='YEAR')[['YEAR']], content_areas=unique(tmp.target.data[SGP_PROJECTION_GROUP==projection_group.iter], by='CONTENT_AREA')[['CONTENT_AREA']]),
sgp.config=sgp.config,
projection_group.identifier=projection_group.iter,
sgp.projections.equated=if (grepl("baseline", target.type.iter)) NULL else sgp.projections.equated,
SGPt=SGPt,
fix.duplicates=fix.duplicates,
parallel.config=parallel.config)
}
}
}
}
if (length(max.sgp.target.years.forward) > 1) {
for (names.iter in grep("TARGET_SCALE_SCORES", names(sgp_object@SGP$SGProjections), value=TRUE)) {
sgp_object@SGP$SGProjections[[names.iter]] <- sgp_object@SGP$SGProjections[[names.iter]][,lapply(.SD, mean_nan), by=c("ID", "GRADE", "SGP_PROJECTION_GROUP", "SGP_PROJECTION_GROUP_SCALE_SCORES")]
}
}
if (!identical(sgp.target.scale.scores.merge, FALSE)) {
slot.data <- mergeScaleScoreTarget(sgp_object, state, slot.data, years, sgp.target.scale.scores.merge)
}
} ### END if (sgp.target.scale.scores)
### Final clean and put slot.data into @Data slot
if ("DUPS_FLAG" %in% names(slot.data)) invisible(slot.data[, DUPS_FLAG := NULL])
if (any(grepl("SCALE_SCORE_PRIOR_[0-9]", names(slot.data)))) invisible(slot.data[, grep("SCALE_SCORE_PRIOR_[0-9]", names(slot.data), value=TRUE) := NULL])
setkeyv(slot.data, getKey(slot.data))
sgp_object@Data <- slot.data
messageSGP(c(tmp.messages, paste("Finished combineSGP", prettyDate(), "in", convertTime(timetakenSGP(started.at)), "\n")))
return(sgp_object)
} ## END combineSGP Function
Try the SGP package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.