library(haven)
library(dplyr)
library(knitr)
library(ggplot2)
library(naniar)
#Bu kod baya işlevsel oldu
setwd(dirname(rstudioapi::getActiveDocumentContext()$path))
data <- read_sav("bsgturm4.sav") %>% expss::drop_var_labs()
# Değişken isimlerini değiştirme
colnames(data) <- c("IDSTUD","CINSIYET","MATBASARI","PATM","SVM","SCM")
psych::describe(data[,-1], fast = T)
## vars n mean sd median min max range skew kurtosis se
## CINSIYET 1 323 1.59 1.24 2.00 1.00 22.00 21.00 13.65 221.50 0.07
## MATBASARI 2 323 446.86 119.85 432.21 47.88 802.42 754.54 0.21 -0.08 6.67
## PATM 3 300 1.26 0.57 1.00 1.00 3.00 2.00 2.08 3.11 0.03
## SVM 4 316 1.16 0.67 1.00 1.00 11.00 10.00 10.30 140.91 0.04
## SCM 5 302 1.72 0.80 2.00 1.00 3.00 2.00 0.54 -1.23 0.05
Cinsiyet değişkeninde “22”, SVM değişkeninde ise “11” kodlu bireyler bulunmaktadır. Bu yanıtlar olası yanıtlar arasında yer almamakta olup hatalı kodlama kabul edilmiştir. Analizler bu bireyler çıkarıldıktan sonra yapılacaktır.
table(data[,2])
## CINSIYET
## 1 2 22
## 153 169 1
table(data[,4])
## PATM
## 1 2 3
## 242 38 20
table(data[,5])
## SVM
## 1 2 3 11
## 278 32 5 1
table(data[,6])
## SCM
## 1 2 3
## 150 87 65
which(data$CINSIYET == 22)
## [1] 96
data[96,1]
## # A tibble: 1 × 1
## IDSTUD
## <dbl>
## 1 400707
which(data$SVM == 11)
## [1] 155
data[155,1]
## # A tibble: 1 × 1
## IDSTUD
## <dbl>
## 1 680204
data_complete <- data %>%
filter(!(IDSTUD %in% c(400707 , 680204)))
Kalan veri seti 321 kişiliktir. Kızlar grubun 47.66%’sini oluşturmaktadır.
# PATM, SVM ve SCM değişkenlerinin yeniden kodlanması
data <- data_complete
data <- data %>%
mutate(
PATM = 4 - PATM,
SVM = 4 - SVM,
SCM = 4 - SCM
)
# Kayıp veri
t <- data.frame(
naniar::miss_var_summary(data))
kable(t, caption = "Kayıp Veri İçeren Sütunlara İlişkin Özet Bilgiler")
variable | n_miss | pct_miss |
---|---|---|
PATM | 23 | 7.17 |
SCM | 21 | 6.54 |
SVM | 7 | 2.18 |
IDSTUD | 0 | 0 |
CINSIYET | 0 | 0 |
MATBASARI | 0 | 0 |
Veri seti kayıp veri açısından incelendiğinde verilerin 2.6% oranında kayıp veri içerdiği görülmektedir. PATM değişkeni en çok kayıp veri içeren değişkendir (7.2%). SCM 6.5% ve SVM 2.2% kayıp veri içermektedir. Kayıp verinin mekanizması Little’ın MCAR Testi ile test edilmiştir.
t <- round(mcar_test(data),2)[1:3]
kable(t,format = "html", caption = "Little'ın MCAR Testi Sonuçları")
statistic | df | p.value |
---|---|---|
93.5 | 22 | 0 |
Veri setinin kayıp verileri için yapılan Little’ın MCAR testi sonuçları, p-değerinin (\(\chi^2 = 93.5, df = 22, p < 0.001\)) anlamlı olması nedeniyle kayıp veri mekanizmasının MCAR’dan farklılaştığı yorumu yapılabilir. Veri setinde toplam kayıp veri oranının %5’in altında olması nedeniyle liste bazlı silme yöntemi ile 286 kişilik tam veri seti elde edilmiştir.
data_complete <- na.omit(data)
psych::describe(data_complete[,-1], fast = T)
## vars n mean sd median min max range skew kurtosis se
## CINSIYET 1 286 1.52 0.50 2.00 1.00 2.00 1.00 -0.10 -2.00 0.03
## MATBASARI 2 286 461.70 115.98 444.82 47.88 802.42 754.54 0.15 0.11 6.86
## PATM 3 286 2.77 0.54 3.00 1.00 3.00 2.00 -2.23 3.89 0.03
## SVM 4 286 2.87 0.38 3.00 1.00 3.00 2.00 -2.95 8.54 0.02
## SCM 5 286 2.33 0.77 3.00 1.00 3.00 2.00 -0.64 -1.07 0.05
Kategorik bir değişken olan cinsiyet değişkeni kategoriler arasındaki frekans farklılığı açısından incelenmiştir.
table(data_complete[,2])
## CINSIYET
## 1 2
## 136 150
Veri setinde cinsiyet değişkenine ait dağılımın dengeli olduğu yorumu yapılabilir. (1: Kız, 2: Erkek)
PATM, SCM ve SVM değişkeni sürekli kabul edilip MATBASARI değişkeni ile birlikte için tek değişkenli uç değerler z-puanı [-3,3] aralığında incelenmiştir. Z-puanı -3 ve 3 dışındaki değerler uç değer olarak kabul edilmiştir. Uç değerler veri setinden çıkarılmıştır.
library(outliers)
z_scores <- data_complete %>%
dplyr::select(MATBASARI, PATM, SVM, SCM) %>%
outliers::scores(type = "z") %>%
round(2) %>%
as.data.frame()
library(summarytools)
descr(z_scores,stats = c("min","max"),transpose = T,headings = F) %>% knitr::kable()
Min | Max | |
---|---|---|
MATBASARI | -3.57 | 2.94 |
PATM | -3.27 | 0.43 |
SCM | -1.71 | 0.87 |
SVM | -4.98 | 0.34 |
SCM dışında tüm değişkenler için değişkenli uç değerlerin varlığından söz edilebilir. Bu uç değerler analizlerden çıkarılmıştır. Hangi bireyin uç değer olduğu ise aşağıdaki incelenebilir (örneğin MATBASARI için 14. birey).
DT::datatable(z_scores)
outlier_rows <- apply(z_scores, 1, function(row) any(row < -3 | row > 3))
data_complete <- data_complete[!outlier_rows, ]
Tek değişkenli uç değer olarak belirlenen 21 kişi analizlerden çıkarılmıştır. Böylece 266 kişilik veri seti ile analizlere devam edilmiştir. Çok değişkenli uç değerler Mahalanobis Uzaklığı ile incelenmiştir.
cov_mat <- cov(data_complete[, 3:6])
center <- colMeans(data_complete[, 3:6], na.rm = TRUE)
mahal <- mahalanobis(data_complete[, 3:6], center, cov_mat)
cutoff <- qchisq(0.975, df = ncol(data_complete[, 3:6]))
data_complete$mvoutlier <- mahal > cutoff
sum(data_complete$mvoutlier)
## [1] 20
20 kişi çok değişkenli uç değer olarak belirlenmiş ve analizlerden çıkarılmıştır. 246 kişilik veri seti ile analizlere devam edilmiştir.
# Çok değişkenli uç değerlerin veri setinden çıkarılması
data_complete <- data_complete[!data_complete$mvoutlier, ]
data_complete$mvoutlier <- NULL
psych::describe(data_complete[,-1], fast = T)
## vars n mean sd median min max range skew kurtosis
## CINSIYET 1 246 1.49 0.50 1.0 1.00 2.00 1.00 0.03 -2.01
## MATBASARI 2 246 466.01 114.06 448.9 184.48 802.42 617.94 0.32 -0.21
## PATM 3 246 2.91 0.29 3.0 2.00 3.00 1.00 -2.78 5.73
## SVM 4 246 2.96 0.20 3.0 2.00 3.00 1.00 -4.62 19.46
## SCM 5 246 2.43 0.72 3.0 1.00 3.00 2.00 -0.84 -0.65
## se
## CINSIYET 0.03
## MATBASARI 7.27
## PATM 0.02
## SVM 0.01
## SCM 0.05
Değişkenlerin normalliğine ilişkin bulgular çarpıklık ve basıklık katsayıları açısından incelendiğinde, MATBASARI puanları ve SCM normal dağılıma yakın bir dağılım göstermekte olduğu yorumu yapılabilir. PATM ve SVM’nin ise normal dağılımdan uzaklaştığı söylenebilir.
Artıkların normal dağılımını incelemek amacıyla Q-Q Plot grafiğini kullanabiliriz.
library(tidyverse)
data_complete %>%
dplyr::select(MATBASARI, PATM, SCM, SVM) %>%
pivot_longer(cols = everything(),
names_to = "variable",
values_to = "value") %>%
ggplot(aes(sample = value)) +
stat_qq(color = "blue") +
stat_qq_line(color = "red") +
facet_wrap(~ variable, scales = "free") +
labs(title = "Tutum, Deger ve Guven icin QQ Plot (Normallik Kontrolu)",
x = "Beklenen Degerler (Normal Dağılım)",
y = "Gozlenen Degerler") +
theme_minimal()
Artıklar da MATBASARI puanına ilişkin artıkların özellikle düşük
değerlerde normal dağılımdan saptığına işaret etmektedir. Bununla
birlikte PATM ve SVM değişkenlerinin de normal dağılım göstermediğini
yeniden gözlemlemiş bulunuyoruz. Çok değişkenli normal dağılım
varsayımını incelemek amacıyla Mardia’nın Çok Değişkenli Normallik
Testini kullanabiliriz.
library(mvnormalTest)
mardia(data_complete[,3:6]) %>% kable(.)
|
|
Mardia’nın Çok Değişkenli Normallik Testi sonuçlarına göre çok değişkenli normal dağılım varsayımının sağlanmadığı yorumu yapılabilir (p<0.05).
library(GGally)
ggpairs(data_complete[,-1])
MATBASARI ile SVM arasında istatistiksel olarak anlamlı düzeyde bir ilişki gözlenmemiştir.Buna karşın CINSIYET, PATM ve SCM ile MATBASARI arasındaki ilişki anlamlıdır.
Bağımlı değişken: MATBASARI Bağımsız değişkenler: CINSIYET, PATM, SCM, SVM, SCM
\[ MATBASARI = \beta_0 + \beta_1 CINSIYET + \beta_2 PATM + \beta_3 SVM + \beta_4 SCM + \epsilon \]
MATBASARI ile ilişkili olmayan SVM değişkeni modelden çıkarılmıştır. PATM, SCM ve CINSIYET yordayıcı, MATBASARI ise yordanan olacak şekilde model güncellenmiştir.
Güncel model: \[ MATBASARI = \beta_0 + \beta_1 CINSIYET + \beta_2 SCM + \beta_3 PATM + \epsilon \] # Varyansların Homojenliğinin Testi
library(car)
data_complete$CINSIYET <- as.factor(data_complete$CINSIYET)
data_complete$SCM <- as.factor(data_complete$SCM)
data_complete$PATM <- as.factor(data_complete$PATM)
leveneTest(MATBASARI ~ SCM * CINSIYET * PATM, data = data_complete[,-1]) %>% kable(.,digits = 3)
Df | F value | Pr(>F) | |
---|---|---|---|
group | 11 | 2.123 | 0.02 |
234 | NA | NA |
# FULLY-CROSSED olunca işlem yaptı yalnızca. Fakktör olarak tanımladığım için olabilir.
Levene testi sonuçları istatistiksel olarak anlamlıdır (p<0.05). Bu nedenle varyansların homojenliği varsayımının ihlal edildiği yorumu yapılabilir.
data_complete$SCM <- as.numeric(data_complete$SCM)
data_complete$CINSIYET <- as.numeric(data_complete$CINSIYET)
data_complete$PATM <- as.numeric(data_complete$PATM)
model <- lm(MATBASARI ~ SCM + CINSIYET + PATM, data = data_complete)
library(olsrr)
ols_vif_tol(model) %>% kable(digit=2)
Variables | Tolerance | VIF |
---|---|---|
SCM | 0.96 | 1.05 |
CINSIYET | 1.00 | 1.00 |
PATM | 0.96 | 1.05 |
Veri setinde çoklu bağlantı olmadığı yorumu yapılabilir.
Stepwise Regression (Aşamalı Regresyon) yöntemi ile modele katkı sağlayan değişkenler belirlenmiştir. Cinsiyet ve SCM değişkenlerinin modele katkı sunduğu belirlenmiştir.
library(MASS)
data_complete$SCM <- as.numeric(data_complete$SCM)
data_complete$PATM <- as.numeric(data_complete$PATM)
data_complete$CINSIYET <- as.factor(data_complete$CINSIYET) #dummy ref: Boy
levels(data_complete$CINSIYET) <- c("Girl", "Boy")
steps <- lm(MATBASARI ~ PATM + CINSIYET + SCM + SVM, data = data_complete)
step_selected <- stepAIC(steps, direction = "backward", trace = FALSE)
Aşamalı regresyon analizi sonucunda SCM ve Cinsiyet değişkenlerinin modele katkı sağladığı belirlenmişti. SCM değişkeni pozitif ve anlamlı bir yordayıcıdır (\(\beta = 80.44, p < 0.001\)). Cinsiyet doğrudan etkili bir değişken olmakla birlikte, kategorik bir değişken olması nedeniyle SCM ile olası etkileşimlerinin incelenmesi gerekmektedir. Bu nedenle Cinsiyet ve SCM değişkenlerinin etkileşim terimi modele eklenmiştir. PATM değişkeni modele anlamlı katkı yapmaması sebebiyle modelden çıkarılmıştır.
library(sjPlot)
tab_model(step_selected,
show.ci = FALSE,
show.se = TRUE,
show.stat = TRUE,
title = "Coklu Regresyon Analizi Sonuçları")
MATBASARI | ||||
---|---|---|---|---|
Predictors | Estimates | std. Error | Statistic | p |
(Intercept) | 252.32 | 22.42 | 11.25 | <0.001 |
CINSIYET [Boy] | 37.53 | 12.32 | 3.05 | 0.003 |
SCM | 80.44 | 8.54 | 9.43 | <0.001 |
Observations | 246 | |||
R2 / R2 adjusted | 0.288 / 0.282 |
Model değişkenliğin \(R = 0.288\)’sini açıklamaktadır.
par(mfrow = c(2,2))
plot(step_selected)
Residuals vs Fitter grafiği incelendiğinde dağılımın yatay eksene paralel çizgiden hafif düzeyde sapma gösterdiğini görmekteyiz. Bu durum doğrusallık varsayımının ihlal edildiğine işaret edebilir. Q-Q Plot ise artıkların dağılımına ilişkin bilgi veriyor. Uçlarda normal dağılımdan sapmalar açıkça gözlenebilir. Scale-Location ise standart sapmanın verinin her yerinde benzer olmadığını, hafif bükük bir U biçimi gösterdiğine işaret ediyor. Aykırı değerler incelendiğinde birden fazla bireyin (örneğin 4, 169, 231) kaldıraç etkisi yarattığını görmekteyiz.
Cook’s Uzaklığı kriter değerden uzak bireyler veri setinden çıkarılarak kaldıraç etkisi indirgenmeye çalışılır.
library(gt)
cooks_values <- cooks.distance(step_selected)
limit <- 4 / nrow(data_complete)
infvalues <- which(cooks_values > limit)
data_complete_noleverage <- data_complete[-infvalues,]
data_complete_noleverage$CINSIYET <- as.numeric(data_complete_noleverage$CINSIYET)
model_final <- lm(MATBASARI ~ CINSIYET + SCM, data = data_complete_noleverage)
Kaldıraç etkisi yaratan bireylerin veri setinden çıkarılması ile birlikte model yeniden oluşturulmuştur.
library(stargazer)
stargazer(model,model_final, type = "text", title = "Final Model Results", digits = 3)
##
## Final Model Results
## ===================================================================
## Dependent variable:
## -----------------------------------------------
## MATBASARI
## (1) (2)
## -------------------------------------------------------------------
## SCM 79.729*** 82.162***
## (8.743) (7.920)
##
## CINSIYET 37.490*** 30.210***
## (12.346) (11.234)
##
## PATM 8.490
## (21.680)
##
## Constant 200.406*** 217.936***
## (46.422) (25.701)
##
## -------------------------------------------------------------------
## Observations 246 234
## R2 0.289 0.335
## Adjusted R2 0.280 0.329
## Residual Std. Error 96.800 (df = 242) 85.784 (df = 231)
## F Statistic 32.717*** (df = 3; 242) 58.172*** (df = 2; 231)
## ===================================================================
## Note: *p<0.1; **p<0.05; ***p<0.01
PATM modelden çıkarıldıktan sonra \(R^2 = 0.335\)’e yükselmiştir. SCM ve Cinsiyet değişkenleri istatistiksel olarak MATBASARI değişkenini son modelde de yordamaktadır (p<0.001).
Cinsiyet kategorik bir değişken olması nedeniyle SCM’nin Cinsiyet ile etkileşimi incelenmiştir. Bu amaçla Cinsiyet ve SCM değişkenlerinin etkileşim terimi modele eklenmiştir.
data_complete_noleverage$CINSIYET <- as.factor(data_complete_noleverage$CINSIYET)
levels(data_complete_noleverage$CINSIYET) <- c("Girl", "Boy")
model_interaction <- lm(MATBASARI ~ CINSIYET * SCM, data = data_complete_noleverage)
stargazer(model_interaction, type = "text", title = "Etkileşim Modeli Sonuçları", digits = 3)
##
## Etkileşim Modeli Sonuçları
## ===============================================
## Dependent variable:
## ---------------------------
## MATBASARI
## -----------------------------------------------
## CINSIYETBoy 1.069
## (40.487)
##
## SCM 76.911***
## (10.581)
##
## CINSIYETBoy:SCM 11.969
## (15.975)
##
## Constant 260.825***
## (26.697)
##
## -----------------------------------------------
## Observations 234
## R2 0.337
## Adjusted R2 0.328
## Residual Std. Error 85.866 (df = 230)
## F Statistic 38.895*** (df = 3; 230)
## ===============================================
## Note: *p<0.1; **p<0.05; ***p<0.01
Etkileşim etkisinin anlamlı olmadığı görülmektedir (p>0.05).
Aracı etki analizi için SCM aracı değişken olarak tanımlanmıştır. Bu bağlamda hipotetik yollar sırasıyla:
1- PATM, MATBASARI’nın anlamlı bir yordayıcısıdır (PATM –> MATBASARI).
2- PATM, SCM’nin anlamlı bir yordayıcısıdır (PATM –> SCM).
3- SCM, MATBASARININ anlamlı bir yordayıcısıdır (SCM –> MATBASARI).
4- SCM, PATM ve MATBASARI arasındaki ilişkide anlamlı bir aracı değişkendir (PATM –> SCM –> MATBASARI).
library(stargazer) # Kullanışlı regresyon tabloları
data <- data_complete_noleverage
#1. toplam etki
fit <- lm(MATBASARI ~ PATM, data=data)
#2. YOL A (X on M)
fita <- lm(SCM ~ PATM, data=data)
#3. YOL B' (M on Y, X kontrol edildiğinde )
fitb <- lm(SCM ~ MATBASARI + PATM, data=data)
#4. YOL C - ters yol (Y on X, M kontrol edildiğinde)
fitc <- lm(PATM ~ SCM + MATBASARI, data=data)
# Özet tablo
stargazer(fit, fita, fitb, fitc, type = "text", title = "Baron and Kenny Yöntemi ile Aracılık Etkisi",digits = 2,
font.size ="tiny")
##
## Baron and Kenny Yöntemi ile Aracılık Etkisi
## ============================================================================================================
## Dependent variable:
## ----------------------------------------------------------------------------------------
## MATBASARI SCM PATM
## (1) (2) (3) (4)
## ------------------------------------------------------------------------------------------------------------
## SCM 0.09***
## (0.03)
##
## MATBASARI 0.004*** 0.0000
## (0.0004) (0.0002)
##
## PATM 46.53** 0.53*** 0.36***
## (22.85) (0.15) (0.13)
##
## Constant 373.78*** 1.43*** 0.06 1.67***
## (43.97) (0.29) (0.28) (0.09)
##
## ------------------------------------------------------------------------------------------------------------
## Observations 234 234 234 234
## R2 0.02 0.05 0.34 0.05
## Adjusted R2 0.01 0.04 0.33 0.04
## Residual Std. Error 104.04 (df = 232) 0.69 (df = 232) 0.58 (df = 231) 0.29 (df = 231)
## F Statistic 4.15** (df = 1; 232) 11.96*** (df = 1; 232) 58.49*** (df = 2; 231) 5.97*** (df = 2; 231)
## ============================================================================================================
## Note: *p<0.1; **p<0.05; ***p<0.01
Baron & Kenny yöntemi ile yapılan analiz sonucunda SCM’nin kısmî aracı bir değişken olabileceği görülmektedir.
library(mediation)
library(gvlma)
fitM <- lm(SCM ~ PATM, data=data)
fitY <- lm(MATBASARI ~ SCM + PATM, data=data)
gvlma(fitM)
##
## Call:
## lm(formula = SCM ~ PATM, data = data)
##
## Coefficients:
## (Intercept) PATM
## 1.4296 0.5269
##
##
## ASSESSMENT OF THE LINEAR MODEL ASSUMPTIONS
## USING THE GLOBAL TEST ON 4 DEGREES-OF-FREEDOM:
## Level of Significance = 0.05
##
## Call:
## gvlma(x = fitM)
##
## Value p-value Decision
## Global Stat 3.003e+01 4.816e-06 Assumptions NOT satisfied!
## Skewness 2.709e+01 1.946e-07 Assumptions NOT satisfied!
## Kurtosis 1.837e+00 1.753e-01 Assumptions acceptable.
## Link Function -4.114e-15 1.000e+00 Assumptions acceptable.
## Heteroscedasticity 1.111e+00 2.919e-01 Assumptions acceptable.
gvlma(fitY)
##
## Call:
## lm(formula = MATBASARI ~ SCM + PATM, data = data)
##
## Coefficients:
## (Intercept) SCM PATM
## 255.962 82.410 3.108
##
##
## ASSESSMENT OF THE LINEAR MODEL ASSUMPTIONS
## USING THE GLOBAL TEST ON 4 DEGREES-OF-FREEDOM:
## Level of Significance = 0.05
##
## Call:
## gvlma(x = fitY)
##
## Value p-value Decision
## Global Stat 3.0041 0.5571 Assumptions acceptable.
## Skewness 0.3807 0.5372 Assumptions acceptable.
## Kurtosis 2.0432 0.1529 Assumptions acceptable.
## Link Function 0.4228 0.5155 Assumptions acceptable.
## Heteroscedasticity 0.1573 0.6916 Assumptions acceptable.
Varsayımların büyük oranda sağlandığı ancak Global Stat ve Çarpıklık için aracı değişken - yordayıcı değişken ilişkisinde varsayımların ihlal edildiği görülmektedir.
Bu bağlamda bootstrap yöntemi kullanılarak aracı etki analizi yapılmıştır. Bootstrap yöntemi ile yapılan analiz sonucunda PATM’nin SCM üzerinden MATBASARI üzerindeki etkisinin anlamlı olduğu görülmektedir (PATM –> SCM –> MATBASARI \(\beta = 43.421,p<0.05\)). Ayrıca doğrudan etkinin anlamlı olmadığı (ADE: \(\beta=3.108, p>0.05\)).
set.seed(59)
fitMed <- mediate(fitM, fitY, boot=TRUE, sims=1000,treat=c("PATM"), mediator=c("SCM"))
summary(fitMed)
##
## Causal Mediation Analysis
##
## Nonparametric Bootstrap Confidence Intervals with the Percentile Method
##
## Estimate 95% CI Lower 95% CI Upper p-value
## ACME 43.421 15.526 71.56 0.004 **
## ADE 3.108 -33.436 36.60 0.864
## Total Effect 46.529 6.541 80.13 0.018 *
## Prop. Mediated 0.933 0.315 3.29 0.018 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Sample Size Used: 234
##
##
## Simulations: 1000
Bu bağlamda dolaylı etki, doğrudan etkinin %93.3’ünü açıklamaktadır (Dolaylı Etki / Toplam Etki = 43.421 / 46.529)
Not: Ödev 3 farklı günde toplam 7-8 saatimi aldı.