fixed pasfr global norm when missing countries

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: bayesPop
 Type: Package
 Title: Probabilistic Population Projection
-Version: 10.0-1.9022
+Version: 10.0-1.9023
 Date: 2024-12-10
 Author: Hana Sevcikova, Adrian Raftery, Thomas Buettner
 Maintainer: Hana Sevcikova <[email protected]>

R/predict.pop.R

@@ -630,22 +630,32 @@ load.inputs <- function(inputs, start.year, present.year, end.year, wpp.year, fi
 			observed$MIGf <- MIGf[,c('country_code', 'age', obs.periods[avail.obs.periods])]
 		}
 	}
-	MIGm <- MIGm[,c('country_code', 'age', proj.periods)]
-	MIGf <- MIGf[,c('country_code', 'age', proj.periods)]
+	MIGm <- MIGm[,c('country_code', 'age', intersect(proj.periods, colnames(MIGm)))]
+	MIGf <- MIGf[,c('country_code', 'age', intersect(proj.periods, colnames(MIGf)))]
 
 	# assign some migrate-specific attributes, since they get lost by slicing above
 	if(!is.null((rates <- attr(miginp[["migM"]], "rate")))){
-	    attr(MIGm, "rate") <- rates[, c('country_code', proj.periods), with = FALSE]
-	    attr(MIGm, "code") <- attr(miginp[["migM"]], "code")[, c('country_code', proj.periods), with = FALSE]
-	    if(!is.null(obs.periods) && is.null(existing.mig)) {
+	    if(length(intersect(proj.periods, colnames(rates))) > 0) {
+	        attr(MIGm, "rate") <- rates[, c('country_code', intersect(proj.periods, colnames(rates))), with = FALSE]
+	        attr(MIGm, "code") <- attr(miginp[["migM"]], "code")[, c('country_code', intersect(proj.periods, colnames(code))), with = FALSE]
+	    } else {
+	        attr(MIGm, "rate") <- NULL
+	        attr(MIGm, "code") <- NULL
+	    }
+	    if(!is.null(obs.periods) && is.null(existing.mig) && any(avail.obs.periods)) {
 	        attr(observed$MIGm, "rate") <- rates[, c('country_code', obs.periods[avail.obs.periods]), with = FALSE]
 	        attr(observed$MIGm, "code") <- attr(miginp[["migM"]], "code")[, c('country_code', obs.periods[avail.obs.periods]), with = FALSE]
 	    }
 	}
 	if(!is.null((rates <- attr(miginp[["migF"]], "rate")))){
-	    attr(MIGf, "rate") <- rates[, c('country_code', proj.periods), with = FALSE]
-	    attr(MIGf, "code") <- attr(miginp[["migF"]], "code")[, c('country_code', proj.periods), with = FALSE]
-	    if(!is.null(obs.periods) && is.null(existing.mig)) {
+	    if(length(intersect(proj.periods, colnames(rates))) > 0) {
+	        attr(MIGf, "rate") <- rates[, c('country_code', intersect(proj.periods, colnames(rates))), with = FALSE]
+	        attr(MIGf, "code") <- attr(miginp[["migF"]], "code")[, c('country_code', intersect(proj.periods, colnames(code))), with = FALSE]
+	    } else {
+	        attr(MIGf, "rate") <- NULL
+	        attr(MIGf, "code") <- NULL
+	    }
+	    if(!is.null(obs.periods) && is.null(existing.mig) && any(avail.obs.periods)) {
 	        attr(observed$MIGf, "rate") <- rates[, c('country_code', obs.periods[avail.obs.periods]), with = FALSE]
 	        attr(observed$MIGf, "code") <- attr(miginp[["migF"]], "code")[, c('country_code', obs.periods[avail.obs.periods]), with = FALSE]
 	    }
@@ -729,6 +739,20 @@ load.inputs <- function(inputs, start.year, present.year, end.year, wpp.year, fi
 		assign(par, get(par), envir=inp)
 	inp$pop.matrix <- list(male=pop.ini.matrix[['M']], female=pop.ini.matrix[['F']])
 	inp$PASFRnorms <- compute.pasfr.global.norms(inp)
+	if(is.null(inp$PASFRnorms)){ # if a country is missing in the pasfr data, take the pre-computed global norms
+	    env <- new.env()
+	    do.call("data", list("pasfr_global_norms", envir = env))
+	    inp$PASFRnorms <- if(annual) env$pasfr.glob.norms1 else env$pasfr.glob.norms5
+	    if(!is.null(obs.periods)) { 
+	        # if any of the observed years are missing in the global norm, use the latest norm for those time periods
+	        missing.years <- obs.periods[! obs.periods %in% colnames(inp$PASFRnorms$PasfrGlobalNorm)]
+	        if(length(missing.years) > 0) {
+	            last.norm <- inp$PASFRnorms$PasfrGlobalNorm[, rep(ncol(inp$PASFRnorms$PasfrGlobalNorm), length(missing.years))]
+	            colnames(last.norm) <- missing.years
+	            inp$PASFRnorms$PasfrGlobalNorm <- cbind(inp$PASFRnorms$PasfrGlobalNorm, last.norm)
+	        }
+	    }
+	}
 	inp$average.annual <- inputs$average.annual
 	inp$mig.alt.age.schedule <- inputs$mig.alt.age.schedule
 	return(inp)
@@ -1386,6 +1410,7 @@ compute.pasfr.global.norms <- function(inputs) {
 		ccounter <- rep(0, )
 		for(country in countries) {
 			pasfr <- .get.par.from.inputs('PASFR', inputs$observed, country)
+			if(is.null(pasfr)) return(NULL)
 			pasfr <- .fill.pasfr.ages(pasfr, ages.fert(inputs$annual), check.length.only = !inputs$annual)
 			if(is.null(ccounter)) ccounter <- rep(0, ncol(pasfr)) # deals with missing years for some countries
             is.not.observed <- apply(pasfr, 2, function(x) any(is.na(x)))