Economics UG 4251 - Problem Set 4
Alexander Zhao
2026-04-20
data_path <- "C:/Users/Alex/Documents/Industrial Organization/Airport Data"
db1b_clean <- fread(
file.path(data_path, "db1b_clean_route_quarter_airline.csv")
)
head(db1b_clean)## Year Quarter quarter_id route_origin route_dest route airline passengers
## <int> <int> <char> <char> <char> <char> <char> <int>
## 1: 2007 1 2007Q1 ATL PWM ATL_PWM US 61
## 2: 2007 1 2007Q1 DTW PWM DTW_PWM US 36
## 3: 2007 1 2007Q1 MSP RDU MSP_RDU US 225
## 4: 2007 1 2007Q1 DTW RDU DTW_RDU US 388
## 5: 2007 1 2007Q1 DTW RDU DTW_RDU -- 1
## 6: 2007 1 2007Q1 ATL RIC ATL_RIC US 78
## avg_fare
## <num>
## 1: 275.8782
## 2: 254.8306
## 3: 181.0300
## 4: 147.1308
## 5: 0.0000
## 6: 178.1823str(db1b_clean)## Classes 'data.table' and 'data.frame': 41559 obs. of 9 variables:
## $ Year : int 2007 2007 2007 2007 2007 2007 2007 2007 2007 2007 ...
## $ Quarter : int 1 1 1 1 1 1 1 1 1 1 ...
## $ quarter_id : chr "2007Q1" "2007Q1" "2007Q1" "2007Q1" ...
## $ route_origin: chr "ATL" "DTW" "MSP" "DTW" ...
## $ route_dest : chr "PWM" "PWM" "RDU" "RDU" ...
## $ route : chr "ATL_PWM" "DTW_PWM" "MSP_RDU" "DTW_RDU" ...
## $ airline : chr "US" "US" "US" "US" ...
## $ passengers : int 61 36 225 388 1 78 43 203 129 176 ...
## $ avg_fare : num 276 255 181 147 0 ...
## - attr(*, ".internal.selfref")=<externalptr>For this project, I constructed a dataset of my own creation using the db1b data I retrieved. Here is that code; library(data.table)
Set folder path data_path <- “C:/Users/Alex/Documents/Industrial Organization/Airport Data”
List all CSV files files <- list.files( path = data_path, pattern = “\.csv$”, full.names = TRUE )
print(files) cat(“Number of files found:”, length(files), “”)
Keep only needed columns cols_needed <- c( “Year”, “Quarter”, “Origin”, “Dest”, “TkCarrier”, “Passengers”, “MktFare”, “BulkFare”, “MktCoupons” )
Function to process one file process_db1b_file <- function(file) {
cat(“file:”, basename(file), “”)
dt <- fread(file, select = cols_needed) setDT(dt)
# Make sure carrier is character dt[, TkCarrier := as.character(TkCarrier)]
# Filter to assignment sample dt <- dt[ MktCoupons <= 2
&
# nonstop or one-stop (Origin %in% c(“MSP”, “ATL”, “DTW”) | Dest %in%
c(“MSP”, “ATL”, “DTW”)) &
# route must include MSP/ATL/DTW BulkFare == 0 &
# drop bulk fares TkCarrier != “99”
# drop mixed/no single marketing carrier ]
# Create non-directional route dt[, route_origin := pmin(Origin, Dest)] dt[, route_dest := pmax(Origin, Dest)] dt[, route := paste(route_origin, route_dest, sep = “_“)]
# Quarter ID dt[, quarter_id := paste0(Year, “Q”, Quarter)]
# Airline variable = marketing carrier dt[, airline := TkCarrier]
# Collapse to route x quarter x airline collapsed <- dt[ , .( passengers = sum(Passengers, na.rm = TRUE), avg_fare = weighted.mean(MktFare, Passengers, na.rm = TRUE) ), by = .(Year, Quarter, quarter_id, route_origin, route_dest, route, airline) ]
cat(“Rows after collapse:”, nrow(collapsed), “”)
return(collapsed) }
- Process all files cleaned_list <- lapply(files, process_db1b_file)
- Combine into one dataset db1b_clean <- rbindlist(cleaned_list, use.names = TRUE, fill = TRUE)
Collapse again just in case - worried about the change NOT going through db1b_clean <- db1b_clean[ , .( passengers = sum(passengers, na.rm = TRUE), avg_fare = weighted.mean(avg_fare, passengers, na.rm = TRUE) ), by = .(Year, Quarter, quarter_id, route_origin, route_dest, route, airline)]
Inspect output cat(“dataset dimensions:”) print(dim(db1b_clean))
cat(“few rows:”) print(head(db1b_clean))
cat(“of passengers:”) print(summary(db1b_clean$passengers))
cat(“of average fares:”) print(summary(db1b_clean$avg_fare))
cat(“of unique routes:”) print(length(unique(db1b_clean$route)))
cat(“of unique airlines:”) print(length(unique(db1b_clean$airline)))
- Save cleaned master dataset output_file <- file.path(data_path, “db1b_clean_route_quarter_airline.csv”)
fwrite(db1b_clean, output_file)
cat(“cleaned dataset to:”, output_file, “”)
structure_check <- db1b_clean[
,
.N,
by = .(route, quarter_id, airline)
]
table(structure_check$N)##
## 1
## 41559Shape looks good!
# Total passengers on each route-quarter
db1b_clean[
,
route_quarter_passengers := sum(passengers, na.rm = TRUE),
by = .(route, quarter_id)
]
# Airline market share within each route-quarter - does not include the airline yet
db1b_clean[
,
market_share := passengers / route_quarter_passengers
]
# HHI contribution of each airline
db1b_clean[
,
hhi_component := (100 * market_share)^2
]
# Route-quarter DATASET
route_quarter_data <- db1b_clean[
,
.(
total_passengers = sum(passengers, na.rm = TRUE),
route_avg_fare = weighted.mean(avg_fare, passengers, na.rm = TRUE),
HHI = sum(hhi_component, na.rm = TRUE)
),
by = .(
Year,
Quarter,
quarter_id,
route,
route_origin,
route_dest
)
]
head(route_quarter_data)## Year Quarter quarter_id route route_origin route_dest total_passengers
## <int> <int> <char> <char> <char> <char> <int>
## 1: 2007 1 2007Q1 ATL_PWM ATL PWM 639
## 2: 2007 1 2007Q1 DTW_PWM DTW PWM 85
## 3: 2007 1 2007Q1 MSP_RDU MSP RDU 2003
## 4: 2007 1 2007Q1 DTW_RDU DTW RDU 3063
## 5: 2007 1 2007Q1 ATL_RIC ATL RIC 6060
## 6: 2007 1 2007Q1 ATL_IAH ATL IAH 8369
## route_avg_fare HHI
## <num> <num>
## 1: 287.2698 5995.357
## 2: 197.8945 2758.478
## 3: 224.0800 4847.085
## 4: 164.2030 4842.933
## 5: 142.9216 4912.053
## 6: 166.1696 5072.865summary(route_quarter_data$HHI)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1322 4682 6322 6803 10000 10000summary_table <- data.table(
Variable = c(
"Route-quarter average fare",
"Route-quarter total passengers",
"HHI"
),
Mean = c(
mean(route_quarter_data$route_avg_fare, na.rm = TRUE),
mean(route_quarter_data$total_passengers, na.rm = TRUE),
mean(route_quarter_data$HHI, na.rm = TRUE)
),
SD = c(
sd(route_quarter_data$route_avg_fare, na.rm = TRUE),
sd(route_quarter_data$total_passengers, na.rm = TRUE),
sd(route_quarter_data$HHI, na.rm = TRUE)
),
N = c(
sum(!is.na(route_quarter_data$route_avg_fare)),
sum(!is.na(route_quarter_data$total_passengers)),
sum(!is.na(route_quarter_data$HHI))
)
)
summary_table## Variable Mean SD N
## <char> <num> <num> <int>
## 1: Route-quarter average fare 244.0378 96.96704 11659
## 2: Route-quarter total passengers 1321.4404 3413.92574 11659
## 3: HHI 6803.0435 2581.20638 11659summary(route_quarter_data$HHI)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1322 4682 6322 6803 10000 10000ggplot(route_quarter_data, aes(x = HHI)) +
geom_histogram(bins = 30) +
labs(
title = "Dist. of Route-Quarter HHI",
x = "HHI",
y = "Count"
) +
theme_minimal()
route_counts <- db1b_clean[
,
.(num_airlines = uniqueN(airline)),
by = .(route, quarter_id)
]
table(route_counts$num_airlines)##
## 1 2 3 4 5 6 7 8 9 10 11 12 13 14
## 3232 2229 1485 1198 870 756 671 517 334 202 110 49 5 1fwrite(
route_quarter_data,
file.path(data_path, "route_quarter_data.csv")
)
fwrite(
summary_table,
file.path(data_path, "summary_statistics_route_quarter.csv")
)# Keep only first and last quarter
first_last <- route_quarter_data[
quarter_id %in% c("2007Q1", "2010Q4")
]
# Reshape to wide format (used AI - why does my graph look bad? and implemented solution)
route_changes <- dcast(
first_last,
route ~ quarter_id,
value.var = c("route_avg_fare", "HHI")
)
# Rename columns
setnames(
route_changes,
old = c(
"route_avg_fare_2007Q1",
"route_avg_fare_2010Q4",
"HHI_2007Q1",
"HHI_2010Q4"
),
new = c(
"fare_first",
"fare_last",
"HHI_first",
"HHI_last"
)
)
# Keep only routes observed in both periods
route_changes <- route_changes[
!is.na(fare_first) &
!is.na(fare_last) &
!is.na(HHI_first) &
!is.na(HHI_last)
]
# Compute changes
route_changes[, delta_fare := fare_last - fare_first]
route_changes[, delta_HHI := HHI_last - HHI_first]
head(route_changes)## Key: <route>
## route fare_first fare_last HHI_first HHI_last delta_fare delta_HHI
## <char> <num> <num> <num> <num> <num> <num>
## 1: ABE_ATL 227.6140 212.8068 4755.864 4708.777 -14.80717 -47.08669
## 2: ABE_DTW 185.4936 244.0500 3388.203 6041.346 58.55647 2653.14304
## 3: ABE_MSP 331.5646 181.6502 2522.137 2840.613 -149.91443 318.47655
## 4: ABI_ATL 261.4641 187.9635 8300.781 10000.000 -73.50060 1699.21875
## 5: ABI_DTW 253.0738 283.3342 8579.882 10000.000 30.26038 1420.11834
## 6: ABI_MSP 236.5510 212.9857 10000.000 10000.000 -23.56526 0.00000ggplot(route_changes, aes(x = delta_HHI, y = delta_fare)) +
geom_point(alpha = 0.5) +
geom_smooth(method = "lm", se = TRUE, color = "blue") +
labs(
title = "Change in Fare vs. Change in HHI",
subtitle = "Route-level changes between 2007 Q1 and 2010 Q4",
x = "Change in HHI",
y = "Change in Passenger-Weighted Average Fare ($)"
) +
theme_minimal()
scatter_reg <- lm(delta_fare ~ delta_HHI, data = route_changes)
summary(scatter_reg)##
## Call:
## lm(formula = delta_fare ~ delta_HHI, data = route_changes)
##
## Residuals:
## Min 1Q Median 3Q Max
## -722.83 -27.34 6.37 38.40 507.83
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -20.613080 2.907103 -7.091 2.73e-12 ***
## delta_HHI 0.005932 0.001557 3.811 0.000148 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 84.92 on 886 degrees of freedom
## Multiple R-squared: 0.01613, Adjusted R-squared: 0.01502
## F-statistic: 14.52 on 1 and 886 DF, p-value: 0.0001481# Log fare
route_quarter_data[, log_route_price := log(route_avg_fare)]
# Fixed effects regression - used AI - (why is my fixed effect demonstrating such a large negative slope --> answered that this may be a byproduct of the dataset - no clear way to fix afaik)
fe_model <- feols(
log_route_price ~ HHI | route + quarter_id,
data = route_quarter_data,
weights = ~ total_passengers,
cluster = ~ route + quarter_id
)
summary(fe_model)## OLS estimation, Dep. Var.: log_route_price
## Observations: 11,595
## Weights: total_passengers
## Fixed-effects: route: 1,091, quarter_id: 12
## Standard-errors: Clustered (route & quarter_id)
## Estimate Std. Error t value Pr(>|t|)
## HHI -4.5e-06 7.07e-06 -0.636663 0.53737
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## RMSE: 0.096153 Adj. R2: 0.868426
## Within R2: 9.881e-4etable(
fe_model,
digits = 4,
fitstat = c("n", "r2")
)## fe_model
## Dependent Var.: log_route_price
##
## HHI -4.5e-6 (7.07e-6)
## Fixed-Effects: -----------------
## route Yes
## quarter_id Yes
## _______________ _________________
## S.E.: Clustered by: route & quar.
## Observations 11,595
## R2 0.88093
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Pre-merger route-quarter observations
pre_merger_routes <- route_quarter_data[
quarter_id == "2007Q1"
]
# Pre-merger airline observations
pre_merger_airline <- db1b_clean[
quarter_id == "2007Q1"
]
# Total route passengers
pre_merger_airline[
,
route_total_passengers := sum(passengers, na.rm = TRUE),
by = route
]
# Airline market share in percent
pre_merger_airline[
,
share_pct := 100 * passengers / route_total_passengers
]
# Delta and Northwest shares on each route
dl_nw_shares <- dcast(
pre_merger_airline[airline %in% c("DL", "NW")],
route ~ airline,
value.var = "share_pct",
fill = 0
)
# Indicator for routes where both carriers were active pre-merger
dl_nw_shares[
,
overlap_route := DL > 0 & NW > 0
]
# Predicted change in HHI from merger:
dl_nw_shares[
,
delta_HHI_merger := 2 * DL * NW
]
# Keep only the columns needed
merger_effects <- merge(
pre_merger_routes[, .(route, HHI)],
dl_nw_shares[, .(route, DL, NW, overlap_route, delta_HHI_merger)],
by = "route",
all.x = TRUE
)
# Routes without DL/NW presence get zero merger effect!!
merger_effects[
is.na(delta_HHI_merger),
`:=`(
DL = 0,
NW = 0,
overlap_route = FALSE,
delta_HHI_merger = 0
)
]
# Predicted post-merger HHI
merger_effects[
,
HHI_post_merger := HHI + delta_HHI_merger
]
head(merger_effects)## Key: <route>
## route HHI DL NW overlap_route delta_HHI_merger
## <char> <num> <num> <num> <lgcl> <num>
## 1: ABE_ATL 4755.864 60.928433 1.160542 TRUE 141.4200
## 2: ABE_DTW 3388.203 3.703704 20.740741 TRUE 153.6351
## 3: ABE_MSP 2522.137 9.638554 31.325301 TRUE 603.8612
## 4: ABI_ATL 8300.781 0.000000 0.000000 FALSE 0.0000
## 5: ABI_DTW 8579.882 0.000000 0.000000 FALSE 0.0000
## 6: ABI_MSP 10000.000 0.000000 0.000000 FALSE 0.0000
## HHI_post_merger
## <num>
## 1: 4897.283
## 2: 3541.838
## 3: 3125.998
## 4: 8300.781
## 5: 8579.882
## 6: 10000.000table(merger_effects$overlap_route)##
## FALSE TRUE
## 540 427summary(merger_effects$delta_HHI_merger)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.0 0.0 0.0 318.7 197.0 4800.0ggplot(merger_effects, aes(x = delta_HHI_merger)) +
geom_histogram(bins = 30) +
labs(
title = "Unweighted Route-Level Change in HHI from the DL-NW Merger",
x = "Predicted Change in HHI",
y = "Number of Routes"
) +
theme_minimal()
# Merge merger effect onto route-quarter dataset
route_quarter_sim <- merge(
route_quarter_data,
merger_effects[, .(route, delta_HHI_merger)],
by = "route",
all.x = TRUE
)
# Routes without DL or NW overlap get zero change
route_quarter_sim[
is.na(delta_HHI_merger),
delta_HHI_merger := 0
]
# Predicted post-merger HHI
route_quarter_sim[
,
delta_HHI_applied := ifelse(
quarter_id %in% c("2009Q3","2009Q4","2010Q1","2010Q2","2010Q3","2010Q4"),
delta_HHI_merger,
0
)
]
route_quarter_sim[
,
HHI_new := HHI + delta_HHI_applied
]
# Regression coefficient
beta_hhi <- coef(fe_model)["HHI"]
# Predicted original and new log prices
route_quarter_sim[
,
log_price_hat_old := predict(fe_model, newdata = route_quarter_sim)
]
route_quarter_sim[
,
log_price_hat_new := log_price_hat_old + beta_hhi * delta_HHI_applied
]
# Convert back to dollars
route_quarter_sim[
,
price_hat_old := exp(log_price_hat_old)
]
route_quarter_sim[
,
price_hat_new := exp(log_price_hat_new)
]
# Additional dollars paid by passengers
route_quarter_sim[
,
extra_paid := (price_hat_new - price_hat_old) * total_passengers
]
head(
route_quarter_sim[
,
.(
route,
quarter_id,
HHI,
delta_HHI_merger,
HHI_new,
price_hat_old,
price_hat_new,
extra_paid
)
]
)## Key: <route>
## route quarter_id HHI delta_HHI_merger HHI_new price_hat_old
## <char> <char> <num> <num> <num> <num>
## 1: ABE_ATL 2007Q1 4755.864 141.42 4755.864 207.0706
## 2: ABE_ATL 2007Q2 6328.009 141.42 6328.009 206.3142
## 3: ABE_ATL 2007Q3 5191.574 141.42 5191.574 203.1003
## 4: ABE_ATL 2007Q4 6587.854 141.42 6587.854 197.5780
## 5: ABE_ATL 2008Q1 5525.430 141.42 5525.430 210.9684
## 6: ABE_ATL 2008Q2 5560.790 141.42 5560.790 218.7130
## price_hat_new extra_paid
## <num> <num>
## 1: 207.0706 0
## 2: 206.3142 0
## 3: 203.1003 0
## 4: 197.5780 0
## 5: 210.9684 0
## 6: 218.7130 0post_merger_quarters <- c("2009Q3","2009Q4","2010Q1","2010Q2","2010Q3","2010Q4")
results_table <- data.table(
Metric = c(
"Mean original predicted price (post-merger quarters)",
"Mean new predicted price (post-merger quarters)",
"Total extra paid over sample window"
),
Value = c(
mean(route_quarter_sim[quarter_id %in% post_merger_quarters, price_hat_old], na.rm = TRUE),
mean(route_quarter_sim[quarter_id %in% post_merger_quarters, price_hat_new], na.rm = TRUE),
sum(route_quarter_sim$extra_paid, na.rm = TRUE)
)
)
results_table## Metric Value
## <char> <num>
## 1: Mean original predicted price (post-merger quarters) 230.5468
## 2: Mean new predicted price (post-merger quarters) 230.2190
## 3: Total extra paid over sample window -1252470.5750summary(fe_model)## OLS estimation, Dep. Var.: log_route_price
## Observations: 11,595
## Weights: total_passengers
## Fixed-effects: route: 1,091, quarter_id: 12
## Standard-errors: Clustered (route & quarter_id)
## Estimate Std. Error t value Pr(>|t|)
## HHI -4.5e-06 7.07e-06 -0.636663 0.53737
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## RMSE: 0.096153 Adj. R2: 0.868426
## Within R2: 9.881e-4coef(fe_model)["HHI"]## HHI
## -4.50001e-06fwrite(
route_quarter_sim,
file.path(data_path, "route_quarter_simulation_results.csv")
)
fwrite(
results_table,
file.path(data_path, "merger_simulation_summary.csv")
)Based on the estimated model, I would not recommend challenging the merger on the basis of these predicted price effects alone. The estimated coefficient on HHI is slightly negative and statistically insignificant, so the simulation does not predict that the merger raised fares on average.
I would interpret that conclusion with abundant caution. The negative sign is counterintuitive and likely reflects limitations of the specification rather than evidence that the merger was actually pro-competitive. The 2007–2010 period includes the Great Recession and large swings in fuel prices, both of which may have affected fares more strongly than modest differences in concentration. In addition, many routes in the sample are already highly concentrated, leaving limited within-route variation in HHI to identify a precise effect. DB1B fares are also averages across many passengers and ticket types, so measured prices may change for reasons unrelated to competitive conditions.
For these reasons, I would not interpret the negative coefficient as evidence that the merger lowered prices. Instead, I would conclude that this particular fixed-effects specification does not provide strong evidence that the merger increased fares. At the same time, the merger does mechanically increase concentration on overlapping Delta–Northwest routes, so those routes would still be natural candidates for closer antitrust scrutiny. A stronger conclusion would require a more targeted strategy, such as isolating overlap routes more directly or comparing affected routes to a cleaner control group.