diff --git a/ChangeLog b/ChangeLog index a6ce99c..0c8166e 100644 --- a/ChangeLog +++ b/ChangeLog @@ -2,6 +2,8 @@ ------ Added vwBaseYear2024 dataset. +Incorporated use of 2024 migration dataset by age. + pop.predict.subnat can handle 1x1 subnational projections. Fix in 1x1 GQs. diff --git a/DESCRIPTION b/DESCRIPTION index 6e3ea67..9f39116 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Package: bayesPop Type: Package Title: Probabilistic Population Projection -Version: 10.0-1.9016 -Date: 2024-09-18 +Version: 10.0-1.9017 +Date: 2024-09-19 Author: Hana Sevcikova, Adrian Raftery, Thomas Buettner Maintainer: Hana Sevcikova Depends: R (>= 3.5.0), bayesTFR (>= 7.1-0), bayesLife (>= 5.0-0), MortCast (>= 2.6-1) diff --git a/R/predict.pop.R b/R/predict.pop.R index bb88896..b696f86 100644 --- a/R/predict.pop.R +++ b/R/predict.pop.R @@ -1061,8 +1061,13 @@ migration.totals2age <- function(df, ages = NULL, annual = FALSE, time.periods = if(annual && wpp.year < 2022) stop("Migration must be given for an annual simulation and wpp.year < 2022.") migdsname <- paste0('migration', sex) if(wpp.year >= 2022) migdsname <- paste0(migdsname, if(annual) 1 else 5) - if(migdsname %in% wppds$results[,'Item']) { # if available in the WPP package (only in wpp2012) + if(migdsname %in% wppds$results[,'Item']) { # if available in the WPP package (only in wpp2012 and for projections in wpp2024) miginp[[inpname]] <- bayesTFR:::load.from.wpp(migdsname, wpp.year, annual = annual) + if(length((missing.years <- setdiff(periods, colnames(miginp[[inpname]])))) > 0){ #for wpp2024 only projected years available, so attach the remaining years + miginp[[inpname]] <- data.frame(merge(migtempl[, c("country_code", "age", missing.years), with = FALSE], + miginp[[inpname]][, setdiff(colnames(miginp[[inpname]]), "name")], + by = c("country_code", "age")), check.names = FALSE) + } next } if(all.countries) { # split default total migration into ages for all countries @@ -1598,9 +1603,11 @@ get.country.inputs <- function(country, inputs, nr.traj, country.name) { } inpc[['MIGBaseYear']] <- inpc[['MIGtype']][,'ProjFirstYear'] inpc[['MIGtype']] <- inpc[['MIGtype']][,'MigCode'] + # generate sex and age-specific migration if needed - if((!is.null(inpc[['MIGm']]) && all(is.na(inpc[['MIGm']]))) || (!is.null(inpc[['MIGf']]) && all(is.na(inpc[['MIGf']])))) { - if(inputs$annual || inputs$mig.age.method == "rc" || (inputs$mig.age.method %in% c("auto", "un") && !inputs$annual && inputs$wpp.year == 2022)){ + if((!is.null(inpc[['MIGm']]) && any(colSums(is.na(inpc[['MIGm']])) > 0)) || ( + !is.null(inpc[['MIGf']]) && any(colSums(is.na(inpc[['MIGf']])) > 0))) { + if(inputs$annual || inputs$mig.age.method == "rc" || (inputs$mig.age.method %in% c("auto", "un") && !inputs$annual && inputs$wpp.year >= 2022)){ migtempl <- if(!is.null(inpc[['MIGm']])) inpc[['MIGm']] else inpc[['MIGf']] mig.recon <- list() wppdata <- bayesTFR:::load.from.wpp("migration", inputs$wpp.year, annual = inputs$annual) @@ -1628,6 +1635,7 @@ get.country.inputs <- function(country, inputs, nr.traj, country.name) { wpp.year = inputs$wpp.year), check.names = FALSE) } + rownames(mig.recon[["male"]]) <- rownames(mig.recon[["female"]]) <- rownames(migtempl) # rownames should be the ages } else { mig.recon <- age.specific.migration(wpp.year=inputs$wpp.year, countries=country, #use.rc = inputs$mig.age.method == "rc", @@ -1636,14 +1644,14 @@ get.country.inputs <- function(country, inputs, nr.traj, country.name) { } mig.pair <- list(MIGm="male", MIGf="female") for(what.mig in names(mig.pair)) { - if(!is.null(inpc[[what.mig]]) && all(is.na(inpc[[what.mig]]))) { + if(!is.null(inpc[[what.mig]]) && any(colSums(is.na(inpc[[what.mig]])) > 0)) { # extract predicted migration - cols <- intersect(colnames(mig.recon[[mig.pair[[what.mig]]]]), colnames(inpc[[what.mig]])) + cols <- intersect(colnames(mig.recon[[mig.pair[[what.mig]]]]), colnames(inpc[[what.mig]][, colSums(is.na(inpc[[what.mig]])) > 0])) inpc[[what.mig]][,cols] <- as.matrix(mig.recon[[mig.pair[[what.mig]]]][,cols]) rownames(inpc[[what.mig]]) <- rownames(mig.recon[[mig.pair[[what.mig]]]]) # extract observed migration if(!is.null(obs[[what.mig]])) { - cols <- intersect(colnames(mig.recon[[mig.pair[[what.mig]]]]), colnames(obs[[what.mig]])) + cols <- intersect(colnames(mig.recon[[mig.pair[[what.mig]]]]), colnames(obs[[what.mig]][, colSums(is.na(obs[[what.mig]])) > 0])) obs[[what.mig]][,cols] <- as.matrix(mig.recon[[mig.pair[[what.mig]]]][,cols]) rownames(obs[[what.mig]]) <- rownames(mig.recon[[mig.pair[[what.mig]]]]) }