This does not solve for the full solution, just the targeting queue, individual position on queue.

ffp_opt_sobin_target_row(
  ls_row,
  fl_rho,
  ar_A,
  ar_alpha,
  ar_beta,
  svr_A_i = "A",
  svr_alpha_i = "alpha",
  svr_beta_i = "beta"
)

Arguments

ls_row

list a row from dataframe tibble row where there are variables for A, alpha and beta

fl_rho

float preference for equality for the planner, negative infinity to 1

ar_A

float array of expected outcome without provision for all N

ar_alpha

float array of expected effect of provision for each i of N

ar_beta

float array of planner bias

svr_A_i

string name of the A_i variable, any nonlinear or linear evaluated expected outcome

svr_alpha_i

string name of the alpha_i variable, individual specific effects of treatment

svr_beta_i

string name of the beta_i variable, relative preference weight for each child

Value

a list with an integer and an array

  • ar_rank_val - array of relative values based on which rank is computed, relative value order same for all rows

  • ar_rank - array of index that correspond to ar_rank_val

  • it_rank - an integer equal to the person's rank on the optimal binary targeting queue, smaller number means higher ranking, 1 is ranked first to receive allocations

Author

Fan Wang, http://fanwangecon.github.io

Examples

library(tibble)
library(dplyr)
library(tidyr)
ar_alpha <- c(0.1,1.5,2.5,4)
ar_A <-     c(0.5,1.5,3.5,6.5)
ar_beta <- c(0.25,0.25,0.25,0.25)
mt_alpha_A <- cbind(ar_alpha, ar_A, ar_beta)
ar_st_varnames <- c('alpha', 'A', 'beta')
tb_alpha_A <- as_tibble(mt_alpha_A) %>% rename_all(~c(ar_st_varnames))
tb_alpha_A
#> # A tibble: 4 x 3
#>   alpha     A  beta
#>   <dbl> <dbl> <dbl>
#> 1   0.1   0.5  0.25
#> 2   1.5   1.5  0.25
#> 3   2.5   3.5  0.25
#> 4   4     6.5  0.25

ar_rho <- c(-100, -1.1, 0.01, 0.10, 0.9)
for (it_rho_ctr in seq(1,length(ar_rho))) {
  fl_rho <- ar_rho[it_rho_ctr]
  ls_ranks <- ffp_opt_sobin_target_row(tb_alpha_A[1,], 0.1, ar_A, ar_alpha, ar_beta)
  it_rank <- ls_ranks$it_rank
  ar_it_rank <- ls_ranks$ar_it_rank
  ar_fl_rank_val <- ls_ranks$ar_fl_rank_val
  cat('fl_rho:', fl_rho, 'it_rank:', it_rank, '\n')
  cat('ar_it_rank:', ar_it_rank, '\n')
  cat('ar_fl_rank_val:', ar_fl_rank_val, '\n')
}
#> fl_rho: -100 it_rank: 4 
#> ar_it_rank: 4 1 2 3 
#> ar_fl_rank_val: 1 4.353845 3.656364 3.450654 
#> fl_rho: -1.1 it_rank: 4 
#> ar_it_rank: 4 1 2 3 
#> ar_fl_rank_val: 1 4.353845 3.656364 3.450654 
#> fl_rho: 0.01 it_rank: 4 
#> ar_it_rank: 4 1 2 3 
#> ar_fl_rank_val: 1 4.353845 3.656364 3.450654 
#> fl_rho: 0.1 it_rank: 4 
#> ar_it_rank: 4 1 2 3 
#> ar_fl_rank_val: 1 4.353845 3.656364 3.450654 
#> fl_rho: 0.9 it_rank: 4 
#> ar_it_rank: 4 1 2 3 
#> ar_fl_rank_val: 1 4.353845 3.656364 3.450654