Ödev 3

1 a

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

odev3 <- read_excel("odev3.xlsx")
view(odev3)

colSums(is.na(odev3))

## Cinsiyet      SES      WV1      WV2      WV3      WV4      WV5      WV6 
##        0        0        0        0        0        0        0        0 
##      WV7      WV8      WV9     WV10     WV11     WV12     WV13     WV14 
##        0        0        0        0        0        0        0        0 
##     WV15     WV16 
##        0        0

331 gözlem ve 18 değişkenden oluşan “odev3” veri setinde eksik veri bulunmamaktadır.

2 b

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

table(odev3$Cinsiyet)

## 
##   1   2 
## 257  74

ggplot(odev3, aes(x = factor(Cinsiyet, labels=c("Kadın", "Erkek")))) +
  geom_bar(aes(fill= factor(Cinsiyet))) +
  labs(x = "Cinsiyet", y = "Frekans", title = "Cinsiyet Dağılımı") +
  theme_minimal()

table(odev3$SES)

## 
##   1   2   3 
##  18 262  51

ggplot(odev3, aes(x = factor(SES, labels=c("Düşük","Orta", "Yüksek")))) +
  geom_bar(aes(fill= factor(SES))) +
  labs(x = "SES", y = "Frekans", title = "SES Dağılımı") +
  theme_minimal()

Veri setinde 257 kadın, 74 erkek bulunmaktadır. Grubun 18’i düşük, 262’si orta ve 51’i yüksek sosyo-ekonomik düzeyde yer almaktadır.

3 c

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

Maddeler 7’li likert tipinde derecelendirilmiştir. Bu yüzden 7 + 1 den mevcut değer çıkarılırsa maddeler ters kodlanmış olur.

ters_kodla <- function(x) {
  8 - x
}

odev3 <- odev3 %>% 
mutate(across(WV1:WV9, ters_kodla, .names = "{col}_R"))

4 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.

boyut1 <- select(odev3, contains("_R")) 
boyut1_top <- rowSums(boyut1, na.rm = TRUE) 
head(boyut1_top)

## [1] 55 53 63 33 57 22

ggplot(odev3, aes(x = boyut1_top)) +
  geom_histogram(fill= "pink") +
  labs(title = "Boyut1 Toplam Puan Dağılımı", x = "Toplam Puan", y = "Frekans") +
  theme_minimal()

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

boyut2 <- select(odev3, num_range("WV", 10:16))
boyut2_top <- rowSums(boyut2, na.rm = TRUE)
head(boyut2_top)

## [1] 32 40 33 39 40 39

ggplot(odev3, aes(x = boyut2_top)) +
  geom_histogram(fill = "purple") +
  labs(title = "Boyut2 Toplam Puan Dağılımı", x = "Toplam Puan", y = "Frekans") +
  theme_minimal()

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

5 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.

boyut2_ort <- round(mean(rowSums(boyut2, na.rm=TRUE), na.rm=TRUE), digits = 2)
boyut2_sd <- round(sd(boyut2_top, na.rm = TRUE), digits= 2)


ggplot(odev3, aes(x = boyut2_top)) +
  geom_histogram(bins = 30, fill = "#69b3a2") + 
  geom_vline(xintercept = boyut2_ort, color = "red", linetype = "dashed") +
  annotate("text", label = expression(mu == 33.03), x = 10, y = 120) +
    geom_vline(xintercept = boyut2_ort + boyut2_sd, color = "purple", linetype = "dashed") +
    annotate("text", label = expression(mu + sigma == 42.86), x = 10, y = 110) +
      geom_vline(xintercept = boyut2_ort - boyut2_sd, color = "purple", linetype = "dashed") +
      annotate("text", label = expression(mu - sigma == 23.2), x = 10, y = 100) +
  theme_minimal()

## Warning in is.na(x): is.na() applied to non-(list or vector) of type
## 'expression'
## Warning in is.na(x): is.na() applied to non-(list or vector) of type
## 'expression'
## Warning in is.na(x): is.na() applied to non-(list or vector) of type
## 'expression'

6 f

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

library(summarytools)

## Warning: package 'summarytools' was built under R version 4.4.3

## 
## Attaching package: 'summarytools'

## The following object is masked from 'package:tibble':
## 
##     view

freq(boyut1, round.digits=2, report.nas= FALSE, style="rmarkdown")

## ### Frequencies  
## #### boyut1$WV1_R  
## **Type:** Numeric  
## 
## |      | Freq |      % | % Cum. |
## |----------:|-----:|-------:|-------:|
## |     **1** |   18 |   5.44 |   5.44 |
## |     **2** |   25 |   7.55 |  12.99 |
## |     **3** |   33 |   9.97 |  22.96 |
## |     **4** |   23 |   6.95 |  29.91 |
## |     **5** |   50 |  15.11 |  45.02 |
## |     **6** |   63 |  19.03 |  64.05 |
## |     **7** |  119 |  35.95 | 100.00 |
## | **Total** |  331 | 100.00 | 100.00 |
## 
## #### boyut1$WV2_R  
## **Type:** Numeric  
## 
## |      | Freq |      % | % Cum. |
## |----------:|-----:|-------:|-------:|
## |     **1** |    4 |   1.21 |   1.21 |
## |     **2** |   13 |   3.93 |   5.14 |
## |     **3** |   16 |   4.83 |   9.97 |
## |     **4** |   22 |   6.65 |  16.62 |
## |     **5** |   46 |  13.90 |  30.51 |
## |     **6** |   68 |  20.54 |  51.06 |
## |     **7** |  162 |  48.94 | 100.00 |
## | **Total** |  331 | 100.00 | 100.00 |
## 
## #### boyut1$WV3_R  
## **Type:** Numeric  
## 
## |      | Freq |      % | % Cum. |
## |----------:|-----:|-------:|-------:|
## |     **1** |   18 |   5.44 |   5.44 |
## |     **2** |   19 |   5.74 |  11.18 |
## |     **3** |   30 |   9.06 |  20.24 |
## |     **4** |   33 |   9.97 |  30.21 |
## |     **5** |   48 |  14.50 |  44.71 |
## |     **6** |   59 |  17.82 |  62.54 |
## |     **7** |  124 |  37.46 | 100.00 |
## | **Total** |  331 | 100.00 | 100.00 |
## 
## #### boyut1$WV4_R  
## **Type:** Numeric  
## 
## |      | Freq |      % | % Cum. |
## |----------:|-----:|-------:|-------:|
## |     **1** |   12 |   3.63 |   3.63 |
## |     **2** |   23 |   6.95 |  10.57 |
## |     **3** |   28 |   8.46 |  19.03 |
## |     **4** |   37 |  11.18 |  30.21 |
## |     **5** |   57 |  17.22 |  47.43 |
## |     **6** |   63 |  19.03 |  66.47 |
## |     **7** |  111 |  33.53 | 100.00 |
## | **Total** |  331 | 100.00 | 100.00 |
## 
## #### boyut1$WV5_R  
## **Type:** Numeric  
## 
## |      | Freq |      % | % Cum. |
## |----------:|-----:|-------:|-------:|
## |     **1** |   10 |   3.02 |   3.02 |
## |     **2** |   23 |   6.95 |   9.97 |
## |     **3** |   23 |   6.95 |  16.92 |
## |     **4** |   31 |   9.37 |  26.28 |
## |     **5** |   34 |  10.27 |  36.56 |
## |     **6** |   56 |  16.92 |  53.47 |
## |     **7** |  154 |  46.53 | 100.00 |
## | **Total** |  331 | 100.00 | 100.00 |
## 
## #### boyut1$WV6_R  
## **Type:** Numeric  
## 
## |      | Freq |      % | % Cum. |
## |----------:|-----:|-------:|-------:|
## |     **1** |   19 |   5.74 |   5.74 |
## |     **2** |   33 |   9.97 |  15.71 |
## |     **3** |   33 |   9.97 |  25.68 |
## |     **4** |   41 |  12.39 |  38.07 |
## |     **5** |   43 |  12.99 |  51.06 |
## |     **6** |   64 |  19.34 |  70.39 |
## |     **7** |   98 |  29.61 | 100.00 |
## | **Total** |  331 | 100.00 | 100.00 |
## 
## #### boyut1$WV7_R  
## **Type:** Numeric  
## 
## |      | Freq |      % | % Cum. |
## |----------:|-----:|-------:|-------:|
## |     **1** |   13 |   3.93 |   3.93 |
## |     **2** |   22 |   6.65 |  10.57 |
## |     **3** |   31 |   9.37 |  19.94 |
## |     **4** |   33 |   9.97 |  29.91 |
## |     **5** |   39 |  11.78 |  41.69 |
## |     **6** |   65 |  19.64 |  61.33 |
## |     **7** |  128 |  38.67 | 100.00 |
## | **Total** |  331 | 100.00 | 100.00 |
## 
## #### boyut1$WV8_R  
## **Type:** Numeric  
## 
## |      | Freq |      % | % Cum. |
## |----------:|-----:|-------:|-------:|
## |     **1** |    8 |   2.42 |   2.42 |
## |     **2** |   17 |   5.14 |   7.55 |
## |     **3** |    7 |   2.11 |   9.67 |
## |     **4** |   31 |   9.37 |  19.03 |
## |     **5** |   40 |  12.08 |  31.12 |
## |     **6** |   67 |  20.24 |  51.36 |
## |     **7** |  161 |  48.64 | 100.00 |
## | **Total** |  331 | 100.00 | 100.00 |
## 
## #### boyut1$WV9_R  
## **Type:** Numeric  
## 
## |      | Freq |      % | % Cum. |
## |----------:|-----:|-------:|-------:|
## |     **1** |    4 |   1.21 |   1.21 |
## |     **2** |   12 |   3.63 |   4.83 |
## |     **3** |   15 |   4.53 |   9.37 |
## |     **4** |   19 |   5.74 |  15.11 |
## |     **5** |   34 |  10.27 |  25.38 |
## |     **6** |   51 |  15.41 |  40.79 |
## |     **7** |  196 |  59.21 | 100.00 |
## | **Total** |  331 | 100.00 | 100.00 |

freq(boyut2, round.digits=2, report.nas= FALSE, style="rmarkdown")

## ### Frequencies  
## #### boyut2$WV10  
## **Type:** Numeric  
## 
## |      | Freq |      % | % Cum. |
## |----------:|-----:|-------:|-------:|
## |     **1** |   25 |   7.55 |   7.55 |
## |     **2** |   22 |   6.65 |  14.20 |
## |     **3** |   53 |  16.01 |  30.21 |
## |     **4** |   32 |   9.67 |  39.88 |
## |     **5** |   56 |  16.92 |  56.80 |
## |     **6** |   72 |  21.75 |  78.55 |
## |     **7** |   71 |  21.45 | 100.00 |
## | **Total** |  331 | 100.00 | 100.00 |
## 
## #### boyut2$WV11  
## **Type:** Numeric  
## 
## |      | Freq |      % | % Cum. |
## |----------:|-----:|-------:|-------:|
## |     **1** |   40 |  12.08 |  12.08 |
## |     **2** |   32 |   9.67 |  21.75 |
## |     **3** |   48 |  14.50 |  36.25 |
## |     **4** |   35 |  10.57 |  46.83 |
## |     **5** |   29 |   8.76 |  55.59 |
## |     **6** |   69 |  20.85 |  76.44 |
## |     **7** |   78 |  23.56 | 100.00 |
## | **Total** |  331 | 100.00 | 100.00 |
## 
## #### boyut2$WV12  
## **Type:** Numeric  
## 
## |      | Freq |      % | % Cum. |
## |----------:|-----:|-------:|-------:|
## |     **1** |   22 |   6.65 |   6.65 |
## |     **2** |   34 |  10.27 |  16.92 |
## |     **3** |   55 |  16.62 |  33.53 |
## |     **4** |   48 |  14.50 |  48.04 |
## |     **5** |   65 |  19.64 |  67.67 |
## |     **6** |   55 |  16.62 |  84.29 |
## |     **7** |   52 |  15.71 | 100.00 |
## | **Total** |  331 | 100.00 | 100.00 |
## 
## #### boyut2$WV13  
## **Type:** Numeric  
## 
## |      | Freq |      % | % Cum. |
## |----------:|-----:|-------:|-------:|
## |     **1** |   12 |   3.63 |   3.63 |
## |     **2** |   23 |   6.95 |  10.57 |
## |     **3** |   44 |  13.29 |  23.87 |
## |     **4** |   45 |  13.60 |  37.46 |
## |     **5** |   77 |  23.26 |  60.73 |
## |     **6** |   75 |  22.66 |  83.38 |
## |     **7** |   55 |  16.62 | 100.00 |
## | **Total** |  331 | 100.00 | 100.00 |
## 
## #### boyut2$WV14  
## **Type:** Numeric  
## 
## |      | Freq |      % | % Cum. |
## |----------:|-----:|-------:|-------:|
## |     **1** |    6 |   1.81 |   1.81 |
## |     **2** |   16 |   4.83 |   6.65 |
## |     **3** |   41 |  12.39 |  19.03 |
## |     **4** |   34 |  10.27 |  29.31 |
## |     **5** |   63 |  19.03 |  48.34 |
## |     **6** |   97 |  29.31 |  77.64 |
## |     **7** |   74 |  22.36 | 100.00 |
## | **Total** |  331 | 100.00 | 100.00 |
## 
## #### boyut2$WV15  
## **Type:** Numeric  
## 
## |      | Freq |      % | % Cum. |
## |----------:|-----:|-------:|-------:|
## |     **1** |   24 |   7.25 |   7.25 |
## |     **2** |   24 |   7.25 |  14.50 |
## |     **3** |   55 |  16.62 |  31.12 |
## |     **4** |   45 |  13.60 |  44.71 |
## |     **5** |   71 |  21.45 |  66.16 |
## |     **6** |   69 |  20.85 |  87.01 |
## |     **7** |   43 |  12.99 | 100.00 |
## | **Total** |  331 | 100.00 | 100.00 |
## 
## #### boyut2$WV16  
## **Type:** Numeric  
## 
## |      | Freq |      % | % Cum. |
## |----------:|-----:|-------:|-------:|
## |     **1** |   11 |   3.32 |   3.32 |
## |     **2** |   20 |   6.04 |   9.37 |
## |     **3** |   43 |  12.99 |  22.36 |
## |     **4** |   44 |  13.29 |  35.65 |
## |     **5** |   69 |  20.85 |  56.50 |
## |     **6** |   90 |  27.19 |  83.69 |
## |     **7** |   54 |  16.31 | 100.00 |
## | **Total** |  331 | 100.00 | 100.00 |

Boyut 1 ve 2’nin frekanslarına bakıldığında bir eşitsizlik görünmemektedir. Uç değerlerin tespiti için Z puan da kullanılmaktadır.

library(outliers)
z.scores1 <- boyut1 %>% 
  select(1:9) %>% 
  scores(type="z") %>% 
  round(2)
head(z.scores1)

##   WV1_R WV2_R WV3_R WV4_R WV5_R WV6_R WV7_R WV8_R WV9_R
## 1 -0.10  0.10 -0.14  1.00  0.81  0.55 -0.18  0.76  0.65
## 2 -1.68  0.10 -0.14  0.44  0.26  1.07  0.91  0.76  0.65
## 3  0.95  0.76  0.94  1.00  0.81  1.07  0.91  0.76  0.65
## 4 -1.68 -1.24 -0.67  0.44 -0.86 -1.52 -0.18 -2.37 -1.36
## 5  0.95  0.10  0.94  1.00 -0.30  0.55 -0.18  0.76  0.65
## 6 -1.68 -2.57 -1.21 -1.82 -1.41 -1.52 -1.27 -2.37 -2.04

summarytools::descr(z.scores1, stats= c("min", "max"),
transpose= TRUE, headings = FALSE)

## 
##                 Min    Max
## ----------- ------- ------
##       WV1_R   -2.21   0.95
##       WV2_R   -3.24   0.76
##       WV3_R   -2.29   0.94
##       WV4_R   -2.38   1.00
##       WV5_R   -2.52   0.81
##       WV6_R   -2.04   1.07
##       WV7_R   -2.36   0.91
##       WV8_R   -2.99   0.76
##       WV9_R   -3.38   0.65

z.scores2 <- boyut2 %>% 
  select(1:7) %>% 
  scores(type="z") %>% 
  round(2)
head(z.scores2)

##    WV10  WV11 WV12  WV13  WV14  WV15 WV16
## 1 -0.39 -0.24 0.32  0.12 -0.11 -0.28 0.07
## 2  1.20 -0.24 0.87  0.72  1.16  0.29 0.07
## 3 -1.45  1.18 0.32 -1.09  0.52  0.29 0.07
## 4  0.14  0.71 0.32  0.72 -0.11  0.86 0.68
## 5 -0.39  1.18 0.87  0.72  0.52  0.29 0.68
## 6  0.14  0.71 0.87  0.12 -0.11  0.86 0.68

summarytools::descr(z.scores2, stats= c("min", "max"),
transpose= TRUE, headings = FALSE)

## 
##                Min    Max
## ---------- ------- ------
##       WV10   -1.98   1.20
##       WV11   -1.67   1.18
##       WV12   -1.89   1.42
##       WV13   -2.30   1.33
##       WV14   -2.64   1.16
##       WV15   -1.99   1.43
##       WV16   -2.39   1.30

Maksimum ve minimum değerlere bakıldığında uç değerlerin olabileceğine dair kanıtlar bulunmaktadır.

out_boyut1 <- lapply(boyut1, function(x) boxplot.stats(x)$out)
out_boyut1

## $WV1_R
## numeric(0)
## 
## $WV2_R
## [1] 1 1 1 1
## 
## $WV3_R
## numeric(0)
## 
## $WV4_R
## numeric(0)
## 
## $WV5_R
## numeric(0)
## 
## $WV6_R
## numeric(0)
## 
## $WV7_R
## numeric(0)
## 
## $WV8_R
## [1] 1 1 1 1 1 1 1 1
## 
## $WV9_R
## [1] 1 1 1 1

out_ind <- lapply(boyut1, function(x) which(x %in% boxplot.stats(x)$out))
out_ind

## $WV1_R
## integer(0)
## 
## $WV2_R
## [1]  22  34 143 273
## 
## $WV3_R
## integer(0)
## 
## $WV4_R
## integer(0)
## 
## $WV5_R
## integer(0)
## 
## $WV6_R
## integer(0)
## 
## $WV7_R
## integer(0)
## 
## $WV8_R
## [1]  21  24  31  91 143 185 273 315
## 
## $WV9_R
## [1]  18 143 185 273

out_boyut2 <- lapply(boyut2, function(x) boxplot.stats(x)$out)
out_boyut2

## $WV10
## numeric(0)
## 
## $WV11
## numeric(0)
## 
## $WV12
## numeric(0)
## 
## $WV13
## numeric(0)
## 
## $WV14
## numeric(0)
## 
## $WV15
## numeric(0)
## 
## $WV16
## numeric(0)

out_ind2 <- lapply(boyut2, function(x) which(x %in% boxplot.stats(x)$out))
out_ind2

## $WV10
## integer(0)
## 
## $WV11
## integer(0)
## 
## $WV12
## integer(0)
## 
## $WV13
## integer(0)
## 
## $WV14
## integer(0)
## 
## $WV15
## integer(0)
## 
## $WV16
## integer(0)

library(psych)

## 
## Attaching package: 'psych'

## The following object is masked from 'package:outliers':
## 
##     outlier

## The following objects are masked from 'package:ggplot2':
## 
##     %+%, alpha

md1 <- mahalanobis(boyut1, center= colMeans(boyut1), cov=cov(boyut1))
head(md1,20)

##  [1]  5.328545  6.986309  1.884722 16.151021  5.941416  9.864063 10.671336
##  [8] 11.790125  2.791874  3.220032  6.372102  1.884722  4.704732 10.942032
## [15] 16.325549  7.844834 11.489983 25.955947 12.059893  3.249247

library(psych)
md2 <- mahalanobis(boyut2, center= colMeans(boyut2), cov=cov(boyut2))
head(md2,20)

##  [1]  1.0054198  4.1084815 12.2995775  2.6560229  3.2300599  3.3220265
##  [7]  8.3009085  6.4580832  3.1985340  6.4421969  2.0608597 10.0559697
## [13]  2.8699641  7.6880618 21.3756206  3.7424944 11.4823842 10.4322492
## [19]  0.4381649  2.5515231

alpha <- .001
cutoff1 <- (qchisq(p=1 - alpha, df= ncol(boyut1)))
cutoff1

## [1] 27.87716

alpha <- .001
cutoff2 <- (qchisq(p=1 - alpha, df= ncol(boyut2)))
cutoff2

## [1] 24.32189

ucdegerler1 <- which(md1 > cutoff1)
boyut1[ucdegerler1,]

## # A tibble: 13 × 9
##    WV1_R WV2_R WV3_R WV4_R WV5_R WV6_R WV7_R WV8_R WV9_R
##    <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
##  1     7     5     7     7     7     3     7     1     7
##  2     1     1     6     5     2     6     7     4     2
##  3     3     7     3     1     1     1     1     2     7
##  4     5     6     7     7     6     3     2     2     2
##  5     2     3     5     3     7     4     1     3     2
##  6     7     7     7     1     7     7     7     7     7
##  7     6     2     7     5     6     6     2     4     7
##  8     3     7     7     3     1     1     3     7     2
##  9     7     2     7     3     1     1     1     6     7
## 10     7     6     1     7     2     6     5     4     6
## 11     1     5     2     4     7     1     7     7     7
## 12     6     2     1     7     5     1     5     7     7
## 13     7     2     7     2     2     1     3     7     7

boyut1_temiz <- boyut1[-ucdegerler1,]


ucdegerler2 <- which(md2 > cutoff2)
boyut2[ucdegerler2,]

## # A tibble: 10 × 7
##     WV10  WV11  WV12  WV13  WV14  WV15  WV16
##    <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
##  1     3     7     7     5     5     1     1
##  2     7     1     7     5     6     1     7
##  3     7     3     2     6     2     7     5
##  4     5     7     1     1     3     1     7
##  5     1     7     1     7     7     7     7
##  6     6     7     1     6     7     3     3
##  7     1     1     1     7     2     2     1
##  8     5     2     1     5     7     1     5
##  9     7     7     7     7     7     1     3
## 10     3     1     5     5     5     1     7

b2_temiz <- boyut2[-ucdegerler2, ]