Eksplorasi Data Harga Sewa Kos Mahasiswa IPB
RF
2021-01-13
Memanggil library
library(readxl)
library(ggplot2)
library(ggridges)
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(hrbrthemes)## NOTE: Either Arial Narrow or Roboto Condensed fonts are required to use these themes.## Please use hrbrthemes::import_roboto_condensed() to install Roboto Condensed and## if Arial Narrow is not on your system, please see https://bit.ly/arialnarrowlibrary(tidyr)
library(viridis)## Loading required package: viridisLitelibrary(RCurl)##
## Attaching package: 'RCurl'## The following object is masked from 'package:tidyr':
##
## completelibrary(MASS)##
## Attaching package: 'MASS'## The following object is masked from 'package:dplyr':
##
## selectMemanggil dataset dan data cleaning
datauts <-read_excel('D:/Semester5/AED/data UTS AED.xlsx')
datauts <- datauts[,-1]
colnames(datauts)## [1] "Jenis Kelamin" "harga sewa kos" "jarak ke kampus"
## [4] "strata pendidikan" "yang merekomendasikan" "ada teman satu daerah"
## [7] "tingkat kebersihan"colnames(datauts)<- c("JK", "Price", "Distance", "Education", "WhoRecommend", "Friends", "Cleanliness")
datauts## # A tibble: 80 × 7
## JK Price Distance Education WhoRecommend Friends Cleanliness
## <chr> <dbl> <dbl> <chr> <chr> <chr> <dbl>
## 1 Perempuan 410 2.3 S1 lainnya ya 4
## 2 Laki-Laki 210 8.8 S1 lainnya ya 3
## 3 Perempuan 590 0.4 S2 teman tidak 5
## 4 Laki-Laki 480 5.5 S1 kakak kelas ya 8
## 5 Laki-Laki 390 6.7 S2 kakak kelas ya 5
## 6 Laki-Laki 470 2.1 S2 teman ya 6
## 7 Laki-Laki 490 1.8 S1 teman ya 3
## 8 Perempuan 750 4.5 S2 kakak kelas tidak 6
## 9 Perempuan 560 8.1 S2 lainnya tidak 5
## 10 Perempuan 770 10 S3 kakak kelas tidak 8
## # ℹ 70 more rowsEksplorasi data
Density Plot
ggplot(datauts, aes(x = Price, y = Education, fill = Education)) +
geom_density_ridges() +
theme_ridges() +
theme(legend.position = "none")## Picking joint bandwidth of 65.2
Terlihat dari gambar di atas bahwa mahasiswa S2 dan S3 memilih kos dengan harga lebih tinggi daripada mahasiswa S1, dengan rata-rata harga sewa kos mahasiswa S2 dan S3 yang hampir sama disekitar 625 ribu rupiah dan rata-rata harga sewa kos mahasiswa S1 disekitar 400 ribu rupiah. Terlihat juga bahwa mahasiswa S1 memiliki keragaman harga sewa yang sedikit lebih besar daripada mahasiswa S2 dan S3. Namun, ada sekumpulan mahasiswa S1 yang memiliki kos dengan harga sewa yang hampir sama dengan mahasiswa S2 dan S3. Hal ini terjadi karena beberapa hal, seperti memiliki budget ‘sewa kos’ yang cukup besar, dan pendapatan yang berbeda.
ggplot(datauts, aes(x = Price, y = JK, fill = JK)) +
geom_density_ridges() +
theme_ridges() +
theme(legend.position = "none")## Picking joint bandwidth of 44.4
Terlihat dari gambar di atas bahwa rata-rata harga sewa kos mahasiswi (sekitar 625 ribu rupiah) lebih besar dari rata-rata harga sewa kos mahasiswa (sekitar 400 ribu rupiah). Namun, keragaman harga sewa kos mahasiswa (0-800 ribu rupiah) lebih besar dari keragaman harga sewa kos mahasiswi (250-900 ribu rupiah). Terlihat juga bahwa ada beberapa kelompok di kedua jenis kelamin, yang menunjukkan bahwa ada sekelompok mahasiswa yang memilih kos dengan harga sewa yang lebih mahal dari kelompok lainnya. Hal ini terjadi karena beberapa hal, seperti kualitas kos, budget ‘sewa kos’ yang berbeda, dan lain-lain.
Histogram
hist (datauts$Price,
main ='Histogram Harga Sewa Kos Mahasiswa ',
ylab = 'Frekuensi',
xlab = 'Harga Sewa Kos',
col = 'blue',
breaks = seq(max(datauts$Price), min(datauts$Price), length.out = 7+1))
Terlihat dari histogram diatas, bahwa harga sewa kos mahasiswa menyebar normal dengan rata-rata diantara 400-500 ribu rupiah. Terlihat ada 2 puncak di histogram ini, hal ini menunjukkan ada satu kelompok yang memiliki kos dengan harga sewa yang lebih besar dari kelompok mahasiswa lainnya.
Creating sub-dataset
laki2 <- (datauts$JK == "Laki-Laki")
dataLK <- datauts[laki2,]
perempuan <- (datauts$JK == "Perempuan")
dataPRP <- datauts[perempuan,]
S1 <- (datauts$Education == "S1")
dataS1 <- datauts[S1,]
S2 <- (datauts$Education == "S2")
dataS2 <- datauts[S2,]
S3 <- (datauts$Education == "S3")
dataS3 <- datauts[S3,]Trimmed mean
Mean_LK<-mean(dataLK$Price)
Mean_PRP<-mean(dataPRP$Price)
Mean_S1<-mean(dataS1$Price)
Mean_S2<-mean(dataS2$Price)
Mean_S3<-mean(dataS3$Price)
Trimmed_mean_LK <- mean(dataLK$Price, trim = 0.05)
Trimmed_mean_PRP <- mean(dataPRP$Price, trim = 0.05)
Trimmed_mean_S1 <- mean(dataS1$Price, trim = 0.05)
Trimmed_mean_S2 <- mean(dataS2$Price, trim = 0.05)
Trimmed_mean_S3 <- mean(dataS3$Price, trim = 0.05)
trimmean <-rbind(Trimmed_mean_LK, Trimmed_mean_PRP, Trimmed_mean_S1, Trimmed_mean_S2, Trimmed_mean_S3)
trimmean## [,1]
## Trimmed_mean_LK 408.1818
## Trimmed_mean_PRP 597.3171
## Trimmed_mean_S1 486.6667
## Trimmed_mean_S2 544.4000
## Trimmed_mean_S3 543.3333Winsorized mean
winsorMEAN <- function(x,probs=c(0.05,0.95)) {
xq <- quantile(x, probs = probs)
x[x < xq[1]] <- xq[1]
x[x > xq[2]] <- xq[2]
return(mean(x))
}
MeanWinsorLK<-winsorMEAN(dataLK$Price)
MeanWinsorPRP<-winsorMEAN(dataPRP$Price)
MeanWinsorS1<-winsorMEAN(dataS1$Price)
MeanWinsorS2<-winsorMEAN(dataS2$Price)
MeanWinsorS3<-winsorMEAN(dataS3$Price)
MeanWinsor <-rbind(MeanWinsorLK, MeanWinsorPRP, MeanWinsorS1, MeanWinsorS2, MeanWinsorS3)
MeanWinsor## [,1]
## MeanWinsorLK 408.8000
## MeanWinsorPRP 595.7778
## MeanWinsorS1 486.1316
## MeanWinsorS2 541.6296
## MeanWinsorS3 546.1333Terlihat bahwa nilai Trimmed Mean dan Winsorized Mean untuk setiap peubah tidak terlalu berbeda jauh. Maka, pemotongan data pada Trimmed Mean dan penggantian nilai terkecil dan terbesar pada Winsorized Mean memiliki dampak perubahan nilai Mean yang hampir sama.
Penduga-M Huber untuk rata-rata
HuberLK<-huber(dataLK$Price, k = 1.5, tol = 1e-06)
HuberPRP<-huber(dataPRP$Price, k = 1.5, tol = 1e-06)
HuberS1<-huber(dataS1$Price, k = 1.5, tol = 1e-06)
HuberS2<-huber(dataS2$Price, k = 1.5, tol = 1e-06)
HUberS3<-huber(dataS3$Price, k = 1.5, tol = 1e-06)
Huber <-rbind(HuberLK, HuberPRP, HuberS1, HuberS2, HUberS3)
Huber## mu s
## HuberLK 411.6622 88.956
## HuberPRP 600.0828 103.782
## HuberS1 487.6666 140.847
## HuberS2 548.4513 148.26
## HUberS3 555.4546 118.608Nilai yang didapat adalah nilai dugaan rata-rata harga sewa kos dengan penduga Huber. Terlihat bahwa nilai yang didapat cukup mendekati Mean yang didapat.
Simpangan baku robust
simp.baku.kekar.LK <- mad(dataLK$Price)
simp.baku.kekar.PRP <- mad(dataPRP$Price)
simp.baku.kekar.S1 <- mad(dataS1$Price)
simp.baku.kekar.S2 <- mad(dataS2$Price)
simp.baku.kekar.S3 <- mad(dataS3$Price)
simp.baku.kekar <-rbind(simp.baku.kekar.LK, simp.baku.kekar.PRP, simp.baku.kekar.S1, simp.baku.kekar.S2, simp.baku.kekar.S3)
simp.baku.kekar## [,1]
## simp.baku.kekar.LK 88.956
## simp.baku.kekar.PRP 103.782
## simp.baku.kekar.S1 140.847
## simp.baku.kekar.S2 148.260
## simp.baku.kekar.S3 118.608Setelah setiap peubah dihilangkan pencilannya, didapatkan nilai simpangan baku seperti di tabel. Terlihat bahwa mahasiswa S3 dan mahasiswa laki-laki memiliki keragaman harga sewa kos lebih kecil dari peubah lainnya.
Note : Proyek ini adalah bagian dari UTS mata kuliah Analisis Eksplorasi Data.