inst/doc/using_ipfr.R

In ipfr: List Balancing for Reweighting and Population Synthesis

## ---- include = FALSE---------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

## ----setup--------------------------------------------------------------------
suppressPackageStartupMessages({
  library(ipfr)
  library(dplyr)
})

## -----------------------------------------------------------------------------
set.seed(42)
mtx <- matrix(data = runif(9), nrow = 3, ncol = 3)
row_targets <- c(3, 4, 5)
column_targets <- c(5, 4, 3)
mtx

## -----------------------------------------------------------------------------
result <- ipu_matrix(mtx, row_targets, column_targets)
result
rowSums(result)
colSums(result)

## -----------------------------------------------------------------------------
survey <- tibble(
  size = c(1, 2, 1, 1),
  autos = c(0, 2, 2, 1),
  weight = 1
)

survey

## -----------------------------------------------------------------------------
targets <- list()
targets$size <- tibble(
  `1` = 75,
  `2` = 25
)
targets$autos <- tibble(
  `0` = 25,
  `1` = 50,
  `2` = 25
)

targets

## -----------------------------------------------------------------------------
result <- ipu(survey, targets)
names(result)

## -----------------------------------------------------------------------------
result$weight_tbl

## -----------------------------------------------------------------------------
result$weight_dist

## -----------------------------------------------------------------------------
result$primary_comp

## ----arizona inputs-----------------------------------------------------------
result <- setup_arizona()
hh_seed <- result$hh_seed
hh_targets <- result$hh_targets
per_seed <- result$per_seed
per_targets <- result$per_targets

## ----arizona ipu--------------------------------------------------------------
result <- ipu(hh_seed, hh_targets, per_seed, per_targets, max_iterations = 30)

## ----arizona results----------------------------------------------------------
result$weight_tbl
  
result$primary_comp

result$secondary_comp

## ----multigeo inputs----------------------------------------------------------
# Repeat the hh_seed to create tract 1 and 2 households
new_hh_seed <- hh_seed %>%
  mutate(geo_tract = 1)
new_hh_seed <- bind_rows(
  new_hh_seed,
  new_hh_seed %>% 
    mutate(geo_tract = 2, id = id + 8)
)
new_hh_seed$geo_region <- 1

new_hh_seed

# Repeat the household targets for two tracts
new_hh_targets <- hh_targets
new_hh_targets$hhtype <- bind_rows(hh_targets$hhtype, hh_targets$hhtype)
new_hh_targets$hhtype <- new_hh_targets$hhtype %>%
  mutate(geo_tract = c(1, 2))

new_hh_targets$hhtype

# Repeat the per_seed to create tract 1 and 2 persons
new_per_seed <- bind_rows(
  per_seed,
  per_seed %>% 
    mutate(id = id + 8)
)

new_per_seed

# Double the regional person targets
new_per_targets <- per_targets
new_per_targets$pertype <- per_targets$pertype %>%
  mutate_all(list(~. * 2)) %>%
  mutate(geo_region = 1)

new_per_targets$pertype

## ----multigeo ipu-------------------------------------------------------------
result <- ipu(
  new_hh_seed, new_hh_targets,
  new_per_seed, new_per_targets,
  max_iterations = 30
)

## ----multigeo results---------------------------------------------------------
result$primary_comp

result$secondary_comp

## -----------------------------------------------------------------------------
set.seed(42)
synthesize(result$weight_tbl, group_by = "geo_tract") %>%
  head()

## -----------------------------------------------------------------------------
set.seed(42)
result$weight_tbl %>%
  group_by(geo_tract) %>%
  synthesize() %>%
  head()