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

Given allocation space parameters (A, alpha), test lower-bounded continuous optimal allocation solution.Compare inequality measures given optimal allocations across planner preferences. This function tests out the procedure to solve for optimal allocations over various rhos, and computes gini each time.

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

library(dplyr)
library(tidyr)

library(REconTools)
library(PrjOptiAlloc)

bl_save_rda = FALSE

Get Data

Load data that is generated by regression ffy_opt_dtgch_cbem4 (vignette).

# Load Library
ls_opti_alpha_A <- PrjOptiAlloc::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)
ar_prot_data = df_hw_cebu_m24$prot
fl_N_agg = sum(ar_prot_data)

# Attach
attach(df_raw)

Solve

I would like to be able to directly call the dataset generated here in various functions. Save the datafile we just created in the project folder.

Prep Inputs

df <- df_opt_dtgch_cbem4
svr_id_i <- 'indi.id'
svr_A_i <- 'A_lin'
svr_alpha_i <- 'alpha_lin'
svr_beta_i <- 'beta'
fl_N_agg <- 10000
ar_rho <- c(-50, -10, -0.1, 0.1, 0.5, 0.7)
svr_inpalc <- 'optiallocate'
svr_expout <- 'optiexpoutcm'

Solve Relative Allocation Problem Looping over Planner Elasticities

df_opti_alloc_all_rho <- df
it_indi_count <- dim(df)[1]

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

  # B. 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
  ls_lin_solu <- PrjOptiAlloc::ffp_opt_solin_relow(
    df, svr_A_i, svr_alpha_i, svr_beta_i, fl_N_agg, fl_rho,
    svr_inpalc, svr_expout)

  # C. Keep for df collection individual key + optimal allocation ----
  # _on stands for optimal nutritional choices
  # _eh stands for expected height
  tb_opti_allocate_wth_key <- ls_lin_solu$df_opti %>% select(one_of(svr_id_i, svr_inpalc, svr_expout)) %>%
                                rename(!!paste0('rho_c', it_rho_ctr, '_', svr_inpalc) := !!sym(svr_inpalc),
                                        !!paste0('rho_c', it_rho_ctr, '_', svr_expout) := !!sym(svr_expout))

  # D. merge optimal allocaiton results from different planner preference ----
  df_opti_alloc_all_rho <- df_opti_alloc_all_rho %>%
                            left_join(tb_opti_allocate_wth_key, by=svr_id_i)

}

# Print
head(df_opti_alloc_all_rho, 10)
head(df_opti_alloc_all_rho %>% select(starts_with('rho')), 20)

Extract Optimal Allocations and Expected Outcomes

# E. Extract from All results Optimal Allocation and Expected Outcomes ----
mt_opti_alloc_all_rho <- data.matrix(df_opti_alloc_all_rho %>% select(ends_with(svr_inpalc)))
mt_expc_outcm_all_rho <- data.matrix(df_opti_alloc_all_rho %>% select(ends_with(svr_expout)))

# Print
summary(mt_opti_alloc_all_rho)
summary(mt_expc_outcm_all_rho)

Calculate GINI for each vector

# F. Compute gini for each rho ----
# ff_dist_gini_vector_pos() is from REconTools
ar_opti_alloc_gini <- suppressMessages(apply(t(mt_opti_alloc_all_rho), 1,
                                             REconTools::ff_dist_gini_vector_pos))
ar_expc_outcm_gini <- suppressMessages(apply(t(mt_expc_outcm_all_rho), 1,
                                             REconTools::ff_dist_gini_vector_pos))

# Print
print(ar_opti_alloc_gini)
print(ar_expc_outcm_gini)

Gini Results Reshaping for Easier outputs

# G. Wide to Long to Wide Gini ----
# column names look like: rho_c1_on rho_c2_on rho_c3_on rho_c1_eh rho_c2_eh rho_c3_eh
tb_gini_onerow_wide <- cbind(as_tibble(t(ar_opti_alloc_gini)), as_tibble(t(ar_expc_outcm_gini)))
tb_gini_long <- tb_gini_onerow_wide %>%
  pivot_longer(
    cols = starts_with("rho"),
    names_to = c("it_rho_ctr", "oneh"),
    names_pattern = "rho_c(.*)_(.*)",
    values_to = "gini"
  )
tb_gini_wide2 <- tb_gini_long %>%
  pivot_wider(
    id_cols = it_rho_ctr,
    names_from = oneh,
    values_from = gini
  )
planner_elas <- log(1/(1-ar_rho)+2)
mt_gini <- data.matrix(cbind(tb_gini_wide2, planner_elas))

# Print
print(tb_gini_onerow_wide)
print(tb_gini_long)
print(tb_gini_wide2)
print(mt_gini)

Save Outputs

# df_opt_dtgch_ropti: dataframe, opt project, data guat cebu height, cebu edu mother, results relative linear optimal
df_opt_dtgch_cbem4_rrlop_allrh <- df_opti_alloc_all_rho
df_opt_dtgch_cbem4_rrlop_argin <- mt_gini
if (bl_save_rda) {
  usethis::use_data(df_opt_dtgch_cbem4_rrlop_allrh, df_opt_dtgch_cbem4_rrlop_allrh, overwrite = TRUE)
  usethis::use_data(df_opt_dtgch_cbem4_rrlop_argin, df_opt_dtgch_cbem4_rrlop_argin, overwrite = TRUE)
}

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