Sequential Fences

Data

Inisialisasi Library

library(readxl)
library(plotly)

## Warning: package 'plotly' was built under R version 4.3.2

## Loading required package: ggplot2

## 
## Attaching package: 'plotly'

## The following object is masked from 'package:ggplot2':
## 
##     last_plot

## The following object is masked from 'package:stats':
## 
##     filter

## The following object is masked from 'package:graphics':
## 
##     layout

Import Data

data <- read_xlsx("D:\\KULIAHH\\SEMESTER 4\\AED\\Data IPK Pariwisata.xlsx")
data

## # A tibble: 34 × 3
##    `Nomor Observasi` `Nama Provinsi`      `Indeks Pembangunan Kebudayaan`
##                <dbl> <chr>                                          <dbl>
##  1                 1 ACEH                                            53.0
##  2                 2 SUMATERA UTARA                                  52.5
##  3                 3 SUMATERA BARAT                                  56.9
##  4                 4 RIAU                                            58.5
##  5                 5 JAMBI                                           54.4
##  6                 6 SUMATERA SELATAN                                53.1
##  7                 7 BENGKULU                                        57.3
##  8                 8 LAMPUNG                                         55.7
##  9                 9 KEP. BANGKA BELITUNG                            54.0
## 10                10 KEPULAUAN RIAU                                  56.5
## # ℹ 24 more rows

Summary

summary(data$`Indeks Pembangunan Kebudayaan`)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   44.62   52.73   54.55   54.64   56.83   66.52

Sebaran Data

Uji Kenormalan

shapiro.test(data$`Indeks Pembangunan Kebudayaan`)

## 
##  Shapiro-Wilk normality test
## 
## data:  data$`Indeks Pembangunan Kebudayaan`
## W = 0.94725, p-value = 0.1015

\(H0:\) Data menyebar normal \(H1:\) Data menyebar tidak normal Kesimpulan: Karena p-value = 0.1015 > alpha = 0.05, maka tak tolak H0, sehingga data menyebar normal

QQ-Plot

qqnorm(data$`Indeks Pembangunan Kebudayaan`, col="#6699ff", pch=16,
       main="Normal QQ-Plot Indeks Pembangunan Kebudayaan
Tiap Provinsi di Indonesia")
qqline(data$`Indeks Pembangunan Kebudayaan`)

Data yang menyebar normal tersebut dapat dibuktikan melalui hasil QQ-Plot yang cenderung membentuk garis lurus

Boxplot

boxplot(data$`Indeks Pembangunan Kebudayaan`, horizontal = T,
        main = "Indeks Pembangunan Kebudayaan di Indonesia", col = "blue")

Dari boxplot tersebut terlihat bahwa terdapat 1 pencilan bawah dan 2 pencilan atas

Histogram

hist(data$`Indeks Pembangunan Kebudayaan`,
     main = "Indeks Pembangunan Kebudayaan (IPK) di Indonesia",
     ylab = "Frekuensi",
     xlab = "IPK",
     col = "#4499ee")

Hasil berbeda ditunjukkan pada histogram, yakni hanya ada pencilan atas pada range 65 sampai 70

Density Plot

densplot <- density(data$`Indeks Pembangunan Kebudayaan`, bw = 1)
plot(densplot, main = "Indeks Pembangunan Kebudayaan di Indonesia", col="skyblue", lwd = 2)
polygon(densplot, col = "skyblue", border = NA)

Density plot memberikan hasil yang sama seperti histogram, terlihat seperti ada dua bagian pada data ini

Sequential Fences

Tanpa Penyesuaian MS

Pembentukan Batas

n = nrow(data)
Q1 = quantile(data$`Indeks Pembangunan Kebudayaan`, 0.25)
Q2 = quantile(data$`Indeks Pembangunan Kebudayaan`, 0.5)
Q3 = quantile(data$`Indeks Pembangunan Kebudayaan`, 0.75)
IQR = Q3-Q1
kn = 1.33909
(df = 7.6809524+0.529415*n-0.00237*n^2)

## [1] 22.94134

m = c(1,2,3,4,5,6)
cm = c(0.0512932,0.355362,0.817691,1.35532,1.97015,2.61301)
alpha_nm = cm/n
t = qt(1-alpha_nm, df = df)
Lower = Q2-t*IQR/kn
Upper = Q2+t*IQR/kn
(tabel_fences1 <- data.frame(m,cm,alpha_nm,t,Lower,Upper))

##   m        cm    alpha_nm        t    Lower    Upper
## 1 1 0.0512932 0.001508624 3.316246 44.40257 64.69743
## 2 2 0.3553620 0.010451824 2.480264 46.96060 62.13940
## 3 3 0.8176910 0.024049735 2.087943 48.16108 60.93892
## 4 4 1.3553200 0.039862353 1.833573 48.93942 60.16058
## 5 5 1.9701500 0.057945588 1.634083 49.54985 59.55015
## 6 6 2.6130100 0.076853235 1.475371 50.03549 59.06451

Plot dengan Pagar Berurutan

ggplot(data) +
  geom_point(aes(y = `Indeks Pembangunan Kebudayaan`, x = `Nomor Observasi`),color="steelblue",size=2) +
  ggtitle("Sequential Fences Indeks Pembangunan Kebudayaan") +
  ylab("Nilai IPK") +
  xlab("Nomor Observasi")+
  theme_classic() +
  theme(plot.title = element_text(hjust = 0.5)) +
  ylim(43,68) +
  geom_hline(yintercept = tabel_fences1[1,5], linetype = "solid", color = "darkblue") +
  geom_hline(yintercept = tabel_fences1[1,6], linetype = "solid", color = "darkblue") +
  geom_hline(yintercept = tabel_fences1[2, 6], linetype = "solid", color = "red") +
  annotate("text", x = -Inf, y = tabel_fences1[1,5], label = "STOP (m=1)", vjust = 1.2, hjust = -6.8, color = "darkblue") +
  annotate("text", x = -Inf, y = tabel_fences1[1,6], label = "m=1", vjust = 1.2, hjust = -21, color = "darkblue") +
  annotate("text", x = -Inf, y = tabel_fences1[2, 6], label = "STOP (m=2)", vjust = 1.2, hjust = -6.8, color = "red")

Pada metode sequential fences yang pertama ini hanya digunakan garis m=1 untuk batas bawah karena sudah tidak ada titik pengamatan lain di bawah garis yang mengindikasi bahwa tidak ada pencilan bahwa. Untuk batas atas, terdapat dua titik pengamatan di atas garis m=1, sehingga dilanjutkan untuk garis batas atas m=2. Namun tidak ditemukan titik pengamatan lain di atas garis m=2 sehingga pagar batas tidak ditambah untuk m=3 dan seterusnya. Sehingga kesimpulan terdapat dua pencilan atas pada data ini.

Dengan Penyesuaian MS

Pembentukan Batas

mean = mean(data$`Indeks Pembangunan Kebudayaan`)
sd = sd(data$`Indeks Pembangunan Kebudayaan`)
(MS = (sum((data$`Indeks Pembangunan Kebudayaan`-mean)^3)/((n-1)*sd^3)))

## [1] 0.523455

Lower = Q2-(t+MS)*IQR/kn
Upper = Q2+(t+MS)*IQR/kn
(tabel_fences2 <- data.frame(m,cm,alpha_nm,t,Lower,Upper))

##   m        cm    alpha_nm        t    Lower    Upper
## 1 1 0.0512932 0.001508624 3.316246 42.80085 66.29915
## 2 2 0.3553620 0.010451824 2.480264 45.35888 63.74112
## 3 3 0.8176910 0.024049735 2.087943 46.55935 62.54065
## 4 4 1.3553200 0.039862353 1.833573 47.33770 61.76230
## 5 5 1.9701500 0.057945588 1.634083 47.94812 61.15188
## 6 6 2.6130100 0.076853235 1.475371 48.43377 60.66623

Plot dengan Pagar Berurutan

ggplot(data) +
  geom_point(aes(y = `Indeks Pembangunan Kebudayaan`, x = `Nomor Observasi`),color="steelblue",size=2) +
  ggtitle("Sequential Fences Indeks Pembangunan Kebudayaan") +
  ylab("Nilai IPK") +
  xlab("Nomor Observasi")+
  theme_classic() +
  theme(plot.title = element_text(hjust = 0.5)) +
  ylim(42,68) +
  geom_hline(yintercept = tabel_fences2[1,5], linetype = "solid", color = "darkblue") +
  geom_hline(yintercept = tabel_fences2[1,6], linetype = "solid", color = "darkblue") +
  geom_hline(yintercept = tabel_fences2[2, 6], linetype = "solid", color = "red") +
  geom_hline(yintercept = tabel_fences2[3, 6], linetype = "solid", color = "darkgreen") +
  annotate("text", x = -Inf, y = tabel_fences2[1,5], label = "STOP (m=1)", vjust = 1.2, hjust = -6.8, color = "darkblue") +
  annotate("text", x = -Inf, y = tabel_fences2[1,6], label = "m=1", vjust = 1.2, hjust = -21, color = "darkblue") +
  annotate("text", x = -Inf, y = tabel_fences2[2, 6], label = "m=2", vjust = 1, hjust = -21, color = "red") +
  annotate("text", x = -Inf, y = tabel_fences2[3, 6], label = "STOP (m=3)", vjust = 1.2, hjust = -6.8, color = "darkgreen")

Pada metode sequential fences yang kedua ini, dilakukan penyesuaian dengan memasukkan elemen MS (Measure of Skewness). Pada batas bawah hanya digunakan pagar garis m=1 (tidak terlihat karena berada di luar batas amatan) sehingga dipastikan tidak ada titik pengamatan di bawah garis tersebut. Batas atas pagar m=1 menyisakan satu amatan di atas garis tersebut sehingga dilanjutkan untuk pagar m=2. Pada garis m=2 maasih ditemukan satu amatan di atas garis tersebut sehingga dilanjutkan untuk pagar m=3 yang kemudian tidak ditemukan kembali amatan di atasnya. Sehingga dapat disimpulkan bahwa terdapat dua pencilan atas pada data ini.