Ders 1
Siminber Yariyeva
2023-10-17
Regresyon Discontinuity Tasarımları (RD)
İnsanların birbirlerine uyguladığı keyfi kural ve kanunlar bizim deney yapmamıza olanak sağlıyor.
RD (regresyon discontinuity) tasarımı, bu kurallardan faydalanan bir yöntemdir. Fuzzy ve sharp olmak üzere iki farklı şekli vardır. Sharp tasarımı, gözlemlediğimiz bir olayda kuralların tedavi ve kontrol gruplarını kesin olarak belirlemek üzerine kuruludur. Fuzzy tasarım ise bu grupları ayırabilmek için araç değişkenler gibi bir yapıya ihtiyaç duyar.
6.1.1 üç ayrı grafikten oluşuyor. Doğrusal, doğrusal olmayan, süreksiz olmakla karıştırılan doğrusal olmayan RD tasarımları. İlk olarak bu üç tasarım için veri oluşturuyoruz.
Her biri veri için 100 gözlem belirleyelim
n=100Rasgele x verisi oluşturulalım
set.seed(1149)
x <- runif(n)Rasgele veri oluşturduktan sonra bu verilerin ilk altı satrını görmek adına head() fonksiyonu, kullanalım
head(x)## [1] 0.901608043 0.508481772 0.003583934 0.644593220 0.051421000 0.273405757Koşullara göre 3 tane y oluşturun. Eşik değeri 0.5 olarak belirlenmiştir.
y_dogrusal <- x + (x > 0.5) * 0.25 + rnorm(n, mean = 0, sd = 0.1)
y_dogrusal_olmayan <- 0.5 * sin(6 * (x - 0.5)) + 0.5 + (x > 0.5) * 0.25 + rnorm(n, mean = 0, sd = 0.1)
y_hatalı <- 1 / (1 + exp(-25 * (x - 0.5))) + rnorm(n, mean = 0, sd = 0.1)x ve y değişkenlerini doğrusal bir grafik çizmek için bir data frame içinde birleştirirsek
df <- data.frame(x = x, y_dogrusal = y_dogrusal)Bu dataframe’i eşik değerine göre ikiye bölelim
df_alt <- df[df$x < 0.5, ]
df_ust <- df[df$x > 0.5, ]1.grafik, doğrusal sharp tasarım
paketi yükledikten sonra çalıştırmak için aşağıdaki işlemi uygulayabiliriz.
library(plotrix)A <- plot(df_alt$x, df_alt$y_dogrusal, xlim = c(0, 1), ylim = c(0, 2), pch = 16, cex = 0.5, col = "black", main = "A. Doğrusal E[Y|X]", xlab = "x", ylab = "Y")
points(df_ust$x, df_ust$y_dogrusal, pch = 16, cex = 0.5, col = "black")
lm_alt <- lm(y_dogrusal ~ x, data = df_alt)
lm_ust <- lm(y_dogrusal ~ x, data = df_ust)
ablineclip(lm_alt, x1 = 0,x2 = .5, col = "black", lwd = 2)
ablineclip(lm_ust, x1 = .5,x2 = 1, col = "black", lwd = 2)
abline(v = 0.5, lty = 2)
- Grafik için doğrusal olmayan tasarım.
df_dogrusal_olmayan <- data.frame(x = x, y_dogrusal_olmayan = y_dogrusal_olmayan)Dogrusal olmayan veri setini ikiye ayıralım
df_dogrusal_olmayan_alt <- df_dogrusal_olmayan[df_dogrusal_olmayan$x < 0.5, ]
df_dogrusal_olmayan_ust <- df_dogrusal_olmayan[df_dogrusal_olmayan$x > 0.5, ]Bu sefer plot fonksiyonu yerine ggplot2 paketini kullanabiliriz. (Not: Bu ders notunun amacı kullanılan paketleri öğretmek değil. Paketlerin detayları için ayrı bir ders hazırlanabilir.)
library(ggplot2)B<- ggplot() +
geom_smooth(data = df_dogrusal_olmayan_alt, aes(x = x, y = y_dogrusal_olmayan), method = "lm", formula = y ~ poly(x, 2), se = FALSE, color = "black")+
geom_point(data = df_dogrusal_olmayan_alt, aes(x = x, y = y_dogrusal_olmayan), size = 1, shape = 16, color = "black") +
geom_smooth(data = df_dogrusal_olmayan_ust, aes(x = x, y = y_dogrusal_olmayan), method = "lm", formula = y ~ poly(x, 2), se = FALSE, color = "black") +
geom_point(data = df_dogrusal_olmayan_ust, aes(x = x, y = y_dogrusal_olmayan), size = 1, shape = 16, color = "black") +
labs(title = "B. Doğrusal Olmayan E[Y|X]", y = "Y", x = "x") +
theme_bw() +
theme(legend.position = "none") +
geom_vline(xintercept = 0.5, linetype = "dashed") +
xlim(0, 1)3.grafik RD ile karıştırılma ihtimali olan tasarım.
df_hatalı <- data.frame(x = x, y_hatalı = y_hatalı)df_hatalı_alt <- df_hatalı[df_hatalı$x < 0.5, ]
df_hatalı_ust <- df_hatalı[df_hatalı$x >= 0.5, ]Quadratic fonksiyon yerine, bir süreksizlik fonksiyonu belirlenmiş
discontinuity <- function(x) {
1 / (1 + exp(-25 * (x - 0.5)))
}C<- ggplot() +
geom_smooth(data = df_hatalı_alt, aes(x = x, y = y_hatalı), method = "lm", se = FALSE, color = "black") +
geom_smooth(data = df_hatalı_ust, aes(x = x, y = y_hatalı), method = "lm", se = FALSE, color = "black") +
geom_function(fun = discontinuity, linetype = "dashed") +
geom_point(data = df_hatalı, aes(x = x, y = y_hatalı), size = 1, shape = 16, color = "black") +
labs(title = "C. Doğrusal olmama durumunun süreksiz olmakla karıştırılması", y = "Y", x = "x") +
theme_bw() +
theme(legend.position = "none") +
geom_vline(xintercept = 0.5, linetype = "dashed") +
xlim(0, 1)Bu gösterim yerine, 2 grafiği birleştirerek göstermek isterseniz cowplot paketini kullanabilirsiniz.
Bunun için ilk olarak cowplot paketini indirelim. Ardından indirilen paketi çalıştıralım. Bunun için de library() fonksiyonunu kullanacağız.
library(cowplot)cowplot::plot_grid(B, C, ncol = 1, align = "h")## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'
Şekil 6.1.2 tekrarı
Lee’nin (2008) parti görevinin yeniden seçilme olasılıkları üzerindeki etkisini incelediği keskin RD tasarımını göstermektedir.
Soru:
ABD Temsilciler Meclisi’nde bir koltuk için Demokrat adayın partisinin geçen sefer sandalyeyi kazanması durumunda bir sonraki seçim için avantajının olup olmadığıyla ilgilenmektedir
Lee, görevde olmanın nedensel etkisini yakalamak için bir önceki seçimdeki göreli oy paylarını kazanma olasılığına bağlı olarak inceliyor. Özellikle, bir seçimi kazananın \(Di=1(xi≥0)\) şeklinde belirlendiği gerçeğinden yararlanıyor; burada \(x_i\), kazananın oy payı marjını temsil etmektedir. \(D_i\), \(x_i\) ’nin deterministik bir fonksiyonu olduğundan, \(x_i\) dışında başka bir karıştırıcı değişkenin olmadığına dikkat edilmelidir. Bu, RD tasarımının sinyal özelliğidir.
library(haven)
library(data.table)
library(ggplot2)
library(gridExtra)veri setini indirelim.
download.file('https://economics.mit.edu/people/faculty/josh-angrist/mhe-data-archive', 'Lee2008.zip')library(haven)
individ_final.dta <- read_dta("C:/Users/User1/OneDrive/Masaüstü/Lee2008/individ_final.dta")
View(individ_final.dta)library(data.table)lee <- data.table(read_dta('individ_final.dta'))library(dplyr)##
## Attaching package: 'dplyr'## The following object is masked from 'package:gridExtra':
##
## combine## The following objects are masked from 'package:data.table':
##
## between, first, last## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(DT)
data.table(lee)## yearel myoutcome second myoutcomenext use difshare difgrp
## 1: 1946 1 NA 0 NA 0.06148815 212
## 2: 1946 0 1 0 1 -0.06148815 187
## 3: 1948 1 NA 1 1 0.10486948 220
## 4: 1948 0 1 0 NA -0.10486948 179
## 5: 1948 0 NA 0 NA -0.53572100 92
## ---
## 27172: 1996 1 NA 0 NA 0.19821346 239
## 27173: 1996 0 1 1 1 -0.19821346 160
## 27174: 1996 0 NA 0 NA -0.21053660 157
## 27175: 1998 1 NA NA NA 0.60390604 320
## 27176: 1998 0 1 NA NA -0.60390604 79
## mmyoutcomenext mrunagain mofficeexp melectexp mpmyoutcomenext mprunagain
## 1: NA NA NA NA NA NA
## 2: 0.10714286 0.2142857 2.0535715 2.3392856 0.069917142 0.2855549
## 3: 0.74358976 0.8717949 3.2564104 3.4615386 0.749363303 0.8693877
## 4: NA NA NA NA NA NA
## 5: NA NA NA NA NA NA
## ---
## 27172: NA NA NA NA NA NA
## 27173: 0.05405406 0.2702703 0.2972973 0.5405405 0.009250412 0.1554371
## 27174: NA NA NA NA NA NA
## 27175: NA NA NA NA NA NA
## 27176: NA NA NA NA NA NA
## mpofficeexp mpelectexp
## 1: NA NA
## 2: 0.6714829 0.9329183
## 3: 2.6508601 2.8722246
## 4: NA NA
## 5: NA NA
## ---
## 27172: NA NA
## 27173: 0.1880660 0.3967127
## 27174: NA NA
## 27175: NA NA
## 27176: NA NA2- Verisetini sadece 2 değişkene indirin. Oy farkı (Running variable, x, ve sonuç değişkeni (Y).
df <- lee %>%
select(myoutcomenext, difshare) %>%
na.omit()head(df)## myoutcomenext difshare
## 1: 0 0.06148815
## 2: 0 -0.06148815
## 3: 1 0.10486948
## 4: 0 -0.10486948
## 5: 0 -0.53572100
## 6: 0 0.16446409D değişkenini oluşturun.
df <- df %>%
mutate(D = as.numeric(difshare >= 0))head(df)## myoutcomenext difshare D
## 1: 0 0.06148815 1
## 2: 0 -0.06148815 0
## 3: 1 0.10486948 1
## 4: 0 -0.10486948 0
## 5: 0 -0.53572100 0
## 6: 0 0.16446409 1D değişkeni, Oy farkı (difshare) pozitifse 1 değilse 0 şeklinde oluşturuldu.
4- 4. dereceden logit regresyonu tahmin edin.
logit <- glm(formula = myoutcomenext ~ poly(difshare, degree = 4) +
poly(difshare, degree = 4) * D,
family = binomial(link = "logit"),
data = df)
df <- df %>%
mutate(pmyoutcomenext = predict(logit, type = "response"))head(df)## myoutcomenext difshare D pmyoutcomenext
## 1: 0 0.06148815 1 0.695785959
## 2: 0 -0.06148815 0 0.057708113
## 3: 1 0.10486948 1 0.738774903
## 4: 0 -0.10486948 0 0.029672513
## 5: 0 -0.53572100 0 0.001221896
## 6: 0 0.16446409 1 0.7782849845- 0.005 aralıklarla yerel ortalamalar oluşturun.
breaks <- round(seq(-1, 1, by = 0.005), 3)
df <- df %>%
mutate(i005 = cut(difshare, breaks = breaks, labels = head(breaks, -1), right = TRUE),
i005 = as.numeric(as.character(i005))) %>%
group_by(i005) %>%
mutate(m_next = mean(myoutcomenext),
mp_next = mean(pmyoutcomenext)) %>%
ungroup() %>%
filter(i005 > -0.251 & i005 < 0.251)head(df)## # A tibble: 6 × 7
## myoutcomenext difshare D pmyoutcomenext i005 m_next mp_next
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0 0.0615 1 0.696 0.06 0.72 0.697
## 2 0 -0.0615 0 0.0577 -0.065 0.0594 0.0570
## 3 1 0.105 1 0.739 0.1 0.678 0.737
## 4 0 -0.105 0 0.0297 -0.105 0.0556 0.0308
## 5 0 0.164 1 0.778 0.16 0.792 0.777
## 6 0 -0.164 0 0.0130 -0.165 0 0.01336- Grafikler
KO <- ggplot(data = df, aes(x = i005)) +
geom_point(aes(y = m_next)) +
geom_line(aes(y = mp_next, group = i005 >= 0)) +
geom_vline(xintercept = 0, linetype = 'longdash') +
xlab('Demokratların kazanma oy oranları marjini, t seçimi') +
ylab('Kazanma Olasılığı, t+1 Seçimi') +
ggtitle('A')KO
2.grafik için iki ayrı grup oluşturun
df2 <- lee %>%
mutate(i005 = cut(difshare, breaks = breaks, labels = head(breaks, -1), right = TRUE),
i005 = as.numeric(as.character(i005))) %>%
group_by(i005) %>%
summarize(m_vic = mean(mofficeexp, na.rm = TRUE),
mp_vic = mean(mpofficeexp, na.rm = TRUE)) %>%
ungroup() %>%
filter(i005 > -0.251 & i005 < 0.251)head(df2)## # A tibble: 6 × 3
## i005 m_vic mp_vic
## <dbl> <dbl> <dbl>
## 1 -0.25 0.0513 0.0995
## 2 -0.245 0.315 0.106
## 3 -0.24 0 0.114
## 4 -0.235 0 0.121
## 5 -0.23 0.0698 0.130
## 6 -0.225 0 0.138OM <- ggplot(data = df2, aes(x = i005)) +
geom_point(aes(y = m_vic)) +
geom_line(aes(y = mp_vic, group = i005 >= 0)) +
geom_vline(xintercept = 0, linetype = 'longdash') +
xlab('Demokratların kazanma oy oranları marjini, t seçimi') +
ylab('t seçimiyle birlikte geçmiş kazanma sayısı') +
ggtitle('B')OM
lee.p <- grid.arrange(KO, OM, ncol = 1)
Bulanık Kesikli Rassal Deney (Fuzzy RD)
STAR deneyi
Tablo 2.2.1 Replikasyonu
Veri seti Kruger (1999) çalışmasında ele alınan veri seti indirilmiştir.
Stata veri setini R’a yüklemek için haven paketini indiriyoruz.
library(haven)
webstar_7_ <- read_dta("C:/Users/User1/Downloads/webstar (7).dta")data.table(webstar_7_)## newid ssex srace sbirthq sbirthy stark star1 star2 star3 cltypek
## 1: 1122 2 2 3 1979 2 2 2 1 NA
## 2: 1137 2 1 1 1980 1 1 1 1 1
## 3: 1143 2 2 4 1979 1 1 1 1 1
## 4: 1160 1 1 4 1979 2 2 2 1 NA
## 5: 1183 1 2 1 1980 1 2 2 2 3
## ---
## 11594: 186650 1 1 3 1979 1 1 1 1 1
## 11595: 186665 2 1 3 1980 1 1 1 1 2
## 11596: 186687 1 1 1 1980 2 1 1 1 NA
## 11597: 186705 2 2 1 1980 1 1 1 1 2
## 11598: 186718 1 2 2 1980 1 1 1 1 3
## cltype1 cltype2 cltype3 schtypek hdegk cladk totexpk tracek treadssk
## 1: NA NA 2 NA NA NA NA NA NA
## 2: 1 1 1 3 2 1 7 1 447
## 3: 1 3 3 2 2 1 21 1 450
## 4: NA NA 1 NA NA NA NA NA NA
## 5: NA NA NA 1 2 6 0 1 439
## ---
## 11594: 1 1 1 3 2 1 8 1 483
## 11595: 2 2 2 3 2 6 0 1 437
## 11596: 2 2 2 NA NA NA NA NA NA
## 11597: 3 2 3 1 2 1 24 2 431
## 11598: 3 3 3 1 2 NA 2 1 421
## tmathssk sesk schtype1 trace1 hdeg1 clad1 totexp1 treadss1 tmathss1 ses1
## 1: NA NA NA NA NA NA NA NA NA NA
## 2: 473 2 3 1 1 4 7 507 538 1
## 3: 536 2 2 2 2 3 32 579 592 NA
## 4: NA NA NA NA NA NA NA NA NA NA
## 5: 463 1 NA NA NA NA NA NA NA NA
## ---
## 11594: 559 2 3 1 2 4 13 590 584 2
## 11595: 513 1 3 1 1 4 7 533 557 1
## 11596: NA NA 2 1 1 3 0 571 557 2
## 11597: 478 1 1 2 1 4 27 475 486 1
## 11598: 449 2 1 1 1 4 10 468 486 1
## schtype2 trace2 hdeg2 clad2 totexp2 treadss2 tmathss2 ses2 schtype3
## 1: NA NA NA NA NA NA NA NA 2
## 2: 3 1 1 2 3 568 579 2 3
## 3: 2 2 1 4 4 588 579 2 2
## 4: NA NA NA NA NA NA NA NA 3
## 5: NA NA NA NA NA NA NA NA NA
## ---
## 11594: 3 1 2 6 15 650 648 2 3
## 11595: 3 1 1 2 1 586 611 1 3
## 11596: 2 1 1 4 8 604 620 2 2
## 11597: 1 2 1 4 7 542 541 1 1
## 11598: 1 1 1 4 14 571 568 1 1
## treadss3 tmathss3 ses3 trace3 hdeg3 clad3 totexp3 sysidkn sysid1n
## 1: 580 564 1 1 1 4 30 NA NA
## 2: 587 593 1 1 1 2 1 30 30
## 3: 644 639 2 1 1 4 4 11 11
## 4: 686 667 2 1 1 4 10 NA NA
## 5: NA NA NA NA NA NA NA 11 NA
## ---
## 11594: 675 678 2 1 2 4 17 21 21
## 11595: 654 651 1 1 1 1 7 33 33
## 11596: 595 672 2 1 1 4 22 NA 25
## 11597: 624 610 1 1 2 3 12 11 11
## 11598: 580 577 2 2 2 4 33 11 11
## sysid2n sysid3n schidkn schid1n schid2n schid3n
## 1: NA 22 NA NA NA 54
## 2: 30 30 63 63 63 63
## 3: 11 11 20 20 20 20
## 4: NA 6 NA NA NA 8
## 5: NA NA 19 NA NA NA
## ---
## 11594: 21 21 49 49 49 49
## 11595: 33 33 67 67 67 67
## 11596: 25 25 NA 58 58 58
## 11597: 11 11 22 22 22 22
## 11598: 11 11 32 32 32 32srace değişkeninin açıklamaları
value label 1 white 2 black 3 asian 4 hispanic 5 am. indian 6 other 9 missing
srace değişkeni NA’leri çıkar.
webstar_7_ <- data.frame(webstar_7_)webstar_7_ <- webstar_7_[!is.na(webstar_7_$srace), ]Gerekli değişiklikleri yapılacak.
library(dplyr)
webstar_7_ <- as.data.frame(webstar_7_)
webstar_7_ <- webstar_7_ %>% mutate(white_asian = case_when(srace==1 | srace==3 ~ 1 , TRUE ~ 0))data.table(webstar_7_)## newid ssex srace sbirthq sbirthy stark star1 star2 star3 cltypek
## 1: 1122 2 2 3 1979 2 2 2 1 NA
## 2: 1137 2 1 1 1980 1 1 1 1 1
## 3: 1143 2 2 4 1979 1 1 1 1 1
## 4: 1160 1 1 4 1979 2 2 2 1 NA
## 5: 1183 1 2 1 1980 1 2 2 2 3
## ---
## 11449: 186650 1 1 3 1979 1 1 1 1 1
## 11450: 186665 2 1 3 1980 1 1 1 1 2
## 11451: 186687 1 1 1 1980 2 1 1 1 NA
## 11452: 186705 2 2 1 1980 1 1 1 1 2
## 11453: 186718 1 2 2 1980 1 1 1 1 3
## cltype1 cltype2 cltype3 schtypek hdegk cladk totexpk tracek treadssk
## 1: NA NA 2 NA NA NA NA NA NA
## 2: 1 1 1 3 2 1 7 1 447
## 3: 1 3 3 2 2 1 21 1 450
## 4: NA NA 1 NA NA NA NA NA NA
## 5: NA NA NA 1 2 6 0 1 439
## ---
## 11449: 1 1 1 3 2 1 8 1 483
## 11450: 2 2 2 3 2 6 0 1 437
## 11451: 2 2 2 NA NA NA NA NA NA
## 11452: 3 2 3 1 2 1 24 2 431
## 11453: 3 3 3 1 2 NA 2 1 421
## tmathssk sesk schtype1 trace1 hdeg1 clad1 totexp1 treadss1 tmathss1 ses1
## 1: NA NA NA NA NA NA NA NA NA NA
## 2: 473 2 3 1 1 4 7 507 538 1
## 3: 536 2 2 2 2 3 32 579 592 NA
## 4: NA NA NA NA NA NA NA NA NA NA
## 5: 463 1 NA NA NA NA NA NA NA NA
## ---
## 11449: 559 2 3 1 2 4 13 590 584 2
## 11450: 513 1 3 1 1 4 7 533 557 1
## 11451: NA NA 2 1 1 3 0 571 557 2
## 11452: 478 1 1 2 1 4 27 475 486 1
## 11453: 449 2 1 1 1 4 10 468 486 1
## schtype2 trace2 hdeg2 clad2 totexp2 treadss2 tmathss2 ses2 schtype3
## 1: NA NA NA NA NA NA NA NA 2
## 2: 3 1 1 2 3 568 579 2 3
## 3: 2 2 1 4 4 588 579 2 2
## 4: NA NA NA NA NA NA NA NA 3
## 5: NA NA NA NA NA NA NA NA NA
## ---
## 11449: 3 1 2 6 15 650 648 2 3
## 11450: 3 1 1 2 1 586 611 1 3
## 11451: 2 1 1 4 8 604 620 2 2
## 11452: 1 2 1 4 7 542 541 1 1
## 11453: 1 1 1 4 14 571 568 1 1
## treadss3 tmathss3 ses3 trace3 hdeg3 clad3 totexp3 sysidkn sysid1n
## 1: 580 564 1 1 1 4 30 NA NA
## 2: 587 593 1 1 1 2 1 30 30
## 3: 644 639 2 1 1 4 4 11 11
## 4: 686 667 2 1 1 4 10 NA NA
## 5: NA NA NA NA NA NA NA 11 NA
## ---
## 11449: 675 678 2 1 2 4 17 21 21
## 11450: 654 651 1 1 1 1 7 33 33
## 11451: 595 672 2 1 1 4 22 NA 25
## 11452: 624 610 1 1 2 3 12 11 11
## 11453: 580 577 2 2 2 4 33 11 11
## sysid2n sysid3n schidkn schid1n schid2n schid3n white_asian
## 1: NA 22 NA NA NA 54 0
## 2: 30 30 63 63 63 63 1
## 3: 11 11 20 20 20 20 0
## 4: NA 6 NA NA NA 8 1
## 5: NA NA 19 NA NA NA 0
## ---
## 11449: 21 21 49 49 49 49 1
## 11450: 33 33 67 67 67 67 1
## 11451: 25 25 NA 58 58 58 1
## 11452: 11 11 22 22 22 22 0
## 11453: 11 11 32 32 32 32 0cltypek değişkeninin açıklamaları.
value label 1 small class 2 regular class 3 regular + aide class
webstar_7_<- webstar_7_[!is.na(webstar_7_$cltypek), ]library(car)## Zorunlu paket yükleniyor: carData##
## Attaching package: 'car'## The following object is masked from 'package:dplyr':
##
## recoderes.ftest <- fligner.test(white_asian ~ cltypek, data = webstar_7_)
res.ftest##
## Fligner-Killeen test of homogeneity of variances
##
## data: white_asian by cltypek
## Fligner-Killeen:med chi-squared = 2.7615, df = 2, p-value = 0.2514sesk değişkenin açıklamarı.
value label 1 free lunch 2 non-free lunch
webstar_7_ <- webstar_7_[!is.na(webstar_7_$sesk), ]webstar_7_ <- webstar_7_ %>% mutate(free_lunch = case_when(sesk==1 ~ 1 , sesk==2 ~ 0))webstar_7_ %>%
group_by(cltypek) %>%
summarise_at(c("white_asian", "free_lunch", "treadssk", "tmathssk"), mean, na.rm = TRUE)## # A tibble: 3 × 5
## cltypek white_asian free_lunch treadssk tmathssk
## <dbl+lbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 [small class] 0.682 0.471 441. 491.
## 2 2 [regular class] 0.675 0.477 435. 483.
## 3 3 [regular + aide class] 0.660 0.503 435. 483.res.ftest <- fligner.test(free_lunch ~ cltypek, data = webstar_7_)
res.ftest##
## Fligner-Killeen test of homogeneity of variances
##
## data: free_lunch by cltypek
## Fligner-Killeen:med chi-squared = 3.2153, df = 2, p-value = 0.2004The Angrist and Lavy (1999) replikasyonu
library(haven)
final4 <- read_dta("C:/Users/User1/Downloads/final4.dta")
View(final4)datatable(final4)library(haven)
final5 <- read_dta("C:/Users/User1/Downloads/final5.dta")
View(final5)datatable(final5)Angrist ve Lavy (1999) makalesinde, İbn Meymun’un kuralının İsrail devlet okullarında sınıf mevcudu belirlemek için kullanıldığından bahsediyorlar. Bu kurala göre, en fazla 40 öğrenci bir sınıfa kaydedilebilir. Makalede, bu kuralın varyasyonlarına dayanarak sınıf mevcudunun öğrenci başarısı üzerindeki etkisini tahmin etmek mümkün olduğunu belirtiyorlar.
İbn Meymun’un kuralına göre, sınıf mevcudu 40 öğrenciye kadar kayıtla bire bir artar. Ancak 41 öğrenci kaydolduğunda, ortalama sınıf mevcudu 20.5’e düşer. Benzer şekilde, 80 öğrenci kaydolduğunda ortalama sınıf mevcudu 40 olurken, 81 öğrenci kaydolduğunda ortalama sınıf mevcudu 27’ye düşer.
Bu varyasyonları kullanarak, araştırmacılar İsrailli öğrencilerin başarısı üzerinde sınıf mevcudunun etkisini tahmin etmek için bu kuralı kullanmışlardır. Bu, sınıf mevcudu değişkeninin doğal bir deneyim gibi işlev görmesini sağlar, çünkü kayıt sayısının belirli bir eşik değeri aşıldığında sınıf mevcudu beklenmedik şekilde değişir.
Angrist ve Lavy, bu tahminleri kullanarak sınıf mevcudunun öğrenci başarısı üzerindeki etkisini değerlendirmişler ve bu etkinin pozitif olduğunu bulmuşlardır. Daha küçük sınıflarda öğrenim gören öğrencilerin genellikle daha iyi performans gösterdiği sonucuna varmışlardır. Bu bulgular, daha küçük sınıfların öğrenci başarısını artırabileceği fikrini desteklemektedir.
library(tidyr)final4 %>%
select(classize, c_size, tip_a, verbsize, mathsize, avgverb, avgmath) %>%
rename("Enrollment" = "c_size", "Percent disadvantaged" = "tip_a", "Class size" = "classize", "Reading size" = "verbsize", "Math size" = "mathsize", "Average verbal" = "avgverb", "Average math" = "avgmath") %>%
mutate_at(c('Enrollment', 'Class size','Math size', 'Reading size', 'Average math','Average verbal', 'Percent disadvantaged'), as.numeric) %>%
summarise(across(where(is.numeric), .fns =
list(Mean = ~mean(.,na.rm=TRUE),
S.D. = ~sd(.,na.rm=TRUE),
Q10 = ~quantile(., 0.10, na.rm=TRUE),
Q25 = ~quantile(., 0.25, na.rm=TRUE),
Q50 = ~quantile(., 0.25, na.rm=TRUE),
Q75 = ~quantile(., 0.75, na.rm=TRUE),
Q90 = ~quantile(., 0.90, na.rm=TRUE)))) %>%
pivot_longer(everything(), names_sep='_', names_to=c('variable', '.value')) %>%
mutate(across(where(is.numeric), round, 2))## Warning: There was 1 warning in `mutate()`.
## ℹ In argument: `across(where(is.numeric), round, 2)`.
## Caused by warning:
## ! The `...` argument of `across()` is deprecated as of dplyr 1.1.0.
## Supply arguments directly to `.fns` through an anonymous function instead.
##
## # Previously
## across(a:b, mean, na.rm = TRUE)
##
## # Now
## across(a:b, \(x) mean(x, na.rm = TRUE))## # A tibble: 7 × 8
## variable Mean S.D. Q10 Q25 Q50 Q75 Q90
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Class size 30.3 6.41 22 26 26 35 38
## 2 Enrollment 78.4 37.9 30 51 51 102 128
## 3 Percent disadvantaged 13.9 13.4 2 4 4 19 35
## 4 Reading size 27.6 6.55 19 24 24 32 36
## 5 Math size 28.1 6.56 19 24 24 33 36
## 6 Average verbal 72.5 7.99 62.2 67.7 67.7 78.2 82
## 7 Average math 68.9 8.77 57.5 63.6 63.6 75.0 79.4final5 %>%
select(classize, c_size, tip_a, verbsize, mathsize, avgverb, avgmath) %>%
rename("Enrollment" = "c_size", "Percent disadvantaged" = "tip_a", "Class size" = "classize", "Reading size" = "verbsize", "Math size" = "mathsize", "Average verbal" = "avgverb", "Average math" = "avgmath") %>%
mutate_at(c('Enrollment', 'Class size','Math size', 'Reading size', 'Average math','Average verbal', 'Percent disadvantaged'), as.numeric) %>%
summarise(across(where(is.numeric), .fns =
list(Mean = ~mean(.,na.rm=TRUE),
S.D. = ~sd(.,na.rm=TRUE),
Q10 = ~quantile(., 0.10, na.rm=TRUE),
Q25 = ~quantile(., 0.25, na.rm=TRUE),
Q50 = ~quantile(., 0.25, na.rm=TRUE),
Q75 = ~quantile(., 0.75, na.rm=TRUE),
Q90 = ~quantile(., 0.90, na.rm=TRUE)))) %>%
pivot_longer(everything(), names_sep='_', names_to=c('variable', '.value')) %>%
mutate(across(where(is.numeric), round, 2))## # A tibble: 7 × 8
## variable Mean S.D. Q10 Q25 Q50 Q75 Q90
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Class size 30.0 6.6 21 26 26 35 38
## 2 Enrollment 77.9 39.1 31 50 50 100 128.
## 3 Percent disadvantaged 14.1 13.6 2 4 4 20 35
## 4 Reading size 27.3 6.62 19 23 23 32 36
## 5 Math size 27.7 6.68 19 23 23 33 36
## 6 Average verbal 74.4 8.08 64.2 69.9 69.9 79.8 83.3
## 7 Average math 67.3 10.0 54.8 61.1 61.1 74.1 79.4final4ek<- final4 %>%
filter(classize > 1, classize < 45, c_size>5)final4ek %>%
select(classize, c_size, tip_a, verbsize, mathsize, avgverb, avgmath) %>%
rename("Enrollment" = "c_size", "Percent disadvantaged" = "tip_a", "Class size" = "classize", "Reading size" = "verbsize", "Math size" = "mathsize", "Average verbal" = "avgverb", "Average math" = "avgmath") %>%
mutate_at(c('Enrollment', 'Class size','Math size', 'Reading size', 'Average math','Average verbal', 'Percent disadvantaged'), as.numeric) %>%
summarise(across(where(is.numeric), .fns =
list(Mean = ~mean(.,na.rm=TRUE),
S.D. = ~sd(.,na.rm=TRUE),
Q10 = ~quantile(., 0.10, na.rm=TRUE),
Q25 = ~quantile(., 0.25, na.rm=TRUE),
Q50 = ~quantile(., 0.25, na.rm=TRUE),
Q75 = ~quantile(., 0.75, na.rm=TRUE),
Q90 = ~quantile(., 0.90, na.rm=TRUE)))) %>%
pivot_longer(everything(), names_sep='_', names_to=c('variable', '.value')) %>%
mutate(across(where(is.numeric), round, 2))## # A tibble: 7 × 8
## variable Mean S.D. Q10 Q25 Q50 Q75 Q90
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Class size 30.3 6.35 22 26 26 35 38
## 2 Enrollment 78.3 37.9 30 51 51 102 128.
## 3 Percent disadvantaged 13.9 13.4 2 4 4 19 35
## 4 Reading size 27.7 6.54 19 24 24 32 36
## 5 Math size 28.1 6.55 19 24 24 33 36
## 6 Average verbal 72.5 7.99 62.2 67.7 67.7 78.2 82
## 7 Average math 68.9 8.77 57.5 63.6 63.6 75.0 79.4final5ek<- final5 %>%
filter(classize > 1, classize < 45, c_size>5)final5ek %>%
select(classize, c_size, tip_a, verbsize, mathsize, avgverb, avgmath) %>%
rename("Enrollment" = "c_size", "Percent disadvantaged" = "tip_a", "Class size" = "classize", "Reading size" = "verbsize", "Math size" = "mathsize", "Average verbal" = "avgverb", "Average math" = "avgmath") %>%
mutate_at(c('Enrollment', 'Class size','Math size', 'Reading size', 'Average math','Average verbal', 'Percent disadvantaged'), as.numeric) %>%
summarise(across(where(is.numeric), .fns =
list(Mean = ~mean(.,na.rm=TRUE),
S.D. = ~sd(.,na.rm=TRUE),
Q10 = ~quantile(., 0.10, na.rm=TRUE),
Q25 = ~quantile(., 0.25, na.rm=TRUE),
Q50 = ~quantile(., 0.25, na.rm=TRUE),
Q75 = ~quantile(., 0.75, na.rm=TRUE),
Q90 = ~quantile(., 0.90, na.rm=TRUE)))) %>%
pivot_longer(everything(), names_sep='_', names_to=c('variable', '.value')) %>%
mutate(across(where(is.numeric), round, 2))## # A tibble: 7 × 8
## variable Mean S.D. Q10 Q25 Q50 Q75 Q90
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Class size 29.9 6.54 21 26 26 35 38
## 2 Enrollment 77.9 39.1 31 50 50 100 129.
## 3 Percent disadvantaged 14.1 13.6 2 4 4 20 35
## 4 Reading size 27.3 6.58 19 23 23 32 36
## 5 Math size 27.7 6.64 19 23 23 33 36
## 6 Average verbal 74.4 8.08 64.2 69.8 69.8 79.8 83.3
## 7 Average math 67.3 10.0 54.8 61.1 61.1 74.1 79.4final4ekdis<- final4ek %>%
filter(c_size>35 & c_size<46 | c_size>75 & c_size<86 | c_size>115 & c_size<125)final4ekdis %>%
select(classize, c_size, tip_a, verbsize, mathsize, avgverb, avgmath) %>%
rename("Enrollment" = "c_size", "Percent disadvantaged" = "tip_a", "Class size" = "classize", "Reading size" = "verbsize", "Math size" = "mathsize", "Average verbal" = "avgverb", "Average math" = "avgmath") %>%
mutate_at(c('Enrollment', 'Class size','Math size', 'Reading size', 'Average math','Average verbal', 'Percent disadvantaged'), as.numeric) %>%
summarise(across(where(is.numeric), .fns =
list(Mean = ~mean(.,na.rm=TRUE),
S.D. = ~sd(.,na.rm=TRUE),
Q10 = ~quantile(., 0.10, na.rm=TRUE),
Q25 = ~quantile(., 0.25, na.rm=TRUE),
Q50 = ~quantile(., 0.25, na.rm=TRUE),
Q75 = ~quantile(., 0.75, na.rm=TRUE),
Q90 = ~quantile(., 0.90, na.rm=TRUE)))) %>%
pivot_longer(everything(), names_sep='_', names_to=c('variable', '.value')) %>%
mutate(across(where(is.numeric), round, 2))## # A tibble: 7 × 8
## variable Mean S.D. Q10 Q25 Q50 Q75 Q90
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Class size 31.0 7.24 21 25 25 38 40
## 2 Enrollment 77.9 29.6 41 43 43 116 119
## 3 Percent disadvantaged 13.0 12.4 1 4 4 18 32
## 4 Reading size 28.2 7.71 18 22 22 35 37.2
## 5 Math size 28.6 7.69 18 23 23 35 38
## 6 Average verbal 72.4 7.88 61.9 67.0 67.0 78.4 81.7
## 7 Average math 68.7 9.14 56.8 62.6 62.6 75.4 79.7final5ekdis<- final5ek %>%
filter(c_size>35 & c_size<46 | c_size>75 & c_size<86 | c_size>115 & c_size<125)final5ekdis %>%
select(classize, c_size, tip_a, verbsize, mathsize, avgverb, avgmath) %>%
rename("Enrollment" = "c_size", "Percent disadvantaged" = "tip_a", "Class size" = "classize", "Reading size" = "verbsize", "Math size" = "mathsize", "Average verbal" = "avgverb", "Average math" = "avgmath") %>%
mutate_at(c('Enrollment', 'Class size','Math size', 'Reading size', 'Average math','Average verbal', 'Percent disadvantaged'), as.numeric) %>%
summarise(across(where(is.numeric), .fns =
list(Mean = ~mean(.,na.rm=TRUE),
S.D. = ~sd(.,na.rm=TRUE),
Q10 = ~quantile(., 0.10, na.rm=TRUE),
Q25 = ~quantile(., 0.25, na.rm=TRUE),
Q50 = ~quantile(., 0.25, na.rm=TRUE),
Q75 = ~quantile(., 0.75, na.rm=TRUE),
Q90 = ~quantile(., 0.90, na.rm=TRUE)))) %>%
pivot_longer(everything(), names_sep='_', names_to=c('variable', '.value')) %>%
mutate(across(where(is.numeric), round, 2))## # A tibble: 7 × 8
## variable Mean S.D. Q10 Q25 Q50 Q75 Q90
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Class size 30.7 7.43 21 24 24 38 40
## 2 Enrollment 75.8 29.2 40.4 43 43 85 119
## 3 Percent disadvantaged 13.7 13.2 2 4 4 17 36
## 4 Reading size 28.1 7.35 18 21 21 35 38
## 5 Math size 28.5 7.46 18 22 22 35 38
## 6 Average verbal 74.5 8.22 63.8 69.6 69.6 80.5 83.6
## 7 Average math 67.0 10.3 54.5 60.8 60.8 74.1 80.0Şekil 6.2.1 replikasyonu
Meymun_rule <- function(x) {x / (floor((x - 1)/40) + 1)}Bu grafiği tekrarlayabilmek için ortalamarı bulmalıyız.
final4Enrollmentmeans <- final4ek %>%
group_by(c_size) %>%
summarise(mean_class_size = mean(classize, na.rm = TRUE))ggplot(data = final4Enrollmentmeans, aes(x = c_size)) + geom_line(aes(y = mean_class_size)) +
stat_function(fun = Meymun_rule,
linetype = "dashed") +
expand_limits(y = 0) +
scale_x_continuous(breaks = seq(0, 240, 40)) +
ylab("Class size") +
xlab("Enrollment count") +
ggtitle("B. Fourth grade")
final5Enrollmentmeans <- final5ek %>%
group_by(c_size) %>%
summarise(mean_class_size = mean(classize, na.rm = TRUE))ggplot(data = final5Enrollmentmeans, aes(x = c_size)) + geom_line(aes(y = mean_class_size)) +
stat_function(fun = Meymun_rule,
linetype = "dashed") +
expand_limits(y = 0) +
scale_x_continuous(breaks = seq(0, 240, 40)) +
ylab("Class size") +
xlab("Enrollment count") +
ggtitle("A. Fifth grade")
40, 80 ve 120’lik kayıt seviyelerinde sınıf mevcudunda belirgin düşüşler var.İbn Meymun kuralı kesikli çizgilerle gösterilmiş. Bu kural araç değişkeni olarak kullanılabilir.
library(sandwich)
library(lmtest)## Zorunlu paket yükleniyor: zoo##
## Attaching package: 'zoo'## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numericlibrary(AER)## Zorunlu paket yükleniyor: survivalAraç değişken regresyonu için estimatr paketini kullanacağız.
library(estimatr)Tüm Veri Regresyon sonuçları
final5ek = final5ek %>%
mutate(avgmath = case_when(avgmath >100 ~ avgmath - 100,
TRUE ~ avgmath))final5ek <- filter(final5ek,c_leom==1 & c_pik<3)final5ek <- filter(final5ek,classize>1 & classize<45 & c_size>5)final5ek <- filter(final5ek,mathsize>0)ols1 <- lm_robust(avgmath ~ classize, data = final5ek, clusters = final5ek$schlcode,se_type = "stata")ols2 <- lm_robust(avgmath ~ classize + tipuach , data = final5ek, clusters = final5ek$schlcode,se_type = "stata")ols3 <- lm_robust(avgmath ~ classize + tipuach + c_size , data = final5ek, clusters = final5ek$schlcode, se_type = "stata")Süreksizlik Örneklemi
olsdis1 <- lm_robust(avgmath ~ classize, data = final5ekdis, clusters = final5ekdis$schlcode,se_type = "stata")olsdis2 <- lm_robust(avgmath ~ classize + tipuach , data = final5ekdis, clusters = final5ekdis$schlcode,se_type = "stata")olsdis3 <- lm_robust(avgmath ~ classize + tipuach + c_size , data = final5ekdis, clusters = final5ekdis$schlcode, se_type = "stata")library(huxtable)##
## Attaching package: 'huxtable'## The following object is masked from 'package:dplyr':
##
## add_rownames## The following object is masked from 'package:ggplot2':
##
## theme_greyhuxreg(ols1, ols2, ols3,
error_format = "[{statistic}]",
note = "{stars}. T statistics in brackets.", number_format = 2)## Warning in huxreg(ols1, ols2, ols3, error_format = "[{statistic}]", note = "{stars}. T statistics in brackets.", : Unrecognized statistics: logLik, AIC
## Try setting `statistics` explicitly in the call to `huxreg()`| (1) | (2) | (3) | |
|---|---|---|---|
| (Intercept) | 57.66 *** | 69.81 *** | 70.09 *** |
| [46.24] | [59.49] | [59.94] | |
| classize | 0.32 *** | 0.08 * | 0.02 |
| [8.01] | [2.12] | [0.44] | |
| tipuach | -0.34 *** | -0.33 *** | |
| [-18.63] | [-17.76] | ||
| c_size | 0.02 * | ||
| [2.27] | |||
| N | 2018 | 2018 | 2018 |
| R2 | 0.05 | 0.25 | 0.25 |
| *** p < 0.001; ** p < 0.01; * p < 0.05. T statistics in brackets. | |||
huxreg(olsdis1, olsdis2, olsdis3,
error_format = "[{statistic}]",
note = "{stars}. T statistics in brackets.", number_format = 2)## Warning in huxreg(olsdis1, olsdis2, olsdis3, error_format = "[{statistic}]", : Unrecognized statistics: logLik, AIC
## Try setting `statistics` explicitly in the call to `huxreg()`| (1) | (2) | (3) | |
|---|---|---|---|
| (Intercept) | 55.80 *** | 69.59 *** | 69.04 *** |
| [21.30] | [28.04] | [27.55] | |
| classize | 0.37 *** | 0.10 | 0.06 |
| [4.56] | [1.36] | [0.74] | |
| tipuach | -0.40 *** | -0.39 *** | |
| [-9.89] | [-9.33] | ||
| c_size | 0.02 | ||
| [0.94] | |||
| N | 465 | 465 | 465 |
| R2 | 0.07 | 0.30 | 0.30 |
| *** p < 0.001; ** p < 0.01; * p < 0.05. T statistics in brackets. | |||
Araç Değişken Regresyonları
Araç değişkeni oluşturun.
final5ek$f <- final5ek$c_size / (floor((final5ek$c_size - 1) / 40) + 1)final5ekdis$f <- final5ekdis$c_size / (floor((final5ekdis$c_size - 1) / 40) + 1)Tüm veri seti için araç değişken tahminleri
iv1 <- iv_robust(avgmath ~ classize | f , data = final5ek, clusters = final5ek$schlcode,se_type = "stata")iv2 <- iv_robust(avgmath ~ classize + tipuach | f + tipuach , data = final5ek, clusters = final5ek$schlcode,se_type = "stata")iv3 <- iv_robust(avgmath ~ classize + tipuach + c_size | f + tipuach + c_size , data = final5ek, clusters = final5ek$schlcode,se_type = "stata")huxreg(iv1, iv2, iv3,
error_format = "[{statistic}]",
note = "{stars}. T statistics in brackets.")## Warning in huxreg(iv1, iv2, iv3, error_format = "[{statistic}]", note = "{stars}. T statistics in brackets."): Unrecognized statistics: logLik, AIC
## Try setting `statistics` explicitly in the call to `huxreg()`| (1) | (2) | (3) | |
|---|---|---|---|
| (Intercept) | 58.490 *** | 72.687 *** | 75.956 *** |
| [32.412] | [39.395] | [32.259] | |
| classize | 0.294 *** | -0.013 | -0.231 * |
| [4.878] | [-0.226] | [-2.344] | |
| tipuach | -0.355 *** | -0.350 *** | |
| [-17.905] | [-17.505] | ||
| c_size | 0.041 *** | ||
| [3.512] | |||
| N | 2018 | 2018 | 2018 |
| R2 | 0.048 | 0.245 | 0.234 |
| *** p < 0.001; ** p < 0.01; * p < 0.05. T statistics in brackets. | |||
Süreksiz örneklem araç regresyonları
ivdis1 <- iv_robust(avgmath ~ classize | f , data = final5ekdis, clusters = final5ekdis$schlcode,se_type = "stata")ivdis2 <- iv_robust(avgmath ~ classize + tipuach | f + tipuach , data = final5ekdis, clusters = final5ekdis$schlcode,se_type = "stata")ivdis3 <- iv_robust(avgmath ~ classize + tipuach + c_size | f + tipuach + c_size , data = final5ekdis, clusters = final5ekdis$schlcode,se_type = "stata")huxreg(ivdis1, ivdis2, ivdis3,
error_format = "[{statistic}]",
note = "{stars}. T statistics in brackets.")## Warning in huxreg(ivdis1, ivdis2, ivdis3, error_format = "[{statistic}]", : Unrecognized statistics: logLik, AIC
## Try setting `statistics` explicitly in the call to `huxreg()`| (1) | (2) | (3) | |
|---|---|---|---|
| (Intercept) | 58.824 *** | 79.183 *** | 81.031 *** |
| [13.022] | [15.272] | [13.857] | |
| classize | 0.267 | -0.189 | -0.476 |
| [1.808] | [-1.225] | [-1.884] | |
| tipuach | -0.462 *** | -0.437 *** | |
| [-8.911] | [-8.633] | ||
| c_size | 0.087 * | ||
| [2.299] | |||
| N | 465 | 465 | 465 |
| R2 | 0.065 | 0.262 | 0.201 |
| *** p < 0.001; ** p < 0.01; * p < 0.05. T statistics in brackets. | |||
Son olarak 3. modellerin hepsini bir tabloda gösterip karşılaştıralım.
huxreg(ols3, olsdis3, iv3, ivdis3,
error_format = "[{statistic}]",
note = "{stars}. T statistics in brackets.")## Warning in huxreg(ols3, olsdis3, iv3, ivdis3, error_format = "[{statistic}]", : Unrecognized statistics: logLik, AIC
## Try setting `statistics` explicitly in the call to `huxreg()`| (1) | (2) | (3) | (4) | |
|---|---|---|---|---|
| (Intercept) | 70.085 *** | 69.039 *** | 75.956 *** | 81.031 *** |
| [59.937] | [27.546] | [32.259] | [13.857] | |
| classize | 0.019 | 0.060 | -0.231 * | -0.476 |
| [0.440] | [0.740] | [-2.344] | [-1.884] | |
| tipuach | -0.332 *** | -0.390 *** | -0.350 *** | -0.437 *** |
| [-17.761] | [-9.334] | [-17.505] | [-8.633] | |
| c_size | 0.017 * | 0.020 | 0.041 *** | 0.087 * |
| [2.273] | [0.941] | [3.512] | [2.299] | |
| N | 2018 | 465 | 2018 | 465 |
| R2 | 0.251 | 0.300 | 0.234 | 0.201 |
| *** p < 0.001; ** p < 0.01; * p < 0.05. T statistics in brackets. | ||||
Angrist ve Lavy’nin bahsettiği “Mostly Harmless” kitabındaki 6.2.1 tablosunda, beşinci sınıf matematik puanları için tahminler kontrolsüz ve kontrollü durumda karşılaştırılmıştır. Kontrolsüz tahminlerde, sınıf mevcudu ile test puanları arasında güçlü bir pozitif ilişki olduğu görülmektedir.
Ancak, kontrol olarak dezavantajlı öğrencilerin yüzdesi dahil edildiğinde, pozitif ilişki anlamlılığını kaybetmektedir. Yani, daha büyük sınıflardaki öğrencilerin yüksek puanlarının, dezavantajlı öğrenci oranındaki farklılıklardan kaynaklanabileceği sonucuna varılmaktadır.
Ancak, 2SLS (iki aşamalı en küçük kareler) tahminleri, OLS (en küçük kareler) tahminlerinden farklı bir sonuç vermektedir. 2SLS tahminleri, daha küçük sınıfların test puanlarını artırdığını göstermektedir. Bu sonuç, Tennessee STAR randomize çalışmasının sonuçlarıyla uyumlu olduğunu ifade etmektedir.
Sonuç olarak, bahsedilen çalışmalardan elde edilen bulgular, sınıf mevcudunun öğrenci başarısı üzerindeki etkisinin karmaşık olduğunu göstermektedir. Daha küçük sınıfların avantajları ve dezavantajları dikkate alınmalı ve bu konuda daha fazla araştırma yapılması gerekmektedir.