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
<- function(to_test_var, original_var, main_run_var = TRUE){
unit_test_f if (main_run_var == TRUE) {
if (length(to_test_var) > 1) {
<- ( abs(sd(to_test_var) - original_var) > 0.0001 )
fails_test <- sd(to_test_var)
text_val else {
} <- ( abs(to_test_var - original_var) > 0.0001 )
fails_test <- to_test_var
text_val
}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_f(
wage_0_in 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_f(
wage_t_in 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_f(lambda1_var = lambda1_var1)
lambda1_in unit_test_f(lambda1_in[1], 1.745, main_run_var = main_run_var1)
= lambda_t_f(
lambda1_t_temp 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
)
<- lambda_eff_f(
lambda1_prevl_in 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_f(lambda2_var = lambda2_var1)
lambda2_in unit_test_f(lambda2_in[1], 10.2 , main_run_var = main_run_var1)
<- saturation_in_f(coverage_var = coverage_var1,
saturation_in 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_var1
lambda1_new_in unit_test_f(lambda1_new_in, 79.51465,
main_run_var = main_run_var1)
= lambda_t_f(
lambda1_t_temp 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
)<- lambda_eff_f(lambda1_var = lambda1_t_temp,
lambda1_prevl_new_in 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_app1_f(
earnings_no_ext_in wage_var = wage_t_in,
lambda1_var = lambda1_in[1],
lambda2_var = 0,
saturation_var = saturation_in,
coverage_var = coverage_var1
)<- earnings_app1_f(
earnings_yes_ext_in 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_app1_f(
earnings_no_ext_prevl_in wage_var = wage_t_in,
lambda1_var = lambda1_prevl_in[1],
lambda2_var = 0,
saturation_var = saturation_in,
coverage_var = coverage_var1
)<- earnings_app1_f(
earnings_yes_ext_prevl_in 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_app2_f(t_var = 0:50,
earnings_no_ext_new_in lambda1k1_var = lambda1_new_in[1])
# earnings2 with prevalence
<- earnings_app2_f(t_var = 0:50,
earnings_no_ext_prevl_new_in lambda1k1_var = lambda1_prevl_new_in[1])
# interest rate NEED TO UPDATE TO EXACT RESULT
<- interest_f(gov_bonds_var = gov_bonds_var1,
interest_in 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_f(include_ext_var = FALSE,
delta_ed_final_in 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_f(
delta_ed_final_x_in 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_f(gov_bonds_var = gov_bonds_var1,
interest_in inflation_var = inflation_var1)$interest_in
unit_test_f(interest_in, 0.0985, main_run_var = main_run_var1)
<- interest_f(
interest_new_in gov_bonds_var = gov_bonds_new_var1,
inflation_var = inflation_new_var1)$interest_in
<- cost_per_student_f(teach_sal_var = teach_sal_var1,
cost_per_student_in 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_f(
cost_per_student_new_in teach_sal_var = teach_sal_new_var1,
teach_ben_var = teach_ben_new_var1,
n_students_var = n_students_var1
)
<- s2_f(
s2_in 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_f(
pv_benef_tax_nx_in 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_f(
pv_benef_tax_yx_in 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_f(
pv_benef_all_nx_in 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_f(
pv_benef_all_nx_prevl_in 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_f(
pv_benef_all_yx_in 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_f(
pv_benef_all_yx_prevl_in 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_f(
pv_benef_tax_new_in 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_f(earnings_var = earnings_no_ext_new_in,
pv_benef_all_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_f(earnings_var = earnings_no_ext_prevl_new_in,
pv_benef_all_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
<- costs1_p2_f(country_total_var = df_costs_var1$total,
cost1_in 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_new_f(interest_var = interest_new_in,
s2_ea_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)
<- pv_costs_f(
costs2_ea_in 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
<- pv_costs_f(
costs2_in 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
<- pv_costs_f(
costs2_x_in 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_f(interest_var = interest_new_in,
s2_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
<- pv_costs_f(
costs_a2_in 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
<- NPV_pe_f(benefits_var = pv_benef_tax_nx_in, costs_var = costs2_in)
a1_tax_pe unit_test_f(a1_tax_pe, 11.8309012188904)
#Baird 2: Costs = Baird w/tax and yes externalities (no ext);
#Benef = Baird yes ext
<- NPV_pe_f(benefits_var = pv_benef_tax_yx_in, costs_var = costs2_x_in)
a1_x_tax_pe unit_test_f(a1_x_tax_pe, 101.903273665711)
# Baird 3: Benefits = Baird all and no ext; Costs = Baird no ext
<- NPV_pe_f(benefits_var = pv_benef_all_nx_in, costs_var = costs2_in)
a1_all_pe unit_test_f(a1_all_pe, 130.649690239252)
# Baird 4: Benefits = Baird all and yes ext; Costs = Baird yes ext
<- NPV_pe_f(benefits_var = pv_benef_all_yx_in, costs_var = costs2_x_in)
a1_x_all_pe unit_test_f(a1_x_all_pe, 741.618186471615)
#KLPS4_1: benefits = KLPS4 w/t and no ext; Costs = Baird no ext
<- NPV_pe_f(benefits_var = pv_benef_tax_new_in, costs_var = costs_a2_in)
klps4_1_pe unit_test_f(klps4_1_pe, 55.884265345947)
#KLPS4_2:benefits = KLPS4 all and no ext; Costs = Baird no ext
<- NPV_pe_f(benefits_var = pv_benef_all_new_in, costs_var = costs_a2_in)
klps4_2_pe unit_test_f(klps4_2_pe, 499.720465340588)
# EA1: no externality NPV using Evidence Action's costs
<- NPV_pe_f(benefits_var = pv_benef_all_nx_prevl_in, costs_var = costs2_ea_in)
ea1_pe unit_test_f(ea1_pe, 77.4612400741955)
# EA2: yes externality NPV using Evidence Action's costs
<- NPV_pe_f(benefits_var = pv_benef_all_yx_prevl_in, costs_var = costs2_ea_in)
ea2_pe unit_test_f(ea2_pe, 701.849761243559)
# EA3: benef= KLPS all and no ext; Costs=Evidence Action
<- NPV_pe_f(benefits_var = pv_benef_all_prevl_new_in, costs_var = costs2_ea_in)
ea3_pe unit_test_f(ea3_pe, 289.751849813911)
= here('data','ea3_pe')
ea3_save_path 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 | - |