Merge pull request #1451 from dbetebenner/master

Multiple updates including studentGrowthProjections changes to align scale score targets with exact time frame of projection. See individual commits for changes

CITATION.cff

@@ -11,7 +11,8 @@ authors:
 - family-names: "Yi"
   given-names: "Shang"
 title: "SGP: Student Growth Percentiles & Percentile Growth Trajectories"
-version: 2.1-0.22
+<<<<<<< HEAD
+version: 2.2-0.0
 doi: 10.5281/zenodo.3634024
-date-released: 2024-8-12
+date-released: 2024-10-6
 url: "https://sgp.io"

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: SGP
 Type: Package
 Title: Student Growth Percentiles & Percentile Growth Trajectories
-Version: 2.1-0.23
-Date: 2024-8-23
+Version: 2.2-0.0
+Date: 2024-10-6
 Authors@R: c(person(given=c("Damian", "W."), family="Betebenner", email="dbetebenner@nciea.org", role=c("aut", "cre")),
 		person(given=c("Adam", "R."), family="Van Iwaarden", email="avaniwaarden@nciea.org", role="aut"),
 		person(given="Ben", family="Domingue", email="ben.domingue@gmail.com", role="aut"),
@@ -70,6 +70,8 @@ Authors@R: c(person(given=c("Damian", "W."), family="Betebenner", email="dbetebe
 		person(given="Brendan", family="Houng", role="ctb", comment="University of Melbourne, Australia, NAPLAN"),
 		person(given="Leslie", family="Rosale", role="ctb", comment="Ministry of Education, Guatemala"),
 		person(given="Nathan", family="Wall", role="ctb", comment="eMetric working with Nevada Department of Education and South Dakota Department of Education"),
+		person(given="Julia", family="English", role="ctb", comment="Massachusetts DESE"),
+		person(given="Sarah Jo", family="Torgrimson", role="ctb", comment="Massachusetts DESE"),
 		person(given="Narek", family="Sahakyan", role="ctb", comment="World Class Instruction and Design (WIDA)"))
 Maintainer: Damian W. Betebenner <dbetebenner@nciea.org>
 Depends: R (>= 4.1.0)

R/abcSGP.R

@@ -7,6 +7,7 @@ function(sgp_object,
 	grades=NULL,
 	prepareSGP.var.names=NULL,
 	prepareSGP.create.additional.variables=FALSE,
+	prepareSGP.create.achievement.level=TRUE,
 	sgp.percentiles=TRUE,
 	sgp.projections=TRUE,
 	sgp.projections.lagged=TRUE,
@@ -75,6 +76,7 @@ function(sgp_object,
 				state=state,
 				var.names=prepareSGP.var.names,
 				create.additional.variables=prepareSGP.create.additional.variables,
+				create.achievement.level=prepareSGP.create.achievement.level,
 				fix.duplicates=fix.duplicates)
 		if (save.intermediate.results) save(sgp_object, file="sgp_object.Rdata")
 	}

R/analyzeSGP.R

@@ -363,6 +363,13 @@ function(sgp_object,
 		goodness.of.fit.print <- FALSE
 	}
 
+	if (!is.null(SGPstateData[[state]][["SGP_Configuration"]][["max.forward.projection.sequence"]]) && 
+			!is.null(SGPstateData[[state]][["SGP_Configuration"]][["max.sgp.target.years.forward"]]) &&
+			max(SGPstateData[[state]][["SGP_Configuration"]][["max.sgp.target.years.forward"]]) > min(unlist(SGPstateData[[state]][["SGP_Configuration"]][["max.forward.projection.sequence"]]))
+		) {
+			stop(paste("SGPstateData configuration value for 'max.forward.projection.sequence' is less than the largest specified value for 'max.sgp.target.years.forward'. Reconcile these values in", state, "meta-data."))
+	}
+
 	###########################################################################################################
 	### Utility functions
 	###########################################################################################################
@@ -2415,7 +2422,7 @@ function(sgp_object,
 					use.my.knots.boundaries=list(my.year=tail(sgp.iter[["sgp.panel.years"]], 1), my.subject=tail(sgp.iter[["sgp.content.areas"]], 1)),
 					performance.level.cutscores=state,
 					max.order.for.progression=getMaxOrderForProgression(tail(sgp.iter[["sgp.panel.years"]], 1),
-            tail(sgp.iter[["sgp.content.areas"]], 1), state, sgp.projections.equated),
+						tail(sgp.iter[["sgp.content.areas"]], 1), state, sgp.projections.equated),
 					percentile.trajectory.values=lagged.percentile.trajectory.values,
 					max.forward.progression.grade=sgp.projections.max.forward.progression.grade,
 					panel.data.vnames=getPanelDataVnames("sgp.projections.lagged", sgp.iter, sgp.data.names, equate.variable),

R/combineSGP.R

@@ -120,25 +120,13 @@ function(
 		sgp.target.scale.scores.merge <- SGP::SGPstateData[[state]][["SGP_Configuration"]][["sgp.target.scale.scores.merge"]]
 	}
 
-	### Check return.target.num.years
+	### Check return.sgp.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
-
-    ##  Odd things happened (e.g. in WIDA_CO) when max.sgp.targe.years.forward = 1 (length 1 only)
-    if (identical(SGP::SGPstateData[[state]][["SGP_Configuration"]][['current.year.lagged.target']], FALSE)) {
-        current.year.lagged.target <- FALSE
-    }
-
+	} else return.sgp.target.num.years <- 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)) {
@@ -216,6 +204,14 @@ function(
 		return(tmp.list)
 	} ### END get.target.arguments
 
+	getInitialStatusNames <- function(target.type.iter) {
+		if (target.type.iter=="sgp.projections") tmp.names <- c("CATCH_UP_KEEP_UP_STATUS_INITIAL_CURRENT", "MOVE_UP_STAY_UP_STATUS_INITIAL_CURRENT")
+		if (target.type.iter=="sgp.projections.baseline") tmp.names <- c("CATCH_UP_KEEP_UP_STATUS_INITIAL_CURRENT_BASELINE", "MOVE_UP_STAY_UP_STATUS_INITIAL_CURRENT_BASELINE")
+		if (target.type.iter=="sgp.projections.lagged") tmp.names <- c("CATCH_UP_KEEP_UP_STATUS_INITIAL", "MOVE_UP_STAY_UP_STATUS_INITIAL")
+		if (target.type.iter=="sgp.projections.lagged.baseline") tmp.names <- c("CATCH_UP_KEEP_UP_STATUS_INITIAL_BASELINE", "MOVE_UP_STAY_UP_STATUS_INITIAL_BASELINE")
+		return(tmp.names)
+	}
+
 	catch_keep_move_functions <- c(min, max)
 
 	getTargetData <- function(tmp.target.data, projection_group.iter, tmp.target.level.names) {
@@ -226,7 +222,6 @@ function(
 		na.omit(tmp.data, cols=grep("MOVE_UP_STAY_UP", tmp.target.level.names, invert=TRUE, value=TRUE))
 	}
 
-
 	############################################################################
 	### Check update.all.years
 	############################################################################
@@ -486,7 +481,7 @@ function(
 							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)
+				tmp.data <- getTargetSGP(sgp_object, slot.data, content_areas, state, years, target.type.iter, target.level.iter, max.sgp.target.years.forward, fix.duplicates=fix.duplicates, return.sgp.target.num.years=TRUE)
 
 				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)
@@ -542,7 +537,8 @@ function(
 		}
 
 		### 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']])
+		tmp.cols.to.test <- grep("SGP_TARGET", grep(paste(max(max.sgp.target.years.forward), "YEAR", sep="_"), names(slot.data), value=TRUE), value=TRUE)
+		terminal.content_areas <- unique(slot.data[slot.data[, rowSums(!is.na(.SD)) > 0, .SDcols = tmp.cols.to.test]][['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))
 		}
@@ -605,7 +601,6 @@ function(
 			}
 		}
 
-
 		### 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)) {
@@ -674,7 +669,7 @@ function(
 		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),
+					data.table(getTargetSGP(sgp_object, slot.data, content_areas, state, years, target.type.iter, target.level.iter, max.sgp.target.years.forward, return.lagged.status=FALSE, fix.duplicates=fix.duplicates, return.sgp.target.num.years=TRUE, return.sgp.target.num.years.note=FALSE),
 						key=c(getKey(sgp_object), "SGP_PROJECTION_GROUP"))
 			}
 		}
@@ -690,19 +685,15 @@ function(
 
 		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) {
+				for (target.years.iter in max.sgp.target.years.forward) {
 					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))
+					tmp.target.level.names.years.to.target <- paste(tmp.target.level.names, "NUM_YEARS_TO_TARGET", sep="_")
+					tmp.initial.status.names <- getInitialStatusNames(target.type.iter)
+					targetData <- getTargetData(tmp.target.data, projection_group.iter, c(tmp.target.level.names, tmp.target.level.names.years.to.target, tmp.initial.status.names))
 
 					if (dim(targetData)[1] > 0) {
 						sgp_object <- getTargetScaleScore(
@@ -722,10 +713,12 @@ function(
 					}
 				}
 			}
-		}
+		} ## END projection.group.iter
+
 		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")]
+			for (names.iter in getTargetScaleScoreTableNames(names(sgp_object@SGP[['SGProjections']]), years)) {
+				sgp_object@SGP[['SGProjections']][[names.iter]] <- sgp_object@SGP[['SGProjections']][[names.iter]][,lapply(.SD, mean, na.rm=TRUE), by=c("ID", "GRADE", "SGP_PROJECTION_GROUP", "SGP_PROJECTION_GROUP_SCALE_SCORES")] # nolint
+				sgp_object@SGP[['SGProjections']][[names.iter]] <- sgp_object@SGP[['SGProjections']][[names.iter]][,lapply(.SD, function(x) ifelse(is.nan(x), NA, x))]
 			}
 		}
 		if (!identical(sgp.target.scale.scores.merge, FALSE)) {
@@ -745,8 +738,3 @@ function(
 
 	return(sgp_object)
 } ## END combineSGP Function
-
-`mean_nan` <-
-    function(x) {
-        if (all(is.na(x))) return(as.numeric(NA)) else return(mean(x, na.rm=TRUE))
-    } ### END mean_nan function

R/csemScoreSimulator.R

@@ -54,7 +54,7 @@ function(
 	} else {
 		tmp.scores <- data.table(SIM=round(rnorm(length(scale_scores), scale_scores, tmp.omega), digits=round.digits))
 	}
-	tmp.scores[SIM < min.max[1L], SIM:=min.max[1L]]
-	tmp.scores[SIM > min.max[2L], SIM:=min.max[2L]]
+
+	tmp.scores[SIM < min.max[1L] | SIM > min.max[2L], SIM:=fifelse(SIM < min.max[1L], min.max[1L], min.max[2L])]
 	return(tmp.scores[['SIM']])
 } ### END csemScoreSimulator

R/getPanelData.R

@@ -225,7 +225,7 @@ function(sgp.data,
 				tmp.data <- ddcast(rbindlist(tmp.lookup.list),
 					ID ~ tmp.timevar, value.var=c("GRADE", "SCALE_SCORE", "YEAR_WITHIN", state, sgp.scale.score.equated, SGPt), sep=".")[
 					sgp.targets[CONTENT_AREA==tail(sgp.iter[[sgp.projection.content.areas.label]], 1L) & YEAR==tail(sgp.iter[["sgp.panel.years"]], 1L) & GRADE==tail(sgp.iter[[sgp.projection.grade.sequences.label]], 1L)], nomatch=0][,
-					!c("CONTENT_AREA", "YEAR"), with=FALSE]
+					!c("CONTENT_AREA", "YEAR", "GRADE"), with=FALSE]
 				if (dim(tmp.data)[1] > 0) {
 					setnames(tmp.data, tail(sort(grep("YEAR_WITHIN", names(tmp.data), value=TRUE)), 1L), "YEAR_WITHIN")
 					if (length(setdiff(grep("YEAR_WITHIN", names(tmp.data), value=TRUE), "YEAR_WITHIN")) > 0L) {
@@ -311,15 +311,15 @@ function(sgp.data,
 					tmp.data <- ddcast(tmp.data,
 						ID ~ tmp.timevar, value.var=c("GRADE", "SCALE_SCORE", state, sgp.scale.score.equated, SGPt), sep=".")[
 							sgp.targets[CONTENT_AREA==tail(sgp.iter[[sgp.projection.content.areas.label]], 1L) & YEAR==tail(sgp.iter[[sgp.projection.panel.years.label]], 1L) &
-							GRADE==tail(sgp.iter[[sgp.projection.grade.sequences.label]], 1L)], nomatch=0][,!c("CONTENT_AREA", "YEAR"), with=FALSE]
+							GRADE==tail(sgp.iter[[sgp.projection.grade.sequences.label]], 1L)], nomatch=0][,!c("CONTENT_AREA", "YEAR", "GRADE"), with=FALSE]
 				} else {  ###  END if (is.character(fix.duplicates)
 				tmp.data <- ddcast(
 					data.table(dbGetQuery(con, paste0("select * from sgp_data where CONTENT_AREA in ('", paste(tmp.lookup$V2, collapse="', '"), "')",
 						" AND GRADE in ('", paste(tmp.lookup$V4, collapse="', '"), "')", " AND YEAR in ('", paste(tmp.lookup$V3, collapse="', '"), "')"))
 						, key=c("VALID_CASE", "CONTENT_AREA", "YEAR", "GRADE"))[tmp.lookup, nomatch=0][,'tmp.timevar':=paste(YEAR, CONTENT_AREA, sep=".")],
 					ID ~ tmp.timevar, value.var=c("GRADE", "SCALE_SCORE", state, sgp.scale.score.equated, SGPt), sep=".")[
 						sgp.targets[CONTENT_AREA==tail(sgp.iter[[sgp.projection.content.areas.label]], 1L) & YEAR==tail(sgp.iter[[sgp.projection.panel.years.label]], 1L) &
-						GRADE==tail(sgp.iter[[sgp.projection.grade.sequences.label]], 1L)], nomatch=0][,!c("CONTENT_AREA", "YEAR"), with=FALSE]
+						GRADE==tail(sgp.iter[[sgp.projection.grade.sequences.label]], 1L)], nomatch=0][,!c("CONTENT_AREA", "YEAR", "GRADE"), with=FALSE]
 				}
 				dbDisconnect(con)
 			} else {
@@ -364,7 +364,7 @@ function(sgp.data,
 						ID ~ tmp.timevar, value.var=c("GRADE", "SCALE_SCORE", state, sgp.scale.score.equated, SGPt), sep=".")[
 							sgp.targets[CONTENT_AREA==tail(sgp.iter[[sgp.projection.content.areas.label]], 1L) &
 							YEAR==tail(sgp.iter[[sgp.projection.panel.years.label]], 1L) & GRADE==tail(sgp.iter[[sgp.projection.grade.sequences.label]], 1L)],
-							on="ID", nomatch=0][,!c("CONTENT_AREA", "YEAR"), with=FALSE]
+							on="ID", nomatch=0][,!c("CONTENT_AREA", "YEAR", "GRADE"), with=FALSE]
 				}
 			}
 
@@ -378,7 +378,7 @@ function(sgp.data,
 
 
 	###
-	### sgp.projections.lagged
+	### sgp.projections.lagged & sgp.projections.lagged.baseline
 	###
 
 	if (sgp.type %in% c("sgp.projections.lagged", "sgp.projections.lagged.baseline")) {
@@ -458,7 +458,7 @@ function(sgp.data,
 				tmp.data <- ddcast(rbindlist(tmp.lookup.list),
 					ID ~ tmp.timevar, value.var=c("GRADE", "SCALE_SCORE", "ACHIEVEMENT_LEVEL", "YEAR_WITHIN", state, sgp.scale.score.equated, SGPt), sep=".")[
 						sgp.targets[CONTENT_AREA==tail(sgp.iter[["sgp.content.areas"]], 1L) &
-						YEAR==tail(sgp.iter[["sgp.panel.years"]], 1L) & GRADE==tail(sgp.iter[["sgp.grade.sequences"]], 1L)], nomatch=0][,!c("CONTENT_AREA", "YEAR"), with=FALSE]
+						YEAR==tail(sgp.iter[["sgp.panel.years"]], 1L) & GRADE==tail(sgp.iter[["sgp.grade.sequences"]], 1L)], nomatch=0][,!c("CONTENT_AREA", "YEAR", "GRADE"), with=FALSE]
 
 				setnames(tmp.data, names(tmp.data)[grep(achievement.level.prior.vname, names(tmp.data))], achievement.level.prior.vname)
 				setnames(tmp.data, tail(sort(grep("YEAR_WITHIN", names(tmp.data), value=TRUE)), 1L), "YEAR_WITHIN")
@@ -563,7 +563,7 @@ function(sgp.data,
 					tmp.data <- ddcast(tmp.data,
 						ID ~ tmp.timevar, value.var=c("GRADE", "SCALE_SCORE", state, sgp.scale.score.equated, SGPt), sep=".")[
 							sgp.targets[CONTENT_AREA==tail(sgp.iter[["sgp.content.areas"]], 1L) &
-							YEAR==tail(sgp.iter[["sgp.panel.years"]], 1L) & GRADE==tail(sgp.iter[[sgp.projection.grade.sequences.label]], 1L)], nomatch=0][, !c("CONTENT_AREA", "YEAR"), with=FALSE]
+							YEAR==tail(sgp.iter[["sgp.panel.years"]], 1L) & GRADE==tail(sgp.iter[[sgp.projection.grade.sequences.label]], 1L)], nomatch=0][, !c("CONTENT_AREA", "YEAR", "GRADE"), with=FALSE]
 					dbDisconnect(con)
 				} else {
 					tmp.lookup1 <- SJ("VALID_CASE",
@@ -619,7 +619,7 @@ function(sgp.data,
 									'tmp.timevar':=paste(YEAR, CONTENT_AREA, sep=".")],
 								ID ~ tmp.timevar, value.var=c("GRADE", "SCALE_SCORE", state, sgp.scale.score.equated, SGPt), sep=".")[
 									sgp.targets[CONTENT_AREA == tmp.lookup1[["CONTENT_AREA"]] & YEAR == tmp.lookup1[["YEAR"]] & GRADE == tmp.lookup1[["GRADE"]]], nomatch=0][,
-									!c("CONTENT_AREA", "YEAR"), with=FALSE]
+									!c("CONTENT_AREA", "YEAR", "GRADE"), with=FALSE]
 					}
 				}