From 5203223aa19d0e2c6b5c242e0bec72e0b9f393ff Mon Sep 17 00:00:00 2001 From: Hana Sevcikova Date: Thu, 4 Apr 2024 15:00:07 -0700 Subject: [PATCH] performance fix --- R/predict.pop.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/R/predict.pop.R b/R/predict.pop.R index 5e31d1f..38f878d 100644 --- 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)