3.hafta regresyon
Zarife Tastan
2026-03-09
REGRESYON
SORU 1. BASÄ°T REGRESYON
Araştırma Problemi: Teksas Üniversitesi’nde (UT Austin) yapılan bir araştırmada, eğitmenlerin öğretim değerlendirme puanları (score) ile güzellik puanları (bty_avg) arasındaki ilişki incelenmiştir. Veriler moderndive paketindeki evals veri setinde yer almaktadır.
Öğretim puanını (score) bağımlı değişken (y) ve güzellik puanını (bty_avg) bağımsız değişken (x) olarak kullanarak bir basit doğrusal regresyon modeli oluşturun.
lm() ve get_regression_table() fonksiyonlarını kullanarak regresyon tablosunu elde edin.
Regresyon denklemini yazın ve güzellik puanının eğim katsayısını (slope) yorumlayın.
library(moderndive)
library(ggplot2) #regresyon için doğrusallık gerktiği için kuruldu.
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionMODELÄ°N KURULMASI
data(evals)
head(evals)## # A tibble: 6 × 14
## ID prof_ID score age bty_avg gender ethnicity language rank pic_outfit
## <int> <int> <dbl> <int> <dbl> <fct> <fct> <fct> <fct> <fct>
## 1 1 1 4.7 36 5 female minority english tenu… not formal
## 2 2 1 4.1 36 5 female minority english tenu… not formal
## 3 3 1 3.9 36 5 female minority english tenu… not formal
## 4 4 1 4.8 36 5 female minority english tenu… not formal
## 5 5 2 4.6 59 3 male not minori… english tenu… not formal
## 6 6 2 4.3 59 3 male not minori… english tenu… not formal
## # ℹ 4 more variables: pic_color <fct>, cls_did_eval <int>, cls_students <int>,
## # cls_level <fct>model_basit <- lm(formula = score ~ bty_avg, data=evals)
get_regression_table(model_basit)## # A tibble: 2 × 7
## term estimate std_error statistic p_value lower_ci upper_ci
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 intercept 3.88 0.076 51.0 0 3.73 4.03
## 2 bty_avg 0.067 0.016 4.09 0 0.035 0.099summary(model_basit)##
## Call:
## lm(formula = score ~ bty_avg, data = evals)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.9246 -0.3690 0.1420 0.3977 0.9309
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.88034 0.07614 50.96 < 2e-16 ***
## bty_avg 0.06664 0.01629 4.09 5.08e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.5348 on 461 degrees of freedom
## Multiple R-squared: 0.03502, Adjusted R-squared: 0.03293
## F-statistic: 16.73 on 1 and 461 DF, p-value: 5.083e-05YORUM: Güzellik puanı (bty_avg) 1 birim arttığında, öğretim değerlendirme puanı (score) ortalama 0.067 puan artmaktadır.
score =3.88+0.067.bty_avg
Adjusted R-squared: 0.03293
ggplot(evals, aes(x= bty_avg, y=score)) +
geom_point(alpha=0.3) +
geom_smooth(method="lm", se=FALSE) +
labs(title="Güzellik ve Ders Puanı İlişkisi")## `geom_smooth()` using formula = 'y ~ x'
get_regression_table(model_basit) #REGRESYON TABLOSU ALDIK.## # A tibble: 2 × 7
## term estimate std_error statistic p_value lower_ci upper_ci
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 intercept 3.88 0.076 51.0 0 3.73 4.03
## 2 bty_avg 0.067 0.016 4.09 0 0.035 0.099SORU 2. ÇOKLU REGRESYON
Araştırma Problemi: Eğitmenlerin öğretim puanlarını tahmin ederken sadece güzellik puanlarının değil, cinsiyetlerinin de (kategorik değişken) etkili olabileceğini düşünüyoruz. Bu durumu hem etkileşim (çarpım) modeli hem de paralel eğimler modeli ile analiz edeceğiz.
evals veri setini kullanarak, bağımlı değişkeni score, bağımsız değişkenleri ise bty_avg (güzellik puanı) ve gender (cinsiyet) olan iki farklı çoklu regresyon modeli kurun:
Etkileşim (Interaction) Modeli: Güzellik puanının öğretim puanı üzerindeki etkisinin cinsiyete göre değişebileceğini varsayan etkileşim modelini kurun. R kodunu yazın.
Paralel Eğimler (Parallel Slopes) Modeli: Her iki cinsiyet için güzellik puanının öğretim puanına etkisinin (eğimin) aynı olduğunu varsayan paralel eğimler modelini kurun.
Bu iki modelin temel varsayım farkını kısaca açıklayın.
library(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ forcats 1.0.1 ✔ stringr 1.6.0
## ✔ lubridate 1.9.5 ✔ tibble 3.3.0
## ✔ purrr 1.2.0 ✔ tidyr 1.3.1
## ✔ readr 2.1.6
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorsmodel_etkilesim <- lm(score ~ bty_avg * gender, data=evals)
get_regression_table(model_etkilesim)## # A tibble: 4 × 7
## term estimate std_error statistic p_value lower_ci upper_ci
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 intercept 3.95 0.118 33.5 0 3.72 4.18
## 2 bty_avg 0.031 0.024 1.28 0.202 -0.017 0.078
## 3 gender: male -0.184 0.153 -1.20 0.232 -0.485 0.118
## 4 bty_avg:gendermale 0.08 0.032 2.45 0.015 0.016 0.143model_paralel <- lm(score ~ bty_avg + gender, data=evals)
get_regression_table(model_paralel)## # A tibble: 3 × 7
## term estimate std_error statistic p_value lower_ci upper_ci
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 intercept 3.75 0.085 44.3 0 3.58 3.91
## 2 bty_avg 0.074 0.016 4.56 0 0.042 0.106
## 3 gender: male 0.172 0.05 3.43 0.001 0.074 0.271library(patchwork)
p1 <-ggplot(evals, aes(x=bty_avg, y=score, color=gender))+
geom_point(alpha=0.3)+
geom_parallel_slopes(se=FALSE)+
labs(title= "paralel EÄŸimler modeli",
subtitle = " her cinsiyet için aynı eğim",
x = "güzellik puanı" , y="öğretim programı") +
theme_minimal()
p1
NOT: ERKEKLERDE GÃœZELLÄ°K PUANINDAKÄ° BÄ°R BÄ°RÄ°MLÄ°K ARTIÅž DEÄžERLENDÄ°RME
PUANINI 0.172 BÄ°RÄ°M ARTIRIR. YANÄ° AYNI GÃœZELLÄ°K PUANINA SAHÄ°P BÄ°R ERKEK
HOCANIN KADIN HOCADAN 0.17 PUAN DAHA YÃœKSEK ALMASI BEKLENÄ°R.
model_paralel<-lm(data=evals, score ~ bty_avg+gender)get_regression_table(model_paralel)## # A tibble: 3 × 7
## term estimate std_error statistic p_value lower_ci upper_ci
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 intercept 3.75 0.085 44.3 0 3.58 3.91
## 2 bty_avg 0.074 0.016 4.56 0 0.042 0.106
## 3 gender: male 0.172 0.05 3.43 0.001 0.074 0.271ggplot(evals, aes(x=bty_avg, y=score, color=gender))+
geom_point(alpha=0.3)+
geom_parallel_slopes(se=FALSE)+
labs(title= "Cinsiyet Kontrol Edildiginde Guzellik Etkisi")
SORU 3. ÇOKLU REGRESYON
ISLR paketinden türetilen ve kredi kartı kullanıcılarının finansal bilgilerini içeren bir veri seti (örneğin credit_ch6) kullanılarak, kredi kartı borcu (Balance) incelenmektedir.
Kredi kartı borcunu (Balance) bağımlı değişken, kredi limitini (credit_limit) ve geliri (income) bağımsız değişkenler olarak kullanarak bir çoklu regresyon modeli oluşturun.
Modelin regresyon tablosunu oluşturacak R kodunu yazın.
Çıktıdaki income (gelir) değişkeninin katsayısını, diğer değişkenleri sabit tuttuğumuzu belirterek yorumlayın.
library(ISLR)
data(Credit)
head(Credit)## ID Income Limit Rating Cards Age Education Gender Student Married Ethnicity
## 1 1 14.891 3606 283 2 34 11 Male No Yes Caucasian
## 2 2 106.025 6645 483 3 82 15 Female Yes Yes Asian
## 3 3 104.593 7075 514 4 71 11 Male No No Asian
## 4 4 148.924 9504 681 3 36 11 Female No No Asian
## 5 5 55.882 4897 357 2 68 16 Male No Yes Caucasian
## 6 6 80.180 8047 569 4 77 10 Male No No Caucasian
## Balance
## 1 333
## 2 903
## 3 580
## 4 964
## 5 331
## 6 1151library(ISLR)
data("Credit")
model_limit <- lm(Balance ~Limit, data = Credit)
get_regression_table(model_limit)## # A tibble: 2 × 7
## term estimate std_error statistic p_value lower_ci upper_ci
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 intercept -293. 26.7 -11.0 0 -345. -240.
## 2 Limit 0.172 0.005 33.9 0 0.162 0.182NOT: limit 0.17 birimlik artışa neden oluyor.
summary(model_limit)##
## Call:
## lm(formula = Balance ~ Limit, data = Credit)
##
## Residuals:
## Min 1Q Median 3Q Max
## -676.95 -141.87 -11.55 134.11 776.44
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -2.928e+02 2.668e+01 -10.97 <2e-16 ***
## Limit 1.716e-01 5.066e-03 33.88 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 233.6 on 398 degrees of freedom
## Multiple R-squared: 0.7425, Adjusted R-squared: 0.7419
## F-statistic: 1148 on 1 and 398 DF, p-value: < 2.2e-16model_income <- lm(Balance ~ Income, data = Credit)
get_regression_table(model_income)## # A tibble: 2 × 7
## term estimate std_error statistic p_value lower_ci upper_ci
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 intercept 247. 33.2 7.42 0 181. 312.
## 2 Income 6.05 0.579 10.4 0 4.91 7.19NOT: income 6 birimlik artışa neden oluyor.
summary(model_income)##
## Call:
## lm(formula = Balance ~ Income, data = Credit)
##
## Residuals:
## Min 1Q Median 3Q Max
## -803.64 -348.99 -54.42 331.75 1100.25
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 246.5148 33.1993 7.425 6.9e-13 ***
## Income 6.0484 0.5794 10.440 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 407.9 on 398 degrees of freedom
## Multiple R-squared: 0.215, Adjusted R-squared: 0.213
## F-statistic: 109 on 1 and 398 DF, p-value: < 2.2e-16model_coklu <- lm(Balance ~ Limit + Income, data = Credit)
get_regression_table(model_coklu)## # A tibble: 3 × 7
## term estimate std_error statistic p_value lower_ci upper_ci
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 intercept -385. 19.5 -19.8 0 -423. -347.
## 2 Limit 0.264 0.006 45.0 0 0.253 0.276
## 3 Income -7.66 0.385 -19.9 0 -8.42 -6.91NOT: limit ve income birlikte ele alındığında limit artarken income tersine dönerek negatif etki yaratıyor.
summary(model_coklu )##
## Call:
## lm(formula = Balance ~ Limit + Income, data = Credit)
##
## Residuals:
## Min 1Q Median 3Q Max
## -232.79 -115.45 -48.20 53.36 549.77
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -385.17926 19.46480 -19.79 <2e-16 ***
## Limit 0.26432 0.00588 44.95 <2e-16 ***
## Income -7.66332 0.38507 -19.90 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 165.5 on 397 degrees of freedom
## Multiple R-squared: 0.8711, Adjusted R-squared: 0.8705
## F-statistic: 1342 on 2 and 397 DF, p-value: < 2.2e-16NOT: limit ve income birlikte ele alındığında limit artarken income tersine dönerek negatif etki yaratıyor. burada bir gariplik var deyip iki değişken arası korelasyona bakıyoruz.
cor(Credit$Income, Credit$Limit)## [1] 0.7920883NOT: Limit ve income aralarındaki korelasyon yüksek çıktı. Aralarında çoklu bağlantı olduğu için regresyona dahil ettiğimizde olduğundan farklı etki yarattı. Bu bizim denklemi yanlış kurduğumuzu gösterir.
O yüzden regresyon yapmadan önce bağımsız değişkenler arası ilişkiye bakarak .80 den fazla ise analize dahil etmemeliyiz. Yada temel bileşenler analizi gibi değişkenleri birleştirerek analiz edebiliriz.
YOL ANALÄ°ZÄ°
YOL ANALİZİ MODELİ YEM AİLESİNİN EN ESKİ ÜYELERİNDENDİR. YOL ANALİZİNDE SADECE GÖZLENEN DEĞİŞKENLER MODELLENİR. BU MODEL GÖZLENEN DEĞİŞKENLER İÇİN BİR YAPISAL EŞİTLİK MODELİDİR. * TEMELDE GÖZLENEN DEĞİŞKENLERİN VARYANSLARINA VE GÖZLENEN DEĞİŞKENLER ARASINDAKİ KOVARYANSLARA DAYALI OLAN YEM ANALİZLERİNİN AMACI BİR GRUP GÖZLENEN DEĞİŞKEN ARASINDAKİ KOVARYANS ÖRÜNTÜSÜNÜ ANLAMAK VE ARAŞTIRMA MODELİ İLE GÖZLENEN DEĞİŞKENLERİN VARYANSLARINI AÇIKLAMAKTIR.
ARAŞTIRMA SENARYOSU: üniversite öğrencilerinde egzersiz, dayanıklılık, form ve stresin hastalık üzerindeki etkileri incelenecektir.
ARAŞTIRMA HİPOTEZLERİ: 1. egzersiz ve dayanıklılık formu etkiler 2. egzersiz ve dayanıklılık stresi etkiler 3. egzersiz,dayanıklılık form ve stres hastalığı etkiler. NOT: bu üç hipotezin her biri çoklu regresyon modelidir.
yol_model <- ‘stres ~ egzersiz + dayaniklilik hastalik ~ egzersiz + dayaniklilik + form + stres form ~ egzersiz + dayaniklilik’
library(readr) # veri setini okuduk
veri <- read_table("illness.dat", col_names = FALSE) # colnames false olma nedeni başlık olmamamsı.##
## ── Column specification ────────────────────────────────────────────────────────
## cols(
## X1 = col_double(),
## X2 = col_double(),
## X3 = col_double(),
## X4 = col_double(),
## X5 = col_double()
## )colnames(veri) <- c("form", "stres", "hastalik", "egzersiz", "dayaniklilik")YOL MODELÄ°NÄ° KURDUK
library(lavaan)## This is lavaan 0.6-21
## lavaan is FREE software! Please report any bugs.yol_model <- 'stres ~ egzersiz + dayaniklilik
hastalik ~ egzersiz + dayaniklilik + form + stres
form ~ egzersiz + dayaniklilik
egzersiz ~~ dayaniklilik'
yol_fit <- sem(yol_model, veri)
yol_fit## lavaan 0.6-21 ended normally after 8 iterations
##
## Estimator ML
## Optimization method NLMINB
## Number of model parameters 14
##
## Number of observations 400
##
## Model Test User Model:
##
## Test statistic 12.307
## Degrees of freedom 1
## P-value (Chi-square) 0.000NOT: EGZERSİZ VE DAYANIKLILIK DIŞSAL DEĞİŞKEN (nedeni bilinmeyen ve modelde gösterilmeyen) * FORM, STRES VE HASTALIK İÇSEL DEĞİŞKEN(varsayılan nedenleri modelde açıkça gösterilen)
library(lavaan)
library(semPlot)## Registered S3 method overwritten by 'openxlsx':
## method from
## as.character.formula formula.toolsyol_model <- 'stres ~ egzersiz + dayaniklilik
hastalik ~ egzersiz + dayaniklilik + form + stres
form ~ egzersiz + dayaniklilik
egzersiz ~~ dayaniklilik'
yol_fit <- sem(yol_model, veri)
semPaths(yol_fit,rotation=2, curvePivot = TRUE,
sizeMan = 12, sizeInt = 1,
sizeLat = 4,
edge.label.cex = 1.8,
pastel=TRUE,
nCharNodes = 0, nCharEdges = 0)
library(lavaan)
yol_model <- 'stres ~ egzersiz + dayaniklilik
hastalik ~ egzersiz + dayaniklilik + form + stres
form ~ egzersiz + dayaniklilik
egzersiz ~~ dayaniklilik'
yol_fit <- sem(yol_model, veri)
library(semPlot)semPaths(yol_fit,rotation=2, curvePivot = TRUE,
sizeMan = 12, sizeInt = 1,
sizeLat = 4,
edge.label.cex = 1.8,
pastel=TRUE,
nCharNodes = 0, nCharEdges = 0)
# uyum indisleri
fitMeasures(yol_fit,
fit.measures = c("chisq","df","pvalue",
"cfi","tli",
"rmsea","srmr"))## chisq df pvalue cfi tli rmsea srmr
## 12.307 1.000 0.000 0.948 0.485 0.168 0.043#yol analizi modeli
p_pa <- semPaths(yol_fit,
whatLabels = "est",
sizeMan = 10,
edge.label.cex = 1.15,
style = "ram",
layout = "spring",
nCharNodes = 0,
nCharEdges = 0)
p_pa_2 <- semptools::mark_sig(p_pa, yol_fit)
plot(p_pa_2)
yol_model_v1 <-
'stres ~ egzersiz + dayaniklilik
hastalik ~ egzersiz + dayaniklilik + form + stres
form ~ egzersiz + dayaniklilik
stres ~ form
egzersiz ~~ dayaniklilik'
yol_model_v2 <-
'stres ~ dayaniklilik
hastalik ~ form + stres
form ~ egzersiz + dayaniklilik
stres ~ form
egzersiz ~~ dayaniklilik'
yol_fit_v2 <- sem(yol_model_v2, veri)fitMeasures(yol_fit_v2,c("rmsea","cfi","srmr"))## rmsea cfi srmr
## 0.000 1.000 0.011m <- matrix(c(NA, NA, "form", NA, NA,
"egzersiz", NA, NA, NA, NA,
NA, NA, NA, NA, "hastalik",
"dayaniklilik", NA, NA, NA, NA,
NA, NA, "stres", NA, NA
), byrow = TRUE, 5, 5)
m## [,1] [,2] [,3] [,4] [,5]
## [1,] NA NA "form" NA NA
## [2,] "egzersiz" NA NA NA NA
## [3,] NA NA NA NA "hastalik"
## [4,] "dayaniklilik" NA NA NA NA
## [5,] NA NA "stres" NA NAp_pa <- semPaths(yol_fit_v2, whatLabels = "est",
sizeMan = 10,
edge.label.cex = 1.15,
style = "ram",
nCharNodes = 0, nCharEdges = 0,
layout=m)