paramFitFunc: Generate Parametric Mortality Smulator

Description Usage Arguments Value Examples

View source: R/paramFitFunc.R

Description

Generates a parametric mortality simulator using a gamma distribution for under 5 mortality and a skewed normal for above five mortality where the probability of puuling from the gamma distribution is generated from the observed data.

Usage

1
2
3
paramFitFunc(start_params = c(0, 0, 1.1, 0.57, 80),
  location_ = "United States", year_ = 2016, sex_ = "Both",
  max_age = 140, returnParams = FALSE)

Arguments

start_params

vector of length five of starting values for parameters

location_

character, country name

year_

1970 <= int <= 2016, year of mortality function to generate

sex_

character, either 'Female', 'Male', or 'Both'

max_age

float, float for the max age allowed for simulatuins generally a value >= 120

return_params

logical, whether to return the fitted parameter values rather than the simulation function

Value

List of Demographic Mortality and Simulation Functions

Generates a parametric mortality simulator using a gamma distribution for under 5 mortality and a skewed normal for above five mortality where the probability of puuling from the gamma distribution is generated from the observed data.

Examples

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
# Show list of countries we can simulate from 
unique(DFDeath$location)

# run plotting and simulation code
require(dplyr)
require(ggplot2)
# Generate the demographic functions for Mexico 1980
MX2016sim <- paramFitFunc(location_="Mexico", year_=1980, sex_="Both")


m <- 10000
system.time(simDeaths <- lapply(1:10, function(y) MX2016sim(m)))

MXDeath <- DFDeath %>%
    filter(location=="Mexico" & year==1980 & sex=="Both")

aggData <- function(sims, sim_num, m_=m){
    MXDeath %>% select(age_group_id, age_time, age_end) %>%
        mutate(ldeaths=sapply(age_end, function(a) sum(sims < a))) %>%
        mutate(deaths=ldeaths-lag(ldeaths)) %>%
        mutate(deaths=ifelse(is.na(deaths), ldeaths, deaths)) %>%
        mutate(pop_size=m_-lag(ldeaths)) %>%
        mutate(pop_size=ifelse(is.na(pop_size), m_, pop_size)) %>%
        mutate(px=deaths/pop_size, qx=1-px) %>%
        mutate(hx=1-(qx^(1/age_time))) %>% 
        mutate(Sx=cumprod(qx), Fx=1-Sx) %>%
        mutate(simulation=sim_num)
}

simDF <- bind_rows(lapply(1:10, function(i) aggData(simDeaths[[i]], i))) 

simDF %>% filter(age_end < 115 & hx != 0) %>%
    ggplot(aes(x=age_end, y=hx, color=simulation, group=simulation)) + 
    geom_line(alpha=.3) + 
    geom_line(aes(x=age_end, y=hx, group=1), data=MXDeath, color="red") + 
    coord_trans(y="log") + 
    labs(title="Parametric Simulated Instantaneous Hazard", x="Age", y="Hazard")

nmmarquez/DemographicSimulation documentation built on May 20, 2019, 8:32 a.m.