Metode SAW, WP, WASPAS pada Data Indeks Desa Membangun Tahun 2024

A. Data

1.1. Library

options(pillar.sigfig = 4)
knitr::opts_chunk$set(warning = FALSE)
library(readxl)
library(dplyr)
library(tidyr)
library(stringr)

1.2. Read Data

data_idm <- read_excel("D:/UNY/MySta/SEM 6/SPK/P3 Tugas/indeks-desa-membangun-tahun-2024-hasil-pemutakhiran.xlsx")

str(data_idm)
## tibble [75,265 Γ— 14] (S3: tbl_df/tbl/data.frame)
##  $ KODE_PROV      : num [1:75265] 11 11 11 11 11 11 11 11 11 11 ...
##  $ NAMA_PROVINSI  : chr [1:75265] "ACEH" "ACEH" "ACEH" "ACEH" ...
##  $ KODE_KAB       : num [1:75265] 1101 1101 1101 1101 1101 ...
##  $ NAMA_KABUPATEN : chr [1:75265] "ACEH SELATAN" "ACEH SELATAN" "ACEH SELATAN" "ACEH SELATAN" ...
##  $ KODE_KEC       : num [1:75265] 110101 110101 110101 110101 110101 ...
##  $ NAMA_KECAMATAN : chr [1:75265] "BAKONGAN" "BAKONGAN" "BAKONGAN" "BAKONGAN" ...
##  $ KODE_DESA      : num [1:75265] 1.1e+09 1.1e+09 1.1e+09 1.1e+09 1.1e+09 ...
##  $ NAMA_DESA      : chr [1:75265] "KEUDE BAKONGAN" "UJONG MANGKI" "X" "GAMPONG DRIEN" ...
##  $ IKS_2024       : num [1:75265] 0.8 0.663 0.703 0.674 0.703 ...
##  $ IKE_2024       : num [1:75265] 0.9 0.633 0.617 0.533 0.8 ...
##  $ IKL_2024       : num [1:75265] 0.533 0.533 0.533 0.6 0.667 ...
##  $ NILAI_IDM_2024 : num [1:75265] 0.744 0.61 0.618 0.603 0.723 ...
##  $ STATUS_IDM_2024: chr [1:75265] "MAJU" "BERKEMBANG" "BERKEMBANG" "BERKEMBANG" ...
##  $ Keterangan     : logi [1:75265] NA NA NA NA NA NA ...
data_idm
## # A tibble: 75,265 Γ— 14
##    KODE_PROV NAMA_PROVINSI KODE_KAB NAMA_KABUPATEN KODE_KEC NAMA_KECAMATAN
##        <dbl> <chr>            <dbl> <chr>             <dbl> <chr>         
##  1        11 ACEH              1101 ACEH SELATAN     110101 BAKONGAN      
##  2        11 ACEH              1101 ACEH SELATAN     110101 BAKONGAN      
##  3        11 ACEH              1101 ACEH SELATAN     110101 BAKONGAN      
##  4        11 ACEH              1101 ACEH SELATAN     110101 BAKONGAN      
##  5        11 ACEH              1101 ACEH SELATAN     110101 BAKONGAN      
##  6        11 ACEH              1101 ACEH SELATAN     110101 BAKONGAN      
##  7        11 ACEH              1101 ACEH SELATAN     110101 BAKONGAN      
##  8        11 ACEH              1101 ACEH SELATAN     110102 KLUET UTARA   
##  9        11 ACEH              1101 ACEH SELATAN     110102 KLUET UTARA   
## 10        11 ACEH              1101 ACEH SELATAN     110102 KLUET UTARA   
## # β„Ή 75,255 more rows
## # β„Ή 8 more variables: KODE_DESA <dbl>, NAMA_DESA <chr>, IKS_2024 <dbl>,
## #   IKE_2024 <dbl>, IKL_2024 <dbl>, NILAI_IDM_2024 <dbl>,
## #   STATUS_IDM_2024 <chr>, Keterangan <lgl>

1.3. Statistik Deskriptif

summary(data_idm[,c("IKS_2024","IKE_2024","IKL_2024","NILAI_IDM_2024")])
##     IKS_2024         IKE_2024         IKL_2024      NILAI_IDM_2024  
##  Min.   :0.2057   Min.   :0.1139   Min.   :0.0000   Min.   :0.2176  
##  1st Qu.:0.7143   1st Qu.:0.5167   1st Qu.:0.6667   1st Qu.:0.6448  
##  Median :0.7886   Median :0.6333   Median :0.6667   Median :0.7156  
##  Mean   :0.7662   Mean   :0.6198   Mean   :0.7502   Mean   :0.7120  
##  3rd Qu.:0.8457   3rd Qu.:0.7333   3rd Qu.:0.8667   3rd Qu.:0.8075  
##  Max.   :1.0000   Max.   :1.0000   Max.   :1.0000   Max.   :1.0000  
##  NA's   :4        NA's   :4        NA's   :4        NA's   :4

B. Preprocessing

2.1. Konsistensi Tipe data & Cleaning

data_idm <- data_idm %>%
  mutate(
    KODE_PROV = as.character(KODE_PROV),
    KODE_KAB  = as.character(KODE_KAB),
    KODE_KEC  = as.character(KODE_KEC),
    KODE_DESA = as.character(KODE_DESA),
    STATUS_IDM_2024 = str_trim(str_to_upper(STATUS_IDM_2024))
  ) %>%
  select(
    NAMA_PROVINSI,
    NAMA_KABUPATEN,
    NAMA_KECAMATAN,
    NAMA_DESA,
    KODE_DESA,
    IKS_2024,
    IKE_2024,
    IKL_2024,
    NILAI_IDM_2024,
    STATUS_IDM_2024
  ) %>%
  drop_na()

str(data_idm)
## tibble [75,261 Γ— 10] (S3: tbl_df/tbl/data.frame)
##  $ NAMA_PROVINSI  : chr [1:75261] "ACEH" "ACEH" "ACEH" "ACEH" ...
##  $ NAMA_KABUPATEN : chr [1:75261] "ACEH SELATAN" "ACEH SELATAN" "ACEH SELATAN" "ACEH SELATAN" ...
##  $ NAMA_KECAMATAN : chr [1:75261] "BAKONGAN" "BAKONGAN" "BAKONGAN" "BAKONGAN" ...
##  $ NAMA_DESA      : chr [1:75261] "KEUDE BAKONGAN" "UJONG MANGKI" "X" "GAMPONG DRIEN" ...
##  $ KODE_DESA      : chr [1:75261] "1101012001" "1101012002" "1101012003" "1101012004" ...
##  $ IKS_2024       : num [1:75261] 0.8 0.663 0.703 0.674 0.703 ...
##  $ IKE_2024       : num [1:75261] 0.9 0.633 0.617 0.533 0.8 ...
##  $ IKL_2024       : num [1:75261] 0.533 0.533 0.533 0.6 0.667 ...
##  $ NILAI_IDM_2024 : num [1:75261] 0.744 0.61 0.618 0.603 0.723 ...
##  $ STATUS_IDM_2024: chr [1:75261] "MAJU" "BERKEMBANG" "BERKEMBANG" "BERKEMBANG" ...
str(data_idm)
## tibble [75,261 Γ— 10] (S3: tbl_df/tbl/data.frame)
##  $ NAMA_PROVINSI  : chr [1:75261] "ACEH" "ACEH" "ACEH" "ACEH" ...
##  $ NAMA_KABUPATEN : chr [1:75261] "ACEH SELATAN" "ACEH SELATAN" "ACEH SELATAN" "ACEH SELATAN" ...
##  $ NAMA_KECAMATAN : chr [1:75261] "BAKONGAN" "BAKONGAN" "BAKONGAN" "BAKONGAN" ...
##  $ NAMA_DESA      : chr [1:75261] "KEUDE BAKONGAN" "UJONG MANGKI" "X" "GAMPONG DRIEN" ...
##  $ KODE_DESA      : chr [1:75261] "1101012001" "1101012002" "1101012003" "1101012004" ...
##  $ IKS_2024       : num [1:75261] 0.8 0.663 0.703 0.674 0.703 ...
##  $ IKE_2024       : num [1:75261] 0.9 0.633 0.617 0.533 0.8 ...
##  $ IKL_2024       : num [1:75261] 0.533 0.533 0.533 0.6 0.667 ...
##  $ NILAI_IDM_2024 : num [1:75261] 0.744 0.61 0.618 0.603 0.723 ...
##  $ STATUS_IDM_2024: chr [1:75261] "MAJU" "BERKEMBANG" "BERKEMBANG" "BERKEMBANG" ...
summary(data_idm[,c("IKS_2024","IKE_2024","IKL_2024","NILAI_IDM_2024")])
##     IKS_2024         IKE_2024         IKL_2024      NILAI_IDM_2024  
##  Min.   :0.2057   Min.   :0.1139   Min.   :0.0000   Min.   :0.2176  
##  1st Qu.:0.7143   1st Qu.:0.5167   1st Qu.:0.6667   1st Qu.:0.6448  
##  Median :0.7886   Median :0.6333   Median :0.6667   Median :0.7156  
##  Mean   :0.7662   Mean   :0.6198   Mean   :0.7502   Mean   :0.7120  
##  3rd Qu.:0.8457   3rd Qu.:0.7333   3rd Qu.:0.8667   3rd Qu.:0.8075  
##  Max.   :1.0000   Max.   :1.0000   Max.   :1.0000   Max.   :1.0000

2.2. Duplikasi Data

# Duplikasi Baris
sum(duplicated(data_idm))
## [1] 0
# Duplikasi berdasarkan kode Desa
data_idm %>%
  count(KODE_DESA) %>%
  filter(n > 1)
## # A tibble: 0 Γ— 2
## # β„Ή 2 variables: KODE_DESA <chr>, n <int>

Tidak terdapat duplikasi data, dengan variabel KODE_DESA sebagai primary key.

2.3. Matriks Keputusan

data_matriks <- as.matrix(
  data_idm[,c("IKS_2024","IKE_2024","IKL_2024")]
)

rownames(data_matriks) <- data_idm$NAMA_DESA
colnames(data_matriks) <- c("IKS","IKE","IKL")

summary(data_matriks)
##       IKS              IKE              IKL        
##  Min.   :0.2057   Min.   :0.1139   Min.   :0.0000  
##  1st Qu.:0.7143   1st Qu.:0.5167   1st Qu.:0.6667  
##  Median :0.7886   Median :0.6333   Median :0.6667  
##  Mean   :0.7662   Mean   :0.6198   Mean   :0.7502  
##  3rd Qu.:0.8457   3rd Qu.:0.7333   3rd Qu.:0.8667  
##  Max.   :1.0000   Max.   :1.0000   Max.   :1.0000

Dari summary data matriks di atas dapat diketahui bahwa nilai maksimum setiap kriteria adalah 1 sehingga proses normalisasi tidak mengubah nilai matriks keputusan.

2.4. Jenis Kriteria

jenis_kriteria <- c(1,1,1)
jenis_kriteria
## [1] 1 1 1

2.5. Fungsi Normalisasi

\[ r_{ij} = \frac{x_{ij}}{\max(x_j)} \]

normalisasi <- function(data, jenis){
  norm_matriks <- matrix(
    0,
    nrow=nrow(data),
    ncol=ncol(data)
  )
  for(j in 1:ncol(data)){
    if(jenis[j] == 1){
      norm_matriks[,j] <- data[,j] / max(data[,j])
    } else {
      norm_matriks[,j] <- min(data[,j]) / data[,j]
    }
  }
  rownames(norm_matriks) <- rownames(data)
  colnames(norm_matriks) <- colnames(data)
  return(norm_matriks)
}

normal <- normalisasi(data_matriks, jenis_kriteria)
head(normal)
##                    IKS    IKE    IKL
## KEUDE BAKONGAN  0.8000 0.9000 0.5333
## UJONG MANGKI    0.6629 0.6333 0.5333
## X               0.7029 0.6167 0.5333
## GAMPONG DRIEN   0.6743 0.5333 0.6000
## DARUL IKHSAN    0.7029 0.8000 0.6667
## PADANG BEURAHAN 0.6171 0.6333 0.6000

2.6. Bobot Kriteria

bobot <- c(1/3,1/3,1/3)
bobot
## [1] 0.3333333 0.3333333 0.3333333

C. Metode SAW, WP, WASPAS

3.1. Metode SAW

\[ V_i = \sum_{j=1}^{n} w_j \, r_{ij} \]

skor_saw <- normal %*% bobot
hasil_saw <- data.frame(
  KODE_DESA = data_idm$KODE_DESA,
  NAMA_DESA = data_idm$NAMA_DESA,
  NAMA_KECAMATAN = data_idm$NAMA_KECAMATAN,
  SAW_score = as.numeric(skor_saw)
)

# rank
hasil_saw <- hasil_saw %>%
  arrange(desc(SAW_score)) %>%
  mutate(
    Rank_SAW = row_number()
  )
head(hasil_saw)
##    KODE_DESA    NAMA_DESA NAMA_KECAMATAN SAW_score Rank_SAW
## 1 3207082001      PANJALU        PANJALU    1.0000        1
## 2 5104052002          MAS           UBUD    1.0000        2
## 3 5104052006     PELIATAN           UBUD    1.0000        3
## 4 3201122003       KEMANG         KEMANG    0.9981        4
## 5 3204052006 CIBIRU WETAN       CILEUNYI    0.9981        5
## 6 3303102001       SERANG     KARANGREJA    0.9981        6

3.2. Metode WP

\[ S_i = \prod_{j=1}^{n} r_{ij}^{\, w_j} \]

Apabila diperlukan skor terstandar, digunakan persamaan:

\[ V_i = \frac{S_i}{\sum_{i=1}^{m} S_i} \]

Pada metode Weighted Product, nilai 𝑆𝑖 digunakan sebagai skor preferensi karena telah merepresentasikan hasil perkalian nilai kriteria yang dipangkatkan oleh bobotnya. Normalisasi menjadi 𝑉𝑖 hanya dilakukan jika diperlukan skor terstandar, sehingga dalam kasus ini, nilai 𝑆𝑖​ digunakan sebagai nilai akhir WP karena lebih representatif terhadap skala indeks IDM.

S_wp <- apply(normal,1,function(x) prod(x^bobot))
head(S_wp)
##  KEUDE BAKONGAN    UJONG MANGKI               X   GAMPONG DRIEN    DARUL IKHSAN 
##       0.7268331       0.6072158       0.6137333       0.5997800       0.7210599 
## PADANG BEURAHAN 
##       0.6166500
hasil_wp <- data.frame(
  KODE_DESA = data_idm$KODE_DESA,
  NAMA_DESA = data_idm$NAMA_DESA,
  NAMA_KECAMATAN = data_idm$NAMA_KECAMATAN,
  WP_score = as.numeric(S_wp)
)
# rank
hasil_wp <- hasil_wp %>%
  arrange(desc(WP_score)) %>%
  mutate(Rank_WP = row_number())
head(hasil_wp)
##    KODE_DESA    NAMA_DESA NAMA_KECAMATAN  WP_score Rank_WP
## 1 3207082001      PANJALU        PANJALU 1.0000000       1
## 2 5104052002          MAS           UBUD 1.0000000       2
## 3 5104052006     PELIATAN           UBUD 1.0000000       3
## 4 3201122003       KEMANG         KEMANG 0.9980964       4
## 5 3204052006 CIBIRU WETAN       CILEUNYI 0.9980964       5
## 6 3303102001       SERANG     KARANGREJA 0.9980964       6

3.3. Metode WASPAS

\[ Q_i = \lambda Q_{i1} + (1 - \lambda) Q_{i2} \]

\[ Q_{i1} = \sum_{j=1}^{n} (r_{ij} w_j) \]

\[ Q_{i2} = \prod_{j=1}^{n} r_{ij}^{w_j} \]

lambda <- 0.5
Q1_wsm <- apply(
  normal,
  1,
  function(x) sum(x*bobot)
)
Q2_wpm <- apply(
  normal,
  1,
  function(x) prod(x^bobot)
)
Q_waspas <- lambda*Q1_wsm +
            (1-lambda)*Q2_wpm
hasil_waspas <- data.frame(
  KODE_DESA = data_idm$KODE_DESA,
  NAMA_DESA = data_idm$NAMA_DESA,
  NAMA_KECAMATAN = data_idm$NAMA_KECAMATAN,
  WASPAS_score = as.numeric(Q_waspas)
)

# rank
hasil_waspas <- hasil_waspas %>%
  arrange(desc(WASPAS_score)) %>%
  mutate(
    Rank_WASPAS = row_number()
  )
head(hasil_waspas)
##    KODE_DESA    NAMA_DESA NAMA_KECAMATAN WASPAS_score Rank_WASPAS
## 1 3207082001      PANJALU        PANJALU    1.0000000           1
## 2 5104052002          MAS           UBUD    1.0000000           2
## 3 5104052006     PELIATAN           UBUD    1.0000000           3
## 4 3201122003       KEMANG         KEMANG    0.9980982           4
## 5 3204052006 CIBIRU WETAN       CILEUNYI    0.9980982           5
## 6 3303102001       SERANG     KARANGREJA    0.9980982           6

D. Klasifikasi Status Desa

4.1. Klasifikasi Berdasarkan Dataset IDM

a. Ambang batas skor IDM Nasional 2024

klasifikasi_idm <- function(x){
  case_when(
    x <= 0.4907 ~ "SANGAT TERTINGGAL",
    x <= 0.5989 ~ "TERTINGGAL",
    x <= 0.7072 ~ "BERKEMBANG",
    x <= 0.8155 ~ "MAJU",
    x > 0.8155  ~ "MANDIRI"
  )
}

b. Klasifikasi pada dataset sesuai batas skor IDM Nasional

data_status <- data_idm %>%
  mutate(
    KLASIFIKASI_DATA = klasifikasi_idm(NILAI_IDM_2024)
  )

# Verifikasi
data_status %>%
  filter(KLASIFIKASI_DATA != STATUS_IDM_2024) %>%
  select(
    NAMA_DESA,
    NAMA_KABUPATEN,
    NILAI_IDM_2024,
    STATUS_IDM_2024,
    KLASIFIKASI_DATA
  )
## # A tibble: 1 Γ— 5
##   NAMA_DESA     NAMA_KABUPATEN NILAI_IDM_2024 STATUS_IDM_2024 KLASIFIKASI_DATA
##   <chr>         <chr>                   <dbl> <chr>           <chr>           
## 1 KUPANG BERSIH BARITO TIMUR           0.7410 BERKEMBANG      MAJU

Terdapat satu desa yakni Desa Kupang Bersih, Kab. Barito Timur yang status IDM nya tidak sesuai dengan SOP ambang batas skor IDM Nasional 2024.

4.2. Evaluasi Metode SAW

a. Evaluasi SAW

evaluasi_saw <- data_status %>%
  left_join(
    hasil_saw,
    by = "KODE_DESA"
  ) %>%
  mutate(
    KLASIFIKASI_SAW =
      klasifikasi_idm(SAW_score),

    MATCH =
      ifelse(
        KLASIFIKASI_DATA ==
        KLASIFIKASI_SAW,
        "MATCH",
        "MISMATCH"
      )
  )

b. Jumlah Data Matching & Mismatch

tab_match_saw <- table(evaluasi_saw$MATCH)
cbind(
  Jumlah = tab_match_saw,
  Persentase =
    round(
      prop.table(tab_match_saw)*100,2))
##       Jumlah Persentase
## MATCH  75261        100

4.3. Evaluasi Metode WP

a. Evaluasi WP

evaluasi_wp <- data_status %>%
  left_join(
    hasil_wp,
    by = "KODE_DESA"
  ) %>%
  mutate(
    KLASIFIKASI_WP =
      klasifikasi_idm(WP_score),

    MATCH =
      ifelse(
        KLASIFIKASI_DATA ==
        KLASIFIKASI_WP,
        "MATCH",
        "MISMATCH"
      ))

b. Jumlah Data Matching & Mismatch

tab_match_wp <- table(evaluasi_wp$MATCH)

cbind(
  Jumlah = tab_match_wp,
  Persentase =
    round(
      prop.table(tab_match_wp)*100,2))
##          Jumlah Persentase
## MATCH     67755      90.03
## MISMATCH   7506       9.97

4.4. Evaluasi Metode WASPAS

a. Evaluasi WASPAS

evaluasi_waspas <- data_status %>%
  left_join(
    hasil_waspas,
    by = "KODE_DESA"
  ) %>%
  mutate(
    KLASIFIKASI_WASPAS =
      klasifikasi_idm(WASPAS_score),

    MATCH =
      ifelse(
        KLASIFIKASI_DATA ==
        KLASIFIKASI_WASPAS,
        "MATCH",
        "MISMATCH"
      )
  )

b. Jumlah Data Matching & Mismatch

tab_match_waspas <- table(evaluasi_waspas$MATCH)

cbind(
  Jumlah = tab_match_waspas,
  Persentase =
    round(
      prop.table(tab_match_waspas)*100,2))
##          Jumlah Persentase
## MATCH     71195       94.6
## MISMATCH   4066        5.4

4.5. Comparison Table

a. Tabel Perbandingan Dataset

tabel_perbandingan <- data_status %>%
  left_join(
    hasil_saw %>% select(KODE_DESA, SAW_score),
    by = "KODE_DESA"
  ) %>%
  left_join(
    hasil_wp %>% select(KODE_DESA, WP_score),
    by = "KODE_DESA"
  ) %>%
  left_join(
    hasil_waspas %>% select(KODE_DESA, WASPAS_score),
    by = "KODE_DESA"
  ) %>%
  select(
    KODE_DESA,
    NAMA_DESA,
    NAMA_KECAMATAN,
    NILAI_IDM_2024,
    KLASIFIKASI_DATA,
    SAW_score,
    WP_score,
    WASPAS_score
  )
print(tabel_perbandingan, width = Inf)
## # A tibble: 75,261 Γ— 8
##    KODE_DESA  NAMA_DESA         NAMA_KECAMATAN NILAI_IDM_2024 KLASIFIKASI_DATA
##    <chr>      <chr>             <chr>                   <dbl> <chr>           
##  1 1101012001 KEUDE BAKONGAN    BAKONGAN               0.7444 MAJU            
##  2 1101012002 UJONG MANGKI      BAKONGAN               0.6098 BERKEMBANG      
##  3 1101012003 X                 BAKONGAN               0.6176 BERKEMBANG      
##  4 1101012004 GAMPONG DRIEN     BAKONGAN               0.6025 BERKEMBANG      
##  5 1101012015 DARUL IKHSAN      BAKONGAN               0.7232 MAJU            
##  6 1101012016 PADANG BEURAHAN   BAKONGAN               0.6168 BERKEMBANG      
##  7 1101012017 GAMPONG BARO      BAKONGAN               0.6146 BERKEMBANG      
##  8 1101022001 FAJAR HARAPAN     KLUET UTARA            0.6983 BERKEMBANG      
##  9 1101022002 KRUENG BATEE      KLUET UTARA            0.8097 MAJU            
## 10 1101022003 PASI KUALA ASAHAN KLUET UTARA            0.6867 BERKEMBANG      
##    SAW_score WP_score WASPAS_score
##        <dbl>    <dbl>        <dbl>
##  1    0.7444   0.7268       0.7356
##  2    0.6098   0.6072       0.6085
##  3    0.6176   0.6137       0.6157
##  4    0.6025   0.5998       0.6012
##  5    0.7232   0.7211       0.7221
##  6    0.6168   0.6167       0.6167
##  7    0.6146   0.6134       0.6140
##  8    0.6983   0.6936       0.6959
##  9    0.8097   0.8092       0.8095
## 10    0.6867   0.6846       0.6856
## # β„Ή 75,251 more rows

b. Tabel Perbandingan Evaluasi Metode

tabel_evaluasi <- data.frame(
  Metode = c("SAW", "WP", "WASPAS"),
  MATCH = c(
    tab_match_saw["MATCH"],
    tab_match_wp["MATCH"],
    tab_match_waspas["MATCH"]
  ),
  MISMATCH = c(
    ifelse(is.na(tab_match_saw["MISMATCH"]), 0, tab_match_saw["MISMATCH"]),
    tab_match_wp["MISMATCH"],
    tab_match_waspas["MISMATCH"]
  )
)
tabel_evaluasi$Persentase_MATCH <- round(
  tabel_evaluasi$MATCH /
  (tabel_evaluasi$MATCH + tabel_evaluasi$MISMATCH) * 100,
  2
)
tabel_evaluasi$Persentase_MISMATCH <- round(
  tabel_evaluasi$MISMATCH /
  (tabel_evaluasi$MATCH + tabel_evaluasi$MISMATCH) * 100,
  2
)
tabel_evaluasi
##   Metode MATCH MISMATCH Persentase_MATCH Persentase_MISMATCH
## 1    SAW 75261        0           100.00                0.00
## 2     WP 67755     7506            90.03                9.97
## 3 WASPAS 71195     4066            94.60                5.40

Metode SAW menghasilkan tingkat kesesuaian klasifikasi sebesar 100%, yang menunjukkan bahwa nilai preferensi SAW identik dengan nilai indeks pembangunan desa yang digunakan sebagai acuan. Metode WP menghasilkan tingkat kesesuaian sebesar 90,03% dengan mismatch sebesar 9,97%. Sementara itu, metode WASPAS memiliki tingkat kesesuaian sebesar 94,60% dengan mismatch sebesar 5,40%. Hal ini menunjukkan bahwa metode WASPAS memiliki performa yang lebih mendekati klasifikasi IDM dibandingkan metode WP, namun masih belum sepenuhnya konsisten seperti metode SAW.

E. Ambang Batas Baru Setiap Metode

5.1. Ambang Batas SAW

Metode SAW tidak memerlukan penyesuaian ambang batas karena metode SAW menghasilkan tingkat kecocokan 100% terhadap klasifikasi IDM asli..

5.2. Ambang Batas WP

a. Proporsi status IDM pada dataset

# urutan status IDM resmi
urutan_status <- c(
  "SANGAT TERTINGGAL",
  "TERTINGGAL",
  "BERKEMBANG",
  "MAJU",
  "MANDIRI"
)

# proporsi setiap kelas
proporsi_kelas <- prop.table(
  table(
    factor(
      data_status$KLASIFIKASI_DATA,
      levels = urutan_status
    )
  )
)

proporsi_kelas
## 
## SANGAT TERTINGGAL        TERTINGGAL        BERKEMBANG              MAJU 
##        0.05797159        0.08105127        0.32594571        0.30645354 
##           MANDIRI 
##        0.22857788

b. Batas dan Klasifikasi baru WP

batas_wp <- quantile(
  hasil_wp$WP_score,
  probs = cumsum(proporsi_kelas)[1:4]
)
batas_wp
## 5.797159% 13.90229% 46.49686% 77.14221% 
## 0.4632337 0.5804068 0.7000175 0.8091489
klasifikasi_wp <- function(x){
  case_when(
    x <= batas_wp[1] ~ "SANGAT TERTINGGAL",
    x <= batas_wp[2] ~ "TERTINGGAL",
    x <= batas_wp[3] ~ "BERKEMBANG",
    x <= batas_wp[4] ~ "MAJU",
    x >  batas_wp[4] ~ "MANDIRI"
  )
}

c.Β Evaluasi ulang WP

evaluasi_wp <- data_status %>%
  left_join(hasil_wp, by = "KODE_DESA") %>%
  mutate(
    KLASIFIKASI_WP = klasifikasi_wp(WP_score),
    MATCH = ifelse(KLASIFIKASI_DATA == KLASIFIKASI_WP,
                   "MATCH",            "MISMATCH")
  )
tab_match_wp_baru <- table(evaluasi_wp$MATCH)
cbind(
  Jumlah = tab_match_wp_baru,
  Persentase =
    round(prop.table(tab_match_wp_baru)*100,2)
)
##          Jumlah Persentase
## MATCH     70815      94.09
## MISMATCH   4446       5.91

5.3. Ambang Batas Baru WASPAS

a. Batas dan klasifikasi baru WASPAS

batas_waspas <- quantile(
  hasil_waspas$WASPAS_score,
  probs = cumsum(proporsi_kelas)[1:4]
)
batas_waspas
## 5.797159% 13.90229% 46.49686% 77.14221% 
## 0.4764080 0.5896254 0.7035962 0.8121528
klasifikasi_waspas <- function(x){
  case_when(
    x <= batas_waspas[1] ~ "SANGAT TERTINGGAL",
    x <= batas_waspas[2] ~ "TERTINGGAL",
    x <= batas_waspas[3] ~ "BERKEMBANG",
    x <= batas_waspas[4] ~ "MAJU",
    x >  batas_waspas[4] ~ "MANDIRI"
  )
}

b. Evaluasi ulang WASPAS

evaluasi_waspas_baru <- data_status %>%
  left_join(
    hasil_waspas,
    by = "KODE_DESA"
  ) %>%
  mutate(
    KLASIFIKASI_WASPAS = klasifikasi_waspas(WASPAS_score),
    MATCH =
      ifelse(
        KLASIFIKASI_DATA == KLASIFIKASI_WASPAS,
        "MATCH",
        "MISMATCH"
      )
  )

tab_match_waspas_baru <- table(evaluasi_waspas_baru$MATCH)

cbind(
  Jumlah = tab_match_waspas_baru,
  Persentase =
    round(prop.table(tab_match_waspas_baru)*100,2)
)
##          Jumlah Persentase
## MATCH     72846      96.79
## MISMATCH   2415       3.21

Tabel Perbandingan Sebelum dan Sesudah Ambang Batas Baru

tabel_perbandingan <- data.frame(
  METODE = c("SAW","WP","WP","WASPAS","WASPAS"),
  KONDISI = c("ASLI","SEBELUM","SESUDAH","SEBELUM","SESUDAH"),
  MATCH = c(
    tab_match_saw["MATCH"],
    tab_match_wp["MATCH"],
    tab_match_wp_baru["MATCH"],
    tab_match_waspas["MATCH"],
    tab_match_waspas_baru["MATCH"]
  ),
  MISMATCH = c(
    ifelse(is.na(tab_match_saw["MISMATCH"]),0,tab_match_saw["MISMATCH"]),
    tab_match_wp["MISMATCH"],
    tab_match_wp_baru["MISMATCH"],
    tab_match_waspas["MISMATCH"],
    tab_match_waspas_baru["MISMATCH"]
  )
)
tabel_perbandingan$MATCH_PERSEN <-
  round(
    tabel_perbandingan$MATCH /
    (tabel_perbandingan$MATCH + tabel_perbandingan$MISMATCH)*100,
    2
  )
tabel_perbandingan$MISMATCH_PERSEN <-
  round(
    tabel_perbandingan$MISMATCH /
    (tabel_perbandingan$MATCH + tabel_perbandingan$MISMATCH)*100,
    2
  )
tabel_perbandingan
##   METODE KONDISI MATCH MISMATCH MATCH_PERSEN MISMATCH_PERSEN
## 1    SAW    ASLI 75261        0       100.00            0.00
## 2     WP SEBELUM 67755     7506        90.03            9.97
## 3     WP SESUDAH 70815     4446        94.09            5.91
## 4 WASPAS SEBELUM 71195     4066        94.60            5.40
## 5 WASPAS SESUDAH 72846     2415        96.79            3.21

Penyesuaian ambang batas pada metode WP dan WASPAS meningkatkan tingkat kesesuaian klasifikasi dengan status IDM pada dataset. Metode WP mengalami peningkatan tingkat kesesuaian dari 90,03% menjadi 94,09%, sedangkan metode WASPAS meningkat dari 94,60% menjadi 96,79%. Hal ini menunjukkan bahwa ambang batas baru yang disesuaikan dengan distribusi data mampu memperbaiki akurasi klasifikasi dibandingkan menggunakan ambang batas indeks IDM nasional secara langsung.