# R/approx_demographics.R In excessmort: Excess Mortality

#### Documented in approx_demographics

```#' Interpolate demographic data
#'
#' Interpolate yearly population estimates so that a population estimate is provided for
#' each day of the year. The function `approx` is used with `rule = 2` for extrapolation.
#'
#' @param demo A data frame with the yearly population estimates
#' @param first_day First day to interpolate
#' @param last_day Last day to interpolate.
#' @param by Vector of column names to group by, for example different demographic strata
#'
#' @return A data frame with dates and population estimates.
#' @export
#' @importFrom stats approx
#' @import dplyr
#'
approx_demographics <- function(demo, first_day, last_day, by = "year")
{
################## ----- PARAMETERS ----- ##################
# 1. demo      : Dataframe from the function getDemographics()
# 2. first_day : First day of interpolating sequence
# 3. last_day  : Last day of interpolating sequence

# -- Defining xout days
first_day <- as.Date(first_day)
last_day  <- as.Date(last_day)
days <- seq(first_day, last_day, by=1)

# -- Function used within approxDemographics to interpolate population
do_approx <- function(tab, days){

# -- Create date variable
tab\$date <- lubridate::make_date(tab\$year, 7, 1)

# -- Variables to be return
return(data.frame(date       = days,
population = approx(tab\$date, tab\$population, xout=days, rule=2)\$y))
}

# -- Interpolating population
demo <- demo %>%
group_by_at(by) %>%
summarize(population = sum(population, na.rm=T)) %>%
ungroup() %>%
group_by_at(by[-1]) %>%
do(do_approx(., days)) %>%
ungroup() %>%
as_tibble()

return(demo)
}
```

## Try the excessmort package in your browser

Any scripts or data that you put into this service are public.

excessmort documentation built on Oct. 11, 2021, 9:06 a.m.