K-modes clustering data kemiskinan Kab. Sidoarjo
Farhan Adham Irawan
Mei 22, 2021
1 Intro
Kita akan mencoba melakukan analisis klasifikasi penerima bantuan sosial Program Keluarga Harapan (PKH) dengan harapan mengetahui letak kesalahan program ini dikarenakan banyak sekali laporan Ombudsman yang menyatakan jika program ini banyak yang salah sasaran / tidak tepat pendistribusiannya.
Data yang digunakan adalah data yang berasal dari Data terpadu kesejahteraan sosial, dimana data ini sangat sensitif sehingga pada kesempatan kali ini saya hanya akan menampilkan nya saja.
2 Library & Setup
library(tidyverse)
library(FactoMineR)
library(factoextra)
library(klaR)
data = read.csv("dataset.lbb7.csv")
head(data,10)str(data)## 'data.frame': 3796 obs. of 56 variables:
## $ IDBDT : Factor w/ 6 levels "351504001*******",..: 2 2 2 2 2 2 2 2 2 2 ...
## $ Jumlah_ART : int 3 5 4 3 1 4 4 4 3 5 ...
## $ Jumlah_Keluarga : int 1 2 1 1 1 1 1 1 1 1 ...
## $ sta_bangunan : int 1 1 1 1 1 1 1 1 1 1 ...
## $ sta_lahan : int 1 1 1 1 1 1 1 1 1 1 ...
## $ luas_lantai : num 36 75 48 36 32 80 100 24 75 28 ...
## $ lantai : int 2 2 4 2 2 2 2 4 4 4 ...
## $ dinding : int 1 1 1 1 1 1 1 1 1 1 ...
## $ kondisi_dinding : int 1 2 2 2 2 1 2 2 2 2 ...
## $ atap : int 4 4 4 4 4 4 4 5 4 4 ...
## $ kondisi_atap : int 2 1 2 2 2 1 2 2 2 2 ...
## $ jumlah_kamar : int 3 2 2 1 2 2 3 1 4 3 ...
## $ sumber_airminum : int 8 8 8 8 8 8 8 8 8 8 ...
## $ cara_peroleh_airminum: int 1 1 1 1 1 1 1 1 1 1 ...
## $ sumber_penerangan : int 1 1 1 1 1 1 1 1 1 1 ...
## $ daya : int 1 2 1 1 1 2 2 2 1 1 ...
## $ bb_masak : int 3 3 3 3 3 3 3 3 3 3 ...
## $ fasbab : int 4 1 4 4 1 1 1 1 1 4 ...
## $ kloset : int 2 1 4 4 1 1 1 1 1 2 ...
## $ buang_tinja : int 3 1 4 4 1 1 1 1 1 3 ...
## $ ada_tabung_gas : int 2 2 2 2 2 2 2 2 2 2 ...
## $ ada_lemari_es : int 3 3 3 3 3 3 3 3 3 3 ...
## $ ada_ac : int 2 2 2 2 2 2 2 2 2 2 ...
## $ ada_pemanas : int 4 4 4 4 4 4 4 4 4 4 ...
## $ ada_telepon : int 2 2 2 2 2 2 2 2 2 2 ...
## $ ada_tv : int 3 3 3 3 3 3 3 3 3 3 ...
## $ ada_emas : int 2 2 2 2 2 2 2 2 2 2 ...
## $ ada_laptop : int 4 4 4 4 4 4 4 4 4 4 ...
## $ ada_sepeda : int 1 2 1 1 2 1 1 1 1 1 ...
## $ ada_motor : int 4 3 3 3 4 3 3 3 3 3 ...
## $ ada_mobil : int 2 2 2 2 2 2 2 2 2 2 ...
## $ ada_perahu : int 4 4 4 4 4 4 4 4 4 4 ...
## $ ada_motor_tempel : int 2 2 2 2 2 2 2 2 2 2 ...
## $ ada_perahu_motor : int 4 4 4 4 4 4 4 4 4 4 ...
## $ ada_kapal : int 2 2 2 2 2 2 2 2 2 2 ...
## $ aset_tak_bergerak : int 1 1 1 1 1 1 1 1 1 1 ...
## $ luas_atb : int 40 80 54 45 40 90 125 36 90 45 ...
## $ rumah_lain : int 4 4 4 4 4 3 4 4 4 4 ...
## $ jumlah_sapi : int 0 0 0 0 0 0 0 0 0 0 ...
## $ jumlah_kerbau : int 0 0 0 0 0 0 0 0 0 0 ...
## $ jumlah_kuda : int 0 0 0 0 0 0 0 0 0 0 ...
## $ jumlah_babi : int 0 0 0 0 0 0 0 0 0 0 ...
## $ jumlah_kambing : int 0 0 0 0 0 0 0 0 0 0 ...
## $ sta_art_usaha : int 2 2 2 1 2 2 2 1 2 1 ...
## $ sta_kks : int 1 1 1 1 1 2 2 1 1 1 ...
## $ sta_kip : int 3 4 4 4 4 4 4 4 4 4 ...
## $ sta_kis : int 1 1 1 1 1 2 1 1 1 1 ...
## $ sta_bpjs_mandiri : int 4 4 4 4 4 4 4 4 4 4 ...
## $ sta_jamsostek : int 2 2 2 2 2 2 2 2 2 2 ...
## $ sta_asuransi : int 4 4 4 4 4 4 4 4 4 4 ...
## $ sta_pkh : int 1 2 2 2 2 2 2 1 2 2 ...
## $ sta_rastra : int 3 3 3 3 3 4 4 3 3 3 ...
## $ sta_kur : int 2 2 2 2 2 2 2 2 2 2 ...
## $ sta_keberadaan_RT : int 0 0 0 0 0 0 0 0 0 0 ...
## $ percentile : int 4 25 21 32 29 48 21 34 15 9 ...
## $ penerima : Factor w/ 2 levels "tidak","ya": 2 1 1 1 1 1 1 2 2 2 ...Terdapat 56 Variabel dalam data tersebut, yang tidak mungkin untuk saya jelaskan satu persatu, namun isi dari variabel tersebut setidaknya dapat diketahui maknanya berdasarkan nama variabel
3 Data Preprocessing
Kita akan mencoba melihat apakah terdapat nilai NA dalam data tersebut
anyNA(data)## [1] TRUEcolSums(is.na(data))## IDBDT Jumlah_ART Jumlah_Keluarga
## 0 0 0
## sta_bangunan sta_lahan luas_lantai
## 0 0 0
## lantai dinding kondisi_dinding
## 0 0 0
## atap kondisi_atap jumlah_kamar
## 0 0 0
## sumber_airminum cara_peroleh_airminum sumber_penerangan
## 0 0 0
## daya bb_masak fasbab
## 0 0 0
## kloset buang_tinja ada_tabung_gas
## 0 0 0
## ada_lemari_es ada_ac ada_pemanas
## 0 0 0
## ada_telepon ada_tv ada_emas
## 0 0 0
## ada_laptop ada_sepeda ada_motor
## 0 0 0
## ada_mobil ada_perahu ada_motor_tempel
## 0 0 0
## ada_perahu_motor ada_kapal aset_tak_bergerak
## 0 0 0
## luas_atb rumah_lain jumlah_sapi
## 270 0 0
## jumlah_kerbau jumlah_kuda jumlah_babi
## 0 0 0
## jumlah_kambing sta_art_usaha sta_kks
## 0 0 0
## sta_kip sta_kis sta_bpjs_mandiri
## 0 0 0
## sta_jamsostek sta_asuransi sta_pkh
## 0 0 0
## sta_rastra sta_kur sta_keberadaan_RT
## 0 0 0
## percentile penerima
## 0 0Terdapat nilai NA sebanyak 270 pada variabel luas_atb, kita akan mencoba mengatasi nya dengan mengisi nilai NA tersebut dengan Mean / Median. Tapi sebelum itu kita harus melihat terlebih dahulu persebaran datanya
boxplot(data$luas_atb)
Banyak sekali nilai outlier dalam variabel tersebut, sehingga saya memutuskan untuk menggunakan nilai median ketimbang mean
data[is.na(data$luas_atb),]$luas_atb = median(data$luas_atb, na.rm = T)
anyNA(data)## [1] FALSEData kosong pada variabel tersebut telah berhasil diatasi, langkah selanjutnya adalah melihat apakah format dari tiap masing masing variabel sudah benar atau belum
str(data)## 'data.frame': 3796 obs. of 56 variables:
## $ IDBDT : Factor w/ 6 levels "351504001*******",..: 2 2 2 2 2 2 2 2 2 2 ...
## $ Jumlah_ART : int 3 5 4 3 1 4 4 4 3 5 ...
## $ Jumlah_Keluarga : int 1 2 1 1 1 1 1 1 1 1 ...
## $ sta_bangunan : int 1 1 1 1 1 1 1 1 1 1 ...
## $ sta_lahan : int 1 1 1 1 1 1 1 1 1 1 ...
## $ luas_lantai : num 36 75 48 36 32 80 100 24 75 28 ...
## $ lantai : int 2 2 4 2 2 2 2 4 4 4 ...
## $ dinding : int 1 1 1 1 1 1 1 1 1 1 ...
## $ kondisi_dinding : int 1 2 2 2 2 1 2 2 2 2 ...
## $ atap : int 4 4 4 4 4 4 4 5 4 4 ...
## $ kondisi_atap : int 2 1 2 2 2 1 2 2 2 2 ...
## $ jumlah_kamar : int 3 2 2 1 2 2 3 1 4 3 ...
## $ sumber_airminum : int 8 8 8 8 8 8 8 8 8 8 ...
## $ cara_peroleh_airminum: int 1 1 1 1 1 1 1 1 1 1 ...
## $ sumber_penerangan : int 1 1 1 1 1 1 1 1 1 1 ...
## $ daya : int 1 2 1 1 1 2 2 2 1 1 ...
## $ bb_masak : int 3 3 3 3 3 3 3 3 3 3 ...
## $ fasbab : int 4 1 4 4 1 1 1 1 1 4 ...
## $ kloset : int 2 1 4 4 1 1 1 1 1 2 ...
## $ buang_tinja : int 3 1 4 4 1 1 1 1 1 3 ...
## $ ada_tabung_gas : int 2 2 2 2 2 2 2 2 2 2 ...
## $ ada_lemari_es : int 3 3 3 3 3 3 3 3 3 3 ...
## $ ada_ac : int 2 2 2 2 2 2 2 2 2 2 ...
## $ ada_pemanas : int 4 4 4 4 4 4 4 4 4 4 ...
## $ ada_telepon : int 2 2 2 2 2 2 2 2 2 2 ...
## $ ada_tv : int 3 3 3 3 3 3 3 3 3 3 ...
## $ ada_emas : int 2 2 2 2 2 2 2 2 2 2 ...
## $ ada_laptop : int 4 4 4 4 4 4 4 4 4 4 ...
## $ ada_sepeda : int 1 2 1 1 2 1 1 1 1 1 ...
## $ ada_motor : int 4 3 3 3 4 3 3 3 3 3 ...
## $ ada_mobil : int 2 2 2 2 2 2 2 2 2 2 ...
## $ ada_perahu : int 4 4 4 4 4 4 4 4 4 4 ...
## $ ada_motor_tempel : int 2 2 2 2 2 2 2 2 2 2 ...
## $ ada_perahu_motor : int 4 4 4 4 4 4 4 4 4 4 ...
## $ ada_kapal : int 2 2 2 2 2 2 2 2 2 2 ...
## $ aset_tak_bergerak : int 1 1 1 1 1 1 1 1 1 1 ...
## $ luas_atb : num 40 80 54 45 40 90 125 36 90 45 ...
## $ rumah_lain : int 4 4 4 4 4 3 4 4 4 4 ...
## $ jumlah_sapi : int 0 0 0 0 0 0 0 0 0 0 ...
## $ jumlah_kerbau : int 0 0 0 0 0 0 0 0 0 0 ...
## $ jumlah_kuda : int 0 0 0 0 0 0 0 0 0 0 ...
## $ jumlah_babi : int 0 0 0 0 0 0 0 0 0 0 ...
## $ jumlah_kambing : int 0 0 0 0 0 0 0 0 0 0 ...
## $ sta_art_usaha : int 2 2 2 1 2 2 2 1 2 1 ...
## $ sta_kks : int 1 1 1 1 1 2 2 1 1 1 ...
## $ sta_kip : int 3 4 4 4 4 4 4 4 4 4 ...
## $ sta_kis : int 1 1 1 1 1 2 1 1 1 1 ...
## $ sta_bpjs_mandiri : int 4 4 4 4 4 4 4 4 4 4 ...
## $ sta_jamsostek : int 2 2 2 2 2 2 2 2 2 2 ...
## $ sta_asuransi : int 4 4 4 4 4 4 4 4 4 4 ...
## $ sta_pkh : int 1 2 2 2 2 2 2 1 2 2 ...
## $ sta_rastra : int 3 3 3 3 3 4 4 3 3 3 ...
## $ sta_kur : int 2 2 2 2 2 2 2 2 2 2 ...
## $ sta_keberadaan_RT : int 0 0 0 0 0 0 0 0 0 0 ...
## $ percentile : int 4 25 21 32 29 48 21 34 15 9 ...
## $ penerima : Factor w/ 2 levels "tidak","ya": 2 1 1 1 1 1 1 2 2 2 ...Ada beberapa variabel yang mengandung kata Jumlah, hal tersebut sebaiknya diubah dahulu kedalam bentuk numerik
names(data)[grepl(pattern = "jumlah",
names(data), ignore.case = T)] -> nama_num
nama_num## [1] "Jumlah_ART" "Jumlah_Keluarga" "jumlah_kamar" "jumlah_sapi"
## [5] "jumlah_kerbau" "jumlah_kuda" "jumlah_babi" "jumlah_kambing"data[nama_num] = apply(data[nama_num],2,as.numeric) Seluruh data yang berformat int sebaiknya dirubah ke bentuk factor semuanya
data %>%
mutate_if(is.integer, as.factor) -> dataSetelah itu kita akan menghilangkan beberapa variabel yang tidak diperlukan saat proses clustering
data %>%
dplyr::select(-c(IDBDT,percentile,penerima)) -> data_newKarena beberapa pertimbangan, mengingat hampir seluruh variabel merupakan categorical, maka saya memutuskan untuk mengubah beberapa variabel numeric kedalam bentuk categorical
summary(data_new$luas_lantai)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.00 40.00 50.00 54.43 65.00 606.00Kita akan membagi nilai tersebut kedalam 3 jenis Kategori yakni dibawah nilai quartile 1, median, serta diatas quartile 3
bins <- c(-Inf, 40, 65, Inf)
bin_names <- c("Low", "Mid50", "High")
data_new$luas_lantai <- cut(data_new$luas_lantai,
breaks = bins,
labels = bin_names)Selanjutnya terhadap variabel luas_atb
summary(data_new$luas_atb)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.00 50.00 62.00 77.27 84.00 3556.00bins <- c(-Inf, 50, 85, Inf)
bin_names <- c("Low", "Mid50", "High")
data_new$luas_atb <- cut(data_new$luas_atb,
breaks = bins,
labels = bin_names)Untuk mempermudah mengetahui mana saja variabel numeric dan variabel categorical, maka kita akan membuat list tentang tipe data beserta nomor urutnya
a = NULL
for(i in seq(ncol(data_new))) {
b <- data.frame(num = i, type = typeof(data_new[,i]))
a = rbind(a,b)
}
head(a)Lalu langkah selanjutnya kita akan menjadikan kolom dengan tipe numeric menjadi kolom dengan urutan awal pada dataset kita
data_new %>%
dplyr::select(
a %>%
filter(type == "double") %>%
dplyr::select(num) %>%
unlist() %>%
as.numeric() ,
a %>%
filter(type == "integer") %>%
dplyr::select(num) %>%
unlist() %>%
as.numeric()
) -> data_new4 Clustering
Karena mayoritas variabel yang terdapa dalam data_new merupakan variabel categorical maka Algoritma Unsupervised Learning yang digunakan ialah K-modes.
Untuk pembagian cluster kali ini, saya hanya akan membagi 2 kelas saja, hal ini sesuai dengan jumlah levels kolom penerima pada data asli yang terdiri dari 2 level saja, “ya” & “tidak”
clust <- kmodes(data_new, modes = 2, iter.max = 10)Lalu kita simpan hasil clustering tersebut kedalam data
data$clustering = clust$cluster
head(data$clustering)## [1] 2 1 2 2 2 1Output nya berupa 1 & 2, sedangkan seharusnya berupa “ya” & “tidak”, kita akan mengubah angka 1 & 2 menjadi “ya” & “tidak”, namun sebelum itu kita harus mengetahui terlebih dahulu angka 1 mewakili “ya” atau mewakili “tidak”
data.frame(numb = as.numeric(unique(data$penerima)),
type = unique(data$penerima))Ternyata angka 1 adalah “tidak” sedangkan angka 2 adalah “ya”
data$clustering = factor(data$clustering,
levels = c(1,2),
labels = c("tidak","ya"))5 MCA
Analisis korespondensi berganda (MCA) adalah perpanjangan dari analisis korespondensi sederhana untuk meringkas dan memvisualisasikan tabel data yang berisi lebih dari dua variabel kategori. Ini juga dapat dilihat sebagai generalisasi dari analisis komponen utama ketika variabel yang akan dianalisis bersifat kategorik dan bukan kuantitatif (Abdi dan Williams 2010).
MCA umumnya digunakan untuk menganalisis kumpulan data dari survei. Tujuannya adalah untuk mengidentifikasi:
> Sekelompok individu dengan profil serupa dalam jawaban mereka atas pertanyaan
> Asosiasi antara kategori variabel
5.1 Dimensionality Reduction
Pada tahap ini kita akan melakukan dimention reduction menggunakan metode Multipe Correspondence Analysis untuk mereduksi variabel kategori dalam \(datanew\)
poke_mca <- MCA(X = data_new,
quanti.sup = 1:8,
graph = F,
ncp = 20)
summary(poke_mca)##
## Call:
## MCA(X = data_new, ncp = 20, quanti.sup = 1:8, graph = F)
##
##
## Eigenvalues
## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5 Dim.6 Dim.7
## Variance 0.750 0.091 0.070 0.058 0.051 0.048 0.045
## % of var. 25.768 3.122 2.391 2.001 1.768 1.658 1.563
## Cumulative % of var. 25.768 28.890 31.281 33.281 35.049 36.708 38.271
## Dim.8 Dim.9 Dim.10 Dim.11 Dim.12 Dim.13 Dim.14
## Variance 0.043 0.040 0.038 0.037 0.035 0.033 0.033
## % of var. 1.461 1.375 1.298 1.267 1.202 1.150 1.123
## Cumulative % of var. 39.732 41.107 42.405 43.673 44.875 46.025 47.147
## Dim.15 Dim.16 Dim.17 Dim.18 Dim.19 Dim.20 Dim.21
## Variance 0.031 0.030 0.029 0.029 0.029 0.028 0.028
## % of var. 1.058 1.026 1.013 1.004 0.993 0.964 0.945
## Cumulative % of var. 48.205 49.230 50.243 51.247 52.241 53.204 54.149
## Dim.22 Dim.23 Dim.24 Dim.25 Dim.26 Dim.27 Dim.28
## Variance 0.027 0.027 0.026 0.026 0.026 0.026 0.025
## % of var. 0.928 0.921 0.906 0.899 0.895 0.878 0.862
## Cumulative % of var. 55.077 55.998 56.904 57.804 58.698 59.577 60.439
## Dim.29 Dim.30 Dim.31 Dim.32 Dim.33 Dim.34 Dim.35
## Variance 0.025 0.025 0.024 0.024 0.024 0.024 0.023
## % of var. 0.855 0.849 0.838 0.819 0.815 0.808 0.800
## Cumulative % of var. 61.294 62.143 62.981 63.801 64.616 65.424 66.223
## Dim.36 Dim.37 Dim.38 Dim.39 Dim.40 Dim.41 Dim.42
## Variance 0.023 0.023 0.023 0.023 0.022 0.022 0.022
## % of var. 0.791 0.783 0.781 0.773 0.769 0.766 0.763
## Cumulative % of var. 67.014 67.797 68.579 69.352 70.121 70.887 71.651
## Dim.43 Dim.44 Dim.45 Dim.46 Dim.47 Dim.48 Dim.49
## Variance 0.022 0.022 0.022 0.022 0.022 0.021 0.021
## % of var. 0.759 0.755 0.751 0.748 0.741 0.733 0.730
## Cumulative % of var. 72.409 73.164 73.915 74.663 75.404 76.137 76.867
## Dim.50 Dim.51 Dim.52 Dim.53 Dim.54 Dim.55 Dim.56
## Variance 0.021 0.021 0.021 0.020 0.020 0.020 0.020
## % of var. 0.722 0.717 0.708 0.696 0.686 0.682 0.673
## Cumulative % of var. 77.589 78.306 79.014 79.710 80.396 81.078 81.751
## Dim.57 Dim.58 Dim.59 Dim.60 Dim.61 Dim.62 Dim.63
## Variance 0.019 0.019 0.019 0.018 0.018 0.018 0.018
## % of var. 0.667 0.652 0.643 0.635 0.632 0.622 0.617
## Cumulative % of var. 82.418 83.070 83.713 84.348 84.980 85.602 86.219
## Dim.64 Dim.65 Dim.66 Dim.67 Dim.68 Dim.69 Dim.70
## Variance 0.018 0.018 0.017 0.017 0.017 0.016 0.016
## % of var. 0.615 0.605 0.596 0.581 0.570 0.564 0.561
## Cumulative % of var. 86.834 87.439 88.034 88.616 89.186 89.749 90.310
## Dim.71 Dim.72 Dim.73 Dim.74 Dim.75 Dim.76 Dim.77
## Variance 0.016 0.016 0.016 0.015 0.015 0.014 0.014
## % of var. 0.555 0.535 0.534 0.528 0.515 0.493 0.488
## Cumulative % of var. 90.865 91.400 91.935 92.463 92.978 93.471 93.959
## Dim.78 Dim.79 Dim.80 Dim.81 Dim.82 Dim.83 Dim.84
## Variance 0.014 0.013 0.013 0.013 0.013 0.013 0.012
## % of var. 0.466 0.456 0.454 0.448 0.442 0.430 0.419
## Cumulative % of var. 94.425 94.881 95.335 95.782 96.224 96.654 97.073
## Dim.85 Dim.86 Dim.87 Dim.88 Dim.89 Dim.90 Dim.91
## Variance 0.012 0.012 0.010 0.009 0.007 0.007 0.006
## % of var. 0.405 0.404 0.355 0.315 0.257 0.239 0.219
## Cumulative % of var. 97.479 97.883 98.238 98.554 98.810 99.049 99.268
## Dim.92 Dim.93 Dim.94 Dim.95 Dim.96 Dim.97 Dim.98
## Variance 0.006 0.005 0.004 0.003 0.002 0.002 0.000
## % of var. 0.198 0.159 0.127 0.094 0.082 0.056 0.016
## Cumulative % of var. 99.465 99.625 99.752 99.846 99.928 99.984 100.000
## Dim.99 Dim.100 Dim.101 Dim.102 Dim.103 Dim.104 Dim.105
## Variance 0.000 0.000 0.000 0.000 0.000 0.000 0.000
## % of var. 0.000 0.000 0.000 0.000 0.000 0.000 0.000
## Cumulative % of var. 100.000 100.000 100.000 100.000 100.000 100.000 100.000
## Dim.106 Dim.107 Dim.108 Dim.109 Dim.110 Dim.111 Dim.112
## Variance 0.000 0.000 0.000 0.000 0.000 0.000 0.000
## % of var. 0.000 0.000 0.000 0.000 0.000 0.000 0.000
## Cumulative % of var. 100.000 100.000 100.000 100.000 100.000 100.000 100.000
## Dim.113 Dim.114 Dim.115 Dim.116 Dim.117 Dim.118 Dim.119
## Variance 0.000 0.000 0.000 0.000 0.000 0.000 0.000
## % of var. 0.000 0.000 0.000 0.000 0.000 0.000 0.000
## Cumulative % of var. 100.000 100.000 100.000 100.000 100.000 100.000 100.000
## Dim.120 Dim.121 Dim.122 Dim.123 Dim.124 Dim.125 Dim.126
## Variance 0.000 0.000 0.000 0.000 0.000 0.000 0.000
## % of var. 0.000 0.000 0.000 0.000 0.000 0.000 0.000
## Cumulative % of var. 100.000 100.000 100.000 100.000 100.000 100.000 100.000
## Dim.127 Dim.128 Dim.129 Dim.130 Dim.131
## Variance 0.000 0.000 0.000 0.000 0.000
## % of var. 0.000 0.000 0.000 0.000 0.000
## Cumulative % of var. 100.000 100.000 100.000 100.000 100.000
##
## Individuals (the 10 first)
## Dim.1 ctr cos2 Dim.2 ctr cos2 Dim.3 ctr
## 1 | -0.099 0.000 0.001 | 0.220 0.014 0.006 | -0.204 0.016
## 2 | -0.106 0.000 0.018 | -0.284 0.023 0.131 | -0.098 0.004
## 3 | -0.056 0.000 0.004 | 0.312 0.028 0.112 | -0.496 0.093
## 4 | -0.054 0.000 0.003 | 0.326 0.031 0.112 | -0.409 0.063
## 5 | -0.099 0.000 0.021 | 0.042 0.001 0.004 | -0.111 0.005
## 6 | -0.113 0.000 0.003 | -0.591 0.101 0.090 | 0.136 0.007
## 7 | -0.112 0.000 0.027 | -0.316 0.029 0.215 | -0.047 0.001
## 8 | -0.102 0.000 0.006 | 0.005 0.000 0.000 | -0.092 0.003
## 9 | -0.108 0.000 0.026 | -0.154 0.007 0.053 | -0.272 0.028
## 10 | -0.099 0.000 0.001 | 0.211 0.013 0.006 | -0.078 0.002
## cos2
## 1 0.005 |
## 2 0.016 |
## 3 0.282 |
## 4 0.176 |
## 5 0.027 |
## 6 0.005 |
## 7 0.005 |
## 8 0.005 |
## 9 0.166 |
## 10 0.001 |
##
## Categories (the 10 first)
## Dim.1 ctr cos2 v.test Dim.2 ctr cos2
## sta_bangunan_0 | 9.684 2.928 0.999 61.566 | -0.220 0.013 0.001
## sta_bangunan_1 | -0.104 0.029 0.112 -20.654 | -0.099 0.220 0.102
## sta_bangunan_2 | -0.103 0.001 0.000 -1.151 | 0.486 0.183 0.008
## sta_bangunan_3 | -0.073 0.001 0.000 -0.894 | 1.893 3.301 0.140
## sta_bangunan_4 | -0.113 0.000 0.000 -0.227 | 0.613 0.010 0.000
## sta_bangunan_5 | -0.108 0.000 0.000 -0.573 | 0.763 0.105 0.004
## sta_lahan_0 | 9.684 2.928 0.999 61.566 | -0.220 0.013 0.001
## sta_lahan_1 | -0.105 0.029 0.091 -18.599 | -0.132 0.382 0.145
## sta_lahan_2 | -0.100 0.001 0.000 -1.263 | 0.572 0.323 0.014
## sta_lahan_3 | -0.071 0.001 0.000 -0.975 | 1.887 4.129 0.177
## v.test Dim.3 ctr cos2 v.test
## sta_bangunan_0 -1.401 | 0.001 0.000 0.000 0.007 |
## sta_bangunan_1 -19.686 | -0.177 0.916 0.325 -35.131 |
## sta_bangunan_2 5.414 | 2.392 5.774 0.187 26.622 |
## sta_bangunan_3 23.076 | 1.877 4.237 0.138 22.878 |
## sta_bangunan_4 1.227 | 2.135 0.153 0.005 4.271 |
## sta_bangunan_5 4.050 | 1.787 0.752 0.024 9.489 |
## sta_lahan_0 -1.401 | 0.001 0.000 0.000 0.007 |
## sta_lahan_1 -23.442 | -0.194 1.073 0.311 -34.368 |
## sta_lahan_2 7.223 | 2.140 5.895 0.192 27.022 |
## sta_lahan_3 25.937 | 1.540 3.589 0.118 21.163 |
##
## Categorical variables (eta2)
## Dim.1 Dim.2 Dim.3
## sta_bangunan | 0.999 0.157 0.371 |
## sta_lahan | 0.999 0.205 0.350 |
## luas_lantai | 0.025 0.220 0.063 |
## lantai | 0.999 0.230 0.044 |
## dinding | 0.999 0.172 0.061 |
## kondisi_dinding | 0.362 0.262 0.049 |
## atap | 0.999 0.029 0.035 |
## kondisi_atap | 0.824 0.183 0.016 |
## sumber_airminum | 0.115 0.097 0.166 |
## cara_peroleh_airminum | 0.077 0.081 0.027 |
##
## Supplementary continuous variables
## Dim.1 Dim.2 Dim.3
## Jumlah_ART | 0.029 | -0.162 | -0.136 |
## Jumlah_Keluarga | -0.031 | -0.095 | -0.033 |
## jumlah_kamar | -0.318 | -0.389 | -0.190 |
## jumlah_sapi | -0.003 | -0.002 | -0.024 |
## jumlah_kerbau | -0.002 | 0.001 | -0.024 |
## jumlah_kuda | -0.002 | -0.001 | -0.022 |
## jumlah_babi | -0.002 | 0.003 | -0.026 |
## jumlah_kambing | -0.005 | 0.011 | -0.039 |Mari kita visualisasikan jumlah persentasi varians nilai yang didapatkan oleh tiap dimensi
fviz_eig(poke_mca, ncp = 10, addlabels = T)
Hanya dengan 9 dimensi saja, MCA mampu menjelaskan 40% dari seluruh data yang ada
Kita dapat mempertahankan 51% Informasi dari data hanya dengan mempertahankan 19 Dimensi, itu artinya kita bisa mereduksi data yang awalnya 53 Variabel menjadi 19 Variabel saja
5.2 Compare Kemensos Method & K-modes Clustering
Kita akan mencoba melihat persebaran data menggunakan cluster versi Kemensos
fviz_mca_ind(poke_mca, geom = "point",
repel = T, habillage = data$penerima,
axes = c(1,2)) + labs(title = "Kemensos") +
theme(plot.title = element_text(hjust = 0.5))
Ternyata terdapat nilai outlier dalam data tersebut, kita akan mencoba menghilangkan nya dengan melakukan subseting terhadap nilai outlier tersebut
c <- as.data.frame(poke_mca$ind$coord)
head(c)Gambar diatas adalah hasil dari titik koordinat antara Dim 1 dengan Dim 2, maka kita akan mencoba mencari nilai outlier pada Dim 1
c %>%
mutate(urutan = seq(nrow(c))) %>%
filter(`Dim 1` > 2) %>%
dplyr::select(urutan) %>%
unlist() %>%
as.numeric() -> outliers
outliers## [1] 60 61 306 316 323 328 339 341 345 350 357 363 681 717 767
## [16] 775 1141 1142 1168 1226 1384 1544 1607 1613 1642 1723 1912 2221 2254 2361
## [31] 2364 2920 2942 3069 3112 3150 3441 3491 3514 3665Nilai tersebut adalah nomor baris yang ternyata merupakan outliers dalam data, maka kita akan menghilangkan baris baris dalam data sesuai dengan nomor tersebut
data <- data[-outliers,]
data_new <- data_new[-outliers,]Buat ulang dimention reduction dengan data yang baru lalu tampilkan kembali cluster versi Kemensos
set.seed(1202)
poke_mca <- MCA(X = data_new,
quanti.sup = 1:8,
graph = F,
ncp = 20)
fviz_mca_ind(poke_mca, geom = "point",
repel = T, habillage = data$penerima,
axes = c(1,2)) + labs(title = "Kemensos Dim 1&2") +
theme(plot.title = element_text(hjust = 0.5))
Terlihat titik titik yang saling bertabrakan, dari data tersebut kita bisa menyimpulkan jika data tersebut tidak konsisten, namun kita tidak akan berhenti disini. Kita akan mencoba menampilkan clustering versi K-modes
fviz_mca_ind(poke_mca, geom = "point",
repel = T, habillage = data$clustering,
axes = c(1,2)) + labs(title = "K-modes Dim 1&2") +
theme(plot.title = element_text(hjust = 0.5))
Berdasarkan visualisasi diatas, tidak terlalu banyak titik yang bertabrakan, artinya pembagian clusternya konsisten. Namun jika hanya melihat berdasarkan dimensi 1 & 2, rasanya tidak apple to apple, maka kita akan membandingkan dari beberapa dimensi sekaligus
Nampak perbandingan dari beberapa dimensi, jika hasil dari K-modes clustering lebih baik ketimbang versi Kemensos, lebih baik disini dapat dilihat dari jumlah titik antara “ya” & “tidak” yang tidak seberapa saling bertindihan.
6 Conclusion
Salah satu masalah yang sangat sering dihadapi pemerintah dari tahun ke tahun adalah salah sasaran dalam pendistribusian bantuan barang/jasa secara langsung, hal tersebut telah kita buktikan dengan melihat persebaran data yang begitu acak apabila dilihat dengan menggunakan teknik dimention reduction menggunakan MCA.
salah sasaran terjadi ketika ada salah seorang warga masyarakat yang seharusnya tidak termasuk dalam kriteria kemiskinan, namun dia mendapatkan bantuan sosial, jika di visualisasikan pada gambar diatas, titik titik yang saling overlap menandakan jika terjadi banyak sekali miss-match antara orang yang seharusnya tidak mendapat jatah bantuan namun malah mendapat jatah bantuan.
Hipotesis saya ini di dukung oleh berbagai pernyataan dari lembaga pemerintah / non-pemerintah
(https://forum.pikobar.jabarprov.go.id/t/masalah-pkh-yang-selalu-salah-sasaran/3038)
(https://juraganberdesa.blogspot.com/2020/04/mengapa-pkh-dan-sembako-selalu-salah-Sasaran.html)
Dan masih banyak lagi bukti yang tidak bisa saya tampilkan pada artikel kali ini, untuk mengatasi masalah salah sasaran ini kita juga dapat memanfaatkan algoritma supervised learning dalam peng-implementasiannya.
Pada lain kesempatan saya akan membagikan artikel untuk mengatasi masalah salah sasaran dari sudut pandang supervised learning, dan semoga kedepannya hal ini bisa menjadi solusi atas masalah masalah yang dialami pemerintah.