3 Main Results
This report has presented three different approaches to measuring the welfare effects of deworming interventions. The first approach was based on the original paper that measured the welfare effects of deworming (Baird et al. 2016) and proposed four different ways to compute this effect (with and without externalities, and from a societal or fiscal perspective). The second approach, based on more recent data, focused only on direct effects, and relies less on predictive effects over the lifecycle. Results for the second approach are also separated between the societal and fiscal perspective.
The third and final approach uses similar methodologies with three main differences. First, the report allows the benefits to be scaled to account for differences in the prevalence of worm infections in settings different from the original study. Second, the report allows the benefits to be scaled by the length of treatment provided to children within a particular setting. Finally, based on feedback from Evidence Action on the relevant costs from present-day deworming programs, this approach uses more up to date information on treatment costs and it does not take into account the knock-on effects of additional schooling costs as a result of increased school attendance, which are accounted for in approaches #1 and #28.
The table below summarises the three different approaches and the different alternatives within each approach. The main policy estimate is defined as that of Evidence Action (approach 3) using the latest research (Hamory et al. 2020): approach 3.3 in the table (in bold).
Show all the details
# TODO: Wrap this code chunk in chunk_xxxfunction
#chunk_runvalues <- function(){
# Function dependency is depicted as follows:
# f(g()) =
# f
# └──── g
#
# ## ### #### #####
# 1 2 3 4 5
# ## ### #### #####
# NPV_pe_f
# ├──── pv_benef_f
# │ ├──── earnings_app1_f
# │ | ├──── wage_t_f
# │ | | └──── wage_0_f
# | | ├──── lambda_eff_f
# │ | | └────lambda1_t_f
# │ | | └────lambda1_in_f
# | | ├──── lambda1_in_f
# | | ├──── lambda2_in_f
# │ | └──── saturation_in_f
# │ ├──── earnings_app2_f
# │ | └────lambda_eff_f
# │ | └────lambda1_t_f
# │ └──── interest_f
# └──── pv_costs_f (pv_costs_f)
# ├──── delta_ed_final_f
# ├──── interest_f
# └──── s2_new_f
# | └──── costs1_p2_f
# | └──── costs1_p1_f
# ├──── s2_f
# └──── cost_per_student_f
# ## ### #### #####
# Approach 1
# NPV_pe_f --> a1_tax_pe
# └────pv_benef_f --> pv_benef_tax_nx_in
# | ├────earnings_app1_f --> earnings_no_ext_in * tax_var1
# | | ├────wage_t_f --> wage_t_in
# | | | └────wage_0_f --> wage_0_in
# | | ├────lambda1_in_f --> lambda1_in
# | | └────saturation_in_f --> saturation_in
# | └────interest_f --> interest_in
# |
# |
# └────pv_costs_f --> costs2_in
# ├────delta_ed_final_f --> delta_ed_final_in
# ├────cost_per_student_f --> cost_per_student_in
# ├────s2_f --> s2_in
# └────interest_f --> interest_in
# unit test function
unit_test_f <- function(to_test_var, original_var, main_run_var = TRUE){
if (main_run_var == TRUE) {
if (length(to_test_var) > 1) {
fails_test <- ( abs(sd(to_test_var) - original_var) > 0.0001 )
text_val <- sd(to_test_var)
} else {
fails_test <- ( abs(to_test_var - original_var) > 0.0001 )
text_val <- to_test_var
}
if (fails_test) {
print(paste("Output has changed at",
deparse(substitute(to_test_var) ),
" to ", text_val) )
}
}
}
# TODO: update values of unit test within one_run_f
# one run of all the steps to get one policy estimate
one_run_f <-
function(main_run_var1 = main_run_so,
run_sim_var1 = run_sim_so,
wage_ag_var1 = wage_ag_so,
wage_ww_var1 = wage_ww_so,
profits_se_var1 = profits_se_so,
hours_se_cond_var1 = hours_se_cond_so,
hours_ag_var1 = hours_ag_so,
hours_ww_var1 = hours_ww_so,
hours_se_var1 = hours_se_so,
ex_rate_var1 = ex_rate_so,
growth_rate_var1 = growth_rate_so,
coef_exp_var1 = coef_exp_so[1],
coef_exp2_var1 = coef_exp_so[2],
lambda1_var1 = lambda1_in_f(lambda1_var = lambda1_so),
prevalence_0_var1 = prevalence_0_so,
prevalence_r_var1 = prevalence_r_so,
new_prevl_r_var1 = new_prevalence_r_so,
lambda2_var1 = lambda2_so,
coverage_var1 = coverage_so,
q_full_var1 = q_full_so,
q_zero_var1 = q_zero_so,
lambda1_new_var1 = lambda1_new_so,
gov_bonds_var1 = gov_bonds_so,
inflation_var1 = inflation_so,
gov_bonds_new_var1 = gov_bonds_new_so,
inflation_new_var1 = inflation_new_so,
df_costs_var1 = costs_data_in,
staff_time_var1 = staff_time_so,
delta_ed_var1 = delta_ed_so,
delta_ed_ext_var1 = delta_ed_ext_so,
teach_sal_var1 = teach_sal_so,
teach_ben_var1 = teach_ben_so,
n_students_var1 = n_students_so,
teach_sal_new_var1 = teach_sal_new_so,
teach_ben_new_var1 = teach_ben_new_so,
unit_cost_local_var1 = unit_cost_local_so,
unit_cost_local_new_var1 = unit_cost_2017usdppp_so,
new_costs_var1 = new_costs_so,
countries_var1 = country_sel_so,
years_of_treat_0_var1 = years_of_treat_0_so,
years_of_treat_t_var1 = years_of_treat_t_so,
tax_var1 = tax_so,
periods_var1 = periods_so) {
####------------ Inputs for wage_t -----------------------------------------
wage_0_in <- wage_0_f(
wage_ag_var = wage_ag_var1,
wage_ww_var = wage_ww_var1,
profits_se_var = profits_se_var1,
hours_se_cond_var = hours_se_cond_var1,
hours_ag_var = hours_ag_var1,
hours_ww_var = hours_ww_var1,
hours_se_var = hours_se_var1,
ex_rate_var = ex_rate_var1
)
unit_test_f(wage_0_in, 0.170124466664436, main_run_var = main_run_var1)
###---------- Inputs for earnings_app1_f ---------------------------------------
wage_t_in <- wage_t_f(
wage_0_var = wage_0_in,
growth_rate_var = growth_rate_var1,
coef_exp1_var = coef_exp_var1,
coef_exp2_var = coef_exp2_var1
)
unit_test_f(wage_t_in, 17.8464946727946, main_run_var = main_run_var1)
lambda1_in <- lambda1_in_f(lambda1_var = lambda1_var1)
unit_test_f(lambda1_in[1], 1.745, main_run_var = main_run_var1)
lambda1_t_temp = lambda_t_f(
lambda1_var = lambda1_in_f(lambda1_var = lambda1_var1),
years_of_treat_0_var = years_of_treat_0_var1,
years_of_treat_t_var = years_of_treat_t_var1
)$lambda1_t
lambda1_prevl_in <- lambda_eff_f(
lambda1_var = lambda1_t_temp,
prevalence_0_var = prevalence_0_var1,
prevalence_r_var = prevalence_r_var1,
other_prevl_r_var = new_prevl_r_var1,
country_sel_var = countries_var1
)$lambda1_eff_in
unit_test_f(lambda1_prevl_in[1], 0.9508583060968, main_run_var = main_run_var1)
lambda2_in <- lambda2_in_f(lambda2_var = lambda2_var1)
unit_test_f(lambda2_in[1], 10.2 , main_run_var = main_run_var1)
saturation_in <- saturation_in_f(coverage_var = coverage_var1,
q_full_var = q_full_var1,
q_zero_var = q_zero_var1)$saturation_in
unit_test_f(saturation_in, 0.511, main_run_var = main_run_var1)
###------------ Inputs for earnings_app2_f--------------------------------------
lambda1_new_in <- lambda1_new_var1
unit_test_f(lambda1_new_in, 79.51465,
main_run_var = main_run_var1)
lambda1_t_temp = lambda_t_f(
lambda1_var = lambda1_new_var1,
years_of_treat_0_var = years_of_treat_0_var1,
years_of_treat_t_var = years_of_treat_t_var1
)$lambda1_t
lambda1_prevl_new_in <- lambda_eff_f(lambda1_var = lambda1_t_temp,
prevalence_0_var = prevalence_0_var1,
prevalence_r_var = prevalence_r_var1,
other_prevl_r_var = new_prevl_r_var1,
country_sel_var = countries_var1
)$lambda1_eff_in
unit_test_f(lambda1_prevl_new_in[1], 43.3278884864681, main_run_var = main_run_var1)
##------------ Inputs for pv_benef_f ---------------------------------------
# earnings1
earnings_no_ext_in <- earnings_app1_f(
wage_var = wage_t_in,
lambda1_var = lambda1_in[1],
lambda2_var = 0,
saturation_var = saturation_in,
coverage_var = coverage_var1
)
earnings_yes_ext_in <- earnings_app1_f(
wage_var = wage_t_in,
lambda1_var = lambda1_in[1],
lambda2_var = lambda2_in[1],
saturation_var = saturation_in,
coverage_var = coverage_var1
)
# earnings1 with prevalence
earnings_no_ext_prevl_in <- earnings_app1_f(
wage_var = wage_t_in,
lambda1_var = lambda1_prevl_in[1],
lambda2_var = 0,
saturation_var = saturation_in,
coverage_var = coverage_var1
)
earnings_yes_ext_prevl_in <- earnings_app1_f(
wage_var = wage_t_in,
lambda1_var = lambda1_prevl_in[1],
lambda2_var = lambda2_in[1],
saturation_var = saturation_in,
coverage_var = coverage_var1
)
# earnings2
earnings_no_ext_new_in <- earnings_app2_f(t_var = 0:50,
lambda1k1_var = lambda1_new_in[1])
# earnings2 with prevalence
earnings_no_ext_prevl_new_in <- earnings_app2_f(t_var = 0:50,
lambda1k1_var = lambda1_prevl_new_in[1])
# interest rate NEED TO UPDATE TO EXACT RESULT
interest_in <- interest_f(gov_bonds_var = gov_bonds_var1,
inflation_var = inflation_var1)$interest_in
unit_test_f(earnings_no_ext_in, 31.1421332040266,
main_run_var = main_run_var1)
unit_test_f(earnings_yes_ext_in, 167.667817450905,
main_run_var = main_run_var1)
unit_test_f(earnings_no_ext_prevl_in, 16.9694876943406,
main_run_var = main_run_var1)
unit_test_f(earnings_yes_ext_prevl_in, 153.495171941219,
main_run_var = main_run_var1)
unit_test_f(interest_in, 0.0985, main_run_var = main_run_var1)
##-------------- Inputs for costs2_f----------------------------------------
# Make explicit non-function inputs:
delta_ed_final_in <- delta_ed_final_f(include_ext_var = FALSE,
delta_ed_var = delta_ed_var1,
delta_ed_ext_var = delta_ed_ext_var1)
unit_test_f(delta_ed_final_in, 0.01134819, main_run_var = main_run_var1)
delta_ed_final_x_in <- delta_ed_final_f(
include_ext_var = TRUE,
delta_ed_var = delta_ed_var1,
delta_ed_ext_var = delta_ed_ext_var1
)
unit_test_f(delta_ed_final_x_in, 0.05911765, main_run_var = main_run_var1)
interest_in <- interest_f(gov_bonds_var = gov_bonds_var1,
inflation_var = inflation_var1)$interest_in
unit_test_f(interest_in, 0.0985, main_run_var = main_run_var1)
interest_new_in <- interest_f(
gov_bonds_var = gov_bonds_new_var1,
inflation_var = inflation_new_var1)$interest_in
cost_per_student_in <- cost_per_student_f(teach_sal_var = teach_sal_var1,
teach_ben_var = teach_ben_var1,
n_students_var = n_students_var1)
unit_test_f(cost_per_student_in, 116.8549, main_run_var = main_run_var1)
cost_per_student_new_in <- cost_per_student_f(
teach_sal_var = teach_sal_new_var1,
teach_ben_var = teach_ben_new_var1,
n_students_var = n_students_var1
)
s2_in <- s2_f(
unit_cost_local_var = unit_cost_local_var1,
ex_rate_var = ex_rate_var1,
years_of_treat_var = years_of_treat_0_var1
)
unit_test_f(s2_in, 1.4219, main_run_var = main_run_var1)
#--------------- Inputs for NPV_pe_f--------------------
# Make explicit non-function inputs:
#Benefits:
#Baird w/tax and no externalities (no ext)
pv_benef_tax_nx_in <- pv_benef_f(
earnings_var = earnings_no_ext_in * tax_var1,
interest_r_var = interest_in,
periods_var = periods_var1
)
unit_test_f(pv_benef_tax_nx_in, 23.6070893378784,
main_run_var = main_run_var1)
#Baird w/t and ext
pv_benef_tax_yx_in <- pv_benef_f(
earnings_var = earnings_yes_ext_in * tax_var1,
interest_r_var = interest_in,
periods_var = periods_var1
)
unit_test_f(pv_benef_tax_yx_in, 127.0994867217, main_run_var = main_run_var1)
#Baird all and no
pv_benef_all_nx_in <- pv_benef_f(
earnings_var = earnings_no_ext_in,
interest_r_var = interest_in,
periods_var = periods_var1
)
unit_test_f(pv_benef_all_nx_in, 142.42587835824, main_run_var = main_run_var1)
#Baird all and no ext + prevalence
pv_benef_all_nx_prevl_in <- pv_benef_f(
earnings_var = earnings_no_ext_prevl_in,
interest_r_var = interest_in,
periods_var = periods_var1
)
unit_test_f(pv_benef_all_nx_prevl_in, 77.608498246463, main_run_var = main_run_var1)
#Baird all and ext
pv_benef_all_yx_in <- pv_benef_f(
earnings_var = earnings_yes_ext_in,
interest_r_var = interest_in,
periods_var = periods_var1
)
unit_test_f(pv_benef_all_yx_in, 766.814399527604,
main_run_var = main_run_var1)
#Baird all and ext
pv_benef_all_yx_prevl_in <- pv_benef_f(
earnings_var = earnings_yes_ext_prevl_in,
interest_r_var = interest_in,
periods_var = periods_var1
)
unit_test_f(pv_benef_all_yx_prevl_in, 701.997019415827,
main_run_var = main_run_var1)
#KLPS4 w/t and no ext
pv_benef_tax_new_in <- pv_benef_f(
earnings_var = earnings_no_ext_new_in * tax_var1,
interest_r_var = interest_new_in,
periods_var = periods_var1
)
unit_test_f(pv_benef_tax_new_in, 88.1820199569814,
main_run_var = main_run_var1)
# KLPS4 all and no ext
pv_benef_all_new_in <- pv_benef_f(earnings_var = earnings_no_ext_new_in,
interest_r_var = interest_new_in,
periods_var = periods_var1)
unit_test_f(pv_benef_all_new_in, 532.018219951622, main_run_var = main_run_var1)
# KLPS4 all and no ext + prevalence
pv_benef_all_prevl_new_in <- pv_benef_f(earnings_var = earnings_no_ext_prevl_new_in,
interest_r_var = interest_new_in,
periods_var = periods_var1)
unit_test_f(pv_benef_all_prevl_new_in, 289.899107986178, main_run_var = main_run_var1)
#Costs asd
# costs1: Evidence Action's costs no externalities
cost1_in <- costs1_p2_f(country_total_var = df_costs_var1$total,
country_cost_var = df_costs_var1$costs_by_country,
staff_time_var = staff_time_var1,
country_name_var = df_costs_var1$Country,
select_var = countries_var1,
other_costs_var = new_costs_var1)
unit_test_f(cost1_in, 0.08480686,
main_run_var = main_run_var1)
# s2_ea_in <-- cost1_in (costs1_p2_f) <-- cost_data (costs1_p1_f())
s2_ea_in <- s2_new_f(interest_var = interest_new_in,
unit_cost_local_var = cost1_in,
ex_rate_var = 1,
year_of_treat_var = years_of_treat_t_var1)
unit_test_f(s2_ea_in, 0.19634422968991, main_run_var = main_run_var1)
costs2_ea_in <- pv_costs_f(
periods_var = periods_var1,
delta_ed_var = delta_ed_final_in,
interest_r_var = interest_new_in,
cost_of_schooling_var = 0,
s1_var = 0,
q1_var = 0,
s2_var = s2_ea_in,
q2_var = q_full_var1
)
unit_test_f(costs2_ea_in, 0.147258172267433, main_run_var = main_run_var1)
# costs2: Baird no externalities
costs2_in <- pv_costs_f(
periods_var = periods_var1,
delta_ed_var = delta_ed_final_in,
interest_r_var = interest_in,
cost_of_schooling_var = cost_per_student_in,
s1_var = 0,
q1_var = q_zero_var1,
s2_var = s2_in,
q2_var = q_full_var1
)
unit_test_f(costs2_in, 11.776188118988, main_run_var = main_run_var1)
earnings_no_ext_in
# Baird yes externalities
costs2_x_in <- pv_costs_f(
periods_var = periods_var1,
delta_ed_var = delta_ed_final_x_in,
interest_r_var = interest_in,
cost_of_schooling_var = cost_per_student_in,
s1_var = 0,
q1_var = q_zero_var1,
s2_var = s2_in,
q2_var = q_full_var1
)
unit_test_f(costs2_x_in, 25.1962130559894, main_run_var = main_run_var1)
s2_new_in <- s2_new_f(interest_var = interest_new_in,
unit_cost_local_var = unit_cost_local_new_var1,
ex_rate_var = 1,
year_of_treat_var = years_of_treat_t_var1)
# costs2: KLPS4
costs_a2_in <- pv_costs_f(
periods_var = periods_var1,
delta_ed_var = delta_ed_final_in,
interest_r_var = interest_new_in,
cost_of_schooling_var = cost_per_student_new_in,
s1_var = 0,
q1_var = q_zero_var1,
s2_var = s2_new_in,
q2_var = q_full_var1
)
unit_test_f(costs_a2_in, 32.2977546110344, main_run_var = main_run_var1)
return( list(
"wage_0_in" = wage_0_in,
"wage_t_in" = wage_t_in,
"lambda1_in" = lambda1_in,
"lambda1_prevl_in" = lambda1_prevl_in,
"lambda2_in" = lambda2_in,
"saturation_in" = saturation_in,
"lambda1_new_in" = lambda1_new_in,
"lambda1_prevl_new_in" = lambda1_prevl_new_in,
"earnings_no_ext_in" = earnings_no_ext_in,
"earnings_no_ext_prevl_in" = earnings_no_ext_prevl_in,
"earnings_yes_ext_in" = earnings_yes_ext_in,
"earnings_yes_ext_prevl_in" = earnings_yes_ext_prevl_in,
"earnings_no_ext_new_in" = earnings_no_ext_new_in,
"earnings_no_ext_prevl_new_in" = earnings_no_ext_prevl_new_in,
"interest_in" = interest_in,
"costs1_country_in" = costs_data_in,
"delta_ed_final_in" = delta_ed_final_in,
"delta_ed_final_x_in" = delta_ed_final_x_in,
"cost_per_student_in" = cost_per_student_in,
"s2_in" = s2_in,
"pv_benef_tax_nx_in" = pv_benef_tax_nx_in,
"pv_benef_tax_yx_in" = pv_benef_tax_yx_in,
"pv_benef_all_nx_in" = pv_benef_all_nx_in,
"pv_benef_all_nx_prevl_in" = pv_benef_all_nx_prevl_in,
"pv_benef_all_yx_in" = pv_benef_all_yx_in,
"pv_benef_all_yx_prevl_in" = pv_benef_all_yx_prevl_in,
"pv_benef_tax_new_in" = pv_benef_tax_new_in,
"pv_benef_all_new_in" = pv_benef_all_new_in,
"pv_benef_all_prevl_new_in" = pv_benef_all_prevl_new_in,
"costs2_ea_in" = costs2_ea_in,
"costs2_in" = costs2_in,
"costs2_x_in" = costs2_x_in,
"costs_a2_in" = costs_a2_in,
"cost1_in" = cost1_in
) )
}
invisible( list2env(one_run_f(),.GlobalEnv) )
# return( sapply( ls(pattern= "_in\\b"), function(x) get(x)) )
#}#Baird 1: Costs = Baird w/tax and no externalities (no ext);
#Benef = Baird no ext
a1_tax_pe <- NPV_pe_f(benefits_var = pv_benef_tax_nx_in, costs_var = costs2_in)
unit_test_f(a1_tax_pe, 11.8309012188904)
#Baird 2: Costs = Baird w/tax and yes externalities (no ext);
#Benef = Baird yes ext
a1_x_tax_pe <- NPV_pe_f(benefits_var = pv_benef_tax_yx_in, costs_var = costs2_x_in)
unit_test_f(a1_x_tax_pe, 101.903273665711)
# Baird 3: Benefits = Baird all and no ext; Costs = Baird no ext
a1_all_pe <- NPV_pe_f(benefits_var = pv_benef_all_nx_in, costs_var = costs2_in)
unit_test_f(a1_all_pe, 130.649690239252)
# Baird 4: Benefits = Baird all and yes ext; Costs = Baird yes ext
a1_x_all_pe <- NPV_pe_f(benefits_var = pv_benef_all_yx_in, costs_var = costs2_x_in)
unit_test_f(a1_x_all_pe, 741.618186471615)
#KLPS4_1: benefits = KLPS4 w/t and no ext; Costs = Baird no ext
klps4_1_pe <- NPV_pe_f(benefits_var = pv_benef_tax_new_in, costs_var = costs_a2_in)
unit_test_f(klps4_1_pe, 55.884265345947)
#KLPS4_2:benefits = KLPS4 all and no ext; Costs = Baird no ext
klps4_2_pe <- NPV_pe_f(benefits_var = pv_benef_all_new_in, costs_var = costs_a2_in)
unit_test_f(klps4_2_pe, 499.720465340588)
# EA1: no externality NPV using Evidence Action's costs
ea1_pe <- NPV_pe_f(benefits_var = pv_benef_all_nx_prevl_in, costs_var = costs2_ea_in)
unit_test_f(ea1_pe, 77.4612400741955)
# EA2: yes externality NPV using Evidence Action's costs
ea2_pe <- NPV_pe_f(benefits_var = pv_benef_all_yx_prevl_in, costs_var = costs2_ea_in)
unit_test_f(ea2_pe, 701.849761243559)
# EA3: benef= KLPS all and no ext; Costs=Evidence Action
ea3_pe <- NPV_pe_f(benefits_var = pv_benef_all_prevl_new_in, costs_var = costs2_ea_in)
unit_test_f(ea3_pe, 289.751849813911)
ea3_save_path = here('data','ea3_pe')
write.csv(ea3_pe, file = ea3_save_path)| Approach | Benefits | Costs | Social NPV (all) | Fiscal NPV (tax) |
|---|---|---|---|---|
| 1.1 | Baird et al. (2016) with no externalities | Treatment, Education | 130.6 | 11.8 |
| 1.2 | Baird et al. (2016) with externalities | Treatment, Education with externalities | 741.6 | 101.9 |
| 2.1 | Hamory et al. (2020) with no externalities | Treatment, Education | 499.7 | 55.9 |
| 3.1 | 1.1 + prevalence + length of treatment | Treatment (EA) | 77.5 | - |
| 3.2 | 1.2 + prevalence + length | Treatment (EA) | 701.8 | - |
| 3.3 | 2.1 + prevalence + length | Treatment (EA) | 289.8 | - |