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

library(readxl)
data<- read_excel("D:/OLC_733/odev_3/odev3.xlsx") %>% 
  expss::drop_var_labs()
sum(is.na(data))
## [1] 0

Veri setimizde eksik veri olmadığı görünüyor.

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

library(dplyr)
library(ggplot2)
library(tidyverse)

data1 <- data %>%
  mutate(
    Cinsiyet = factor(Cinsiyet, levels = c(1, 2), labels = c("Kadin", "Erkek")),
    SES = factor(SES, levels = c(1, 2, 3), labels = c("Dusuk", "Orta", "Yuksek"))
  )

tablo <- data1 %>%
  count(Cinsiyet, SES) %>%
  arrange(desc(n))

print(tablo)
## # A tibble: 6 × 3
##   Cinsiyet SES        n
##   <fct>    <fct>  <int>
## 1 Kadin    Orta     206
## 2 Erkek    Orta      56
## 3 Kadin    Yuksek    38
## 4 Kadin    Dusuk     13
## 5 Erkek    Yuksek    13
## 6 Erkek    Dusuk      5
knitr::kable(table(data1$Cinsiyet),caption = "Cinsiyet Frekans Tablosu",format = "markdown")
Table 1: Cinsiyet Frekans Tablosu
Var1 Freq
Kadin 257
Erkek 74 
knitr::kable(table(data1$SES),caption = "SES Frekans Tablosu",format = "markdown")
Table 1: SES Frekans Tablosu
Var1 Freq
Dusuk 18
Orta 262
Yuksek 51 
ggplot(tablo, aes(x = SES, y = n, fill = Cinsiyet)) +
  geom_bar(stat = "identity", position = "dodge") +
  labs(title = "Cinsiyet ve SES Dagilimi",
       x = "SES (Sosyo-Ekonomik Statu)",
       y = "Frekans",
       fill = "Cinsiyet") +
  theme_minimal()

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

1’den 9’a kadar olan maddelerin cevapları 7’li kategorilendirilmiş. Bunlar olumsuz maddeler olduğuna göre ters kodlama yapmamız gerekiyor. Bunun için kategorilerdeki değerleri 8’den(maksimum değer+1) çıkartarak yeni kategori değerlerini belirlemeliyiz.

data2 <- data %>%
  mutate(across(c(3:11), ~ 8 - .))

head(data2)

d) 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.

data3 <- data2 %>% 
  mutate(
    b1_sum = rowSums(data2[,3:11]),
    b2_sum = rowSums(data2[, 12:18]))
ggplot(data3, aes(x = b1_sum)) +
  geom_histogram(binwidth = 5, fill = "blue", alpha = 0.7, color = "black") +
  labs(title = "Boyut1 Toplam Puan Dağılımı", x = "Toplam Puan", y = "Frekans") +
  theme_minimal()

ggplot(data3, aes(x = b2_sum)) +
  geom_histogram(binwidth = 5, fill = "red", alpha = 0.7, color = "black") +
  labs(title = "Boyut2 Toplam Puan Dağılımı", x = "Toplam Puan", y = "Frekans") +
  theme_minimal()

# e) 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.

b2_ort<- mean(data3$b2_sum, na.rm = TRUE)
b2_ort
## [1] 33.02719
b2_sd<- sd(data3$b2_sum, na.rm = TRUE)
b2_sd
## [1] 9.831729
ggplot(data3, aes(x = b2_sum)) +
  geom_histogram(bins = 30, fill = "pink",colour = "black") +
  geom_vline(xintercept = b2_ort,linetype = "solid",colour = "red",size=1)+
  annotate("text", label = expression(mu == 33.02), x = 30, y = 25) +
  geom_vline(xintercept = 33.02+9.83,linetype = "dashed",colour = "green",size=1)+
  annotate("text", label = expression(sigma == mu + 1), x = 33.02+9.83, y = 25) +
  geom_vline(xintercept = 33.02-9.83,linetype = "dashed",colour = "blue", size=1)+
  annotate("text", label = expression(sigma == mu - 1), x = 33.02-9.83, y = 25) +
  labs(title = "Boyut 2'deki Maddelerin Toplam Puan Grafiği ", x = "Toplam Puan", y = "Frekans") +
  theme_minimal()

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

Tek değişkenli uç değerler

library(outliers)
z_puanlari <- data3 %>%
  select(b1_sum, b2_sum) %>% 
  scores(type = "z") %>% round(2)
library(summarytools)
descr(z_puanlari,stats = c("min","max")) 
## Descriptive Statistics  
## z_puanlari  
## N: 331  
## 
##             b1_sum   b2_sum
## --------- -------- --------
##       Min    -3.48    -2.65
##       Max     1.20     1.62

z skoru kesme noktası [-3,3] alındığında boyut 1 için uç değer gözlenirken boyut 2 için uç değer gözlenmemiştir.

library(DT)
datatable(z_puanlari)

Kaç tane uç değer olduğunu anlayabilmek için veriyi tablolaştırdım ve burada boyu 1 için 1 adet uç değer olduğunu gördüm. Boyut 1 için ayrıca kutu bıyık grafiği çizdim.

library(ggplot2)

ggplot(data3, aes(x = "Boyut 1", y = b1_sum)) +
  geom_boxplot(fill = "blue", color = "black", outlier.color = "red", outlier.shape = 16, width = 0.3) +
  labs(title = "Boyut 1 Uc Degerler Kutu Grafigi", y = "Boyut 1 Puani")

## Çok değişkenli uç değerler

Çok değişkenli uç değerler için mahalanobis uzaklığına bakılır.

data4 <- data3[, c("b1_sum", "b2_sum")]

m <- mahalanobis(data4, center = colMeans(data4, na.rm = TRUE), 
                  cov = cov(data4))

head(m, 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 degeri belirleme

alpha <- 0.001

k_deger <- qchisq(p = 1 - alpha, df = ncol(data4))

k_deger
## [1] 13.81551
uc_deger <- which(m > k_deger)

print("Uc Degerlerin Satir Numaralari:")
## [1] "Uc Degerlerin Satir Numaralari:"
print(uc_deger)
## integer(0)
data3[uc_deger, ]

Tek değişkenli uç değerlere bakıldığında Boyut 1 için z puanlarına göre 1, kutu grafiğine göre 3 uç değer olduğu görülmüştür. Boyut 2’de tek değişkenli uç değer görülmemiştir Verideki çok değişkenli uç değerler incelendiğinde herhangi bir uç değer görülmemiştir.

Ödev 2 saatimi aldı, görselleştirmelerde kutu grafiklerine baya uğraştım ancak istediğim gibi olmadı.

Öğrenme günlüklerini bu hafta içerisinde yükleyeceğim hocam.