R/PFilter-fake.R

In ONSdigital/Bayesian-demographic-accounts: Bayesian Demographic Accounts

## ## Functions to create simulated PFilter objects, for use in testing

## fake_pfilter_noreg <- function(is_new_cohort = FALSE,
##                                has_births_to = TRUE,
##                                n_interval = 5,
##                                n_particle = 4,
##                                n_thin = 1,
##                                threshold = 0.5) {
##     if (is_new_cohort)
##         counts_births_of <- stats::rpois(n = 1L, lambda = 20)
##     else
##         counts_births_of <- 0L
##     if (has_births_to) {
##         counts_births_to <- stats::rpois(n = n_interval, lambda = 3)
##         rates_births <- stats::rgamma(n = n_interval, shape = 1, rate = 3)
##     }
##     else {
##         counts_births_to <- rep(0L, times = n_interval)
##         rates_births <- rep(0, times = n_interval)
##     }
##     counts_deaths <- stats::rpois(n = n_interval, lambda = 5)
##     rates_deaths <- stats::rgamma(n = n_interval, shape = 1, rate = 3)
##     rates_immigration1 <- stats::rgamma(n = n_interval, shape = 1, rate = 0.2)
##     rates_emigration1 <- stats::rgamma(n = n_interval, shape = 1, rate = 3)
##     rates_immigration2 <- stats::rgamma(n = n_interval, shape = 1, rate = 0.2)                           
##     rates_emigration2 <- stats::rgamma(n = n_interval, shape = 1, rate = 3)
##     counts_data_stock_1 <- stats::rpois(n = n_interval + 1L, lambda = 20)
##     counts_data_stock_2 <- stats::rpois(n = n_interval + 1L, lambda = 20)
##     cdm_stock_1 <- new_cdm_noreg_poibin(counts_data = counts_data_stock_1, prob = 0.95)
##     cdm_stock_2 <- new_cdm_noreg_poibin(counts_data = counts_data_stock_2, prob = 0.95)
##     cdms_stock <- new_CdmsNoreg(list(cdm_stock_1, cdm_stock_2))
##     counts_data_im1 <- stats::rpois(n = n_interval, lambda = rates_immigration1)
##     cdm_im1 <- new_cdm_noreg_poibin(counts_data = counts_data_im1, prob = 0.95)
##     cdms_immigration1 <- new_CdmsNoreg(list(cdm_im1))
##     counts_data_em1 <- stats::rpois(n = n_interval, lambda = 10 * rates_emigration1)
##     cdm_em1 <- new_cdm_noreg_poibin(counts_data = counts_data_em1, prob = 0.95)
##     cdms_emigration1 <- new_CdmsNoreg(list(cdm_em1))
##     counts_data_im2 <- stats::rpois(n = n_interval, lambda = rates_immigration2)
##     cdm_im2 <- new_cdm_noreg_poibin(counts_data = counts_data_im2, prob = 0.95)
##     cdms_immigration2 <- new_CdmsNoreg(list(cdm_im2))
##     counts_data_em2 <- stats::rpois(n = n_interval, lambda = 10 * rates_emigration2)
##     cdm_em2 <- new_cdm_noreg_poibin(counts_data = counts_data_em2, prob = 0.95)
##     cdms_emigration2 <- new_CdmsNoreg(list(cdm_em2))
##     df_row <- data.frame(cohort = 2000L,
##                          sexgender = "Female",
##                          is_new_cohort = is_new_cohort,
##                          has_births_to = has_births_to,
##                          n_interval = as.integer(n_interval),
##                          counts_births_of = list(counts_births_of),
##                          counts_births_to = list(counts_births_to),
##                          counts_deaths = list(counts_deaths),
##                          rates_births = list(rates_births),
##                          rates_deaths = list(rates_deaths),
##                          rates_immigration1 = list(rates_immigration1),
##                          rates_emigration1 = list(rates_emigration1),
##                          rates_immigration2 = list(rates_immigration2),
##                          rates_emigration2 = list(rates_emigration2),
##                          cdms_stock = list(cdms_stock),
##                          cdms_immigration1 = list(cdms_immigration1),
##                          cdms_emigration1 = list(cdms_emigration1),
##                          cdms_immigration2 = list(cdms_immigration2),
##                          cdms_emigration2 = list(cdms_emigration2))                     
##     PFilterNoReg$new(df_row = df_row,
##                      n_particle = as.integer(n_particle),
##                      n_thin = as.integer(n_thin),
##                      threshold = as.numeric(threshold))
## }


## fake_pfilter_withreg <- function(is_new_cohort = FALSE,
##                                  has_births_to = TRUE,
##                                  n_region = 2,
##                                  n_interval = 5,
##                                  n_particle = 4,
##                                  n_thin = 1,
##                                  threshold = 0.5) {
##     if (is_new_cohort)
##         counts_births_of <- stats::rpois(n = n_region, lambda = 20)
##     else
##         counts_births_of <- rep(0L, times = n_region)
##     if (has_births_to) {
##         counts_births_to <- matrix(stats::rpois(n = n_region * n_interval, lambda = 3),
##                                    nrow = n_region,
##                                    ncol = n_interval)
##         rates_births <- matrix(stats::rgamma(n = n_region * n_interval, shape = 1, rate = 3),
##                                nrow = n_region,
##                                ncol = n_interval)
##     }
##     else {
##         counts_births_to <- matrix(0L,
##                                    nrow = n_region,
##                                    ncol = n_interval)
##         rates_births <- matrix(0,
##                                nrow = n_region,
##                                ncol = n_interval)
##     }
##     counts_deaths <- matrix(stats::rpois(n = n_region * n_interval, lambda = 5),
##                             nrow = n_region,
##                             ncol = n_interval)
##     rates_deaths <- matrix(stats::rgamma(n = n_region * n_interval, shape = 1, rate = 3),
##                            nrow = n_region,
##                            ncol = n_interval)
##     rates_internal_in <- matrix(stats::rgamma(n = n_region * n_interval, shape = 1, rate = 0.2),
##                                 nrow = n_region,
##                                 ncol = n_interval)
##     rates_internal_out <- matrix(stats::rgamma(n = n_region * n_interval, shape = 1, rate = 0.2),
##                                  nrow = n_region,
##                                  ncol = n_interval)
##     rates_immigration1 <- matrix(stats::rgamma(n = n_region * n_interval, shape = 1, rate = 0.2),
##                                  nrow = n_region,
##                                  ncol = n_interval)
##     rates_emigration1 <- matrix(stats::rgamma(n = n_region * n_interval, shape = 1, rate = 3),
##                                 nrow = n_region,
##                                 ncol = n_interval)
##     rates_immigration2 <- matrix(stats::rgamma(n = n_region * n_interval, shape = 1, rate = 0.2),
##                                  nrow = n_region,
##                                  ncol = n_interval)
##     rates_emigration2 <- matrix(stats::rgamma(n = n_region * n_interval, shape = 1, rate = 3),
##                                 nrow = n_region,
##                                 ncol = n_interval)
##     counts_data_stock_1 <- matrix(stats::rpois(n = n_region * (n_interval + 1L), lambda = 20),
##                                   nrow = n_region,
##                                   ncol = n_interval + 1L)
##     counts_data_stock_2 <- matrix(stats::rpois(n = n_region * (n_interval + 1L), lambda = 20),
##                                   nrow = n_region,
##                                   ncol = n_interval + 1L)
##     cdm_stock_1 <- new_cdm_withreg_poibin(counts_data = counts_data_stock_1, prob = 0.95)
##     cdm_stock_2 <- new_cdm_withreg_poibin(counts_data = counts_data_stock_2, prob = 0.95)
##     cdms_stock <- new_CdmsWithreg(list(cdm_stock_1, cdm_stock_2))
##     counts_data_in <- matrix(stats::rpois(n = n_region * n_interval, lambda = rates_internal_in),
##                              nrow = n_region,
##                              ncol = n_interval)
##     cdm_in <- new_cdm_withreg_poibin(counts_data = counts_data_in, prob = 0.95)
##     cdms_internal_in <- new_CdmsWithreg(list(cdm_in))
##     counts_data_out <- matrix(stats::rpois(n = n_region * n_interval, lambda = rates_internal_out),
##                               nrow = n_region,
##                               ncol = n_interval)
##     cdm_out <- new_cdm_withreg_poibin(counts_data = counts_data_out, prob = 0.95)
##     cdms_internal_out <- new_CdmsWithreg(list(cdm_out))
##     counts_data_im1 <- matrix(stats::rpois(n = n_region * n_interval, lambda = rates_immigration1),
##                               nrow = n_region,
##                               ncol = n_interval)
##     cdm_im1 <- new_cdm_withreg_poibin(counts_data = counts_data_im1, prob = 0.95)
##     cdms_immigration1 <- new_CdmsWithreg(list(cdm_im1))
##     counts_data_em1 <- matrix(stats::rpois(n = n_region * n_interval, lambda = 10 * rates_emigration1),
##                               nrow = n_region,
##                               ncol = n_interval)
##     cdm_em1 <- new_cdm_withreg_poibin(counts_data = counts_data_em1, prob = 0.95)
##     cdms_emigration1 <- new_CdmsWithreg(list(cdm_em1))
##     counts_data_im2 <- matrix(stats::rpois(n = n_region * n_interval, lambda = rates_immigration2),
##                               nrow = n_region,
##                               ncol = n_interval)
##     cdm_im2 <- new_cdm_withreg_poibin(counts_data = counts_data_im2, prob = 0.95)
##     cdms_immigration2 <- new_CdmsWithreg(list(cdm_im2))
##     counts_data_em2 <- matrix(stats::rpois(n = n_region * n_interval, lambda = 10 * rates_emigration2),
##                               nrow = n_region,
##                               ncol = n_interval)
##     cdm_em2 <- new_cdm_withreg_poibin(counts_data = counts_data_em2, prob = 0.95)
##     cdms_emigration2 <- new_CdmsWithreg(list(cdm_em2))
##     df_row <- data.frame(cohort = 2000L,
##                          sexgender = "Female",
##                          is_new_cohort = is_new_cohort,
##                          has_births_to = has_births_to,
##                          n_interval = as.integer(n_interval),
##                          counts_births_of = list(counts_births_of),
##                          counts_births_to = list(counts_births_to),
##                          counts_deaths = list(counts_deaths),
##                          rates_births = list(rates_births),
##                          rates_deaths = list(rates_deaths),
##                          rates_immigration1 = list(rates_immigration1),
##                          rates_emigration1 = list(rates_emigration1),
##                          rates_immigration2 = list(rates_immigration2),
##                          rates_emigration2 = list(rates_emigration2),
##                          cdms_stock = list(cdms_stock),
##                          cdms_immigration1 = list(cdms_immigration1),
##                          cdms_emigration1 = list(cdms_emigration1),
##                          cdms_immigration2 = list(cdms_immigration2),
##                          cdms_emigration2 = list(cdms_emigration2))                     
##     PFilterWithReg$new(df_row = df_row,
##                        n_particle = as.integer(n_particle),
##                        n_thin = as.integer(n_thin),
##                        threshold = as.numeric(threshold))
## }