Lab 5
Government Transfer and Poverty Reduction in Brazil
This exercise is based on Litschig, Stephan, and Kevin M Morrison. 2013. “The Impact of Intergovernmental
TransfersonEducationOutcomesandPovertyReduction.”American Economic Journal: Applied Economics
5(4): 206–40.
In this exercise, we estimate the effects of increased government spending on educational attainment, literacy,
and poverty rates.
Some scholars argue that government spending accomplishes very little in environments of high corruption
and inequality. Others suggest that in such environments, accountability pressures and the large demand
for public goods will drive elites to respond. To address this debate, we exploit the fact that until 1991,
the formula for government transfers to individual Brazilian municipalities was determined in part by the
municipality’s population. This meant that municipalities with populations below the official cutoff did
not receive additional revenue, while states above the cutoff did. The data settransfer.csvcontains the
variables:
Name Description
pop82Population in 1982
poverty80Poverty rate of state in 1980
poverty91Poverty rate of state in 1991
educ80Average years education of state in 1980
educ91Average years education of state in 1991
literate91Literacy rate of state in 1991
stateState
regionRegion
idMunicipal ID
yearYear of measurement
# Load the data
transfer <-read.csv("transfer.csv")
head(transfer)
## id state region literate91 educ91 poverty91 poverty80 educ80 pop82
## 1 55 AC N 0.7278106 3.873065 0.6358200 0.6608 1.7 13937
## 2 60 AC N 0.4770992 2.480469 0.7512400 0.7950 1.0 19613
## 3 65 AC N 0.7186312 3.216730 0.6679699 0.4121 0.9 9343
## 4 70 AC N 0.7329843 3.966312 0.5381100 0.4131 0.8 9728
## 5 71 AC N 0.5520231 3.005882 0.6924300 0.4808 1.0 23592
## 6 73 AC N 0.6898396 3.887701 0.5912600 0.5765 1.5 14701
Question 1
We will apply the regression discontinuity design to this application. State the required assumption for
this design and interpret it in the context of this specific application. What would be a scenario in which
1
this assumption is violated? What are the advantages and disadvantages of this design for this specific
application?
Answer:
Regression Discontinuity Design has a valid assumption regarding the outcome continuously changing above
and below the cutoff point only. The only different change at the cutoff due to treatment (via government
transfers).
As such, the municipalities over and under the cutoff with census population have been assigned treatment
and should be similar in all other characteristics. This assumption also implies that none of these other
characteristics will be discontinuous at the population cutoff.
Example of an invalid assumption: If the cities on either side of the population cutoffs were manipulating
their populations to show over the cutoff for treatment, the two populations would not be comparable. For
example, if the local administrators were to overestimate their population to qualify for an increase in
funding.
Benefits / Challenges:- Provides a valid estimate of causal impact on action from observational data -
Eliminates statistically irrelevant confounding factors within close proximity of the cutoff - Evidence exists
demonstrating a clearly defined and observable cutoff
•Not generalizable to cities outside the cutoff (low generalizability)
•Number of respondents needed to estimate accurately must be sufficiently large
•The assumption of no manipulation at the cut-off may not always be true.
Question 2
Begin by creating a variable that determines how close each municipality was to the cutoff that determined
whether states received a transfer or not. Transfers occurred at three separate population cutoffs: 10,188,
13,584, and 16,980. Using these cutoffs, create a single variable that characterizes the difference from the
closest population cutoff. Following the original analysis, standardize this measure by dividing the difference
with the corresponding cutoff and multiply it by 100. This will yield a normalized percent score for the
difference between the population of each state and the cutoff relative to the cutoff value.
# Define the three population cutoffs
cutoffs <-c(10188, 13584, 16980)
# Function to calculate the standardized distance from the nearest cutoff
calc_distance <-function(pop) {
# Calculate absolute distance to each cutoff
distances <-abs(pop-cutoffs)
# Find the nearest cutoff
nearest_idx <-which.min(distances)
nearest_cutoff <- cutoffs[nearest_idx]
# Calculate the difference (positive if above cutoff, negative if below)
diff <- pop-nearest_cutoff
# Standardize by dividing by the cutoff and multiplying by 100
standardized_diff <- (diff/nearest_cutoff)*100
return(standardized_diff)
}
# Apply the function to each municipality using for loop
transfer$distance <-rep(NA,nrow(transfer))
for(iin1:nrow(transfer)) {
2
transfer$distance[i] <-calc_distance(transfer$pop82[i])
}
# Check the result
summary(transfer$distance)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -26.3447 -8.8707 0.1119 1.2678 10.0847 39.8763
head(transfer[,c("pop82", "distance")])
## pop82 distance
## 1 13937 2.598645
## 2 19613 15.506478
## 3 9343 -8.294071
## 4 9728 -4.515116
## 5 23592 38.939929
## 6 14701 8.222909
Question 3
Begin by subsetting the data to include only those municipalities within 3 points of the funding cutoff on
either side. Using regressions, estimate the average causal effect of government transfer on each of the
three outcome variables of interest: educational attainment, literacy, and poverty. Give a brief substantive
interpretation of the results.
# Subset data to municipalities within 3 percentage points of cutoff
transfer_sub <-subset(transfer, distance>= -3&distance<=3)
# Check the number of observations
nrow(transfer_sub)
## [1] 297
# Create a treatment variable (above cutoff = received transfer)
transfer_sub$treated <-ifelse(transfer_sub$distance>=0, 1, 0)
# Fit separate regression models for each side of the threshold
# For educational attainment (educ91)
fit_educ_below <-lm(educ91~distance, data = transfer_sub[transfer_sub$distance<0, ])
fit_educ_above <-lm(educ91~distance, data = transfer_sub[transfer_sub$distance>=0, ])
# For literacy (literate91)
fit_lit_below <-lm(literate91~distance, data = transfer_sub[transfer_sub$distance<0, ])
fit_lit_above <-lm(literate91~distance, data = transfer_sub[transfer_sub$distance>=0, ])
# For poverty (poverty91)
fit_pov_below <-lm(poverty91~distance, data = transfer_sub[transfer_sub$distance<0, ])
fit_pov_above <-lm(poverty91~distance, data = transfer_sub[transfer_sub$distance>=0, ])
3
# Calculate causal effects at the threshold (difference in predicted values at distance = 0)
# Predict at distance = 0 for both sides
pred_educ_below <-predict(fit_educ_below, newdata =data.frame(distance = 0))
pred_educ_above <-predict(fit_educ_above, newdata =data.frame(distance = 0))
effect_educ <- pred_educ_above-pred_educ_below
pred_lit_below <-predict(fit_lit_below, newdata =data.frame(distance = 0))
pred_lit_above <-predict(fit_lit_above, newdata =data.frame(distance = 0))
effect_lit <- pred_lit_above-pred_lit_below
pred_pov_below <-predict(fit_pov_below, newdata =data.frame(distance = 0))
pred_pov_above <-predict(fit_pov_above, newdata =data.frame(distance = 0))
effect_pov <- pred_pov_above-pred_pov_below
# Display results
cat("Causal effect on educational attainment:",round(effect_educ, 4), "years\n")
## Causal effect on educational attainment: 0.5836 years
cat("Causal effect on literacy rate:",round(effect_lit, 4), "\n")
## Causal effect on literacy rate: 0.0556
cat("Causal effect on poverty rate:",round(effect_pov, 4), "\n")
## Causal effect on poverty rate: -0.0603
Interpretation:
The results suggest the following: -Educational attainment: Government transfers increased average
years of education by approximately 0.58 years. -Literacy rate: Government transfers increased the
literacy rate by approximately 0.06 (on a 0-1 scale). -Poverty rate: Government transfers decreased the
poverty rate by approximately -0.06.
These findings suggest that government transfers had positive effects on educational outcomes and reduced
poverty in Brazilian municipalities near the population thresholds.
Question 4
Visualize the analysis done in the previous question by plotting data points, fitted regression lines, and the
population threshold. Briefly comment on the plot.
# Set up plotting area for 3 plots
par(mfrow =c(1, 3))
# Plot for educational attainment
plot(transfer_sub$distance, transfer_sub$educ91,
main = "Educational Attainment",
xlab = "Distance from Cutoff (%)",
ylab = "Years of Education (1991)",
pch = 19, col = "gray70")
4
abline(v = 0, lty = "dashed", col = "red", lwd = 2)
# Add regression lines using abline
abline(fit_educ_below, col = "blue", lwd = 2)
abline(fit_educ_above, col = "blue", lwd = 2)
# Plot for literacy rate
plot(transfer_sub$distance, transfer_sub$literate91,
main = "Literacy Rate",
xlab = "Distance from Cutoff (%)",
ylab = "Literacy Rate (1991)",
pch = 19, col = "gray70")
abline(v = 0, lty = "dashed", col = "red", lwd = 2)
abline(fit_lit_below, col = "blue", lwd = 2)
abline(fit_lit_above, col = "blue", lwd = 2)
# Plot for poverty rate
plot(transfer_sub$distance, transfer_sub$poverty91,
main = "Poverty Rate",
xlab = "Distance from Cutoff (%)",
ylab = "Poverty Rate (1991)",
pch = 19, col = "gray70")
abline(v = 0, lty = "dashed", col = "red", lwd = 2)
abline(fit_pov_below, col = "blue", lwd = 2)
abline(fit_pov_above, col = "blue", lwd = 2)
−3 −1 0 1 2 3
1 2 3 4 5 6 7
Educational Attainment
Distance from Cutoff (%)
Y ears of Education (1991)
−3 −1 0 1 2 3
0.4 0.6 0.8 1.0
Literacy Rate
Distance from Cutoff (%)
Literacy Rate (1991)
−3 −1 0 1 2 3
0.2 0.4 0.6 0.8
Poverty Rate
Distance from Cutoff (%)
Poverty Rate (1991)
5
# Reset plotting area
par(mfrow =c(1, 1))
Comment on the plots:
The plots show the regression discontinuity design for each outcome variable. The red dashed vertical line at
zero represents the population threshold. The blue lines represent the fitted regression lines on each side of
the threshold. The jump at the threshold represents the estimated causal effect. For educational attainment
and literacy, we observe a positive jump at the threshold, suggesting that government transfers improved
these outcomes. For poverty rate, we observe a negative jump, suggesting that transfers reduced poverty.
Question 5
Instead of fitting linear regression models, we compute the difference in means of the outcome variables
between the groups of observations above the threshold and below it. How do the estimates differ from what
you obtained in the earlier Question? Is the assumption invoked here identical to the one required for the
analysis conducted there? Which estimates are more appropriate? Discuss.
# Calculate difference in means
mean_educ_treated <-mean(transfer_sub$educ91[transfer_sub$treated==1])
mean_educ_control <-mean(transfer_sub$educ91[transfer_sub$treated==0])
diff_mean_educ <- mean_educ_treated-mean_educ_control
mean_lit_treated <-mean(transfer_sub$literate91[transfer_sub$treated==1])
mean_lit_control <-mean(transfer_sub$literate91[transfer_sub$treated==0])
diff_mean_lit <- mean_lit_treated-mean_lit_control
mean_pov_treated <-mean(transfer_sub$poverty91[transfer_sub$treated==1])
mean_pov_control <-mean(transfer_sub$poverty91[transfer_sub$treated==0])
diff_mean_pov <- mean_pov_treated-mean_pov_control
cat("Difference in means - Educational attainment:",round(diff_mean_educ, 4), "\n")
## Difference in means - Educational attainment: 0.4367
cat("Difference in means - Literacy rate:",round(diff_mean_lit, 4), "\n")
## Difference in means - Literacy rate: 0.0469
cat("Difference in means - Poverty rate:",round(diff_mean_pov, 4), "\n")
## Difference in means - Poverty rate: -0.0632
cat("\nComparison with regression-based estimates:\n")
##
## Comparison with regression-based estimates:
6
cat("Regression - Educational attainment:",round(effect_educ, 4), "\n")
## Regression - Educational attainment: 0.5836
cat("Regression - Literacy rate:",round(effect_lit, 4), "\n")
## Regression - Literacy rate: 0.0556
cat("Regression - Poverty rate:",round(effect_pov, 4), "\n")
## Regression - Poverty rate: -0.0603
Using the difference-in-means method helps to produce a more straightforward estimate of average results of
municipalities by determining their positions relative to the threshold and comparing their average results.
This method relies on the assumption that, within the window surrounding the threshold value, treatment
assignmentwillbedeterminedbyrandomchanceduetothelackofanobviousrelationshipbetweentreatment
and the running variable.
On the other hand, using regression-based estimates is preferable because of the following reasons:
1.Different assumptions: The difference-in-means calculation works under an assumption that the
relationship between running distance (the running variable) and the outcome is flat near each side of
the threshold. In contrast, the regression model allows for a linear relationship between the running
variable and the outcome of interest, which is more flexible than an equation with merely one slope.
2.Adjustment for the running variable: The regression method adjusts for differences in baseline
outcomes of municipalities from their respective threshold points because municipalities that are lo-
cated at varying distances away from the threshold, but still remain in the relatively narrow window
surrounding the threshold, may have significantly different baseline outcomes.
3.Betterprecision: Whenthereisarelationshipbetweentherunningvariableandtheaverageoutcome,
the regression method generally produces more precisely estimated threshold values.
Thus, in RDD analyses, regression estimates are thought to provide a better approximation of the counter-
factual at the threshold than difference-in-means estimates.
Question 6
Repeat the analysis conducted in the original question but vary the width of analysis window from 1 to 5
percentage points below and above the threshold. Obtain the estimate for every percentage point. Briefly
comment on the results.
# Create a function to run RDD analysis with different window widths
run_rdd <-function(data, width) {
# Subset data
sub_data <-subset(data, distance>= -width&distance<=width)
# Fit models
fit_below <-lm(educ91~distance, data = sub_data[sub_data$distance<0, ])
fit_above <-lm(educ91~distance, data = sub_data[sub_data$distance>=0, ])
7
# Calculate effect
pred_below <-predict(fit_below, newdata =data.frame(distance = 0))
pred_above <-predict(fit_above, newdata =data.frame(distance = 0))
return(list(
effect = pred_above-pred_below,
n =nrow(sub_data)
))
}
# Run for widths 1 to 5
widths <- 1:5
results <-data.frame(
width = widths,
effect_educ = NA,
effect_lit = NA,
effect_pov = NA,
n = NA
)
for(iin1:length(widths)) {
w <- widths[i]
sub_data <-subset(transfer, distance>= -w&distance<=w)
results$n[i] <-nrow(sub_data)
# Educational attainment
fit_below <-lm(educ91~distance, data = sub_data[sub_data$distance<0, ])
fit_above <-lm(educ91~distance, data = sub_data[sub_data$distance>=0, ])
results$effect_educ[i] <-predict(fit_above, newdata =data.frame(distance = 0))-
predict(fit_below, newdata =data.frame(distance = 0))
# Literacy rate
fit_below <-lm(literate91~distance, data = sub_data[sub_data$distance<0, ])
fit_above <-lm(literate91~distance, data = sub_data[sub_data$distance>=0, ])
results$effect_lit[i] <-predict(fit_above, newdata =data.frame(distance = 0))-
predict(fit_below, newdata =data.frame(distance = 0))
# Poverty rate
fit_below <-lm(poverty91~distance, data = sub_data[sub_data$distance<0, ])
fit_above <-lm(poverty91~distance, data = sub_data[sub_data$distance>=0, ])
results$effect_pov[i] <-predict(fit_above, newdata =data.frame(distance = 0))-
predict(fit_below, newdata =data.frame(distance = 0))
}
# Display results
print(results)
## width effect_educ effect_lit effect_pov n
## 1 1 0.2148332 0.03671902 -0.04009163 107
## 2 2 0.4062149 0.05426328 -0.04558973 202
## 3 3 0.5836394 0.05564458 -0.06032728 297
## 4 4 0.7117898 0.07524673 -0.08084478 391
## 5 5 0.6897769 0.06477337 -0.08259017 479
8
# Plot the results
par(mfrow =c(1, 3))
plot(results$width, results$effect_educ, type = "b", pch = 19,
main = "Educational Attainment Effect",
xlab = "Window Width (percentage points)",
ylab = "Estimated Effect")
abline(h = 0, lty = "dashed", col = "gray")
plot(results$width, results$effect_lit, type = "b", pch = 19,
main = "Literacy Rate Effect",
xlab = "Window Width (percentage points)",
ylab = "Estimated Effect")
abline(h = 0, lty = "dashed", col = "gray")
plot(results$width, results$effect_pov, type = "b", pch = 19,
main = "Poverty Rate Effect",
xlab = "Window Width (percentage points)",
ylab = "Estimated Effect")
abline(h = 0, lty = "dashed", col = "gray")
1 2 3 4 5
0.2 0.3 0.4 0.5 0.6 0.7
Educational Attainment Effect
Window Width (percentage points)
Estimated Effect
1 2 3 4 5
0.04 0.05 0.06 0.07
Literacy Rate Effect
Window Width (percentage points)
Estimated Effect
1 2 3 4 5
−0.08 −0.07 −0.06 −0.05 −0.04
Poverty Rate Effect
Window Width (percentage points)
Estimated Effect
par(mfrow =c(1, 1))
Different widths or sizes of observations produce different results; this is due to a number of factors: 1.
A Smaller width produces less bias (more similar) but more variance (less similar) than a larger width;
9
therefore, your overall sample size (number of observations) will be smaller when sampling with a small
width and larger when sampling with a large width. 2. If the assumptions underlying the RDD hold true,
we should see largely equivalent estimates across different widths; if the estimates do not vary significantly,
they will provide evidence that your results are not sensitive to the chosen bandwidth. 3. - The total number
of observations available increases when using larger widths in the results; this is represented in thencolumn
headers.
Question 7 (Bonus Question)
Conduct the same analysis as in the earlier Question but this time using measures of the poverty rate and
educational attainment taken in 1980, before the population-based government transfers began. What do
the results suggest about the validity of analysis presented in the earlier Question?
# Use the subset with 3 percentage points window
# Analyze pre-treatment outcomes from 1980
# Educational attainment in 1980
fit_educ80_below <-lm(educ80~distance, data = transfer_sub[transfer_sub$distance<0, ])
fit_educ80_above <-lm(educ80~distance, data = transfer_sub[transfer_sub$distance>=0, ])
effect_educ80 <-predict(fit_educ80_above, newdata =data.frame(distance = 0))-
predict(fit_educ80_below, newdata =data.frame(distance = 0))
# Poverty rate in 1980
fit_pov80_below <-lm(poverty80~distance, data = transfer_sub[transfer_sub$distance<0, ])
fit_pov80_above <-lm(poverty80~distance, data = transfer_sub[transfer_sub$distance>=0, ])
effect_pov80 <-predict(fit_pov80_above, newdata =data.frame(distance = 0))-
predict(fit_pov80_below, newdata =data.frame(distance = 0))
cat("Placebo test - Effect on pre-treatment variables (1980):\n")
## Placebo test - Effect on pre-treatment variables (1980):
cat("Effect on educational attainment (1980):",round(effect_educ80, 4), "\n")
## Effect on educational attainment (1980): 0.1922
cat("Effect on poverty rate (1980):",round(effect_pov80, 4), "\n")
## Effect on poverty rate (1980): -0.0273
cat("\nComparison with effects on post-treatment variables (1991):\n")
##
## Comparison with effects on post-treatment variables (1991):
cat("Effect on educational attainment (1991):",round(effect_educ, 4), "\n")
## Effect on educational attainment (1991): 0.5836
10
cat("Effect on poverty rate (1991):",round(effect_pov, 4), "\n")
## Effect on poverty rate (1991): -0.0603
# Visualize the placebo test
par(mfrow =c(1, 2))
# Plot for educational attainment 1980
plot(transfer_sub$distance, transfer_sub$educ80,
main = "Educational Attainment (1980)\nPlacebo Test",
xlab = "Distance from Cutoff (%)",
ylab = "Years of Education (1980)",
pch = 19, col = "gray70")
abline(v = 0, lty = "dashed", col = "red", lwd = 2)
abline(fit_educ80_below, col = "blue", lwd = 2)
abline(fit_educ80_above, col = "blue", lwd = 2)
# Plot for poverty rate 1980
plot(transfer_sub$distance, transfer_sub$poverty80,
main = "Poverty Rate (1980)\nPlacebo Test",
xlab = "Distance from Cutoff (%)",
ylab = "Poverty Rate (1980)",
pch = 19, col = "gray70")
abline(v = 0, lty = "dashed", col = "red", lwd = 2)
abline(fit_pov80_below, col = "blue", lwd = 2)
abline(fit_pov80_above, col = "blue", lwd = 2)
11
−3 −1 0 1 2 3
1 2 3 4
Educational Attainment (1980)
Placebo Test
Distance from Cutoff (%)
Y ears of Education (1980)
−3 −1 0 1 2 3
0.2 0.4 0.6 0.8
Poverty Rate (1980)
Placebo Test
Distance from Cutoff (%)
Poverty Rate (1980)
par(mfrow =c(1, 1))
The placebo test investigates any break in pre-treatment results (in 1980, prior to any of the transfers being
made based on location), and if the RDD principles apply to this analysis, then you should not see any major
break in those same pre-treatment variables. This is the following reasons: the first reason would be that
the transfer was not yet completed in 1980. Therefore, there was no causal relationship among the results
of population-based transfers and past years.
Results should provide evidence that there was no statistical effect on the estimated impacts from 1980 and
support the RDD principles; therefore; - municipalities close to the cut-off point (above and below) are alike
before the treatment started; - no evidence of sorting or manipulation in connection with the cut-off point
has been found; therefore; - observed results in the year 1991 are attributed to population-based transfers
with a higher degree of confidence.
If we discovered similar to large effects in the pre-treatment years, this would suggest that the RDD principles
do not apply and that there was likely to be manipulation of the population counts or some other confounding
variable.
12