ÖDEV 3

16 maddelik bir ölçek 331 üniversite öğrencisine uygulanmıştır. 331 öğrenciye ait veriler odev3.xlsx dosyasında yer almaktadır. Cinsiyet değişkeni 1-Kadın, 2-Erkek; SES değişkeni 1-düşük, 2-orta, 3-yüksek olarak kodlanmıştır. Ölçek iki faktörden oluşmaktadır. Birinci alt boyut “boyut1”, 1, 2, 3, 4, 5, 6, 7, 8, 9 numaralı maddelerden oluşmakta, ikinci alt boyut “boyut2”,10, 11, 12, 13, 14, 15, 16 numaralı maddelerden oluşmaktadır. Not: Sorular çözümü readxl ve tidyverse paketleri ile yapılabilmektedir. Ancak sizler istediğiniz paketi kullanmakta özgürsünüz.

library(readxl)
library(tidyverse)
library(ggplot2)
library(knitr)
library(kableExtra)
library(dplyr)
library(plotly)
library(psych)

a. Veri Seti

“odev3.xlsx” dosyasını R ortamına aktarınız ve veri setinde eksik veri olup olmadığını kontrol ediniz.

veri <- read_excel("data/odev3.xlsx", sheet=1)
summary(is.na(veri))
##   Cinsiyet          SES             WV1             WV2         
##  Mode :logical   Mode :logical   Mode :logical   Mode :logical  
##  FALSE:331       FALSE:331       FALSE:331       FALSE:331      
##     WV3             WV4             WV5             WV6         
##  Mode :logical   Mode :logical   Mode :logical   Mode :logical  
##  FALSE:331       FALSE:331       FALSE:331       FALSE:331      
##     WV7             WV8             WV9             WV10        
##  Mode :logical   Mode :logical   Mode :logical   Mode :logical  
##  FALSE:331       FALSE:331       FALSE:331       FALSE:331      
##     WV11            WV12            WV13            WV14        
##  Mode :logical   Mode :logical   Mode :logical   Mode :logical  
##  FALSE:331       FALSE:331       FALSE:331       FALSE:331      
##     WV15            WV16        
##  Mode :logical   Mode :logical  
##  FALSE:331       FALSE:331

Eksik veri yoktur

b. Değişken Kategorileri ve Grafikleri

Cinsiyet ve SES değişkenlerinin kategorilerinde nasıl dağıldığını hem tablo hem de grafikle gösteriniz.

b.1. Frekanslar

cinsiyet_tablosu <- veri %>% count(Cinsiyet) %>%
  mutate(Kategori = case_when(
    Cinsiyet == 1 ~ "Cinsiyet 1 (Kadın)",
    Cinsiyet == 2 ~ "Cinsiyet 2 (Erkek)"
  )) %>%
  select(Kategori, n)


ses_tablosu <- veri %>% count(SES) %>%
  mutate(Kategori = case_when(
    SES == 1 ~ "SES 1 (Düşük)",
    SES == 2 ~ "SES 2 (Orta)",
    SES == 3 ~ "SES 3 (Yüksek)"
  )) %>%
  select(Kategori, n)

cinsiyet_tablosu %>%
  kable(col.names = c("Kategori", "Frekans"), caption = "Cinsiyet Dağılımı") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE) %>%
  row_spec(0, bold = TRUE)
Table 1: Table 2: Cinsiyet Dağılımı
Kategori Frekans
Cinsiyet 1 (Kadın) 257
Cinsiyet 2 (Erkek) 74 
cat("\n\n")
ses_tablosu %>%
  kable(col.names = c("Kategori", "Frekans"), caption = "SES Dağılımı") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE) %>%
  row_spec(0, bold = TRUE)
Table 1: Table 1: SES Dağılımı
Kategori Frekans
SES 1 (Düşük) 18
SES 2 (Orta) 262
SES 3 (Yüksek) 51

b.2. Grafikler

ggplot(cinsiyet_tablosu, aes(x = Kategori, y = n, fill = Kategori)) +
  geom_bar(stat = "identity") +
  geom_text(aes(label = n), vjust = -0.5, size = 4, color = "black") + 
  labs(title = "Cinsiyet Dağılımı", x = "Cinsiyet", y = "Frekans") +
  scale_fill_manual(values = c("purple", "orange")) + 
  theme_minimal()

ggplot(ses_tablosu, aes(x = Kategori, y = n, fill = Kategori)) +
  geom_bar(stat = "identity") +
  geom_text(aes(label = n), vjust = -0.5, size = 4, color = "black") + 
  labs(title = "SES Dağılımı", x = "SES Düzeyi", y = "Frekans") +
  scale_fill_manual(values = c("gray", "blue", "yellow")) +
  theme_minimal()

c. Ters Puanlanan Maddeler

Boyut1 alt boyutunda yer alan maddeler olumsuz maddelerdir, bu maddeleri yeniden kodlayınız.

Boyut1 için en büyük değerleri kontrol edelim. İnsanın eli bir excele de gitmiyor değil.Max değer+1 den değeri çıkararak hesaplama yapacağız.

b1no<- c(3:11) 

veri <- veri %>%
  mutate(across(all_of(b1no), 
                ~ max(., na.rm = TRUE) + 1 - ., 
                .names = "WVT_{.col}"))

d. Toplam Puanlar ve Histogramlar

Boyut1 ve Boyut2 alt boyutunun her ikisi için de toplam puan hesaplayınız. Her iki alt ölçeğin toplam puan dağılımını histogram çizerek gösteriniz.

d.1. Boyut1 ve Boyut2 Toplam Puanları

Boyut1 puanları ters çevirilmiş puanlar üzerinden elde edilmiştir.

veri <- veri %>%
  mutate(
    Boyut1_Toplam = rowSums(select(., starts_with("WVT_WV")), na.rm = TRUE),
    Boyut2_Toplam = rowSums(select(., starts_with("WV")), na.rm = TRUE)
  )

head(veri$Boyut1_Toplam,20)
##  [1] 55 53 63 33 57 22 60 55 42 54 58 63 61 45 45 45 44 30 45 55
head(veri$Boyut2_Toplam,20)
##  [1] 104 112 105 111 112 111 118 109  98  87 116  91 121 108 102 113 101 111 107
## [20] 117

d.2. Toplam Puan Histogramları

ggplot(veri, aes(x = Boyut1_Toplam)) +
  geom_histogram(bins = 20, fill = "green", color = "black", alpha = 0.7) +
  labs(title = "Boyut1 Toplam Puan Dağılımı", x = "Toplam Puan", y = "Frekans") +
  theme_minimal()

ggplot(veri, aes(x = Boyut2_Toplam)) +
  geom_histogram(bins = 20, fill = "orange", color = "black", alpha = 0.7) +
  labs(title = "Boyut2 Toplam Puan Dağılımı", x = "Toplam Puan", y = "Frekans") +
  theme_minimal()

e. Boyut2 Referans Çizgisi ve SD Çizgileri

Boyut2 alt boyutunun toplam puan grafiğine ortalamadan bir dikey referans çizgisi çizdiriniz. Bu çizginin üstüne ortalama değerini yazdırınız. Ayrıca grafiğe ortalamanın bir standart sapma fazlası ve bir standart sapma azı olan noktalarda da birer referans çizgisi ekleyeniz. Bu çizgiler üzerine de açıklama ekleyiniz.

ortalama_boyut2 <- mean(veri$Boyut2_Toplam, na.rm = TRUE)
sd_boyut2 <- sd(veri$Boyut2_Toplam, na.rm = TRUE)



ggplot(veri, aes(x = Boyut2_Toplam)) +
  geom_histogram(bins = 20, fill = "orange", color = "black", alpha = 0.7) +
  geom_vline(xintercept = ortalama_boyut2, color = "blue", linetype = "solid", size = 1.2) +
  geom_vline(xintercept = ortalama_boyut2 + sd_boyut2, color = "black", linetype = "dashed", size = 1) +
  geom_vline(xintercept = ortalama_boyut2 - sd_boyut2, color = "black", linetype = "dashed", size = 1) +
  annotate("text", x = ortalama_boyut2, y = 10, label = paste("Ortalama:", round(ortalama_boyut2, 2)), 
           color = "blue", vjust = -1, fontface = "bold") +
  annotate("text", x = ortalama_boyut2 + sd_boyut2, y = 10, label = "+1 SD", 
           color = "black", vjust = -1) +
  annotate("text", x = ortalama_boyut2 - sd_boyut2, y = 10, label = "-1 SD", 
           color = "black", vjust = -1) +
  labs(title = "Boyut2 Toplam Puan Dağılımı", x = "Toplam Puan", y = "Frekans") +
  theme_minimal()
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

f. Uç Değerler

Her iki alt boyutu da uç değer açısından değerlendiriniz.

f.1. Tek Değişkenli Uç Değerler

Uç değerlerin bulunması için Z skorları hesaplanmış, kritik değer olarak -3/+3 değerleri referans alınmıştır. Elde edilen uç değerler z puanına göre bulunanlardır.

library(outliers)
## 
## Attaching package: 'outliers'
## The following object is masked from 'package:psych':
## 
##     outlier
z_scores <- scores(veri[, c("Boyut1_Toplam", "Boyut2_Toplam")], type = "z")

tek_degiskenli_uc_degerler <- veri[which(abs(z_scores[,1]) > 3 | abs(z_scores[,2]) > 3), ]

Uc_Degerler <- which(abs(z_scores[,1]) > 3 | abs(z_scores[,2]) > 3)
print("Tek Değişkenli Uç Değerler:")
## [1] "Tek Değişkenli Uç Değerler:"
print(Uc_Degerler)
## [1] 273

Ardından kutu grafiği ile değişkenlerin gösterimi gerçekleştirilmiştir.

boxplot(veri$Boyut1_Toplam, main = "Boyut1 Uç Değer Analizi", col = "green")

boxplot(veri$Boyut2_Toplam, main = "Boyut2 Uç Değer Analizi", col = "orange")

Boxplotları daha işe yarar hale getirmek istedim. İtiraf etmeliyim ki buradan sonrasında yapay zekanın payı büyük. Ama sonuç güzel oldu. En fazla uğraştıran kısım verinin üzerine 7eldiğinde satır numarasını görmek istemem oldu. Ekstra 10-15 dakika aldı diyebilirim.

Düzeltme: İlk halinde tek bir mavi noktada imleç, yalnıca bir satır numarası gösteriyordu. Örneğin 19 değeri için yalnızca 21. satırı işaret ediyordu. Bunu düzeltmek için bir fonksiyon gerekti fakat bunu ben yapamadım :) Ama sonuçtan memnunum. Bunu düzeltmem de ekstra bir 5-10 dakikamı aldı :)

outliers_boyut1 <- boxplot.stats(veri$Boyut1_Toplam)$out
outliers_index_boyut1 <- which(veri$Boyut1_Toplam %in% outliers_boyut1)

outliers_boyut2 <- boxplot.stats(veri$Boyut2_Toplam)$out
outliers_index_boyut2 <- which(veri$Boyut2_Toplam %in% outliers_boyut2)


combine_indices <- function(values, data_column) {
  sapply(values, function(v) {
    satirlar <- which(data_column == v) 
    paste("Satır No:", paste(satirlar, collapse = ", ")) 
  })
}

hover_text_boyut1 <- ifelse(veri$Boyut1_Toplam %in% outliers_boyut1, 
                            combine_indices(veri$Boyut1_Toplam, veri$Boyut1_Toplam), 
                            NA)

hover_text_boyut2 <- ifelse(veri$Boyut2_Toplam %in% outliers_boyut2, 
                            combine_indices(veri$Boyut2_Toplam, veri$Boyut2_Toplam), 
                            NA)

plot_ly(y = veri$Boyut1_Toplam, type = "box", name = "Boyut1",
        boxpoints = "outliers",
        text = hover_text_boyut1,  
        hoverinfo = "text") %>%
  layout(title = "Boyut1 Uç Değer Analizi")
plot_ly(y = veri$Boyut2_Toplam, type = "box", name = "Boyut2",
        boxpoints = "outliers",
        text = hover_text_boyut2,  
        hoverinfo = "text") %>%
  layout(title = "Boyut2 Uç Değer Analizi")

f.2. Çok Değişkenli Uç Değerler

Bu işlem için mahalanobis uzaklıklarını hesapladım.

veri_boyut <- veri[, c("Boyut1_Toplam", "Boyut2_Toplam")]

md <- mahalanobis(veri_boyut, center = colMeans(veri_boyut, na.rm = TRUE), 
                  cov = cov(veri_boyut))

head(md, 20)
##  [1] 0.3073774 0.5349603 1.5207201 2.8594245 0.7890880 6.9087666 2.1782412
##  [8] 0.3457912 0.7336680 4.0916247 1.5265835 4.4739275 3.1016067 0.2845978
## [15] 0.1840760 0.9676093 0.3005328 3.7736103 0.2133675 1.5403678

Kritik Değeri Belirleme

alpha <- 0.001

cutoff <- qchisq(p = 1 - alpha, df = ncol(veri_boyut))

cutoff
## [1] 13.81551

ÇD uç değerleri belirleme

cducdegerler <- which(md > cutoff)

print("Çok Değişkenli Uç Değerlerin Satır Numaraları:")
## [1] "Çok Değişkenli Uç Değerlerin Satır Numaraları:"
print(cducdegerler)
## integer(0)
veri[cducdegerler, ]

Tek değişkenli uç değerler hesaplandığında Boyut1de Z puanlarına göre 1, boxplotlara göre 9 uç değer olduğu görülmüştür. Boyut2’de tek değişkenli uç değer bulunmamaktadır. Verideki çok değişkenli uç değerler incelendiğinde herhangi bir uç veriye rastlanmamıştır.

Ödev toplamda 60 dakika kadar sürdü fakat bunun en az 20 dakikası Boyut1 için uç değer görselleştirme oldu. Ama fena da olmadı diye umuyorum :)

Öğrenme günlüklerini henüz yetiştiremedim hocam. İlk fırsatta tamamlamaya çalışacağım.