Merge pull request #1238 from dbetebenner/master

Several updates for 1.9 push to CRAN. See individual pull requests for details

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: SGP
 Type: Package
 Title: Student Growth Percentiles & Percentile Growth Trajectories
-Version: 1.9-0.10
-Date: 2019-2-14
+Version: 1.9-0.0
+Date: 2019-2-19
 Authors@R: c(person(given=c("Damian", "W."), family="Betebenner", email="[email protected]", role=c("aut", "cre")),
 		person(given=c("Adam", "R."), family="Van Iwaarden", email="[email protected]", role="aut"),
 		person(given="Ben", family="Domingue", email="[email protected]", role="aut"),
@@ -74,7 +74,7 @@ Authors@R: c(person(given=c("Damian", "W."), family="Betebenner", email="dbetebe
 Maintainer: Damian W. Betebenner <[email protected]>
 Depends: R (>= 3.0)
 Suggests: SGPdata (>= 21.0-0), knitr, rmarkdown
-Imports: Cairo, colorspace, crayon, datasets, data.table (>= 1.10.0), digest, doParallel, doRNG, equate (>= 2.0-5), foreach, graphics, grid, grDevices, gridBase, iterators, gtools, jsonlite, matrixStats, methods, parallel, plotly, quantreg, RSQLite, randomNames (>= 0.0-5), sn (>= 1.0-0), splines, stats, toOrdinal, utils
+Imports: Cairo, colorspace, crayon, datasets, data.table (>= 1.12.0), digest, doParallel, doRNG, equate (>= 2.0-5), foreach, graphics, grid, grDevices, gridBase, iterators, gtools, jsonlite, matrixStats, methods, parallel, plotly, quantreg, RSQLite, randomNames (>= 0.0-5), sn (>= 1.0-0), splines, stats, toOrdinal, utils
 Description: Functions to calculate student growth percentiles and percentile growth projections/trajectories for students using large scale,
         longitudinal assessment data.  Functions use quantile regression to estimate the conditional density associated
         with each student's achievement history.  Percentile growth projections/trajectories are calculated using the coefficient matrices derived from

NEWS.md

@@ -4,6 +4,7 @@
 
 * Update of web-based documentation (https://sgp.io)
 * Various state meta-data updates
+* Adding functionality to return number of years to reach SGP_TARGET returned. Accessible through SGPstateData meta-data currently. See testSGP(3) source code for example.
 
 
 # SGP 1.8-0.0

R/abcSGP.R

@@ -216,6 +216,6 @@ function(sgp_object,
 
 	### Print finish and return SGP object
 
-	messageSGP(paste("Finished abcSGP", prettyDate(), "in", convertTime(timetaken(started.at)), "\n"))
+	messageSGP(paste("Finished abcSGP", prettyDate(), "in", convertTime(timetakenSGP(started.at)), "\n"))
 	return(sgp_object)
 } ## END abcSGP Function

R/analyzeSGP.R

@@ -2230,7 +2230,7 @@ function(sgp_object,
 
 	if (!is.null(sgp.test.cohort.size) & toupper(return.sgp.test.results) != "ALL_DATA") {
 		if (!return.sgp.test.results) {
-			messageSGP(paste("Finished analyzeSGP", prettyDate(), "in", convertTime(timetaken(started.at)), "\n"))
+			messageSGP(paste("Finished analyzeSGP", prettyDate(), "in", convertTime(timetakenSGP(started.at)), "\n"))
 			return(sgp_object)
 		} else {
 			setkeyv(tmp_sgp_data_for_analysis, getKey(sgp_object@Data))
@@ -2243,6 +2243,6 @@ function(sgp_object,
 	if (goodness.of.fit.print) gof.print(sgp_object)
 	setkeyv(sgp_object@Data, getKey(sgp_object)) # re-key data for combineSGP, etc.
 	sgp_object@Version[["analyzeSGP"]][[as.character(gsub("-", "_", Sys.Date()))]] <- as.character(packageVersion("SGP"))
-	messageSGP(paste("Finished analyzeSGP", prettyDate(), "in", convertTime(timetaken(started.at)), "\n"))
+	messageSGP(paste("Finished analyzeSGP", prettyDate(), "in", convertTime(timetakenSGP(started.at)), "\n"))
 	return(sgp_object)
 } ## END analyzeSGP Function

R/baselineSGP.R

@@ -140,7 +140,7 @@ function(sgp_object,
 
 		message(paste("\tStarted baselineSGP Coefficient Matrix Calculation:", started.date))
 		message(paste0("\tContent Area: ", tail(content_areas, 1), ", Grade Progression: ", paste(grade.sequences, collapse=", "), ". "))
-		message(paste0("\tFinished baselineSGP Coefficient Matrix Calculation ", prettyDate(), " in ", convertTime(timetaken(started.at)), ".\n"))
+		message(paste0("\tFinished baselineSGP Coefficient Matrix Calculation ", prettyDate(), " in ", convertTime(timetakenSGP(started.at)), ".\n"))
 
 		return(tmp_sgp_list)
 
@@ -300,7 +300,7 @@ function(sgp_object,
 	###
 	############################################################
 
-	message(paste("\tFinished baselineSGP", prettyDate(), "in", convertTime(timetaken(started.at)), "\n"))
+	message(paste("\tFinished baselineSGP", prettyDate(), "in", convertTime(timetakenSGP(started.at)), "\n"))
 
 	if (return.matrices.only) {
 		tmp.list <- list()

R/bubblePlot_Styles.R

@@ -368,7 +368,7 @@ if (1 %in% bPlot.styles) {
 		} ## End loop over content_area.iter
 		} ## End loop over year.iter
 
-		message(paste("\tFinished bubblePlot Style 1", prettyDate(), "in", convertTime(timetaken(started.at)), "\n"))
+		message(paste("\tFinished bubblePlot Style 1", prettyDate(), "in", convertTime(timetakenSGP(started.at)), "\n"))
 
 } ## END bubblePlot style 1
 
@@ -498,7 +498,7 @@ if (2 %in% bPlot.styles) {
 		} ## End loop over year.iter
 		} ## End loop over bPlot.levels.iter
 
-		message(paste("\tFinished bubblePlot Style 2", prettyDate(), "in", convertTime(timetaken(started.at)), "\n"))
+		message(paste("\tFinished bubblePlot Style 2", prettyDate(), "in", convertTime(timetakenSGP(started.at)), "\n"))
 
 } ## END bubblePlot style 2
 
@@ -616,7 +616,7 @@ if (3 %in% bPlot.styles) {
 		} ## End loop over content_area.iter
 		} ## End loop over year.iter
 
-		message(paste("\tFinished bubblePlot Style 3", prettyDate(), "in", convertTime(timetaken(started.at)), "\n"))
+		message(paste("\tFinished bubblePlot Style 3", prettyDate(), "in", convertTime(timetakenSGP(started.at)), "\n"))
 
 } ## END bubblePlot style 3
 
@@ -714,7 +714,7 @@ if (10 %in% bPlot.styles) {
 		} ## End loop over content_area.iter
 		} ## End loop over year.iter
 
-		message(paste("\tFinished bubblePlot Style 10", prettyDate(), "in", convertTime(timetaken(started.at)), "\n"))
+		message(paste("\tFinished bubblePlot Style 10", prettyDate(), "in", convertTime(timetakenSGP(started.at)), "\n"))
 
 } ## END bubblePlot style 10
 
@@ -850,7 +850,7 @@ if (10 %in% bPlot.styles) {
 		} ## End loop over year.iter
 		} ## End loop over bPlot.levels.iter
 
-		message(paste("\tFinished bubblePlot Style 11", prettyDate(), "in", convertTime(timetaken(started.at)), "\n"))
+		message(paste("\tFinished bubblePlot Style 11", prettyDate(), "in", convertTime(timetakenSGP(started.at)), "\n"))
 
 } ## END bubblePlot style 11
 
@@ -948,7 +948,7 @@ if (20 %in% bPlot.styles) {
 		} ## End loop over content_area.iter
 		} ## End loop over year.iter
 
-		message(paste("\tFinished bubblePlot Style 20", prettyDate(), "in", convertTime(timetaken(started.at)), "\n"))
+		message(paste("\tFinished bubblePlot Style 20", prettyDate(), "in", convertTime(timetakenSGP(started.at)), "\n"))
 
 } ## END bubblePlot style 20
 
@@ -1068,7 +1068,7 @@ if (21 %in% bPlot.styles) {
 		} ## End loop over content_area.iter
 		} ## End loop over year.iter
 
-		message(paste("\tFinished bubblePlot Style 21", prettyDate(), "in", convertTime(timetaken(started.at)), "\n"))
+		message(paste("\tFinished bubblePlot Style 21", prettyDate(), "in", convertTime(timetakenSGP(started.at)), "\n"))
 
 } ## END bubblePlot style 21
 
@@ -1194,7 +1194,7 @@ if (22 %in% bPlot.styles) {
 		} ## End loop over content_area.iter
 		} ## End loop over year.iter
 
-		message(paste("\tFinished bubblePlot Style 22", prettyDate(), "in", convertTime(timetaken(started.at)), "\n"))
+		message(paste("\tFinished bubblePlot Style 22", prettyDate(), "in", convertTime(timetakenSGP(started.at)), "\n"))
 
 } ## END bubblePlot style 22
 
@@ -1292,7 +1292,7 @@ if (22 %in% bPlot.styles) {
 		} ## End loop over school_number.iter
 		} ## End loop over year.iter
 
-		message(paste("\tFinished bubblePlot Style 50", prettyDate(), "in", convertTime(timetaken(started.at)), "\n"))
+		message(paste("\tFinished bubblePlot Style 50", prettyDate(), "in", convertTime(timetakenSGP(started.at)), "\n"))
 
 	} ## END bubblePlot style 50
 
@@ -1389,7 +1389,7 @@ if (22 %in% bPlot.styles) {
 		} ## End loop over content_area.iter
 		} ## End loop over year.iter
 
-		message(paste("\tFinished bubblePlot Style 53", prettyDate(), "in", convertTime(timetaken(started.at)), "\n"))
+		message(paste("\tFinished bubblePlot Style 53", prettyDate(), "in", convertTime(timetakenSGP(started.at)), "\n"))
 
 	} ## END bubblePlot style 53
 
@@ -1545,7 +1545,7 @@ if (22 %in% bPlot.styles) {
 		} ## End loop over year.iter
 		} ## End loop over bPlot.levels.iter
 
-		message(paste("\tFinished bubblePlot Style 55", prettyDate(), "in", convertTime(timetaken(started.at)), "\n"))
+		message(paste("\tFinished bubblePlot Style 55", prettyDate(), "in", convertTime(timetakenSGP(started.at)), "\n"))
 
 	} ## END bubblePlot style 55
 
@@ -1645,7 +1645,7 @@ if (22 %in% bPlot.styles) {
 		} ## End loop over content_area.iter
 		} ## End loop over year.iter
 
-		message(paste("\tFinished bubblePlot Style 57", prettyDate(), "in", convertTime(timetaken(started.at)), "\n"))
+		message(paste("\tFinished bubblePlot Style 57", prettyDate(), "in", convertTime(timetakenSGP(started.at)), "\n"))
 
 	} ## END bubblePlot style 57
 
@@ -1799,7 +1799,7 @@ if (22 %in% bPlot.styles) {
 		} ## End loop over year.iter
 		} ## End loop over bPlot.levels.iter
 
-		message(paste("\tFinished bubblePlot Style 59", prettyDate(), "in", convertTime(timetaken(started.at)), "\n"))
+		message(paste("\tFinished bubblePlot Style 59", prettyDate(), "in", convertTime(timetakenSGP(started.at)), "\n"))
 
 } ## END bubblePlot style 59
 
@@ -2022,7 +2022,7 @@ if (22 %in% bPlot.styles) {
 		} ## END content_area.iter loop
 		} ## END year.iter loop
 
-		message(paste("\tFinished bubblePlot Style 100", prettyDate(), "in", convertTime(timetaken(started.at)), "\n"))
+		message(paste("\tFinished bubblePlot Style 100", prettyDate(), "in", convertTime(timetakenSGP(started.at)), "\n"))
 
 	} ## END if bubblePlot style 100
 
@@ -2187,7 +2187,7 @@ if (22 %in% bPlot.styles) {
 			} ## END content_area.iter loop
 			} ## END year.iter loop
 
-		message(paste("\tFinished bubblePlot Style 150", prettyDate(), "in", convertTime(timetaken(started.at)), "\n"))
+		message(paste("\tFinished bubblePlot Style 150", prettyDate(), "in", convertTime(timetakenSGP(started.at)), "\n"))
 
 	} ## END if bubblePlot style 150
 
@@ -2366,7 +2366,7 @@ if (22 %in% bPlot.styles) {
 		} ## END content_area.iter loop
 		} ## END year.iter loop
 
-		message(paste("\tFinished bubblePlot Style 153", prettyDate(), "in", convertTime(timetaken(started.at)), "\n"))
+		message(paste("\tFinished bubblePlot Style 153", prettyDate(), "in", convertTime(timetakenSGP(started.at)), "\n"))
 
 	} ## END if bubblePlot style 153
 

R/combineSGP.R

@@ -119,6 +119,14 @@ function(
 		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
+
+
+
 
 	### Utility functions
 
@@ -400,7 +408,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, max.sgp.target.years.forward, fix.duplicates=fix.duplicates)
+				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=return.sgp.target.num.years)
 
 				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)
 
@@ -644,7 +652,7 @@ function(
 	setkeyv(slot.data, getKey(slot.data))
 	sgp_object@Data <- slot.data
 
-	messageSGP(c(tmp.messages, paste("Finished combineSGP", prettyDate(), "in", convertTime(timetaken(started.at)), "\n")))
+	messageSGP(c(tmp.messages, paste("Finished combineSGP", prettyDate(), "in", convertTime(timetakenSGP(started.at)), "\n")))
 
 	return(sgp_object)
 } ## END combineSGP Function

R/convertTime.R

@@ -1,7 +1,6 @@
 `convertTime` <-
 function(tmp.time) {
-#	tmp <- tail(c(0, 0, rev(as.numeric(rev(unlist(strsplit(sub("sec", "", tmp.time), ":")))))), 3)
-	tmp <- tail(c(0, 0, 0, rev(as.numeric(rev(unlist(strsplit(sub(" ", ":", sub("sec|days ", "", tmp.time)), ":")))))), 4)
+	tmp <- tail(c(0, 0, 0, as.numeric(unlist(strsplit(tmp.time, ":")))), 4)
 	tmp.label <- c("Day", "Hour", "Minute", "Second")
 	tmp.label[which(tmp!=1)] <- paste0(tmp.label, "s")[which(tmp!=1)]
 	return(paste(paste(tmp[tmp!=0], tmp.label[tmp!=0]), collapse=", "))

R/getSGPConfig.R

@@ -22,7 +22,8 @@ function(sgp_object,
 	year.for.equate=NULL,
 	sgp.percentiles.equated=FALSE,
 	SGPt=NULL,
-	projection_group.identifier=NULL) {
+	projection_group.identifier=NULL,
+	from.getTargetScaleScore=FALSE) {
 
 	YEAR <- CONTENT_AREA <- VALID_CASE <- NULL
 
@@ -60,7 +61,7 @@ function(sgp_object,
 
 	### get.config function
 
-	get.config <- function(content_area, year, grades) {
+	get.config <- function(content_area, year, grades, from.getTargetScaleScore) {
 
 		### Data for Years & Grades
 		tmp.unique.data <- lapply(sgp_object@Data[SJ("VALID_CASE", content_area), nomatch=0][, c("YEAR", "GRADE"), with=FALSE], function(x) sort(type.convert(unique(x), as.is=TRUE)))
@@ -76,6 +77,11 @@ function(sgp_object,
 		if (!is.numeric(tmp.last.year.grades) | !is.numeric(tmp.unique.data[['GRADE']])) {
 			stop("\tNOTE: Automatic 'sgp.config' calculation is only available for integer grade levels. Manual specification of 'sgp.config' is required for non-traditional grade and course progressions.")
 		}
+
+		if (from.getTargetScaleScore && length(tmp.last.year.grades) > length(grades)) {
+			grades <- c(sort(grades), tmp.last.year.grades[which(tmp.last.year.grades==tail(sort(grades),1))+1])
+		}
+
 		tmp.sgp.grade.sequences <- lapply(tmp.last.year.grades, function(x) tail(tmp.unique.data$GRADE[tmp.unique.data$GRADE <= x], length(tmp.unique.data$YEAR)))
 		if (!is.null(grades)) {
 			tmp.sgp.grade.sequences <- tmp.sgp.grade.sequences[sapply(tmp.sgp.grade.sequences, function(x) tail(x,1)) %in% grades]
@@ -523,7 +529,7 @@ function(sgp_object,
 		}
 		for (i in content_areas) {
 			for (j in tmp.years[[i]]) {
-				tmp.sgp.config[[paste(i,j,sep=".")]] <- get.config(i,j,grades)
+				tmp.sgp.config[[paste(i,j,sep=".")]] <- get.config(i,j,grades,from.getTargetScaleScore)
 			}
 		}
 		par.sgp.config <- checkConfig(get.par.sgp.config(tmp.sgp.config), "Standard")

R/getTargetSGP.R

@@ -9,13 +9,14 @@ function(sgp_object,
 	max.sgp.target.years.forward=3,
 	subset.ids=NULL,
 	return.lagged.status=TRUE,
-	fix.duplicates=fix.duplicates) {
+	fix.duplicates=fix.duplicates,
+	return.sgp.target.num.years=FALSE) {
 
 	VALID_CASE <- ID <- CONTENT_AREA <- YEAR <- GRADE <- FIRST_OBSERVATION <- LAST_OBSERVATION <- STATE <- SGP_PROJECTION_GROUP <- DUPS_FLAG <- SCALE_SCORE <- SCALE_SCORE_PRIOR <- V1 <- NULL
 
 	### Utility functions
 
-	getTargetSGP_INTERNAL <- function(tmp_object_1, state, state.iter, projection_group.iter, target.type, target.level, year_within, fix.duplicates, max.sgp.target.years.forward) {
+	getTargetSGP_INTERNAL <- function(tmp_object_1, state, state.iter, projection_group.iter, target.type, target.level, year_within, fix.duplicates, max.sgp.target.years.forward, return.sgp.target.num.years) {
 
 		if (dups.tf <- !is.null(fix.duplicates)) {
 			if (any(grepl("_DUPS_[0-9]*", tmp_object_1[["ID"]]))) {
@@ -111,16 +112,25 @@ function(sgp_object,
 					paste(grep(paste0(sgp.projections.projection.unit.label, "_[", paste(seq(num.years.to.get), collapse=""), "]", tmp.suffix), names(tmp_object_1), value=TRUE), collapse=", ")
 
 				jExpression <- parse(text=paste0("{catch_keep_move_functions[[unclass(", target.level, "_STATUS_INITIAL)]](", tmp.level.variables, ", na.rm=TRUE)}"))
+				jExpression_num_years <- parse(text=paste0("{catch_keep_move_functions_num_years[[unclass(", target.level, "_STATUS_INITIAL)]](c(", tmp.level.variables, "))}"))
 				if (dups.tf) { #  Re-create _DUPS_ labels since ID is in jExp_Key
 					if ("DUPS_FLAG" %in% names(tmp_object_1)) invisible(tmp_object_1[!is.na(DUPS_FLAG), ID := paste0(ID, "_DUPS_", DUPS_FLAG)])
 					setkeyv(tmp_object_1, getKey(tmp_object_1))
 					jExp_Key <- intersect(names(tmp_object_1), c(jExp_Key, grep("SCALE_SCORE$|SCALE_SCORE_PRIOR", names(tmp_object_1), value=TRUE), "DUPS_FLAG", "SGP_PROJECTION_GROUP_SCALE_SCORES")) #  Keep these vars - still unique by ID so doesn't change results
 				}
 
 				if (max.sgp.target.years.forward.iter==1L) {
-					tmp_object_2 <- tmp_object_1[, eval(jExpression), keyby = jExp_Key]
+					if (return.sgp.target.num.years) {
+						tmp_object_2 <- tmp_object_1[, list(eval(jExpression), eval(jExpression_num_years)), keyby = jExp_Key]
+					} else {
+						tmp_object_2 <- tmp_object_1[, eval(jExpression), keyby = jExp_Key]
+					}
 				} else {
-					tmp_object_2[,V1:=tmp_object_1[, eval(jExpression), keyby = jExp_Key][['V1']]]
+					if (return.sgp.target.num.years) {
+						tmp_object_2[,c('V1', 'V2'):=list(tmp_object_1[, eval(jExpression), keyby = jExp_Key][['V1']], tmp_object_1[, eval(jExpression_num_years), keyby = jExp_Key][['V1']])]
+					} else {
+						tmp_object_2[,V1:=tmp_object_1[, eval(jExpression), keyby = jExp_Key][['V1']]]
+					}
 				}
 
 				if (target.type %in% c("sgp.projections.baseline", "sgp.projections.lagged.baseline")) baseline.label <- "_BASELINE" else baseline.label <- NULL
@@ -129,6 +139,10 @@ function(sgp_object,
 
 				setnames(tmp_object_2, "V1",
 					paste0("SGP_TARGET", baseline.label, target.level.label, "_",  num.years.to.get.label, "_", sgp.projections.projection.unit.label, projection.label))
+				if (return.sgp.target.num.years) {
+					setnames(tmp_object_2, "V2",
+						paste0("SGP_TARGET", baseline.label, target.level.label, "_",  num.years.to.get.label, "_", sgp.projections.projection.unit.label, projection.label, "_NUM_YEARS_TO_TARGET"))
+				}
 
 				if (target.type %in% c("sgp.projections.lagged", "sgp.projections.lagged.baseline") && return.lagged.status) {
 					tmp_object_2[,c("ACHIEVEMENT_LEVEL_PRIOR", grep("STATUS_INITIAL", names(tmp_object_1), value=TRUE)):=
@@ -147,6 +161,7 @@ function(sgp_object,
 	tmp.sgpTarget.list <- list()
 
 	catch_keep_move_functions <- c(min, max)
+	catch_keep_move_functions_num_years <- c(which.min, which.max)
 
 	if (!is.null(SGP::SGPstateData[[state]][["SGP_Configuration"]][["sgp.projections.projection.unit.label"]])) {
 		sgp.projections.projection.unit.label <- SGP::SGPstateData[[state]][["SGP_Configuration"]][["sgp.projections.projection.unit.label"]]
@@ -201,7 +216,7 @@ function(sgp_object,
 			for (projection_group.iter in unique(tmp_object_1[['SGP_PROJECTION_GROUP']])) {
 				tmp.sgpTarget.list[[paste(state.iter, projection_group.iter, sep=".")]] <-
 				getTargetSGP_INTERNAL(tmp_object_1[SGP_PROJECTION_GROUP==projection_group.iter], state, state.iter, projection_group.iter, target.type, target.level,
-					year_within="YEAR_WITHIN" %in% names(slot.data), fix.duplicates=fix.duplicates, max.sgp.target.years.forward=max.sgp.target.years.forward)
+					year_within="YEAR_WITHIN" %in% names(slot.data), fix.duplicates=fix.duplicates, max.sgp.target.years.forward=max.sgp.target.years.forward, return.sgp.target.num.years=return.sgp.target.num.years)
 			}
 		} ### END !is.null(level.to.get)
 	} ### END for state.iter