Homework.07.12.2025
Selman ŞİŞMAN
2025-12-02
library(readxl)## Warning: package 'readxl' was built under R version 4.4.3Netflix <- read_excel("Netflix.xlsx")
library(dplyr)## Warning: package 'dplyr' was built under R version 4.4.3##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union1 Paket adı netflix: imdb puanları, yıllar, film isimleri ve yaş türleri gibi değişkenler var.
1.1 Filmlerin yılları ile Imdb puanları arasında bir ilişki var mı
library(ggplot2)## Warning: package 'ggplot2' was built under R version 4.4.3#Başta regresyon eğrisi doğrusal kondu fakat LOESS çizgisi kullandığımızda sağlamadı. Veri çok dağınık, dolayısıyla polinom eğrisi işe yaradı
ggplot(data = Netflix, aes(x = Year, y = `IMDb Rating`)) +
geom_point(alpha = 0.6) +
geom_smooth(method = "lm", formula = y ~ poly(x, 2), color = "red", fill = "pink") +
labs(title = "Yıllara Gore IMDb Puanı Değişimi",
subtitle = "Spearman Korelasyonu: -0.59",
x = "Yapım Yılı",
y = "IMDb Puanı") +
theme_minimal()
Yorum: Yapım yılı artıkça İMBD puanlarının düştüğünü görüyoruz. Ne derler, ne varsa eskilerde var. Eski yıllarda az gözlem sayısı var fakat paunları oldukça yüksek. İki değişken arasında negatif doğrusal olmayan orta düzey bir ilişki vardır. Spearmanla hesaplayalım ilişki doğrusal olmadığı ve uç değerler için r= -.59; p < 0.01
test <- cor.test(Netflix$Year, Netflix$`IMDb Rating`, method = "spearman")## Warning in cor.test.default(Netflix$Year, Netflix$`IMDb Rating`, method =
## "spearman"): Cannot compute exact p-value with tiesprint(test)##
## Spearman's rank correlation rho
##
## data: Netflix$Year and Netflix$`IMDb Rating`
## S = 33154, p-value = 5.946e-06
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
## rho
## -0.5920062 Doğrusal ilişki yok ama yine de doğrusal regresyon yapalım
model <- lm(`IMDb Rating` ~ Year, data = Netflix)
summary(model)##
## Call:
## lm(formula = `IMDb Rating` ~ Year, data = Netflix)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.7960 -0.3446 -0.0174 0.3530 0.8807
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 37.780219 7.903653 4.780 1.7e-05 ***
## Year -0.014725 0.003942 -3.735 0.000498 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.4423 on 48 degrees of freedom
## Multiple R-squared: 0.2252, Adjusted R-squared: 0.209
## F-statistic: 13.95 on 1 and 48 DF, p-value: 0.0004985Yorum: evet model iyi çalışmadı açıklama varsaysı düşük R-squared: 0.209 ve anlamlı.
3 Doprusal olmayan parabolik regresyon yapalım
model_poly <- lm(`IMDb Rating` ~ poly(Year, 2), data = Netflix)
summary(model_poly)##
## Call:
## lm(formula = `IMDb Rating` ~ poly(Year, 2), data = Netflix)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.99525 -0.21813 0.01884 0.25393 0.73175
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 8.26200 0.05708 144.733 < 2e-16 ***
## poly(Year, 2)1 -1.65185 0.40365 -4.092 0.000166 ***
## poly(Year, 2)2 -1.31583 0.40365 -3.260 0.002076 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.4036 on 47 degrees of freedom
## Multiple R-squared: 0.3681, Adjusted R-squared: 0.3412
## F-statistic: 13.69 on 2 and 47 DF, p-value: 2.07e-05Günlüğe Yorum: Biraz arttı. Yıl değişkeni imdb puanının yüzde 37 sini açıkladı iyi gibi. R-squared: 0.3681 ve anlamlı
4 Augment ile datayı inceleme
library(broom)## Warning: package 'broom' was built under R version 4.4.3augment(model, data = Netflix)## # A tibble: 50 × 12
## Name Year `Age Rating` Duration Category `IMDb Rating` .fitted .resid
## <chr> <dbl> <chr> <chr> <chr> <dbl> <dbl> <dbl>
## 1 Casablanca 1942 PG 102 mins Drama/R… 8.5 9.18 -0.685
## 2 Psycho 1960 R 109 mins Horror/… 8.5 8.92 -0.420
## 3 The Godfa… 1972 R 175 mins Crime/D… 9.2 8.74 0.457
## 4 Star Wars… 1977 PG 121 mins Action/… 8.6 8.67 -0.0696
## 5 E.T. the … 1982 PG 115 mins Family/… 7.8 8.60 -0.796
## 6 Terminato… 1991 R 137 mins Action/… 8.5 8.46 0.0366
## 7 Forrest G… 1994 PG-13 142 mins Drama/R… 8.8 8.42 0.381
## 8 Titanic 1997 PG-13 195 mins Drama/R… 7.8 8.38 -0.575
## 9 The Matrix 1999 R 136 mins Action/… 8.7 8.35 0.354
## 10 Gladiator 2000 R 155 mins Action/… 8.5 8.33 0.169
## # ℹ 40 more rows
## # ℹ 4 more variables: .hat <dbl>, .sigma <dbl>, .cooksd <dbl>, .std.resid <dbl>augment(model_poly, Netflix) %>%
ggplot(aes(x = .fitted, y = .resid)) +
geom_point() + geom_hline(yintercept = 0)
Veriler çizginin etrafında hetorejen dağılmış durumda. sağ alttakı üç değeri bulalım
5 Uç değeri predict ile bulma
Netflix %>%
mutate(tahmin = predict(model_poly),
hata = resid(model_poly)) %>%
arrange(hata) %>% # En kucuk (en negatif) hatayi en basa al
head(1)## # A tibble: 1 × 8
## Name Year `Age Rating` Duration Category `IMDb Rating` tahmin hata
## <chr> <dbl> <chr> <chr> <chr> <dbl> <dbl> <dbl>
## 1 E.T. the Ext… 1982 PG 115 mins Family/… 7.8 8.80 -0.9956 Model_poly R squaredina bakalım
# Nota ekle: Modelin genel performans karnesi (R-kare ve Sigma)
glance(model_poly)## # A tibble: 1 × 12
## r.squared adj.r.squared sigma statistic p.value df logLik AIC BIC
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0.368 0.341 0.404 13.7 0.0000207 2 -24.0 56.1 63.7
## # ℹ 3 more variables: deviance <dbl>, df.residual <int>, nobs <int>7 Çoklu regresyon” için farklı veri setine geçtim.
# Gerekli kutuphaneler
library(tidyverse)## Warning: package 'tidyverse' was built under R version 4.4.3## Warning: package 'tidyr' was built under R version 4.4.3## Warning: package 'readr' was built under R version 4.4.3## Warning: package 'forcats' was built under R version 4.4.3## Warning: package 'lubridate' was built under R version 4.4.3## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ lubridate 1.9.4 ✔ tibble 3.2.1
## ✔ purrr 1.0.2 ✔ tidyr 1.3.1
## ✔ readr 2.1.5
## ── 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 errors# Bu veri seti: High School and Beyond (HSB) anketidir. Amerika'daki liselerden toplanmış, özel okul/devlet okulu, sosyoekonomik düzey ve akademik başarı verilerini içerir.
url <- "https://stats.idre.ucla.edu/stat/data/hsb2.csv"
hsb_data <- read.csv(url)
# 2. Degisken isimlerini ve Kategorik verileri Turkceye cevirelim
egitim_verisi <- hsb_data %>%
transmute(
Ogrenci_ID = id,
Cinsiyet = factor(female, levels = c(0, 1), labels = c("Erkek", "Kadin")),
Irk = factor(race, levels = c(1, 2, 3, 4), labels = c("Hispanik", "Asyali", "Siyahi", "Beyaz")),
Sosyoekonomik_Duzey = factor(ses, levels = c(1, 2, 3), labels = c("Dusuk", "Orta", "Yuksek")),
Okul_Turu = factor(schtyp, levels = c(1, 2), labels = c("Devlet", "Ozel")),
Program_Turu = factor(prog, levels = c(1, 2, 3), labels = c("Genel", "Akademik", "Meslek")),
Okuma_Puani = read,
Yazma_Puani = write,
Matematik_Puani = math,
Bilim_Puani = science,
Sosyal_Bilgiler_Puani = socst
)
# 3. Verinin ilk 10 satirini gorelim
head(egitim_verisi, 10)## Ogrenci_ID Cinsiyet Irk Sosyoekonomik_Duzey Okul_Turu Program_Turu
## 1 70 Erkek Beyaz Dusuk Devlet Genel
## 2 121 Kadin Beyaz Orta Devlet Meslek
## 3 86 Erkek Beyaz Yuksek Devlet Genel
## 4 141 Erkek Beyaz Yuksek Devlet Meslek
## 5 172 Erkek Beyaz Orta Devlet Akademik
## 6 113 Erkek Beyaz Orta Devlet Akademik
## 7 50 Erkek Siyahi Orta Devlet Genel
## 8 11 Erkek Hispanik Orta Devlet Akademik
## 9 84 Erkek Beyaz Orta Devlet Genel
## 10 48 Erkek Siyahi Orta Devlet Akademik
## Okuma_Puani Yazma_Puani Matematik_Puani Bilim_Puani Sosyal_Bilgiler_Puani
## 1 57 52 41 47 57
## 2 68 59 53 63 61
## 3 44 33 54 58 31
## 4 63 44 47 53 56
## 5 47 52 57 53 61
## 6 44 52 51 63 61
## 7 50 59 42 53 61
## 8 34 46 45 39 36
## 9 63 57 54 58 51
## 10 57 55 52 50 51# 4. Veri yapisini kontrol edelim
glimpse(egitim_verisi)## Rows: 200
## Columns: 11
## $ Ogrenci_ID <int> 70, 121, 86, 141, 172, 113, 50, 11, 84, 48, 75, …
## $ Cinsiyet <fct> Erkek, Kadin, Erkek, Erkek, Erkek, Erkek, Erkek,…
## $ Irk <fct> Beyaz, Beyaz, Beyaz, Beyaz, Beyaz, Beyaz, Siyahi…
## $ Sosyoekonomik_Duzey <fct> Dusuk, Orta, Yuksek, Yuksek, Orta, Orta, Orta, O…
## $ Okul_Turu <fct> Devlet, Devlet, Devlet, Devlet, Devlet, Devlet, …
## $ Program_Turu <fct> Genel, Meslek, Genel, Meslek, Akademik, Akademik…
## $ Okuma_Puani <int> 57, 68, 44, 63, 47, 44, 50, 34, 63, 57, 60, 57, …
## $ Yazma_Puani <int> 52, 59, 33, 44, 52, 52, 59, 46, 57, 55, 46, 65, …
## $ Matematik_Puani <int> 41, 53, 54, 47, 57, 51, 42, 45, 54, 52, 51, 51, …
## $ Bilim_Puani <int> 47, 63, 58, 53, 53, 63, 53, 39, 58, 50, 53, 63, …
## $ Sosyal_Bilgiler_Puani <int> 57, 61, 31, 56, 61, 61, 61, 36, 51, 51, 61, 61, …8 Model ve test Soru: “Öğrencilerin okuma becerisi, sosyoekonomik düzeyi, cinsiyeti ve okul türü; yazma puanlarını birlikte anlamlı düzeyde yordamakta mıdır?”
# Model Kurulumu:
# Bagimli Degisken: Yazma_Puani
# Bagimsiz Degiskenler: Okuma_Puani (Surekli), Okul_Turu (Kategorik), Sosyoekonomik_Duzey (Kategorik)
model <- lm(Yazma_Puani ~ Okuma_Puani + Okul_Turu + Sosyoekonomik_Duzey, data = egitim_verisi)
# Ozet Sonuclari Goster
summary(model)##
## Call:
## lm(formula = Yazma_Puani ~ Okuma_Puani + Okul_Turu + Sosyoekonomik_Duzey,
## data = egitim_verisi)
##
## Residuals:
## Min 1Q Median 3Q Max
## -19.6667 -5.0662 0.7082 5.9778 14.9625
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 24.64913 2.88868 8.533 3.97e-15 ***
## Okuma_Puani 0.53608 0.05528 9.698 < 2e-16 ***
## Okul_TuruOzel 2.06587 1.49689 1.380 0.169
## Sosyoekonomik_DuzeyOrta -0.78629 1.39056 -0.565 0.572
## Sosyoekonomik_DuzeyYuksek 0.58450 1.57616 0.371 0.711
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 7.626 on 195 degrees of freedom
## Multiple R-squared: 0.3657, Adjusted R-squared: 0.3527
## F-statistic: 28.11 on 4 and 195 DF, p-value: < 2.2e-16(değişken sayısı arttığı için) Uyarlanmış R kare değerine bakarız. 0.35 geldi ve anlamlı. Bir öğrencinin okuma puanı 1 puan arttığında, yazma puanı ortalama 0.53 puan artıyor.
Evet, yordamaktadır. (Çünkü F testi anlamlı çıktı). Bu değişkenler seti, yazma başarısındaki varyansın %35’ünü açıklamaktadır.
9 Görselleştirelim
9.1 Okuma becerisi arttıkça yazma puanı nasıl değişiyor ve bu değişim devlet okulu ile özel okul arasında farklılık gösteriyor mu?
ggplot(egitim_verisi, aes(x = Okuma_Puani, y = Yazma_Puani, color = Okul_Turu, fill = Okul_Turu)) +
geom_point(alpha = 0.6) +
geom_smooth(method = "lm", fullrange = TRUE) +
labs(title = "Okuma Becerisinin Yazma Puanına Etkisi",
subtitle = "Okul türleri arasında anlamlı bir makas farkı var mı?",
x = "Okuma Puanı",
y = "Yazma Puanı",
color = "Okul Turu",
fill = "Okul Turu") +
theme_minimal() +
scale_color_brewer(palette = "Set1")## `geom_smooth()` using formula = 'y ~ x'
Grafik, okul türünün başarısı üzerinde bir “makas etkisi” olduğunu göstermektedir:
Okuma seviyesi düşükken özel okullar daha başarılıdır (yazma puanları daha yüksektir). Okuma seviyesi arttıkça devlet okulu öğrencilerinin yazma puanları çok daha hızlı (dik bir eğimle) artmaktadır. Yüksek okuma becerisine sahip öğrencilerde, devlet okulları özel okullarla arasındaki farkı kapatmakta, hatta yakalamaktadır.