In FanWangEcon/PrjOptiAlloc: The Optimal Allocation of Resources Among Heterogeneous Individuals

Test the lower-bounded linear-continuous optimal allocation solution function from package. Use the Guatemala-Cebu scrambled nutrition and height early childhood data, same as line by line.

The objective of this file is to solve the linear $N_i$ and $H_i$ problem without invoking any functions. This function first tested out the linear solution algorithm.

File name ffv_opt_solin_relow_allfn:

• opt: optimal allocation project
• solin: linear production function
• relow: solution method relying on relative allocation against lowest (first) to receive subsidy
• allfn: all code by calling relevant functions

See associated functions in the ffv_opt_dtgch_cbem4 file.

Load Packages and Data

Load Dependencies

rm(list = ls(all.names = TRUE))
options(knitr.duplicate.label = 'allow')

library(dplyr)
library(tidyr)
library(stringr)
library(broom)
library(ggplot2)

library(REconTools)
library(PrjOptiAlloc)

library(knitr)
library(kableExtra)

Get Data and Regression Results

Generate four categories by initial height and mother's education levels combinations.

# Load Data and Estimation Results: A and alpha, lin and loglin
ls_opti_alpha_A <- ffy_opt_dtgch_cbem4()
df_raw <- ls_opti_alpha_A$df_raw
df_hw_cebu_m24 <- df_raw
df_esti <- ls_opti_alpha_A$df_esti

# Review dataframes
# raw file
head(df_raw, 10)
head(df_esti, 10)

# Attach
attach(df_raw)

Optimal Allocations

Common Parameters for Optimal Allocation

# Child Count
df_hw_cebu_m24_full <- df_hw_cebu_m24
it_obs = dim(df_hw_cebu_m24)[1]

# Total Resource Count
ar_prot_data = df_hw_cebu_m24$prot
fl_N_agg = sum(ar_prot_data)

# Vector of Planner Preference
ar_rho = c(seq(-200, -100, length.out=5), seq(-100, -25, length.out=5), seq(-25, -5, length.out=5),
           seq(-5, -1, length.out=5), seq(-1, -0.01, length.out=5), seq(0.01, 0.25, length.out=5), seq(0.25, 0.99, length.out=5))
ar_rho = c(-50, -25, -10)
ar_rho = unique(ar_rho)

Optimal Linear Allocation (CRS)

This also works with any CRS CES.

# Matrixes to Store Solution Results
tb_opti_alloc_all_rho <- df_esti
mt_hev_lin = matrix(, nrow = length(ar_rho), ncol = 2)
mt_opti_N = matrix(, nrow = it_obs, ncol = length(ar_rho))
mt_opti_H = matrix(, nrow = it_obs, ncol = length(ar_rho))

# A. First Loop over Planner Preference
# Generate Rank Order
for (it_rho_ctr in seq(1,length(ar_rho))) {
  rho = ar_rho[it_rho_ctr]

  # B. Parameters for solving the optimal allocation problem
  df <- df_esti
  svr_A_i <- 'A_lin'
  svr_alpha_i <- 'alpha_lin'
  svr_beta_i <- 'beta'
  fl_N_agg <- fl_N_agg
  fl_rho <- rho

  # C. Invoke optimal linear (crs) solution problem
  # ar_opti is the array of optimal choices, it is in df_opti as well.
  # use df_opti for merging, because that contains the individual keys.
  # actually file here should contain unique keys, unique key ID as required input. should return?
  # actually it is fine, the function here needs the key, not solin_flinr

  svr_inpalc <- 'opti_allocate'
  svr_expout <- 'opti_exp_outcome'
  ls_lin_solu <- ffp_opt_solin_relow(df, svr_A_i, svr_alpha_i, svr_beta_i, fl_N_agg, fl_rho,
                                     svr_inpalc, svr_expout)
  tb_opti <- ls_lin_solu$df_opti
  ar_opti_inpalc <- ls_lin_solu$ar_opti_inpalc
  ar_opti_expout <- ls_lin_solu$ar_opti_expout

  mt_opti_N[, it_rho_ctr] = ar_opti_inpalc
  mt_opti_H[, it_rho_ctr] = ar_opti_expout

  # m. Keep for df collection individual key + optimal allocation
  # _on stands for optimal nutritional choices
  # _eh stands for expected height
  tb_opti_main_results <- tb_opti %>%
    select(-one_of(c('lowest_rank_alpha', 'lowest_rank_beta')))
  tb_opti_allocate_wth_key <- tb_opti %>% select(one_of('indi.id', svr_inpalc, svr_expout)) %>%
                                rename(!!paste0('rho_c', it_rho_ctr, '_on') := !!sym(svr_inpalc),
                                       !!paste0('rho_c', it_rho_ctr, '_eh') := !!sym(svr_expout))

  # n. merge optimal allocaiton results from different planner preference
  tb_opti_alloc_all_rho <- tb_opti_alloc_all_rho %>% left_join(tb_opti_allocate_wth_key, by='indi.id')

  # print subset
  if (it_rho_ctr == 1 | it_rho_ctr == length(ar_rho) | it_rho_ctr == round(length(ar_rho)/2)) {
    print('')
    print('xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx')
    print(paste0('xxx rho:', rho))
    print('xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx')
    print('xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx')

    print(summary(tb_opti_main_results))
  }
}

FanWangEcon/PrjOptiAlloc documentation built on Jan. 25, 2022, 6:55 a.m.