performance fix

PPgp · Apr 4, 2024 · 5203223 · 5203223
1 parent 6711085
commit 5203223
Showing 1 changed file with 5 additions and 5 deletions.
diff --git a/R/predict.pop.R b/R/predict.pop.R
@@ -1326,7 +1326,9 @@ migration.totals2age <- function(df, ages = NULL, annual = FALSE, time.periods =
 		                                alt.schedule.file = pred$inputs$mig.alt.age.schedule, 
 		                                wpp.year = pred$inputs$wpp.year, ...#, debug = TRUE
 		                                )
-		    migdf <- melt(adf, value.name = "value", variable.name = "year", id.vars = c("trajectory", "age"))
+		    migdf <- melt(adf, value.name = "value", variable.name = "year", 
+		                  id.vars = c("trajectory", "age"), variable.factor = FALSE)
+		    migdf[, year := as.integer(year)]
 		    if("rate" %in% names(attributes(adf))) { # extract rates if available
 		        migrate <- attr(adf, "rate")
 		        migrate <- as.matrix(migrate[, colnames(migrate)[! colnames(migrate) == "trajectory"], with = FALSE]) # remove the trajectory column
@@ -1335,9 +1337,9 @@ migration.totals2age <- function(df, ages = NULL, annual = FALSE, time.periods =
 		        migratecode <- as.matrix(migratecode[, colnames(migratecode)[! colnames(migratecode) == "trajectory"], with = FALSE]) # remove the trajectory column
 		    }
 		}
-		migdf$age <- gsub("^\\s+|\\s+$", "", migdf$age) # trim leading and trailing whitespace
+		#migdf$age <- gsub("^\\s+|\\s+$", "", migdf$age) # trim leading and trailing whitespace
 		lage <- age.length.all(pred$inputs$annual, observed = TRUE)
-		sorted.df <- data.frame(year=rep(pred$inputs$proj.years, each=ntrajs*lage), trajectory=rep(rep(utrajs, each=lage), times=lyears),
+		sorted.df <- data.table(year=rep(pred$inputs$proj.years, each=ntrajs*lage), trajectory=rep(rep(utrajs, each=lage), times=lyears),
 									age = get.age.labels(ages.all(pred$inputs$annual, observed = TRUE), last.open=TRUE, single.year = pred$inputs$annual))
 		# this is to get rows of the data frame in a particular order
 		migdf <- merge(sorted.df, migdf, sort=FALSE)
@@ -1678,7 +1680,6 @@ get.country.inputs <- function(country, inputs, nr.traj, country.name) {
 	}
 	inpc$migMmedian <- medians$migMpred
 	inpc$migFmedian <- medians$migFpred
-
 	if(is.null(inpc$TFRpred)) {
 		inpc$TFRpred <- get.tfr.trajectories(inputs$TFRpred, country)
 		if(is.null(inpc$TFRpred)) {
@@ -1813,7 +1814,6 @@ get.country.inputs <- function(country, inputs, nr.traj, country.name) {
 	    gq <- c(gq, rep(0, age.length.all(inputs$annual, observed = FALSE) - length(gq)))
 	    inpc[[par]] <- gq
 	}
-
 	inpc$observed <- obs
 	inpc$trajectory.indices <- indices
 	return(inpc)