Sistem Pendukung Keputusan

Import Data

library(readxl)
indeks <- read_excel("C:/Users/kevin/Downloads/indeks-desa-membangun-tahun-2024-hasil-pemutakhiran.xlsx",col_names = TRUE, guess_max = 80000)

## New names:
## • `` -> `...15`

Exploratory Data Analysis

Check Data

head(indeks)

## # A tibble: 6 × 15
##   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      
## # ℹ 9 more variables: KODE_DESA <dbl>, NAMA_DESA <chr>, IKS_2024 <chr>,
## #   IKE_2024 <dbl>, IKL_2024 <dbl>, NILAI_IDM_2024 <dbl>,
## #   STATUS_IDM_2024 <chr>, Keterangan <chr>, ...15 <chr>

str(indeks)

## tibble [75,265 × 15] (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       : chr [1:75265] "0.8" "0.66290000000000004" "0.70289999999999997" "0.67430000000000001" ...
##  $ 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     : chr [1:75265] NA NA NA NA ...
##  $ ...15          : chr [1:75265] NA NA NA NA ...

Select Data

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, union

Data_Proses <- indeks %>% 
  select(NAMA_PROVINSI, NAMA_KABUPATEN, NAMA_KECAMATAN, NAMA_DESA, 
         NILAI_IDM_2024, STATUS_IDM_2024, IKS_2024, IKE_2024, IKL_2024) %>%
  mutate(across(c(IKS_2024, IKE_2024, IKL_2024), as.numeric)) %>% 
  mutate(ID_Unik = paste(NAMA_PROVINSI, NAMA_KABUPATEN, NAMA_KECAMATAN, NAMA_DESA, sep = " - ")) %>%
  na.omit()

## Warning: There was 1 warning in `mutate()`.
## ℹ In argument: `across(c(IKS_2024, IKE_2024, IKL_2024), as.numeric)`.
## Caused by warning:
## ! NAs introduced by coercion

Data_Kriteria <- Data_Proses %>% select(IKS_2024, IKE_2024, IKL_2024)
Data_Matrix <- as.matrix(Data_Kriteria)
rownames(Data_Matrix) <- Data_Proses$ID_Unik

Preprocessing

Normalization

Bobot <- c(1/3, 1/3, 1/3)
Kriteria <- c(1, 1, 1)

SAW Normalization Function

normalisasi_saw <- function(data) {
  norm_m <- matrix(0, nrow=nrow(data), ncol=ncol(data))
  for (j in 1:ncol(data)) {
    norm_m[, j] = data[, j] / max(data[, j])
  }
  return(norm_m)
}
norm_matrix <- normalisasi_saw(Data_Matrix)

SAW & WP Calculation

#Hitung SAW(WSM)
skor_saw <- as.numeric(norm_matrix %*% Bobot)

#Hitung WP(WPM)
skor_wp <- apply(norm_matrix, 1, function(x) prod(x^Bobot))

lambda <- 0.5
skor_waspas <- (lambda * skor_saw) + ((1 - lambda) * skor_wp)

Data Integration

hasil_metode <- data.frame(
  ID_Unik = Data_Proses$ID_Unik,
  Skor_SAW = skor_saw,
  Skor_WP = as.numeric(skor_wp),
  Skor_WASPAS = skor_waspas
)
head(hasil_metode,10)

##                                                  ID_Unik  Skor_SAW   Skor_WP
## 1        ACEH - ACEH SELATAN - BAKONGAN - KEUDE BAKONGAN 0.7444333 0.7268331
## 2          ACEH - ACEH SELATAN - BAKONGAN - UJONG MANGKI 0.6098333 0.6072158
## 3                     ACEH - ACEH SELATAN - BAKONGAN - X 0.6176333 0.6137333
## 4         ACEH - ACEH SELATAN - BAKONGAN - GAMPONG DRIEN 0.6025333 0.5997800
## 5          ACEH - ACEH SELATAN - BAKONGAN - DARUL IKHSAN 0.7232000 0.7210599
## 6       ACEH - ACEH SELATAN - BAKONGAN - PADANG BEURAHAN 0.6168000 0.6166500
## 7          ACEH - ACEH SELATAN - BAKONGAN - GAMPONG BARO 0.6146000 0.6134478
## 8      ACEH - ACEH SELATAN - KLUET UTARA - FAJAR HARAPAN 0.6982667 0.6935532
## 9       ACEH - ACEH SELATAN - KLUET UTARA - KRUENG BATEE 0.8096667 0.8092415
## 10 ACEH - ACEH SELATAN - KLUET UTARA - PASI KUALA ASAHAN 0.6866667 0.6846225
##    Skor_WASPAS
## 1    0.7356332
## 2    0.6085245
## 3    0.6156833
## 4    0.6011567
## 5    0.7221299
## 6    0.6167250
## 7    0.6140239
## 8    0.6959100
## 9    0.8094541
## 10   0.6856446

IDM Classification Function

tentukan_status <- function(skor) {
  case_when(
    skor > 0.8155 ~ "MANDIRI",
    skor > 0.7072 & skor <= 0.8155 ~ "MAJU",
    skor > 0.5989 & skor <= 0.7072 ~ "BERKEMBANG",
    skor > 0.4907 & skor <= 0.5989 ~ "TERTINGGAL",
    skor <= 0.4907 ~ "SANGAT TERTINGGAL",
    TRUE ~ "NA"
  )
}

Merge Original Data With Results

Final_Comparison <- Data_Proses %>%
  left_join(hasil_metode, by = "ID_Unik") %>%
  mutate(
    Kat_SAW = tentukan_status(Skor_SAW),
    Kat_WP = tentukan_status(Skor_WP),
    Kat_WASPAS = tentukan_status(Skor_WASPAS)
  ) %>%
  mutate(
    Check_SAW = ifelse(Kat_SAW == STATUS_IDM_2024, "Sesuai", "Mismatch"),
    Check_WP = ifelse(Kat_WP == STATUS_IDM_2024, "Sesuai", "Mismatch"),
    Check_WASPAS = ifelse(Kat_WASPAS == STATUS_IDM_2024, "Sesuai", "Mismatch")
  )

## Warning in left_join(., hasil_metode, by = "ID_Unik"): Detected an unexpected many-to-many relationship between `x` and `y`.
## ℹ Row 57376 of `x` matches multiple rows in `y`.
## ℹ Row 57376 of `y` matches multiple rows in `x`.
## ℹ If a many-to-many relationship is expected, set `relationship =
##   "many-to-many"` to silence this warning.

Evaluation

Accuracy Summary

Akurasi <- Final_Comparison %>%
  summarise(
    Metode_SAW = mean(Check_SAW == "Sesuai") * 100,
    Metode_WP = mean(Check_WP == "Sesuai") * 100,
    Metode_WASPAS = mean(Check_WASPAS == "Sesuai") * 100
  )
Akurasi

## # A tibble: 1 × 3
##   Metode_SAW Metode_WP Metode_WASPAS
##        <dbl>     <dbl>         <dbl>
## 1      100.0      90.0          94.6

Desa_Berbeda_Detail <- Final_Comparison %>%
  filter(Check_WASPAS == "Mismatch") %>%
  select(
    ID_Unik, 
    NILAI_IDM_2024,
    STATUS_IDM_2024,
    Skor_SAW,         
    Kat_SAW,          
    Skor_WP,          
    Kat_WP,           
    Skor_WASPAS,      
    Kat_WASPAS,       
    Check_WASPAS
  )
head(Desa_Berbeda_Detail, 20)

## # A tibble: 20 × 10
##    ID_Unik        NILAI_IDM_2024 STATUS_IDM_2024 Skor_SAW Kat_SAW Skor_WP Kat_WP
##    <chr>                   <dbl> <chr>              <dbl> <chr>     <dbl> <chr> 
##  1 ACEH - ACEH S…          0.708 MAJU               0.708 MAJU      0.696 BERKE…
##  2 ACEH - ACEH S…          0.708 MAJU               0.708 MAJU      0.694 BERKE…
##  3 ACEH - ACEH S…          0.607 BERKEMBANG         0.607 BERKEM…   0.586 TERTI…
##  4 ACEH - ACEH S…          0.602 BERKEMBANG         0.603 BERKEM…   0.594 TERTI…
##  5 ACEH - ACEH S…          0.495 TERTINGGAL         0.495 TERTIN…   0.474 SANGA…
##  6 ACEH - ACEH S…          0.495 TERTINGGAL         0.495 TERTIN…   0.459 SANGA…
##  7 ACEH - ACEH S…          0.512 TERTINGGAL         0.512 TERTIN…   0.446 SANGA…
##  8 ACEH - ACEH S…          0.605 BERKEMBANG         0.605 BERKEM…   0.591 TERTI…
##  9 ACEH - ACEH T…          0.708 MAJU               0.708 MAJU      0.699 BERKE…
## 10 ACEH - ACEH T…          0.708 MAJU               0.708 MAJU      0.696 BERKE…
## 11 ACEH - ACEH T…          0.711 MAJU               0.711 MAJU      0.688 BERKE…
## 12 ACEH - ACEH T…          0.708 MAJU               0.708 MAJU      0.702 BERKE…
## 13 ACEH - ACEH T…          0.712 MAJU               0.712 MAJU      0.702 BERKE…
## 14 ACEH - ACEH T…          0.709 MAJU               0.709 MAJU      0.703 BERKE…
## 15 ACEH - ACEH T…          0.709 MAJU               0.709 MAJU      0.704 BERKE…
## 16 ACEH - ACEH T…          0.710 MAJU               0.710 MAJU      0.701 BERKE…
## 17 ACEH - ACEH T…          0.711 MAJU               0.711 MAJU      0.695 BERKE…
## 18 ACEH - ACEH T…          0.707 MAJU               0.707 MAJU      0.703 BERKE…
## 19 ACEH - ACEH T…          0.714 MAJU               0.713 MAJU      0.696 BERKE…
## 20 ACEH - ACEH T…          0.712 MAJU               0.712 MAJU      0.698 BERKE…
## # ℹ 3 more variables: Skor_WASPAS <dbl>, Kat_WASPAS <chr>, Check_WASPAS <chr>

Desa_sama_Detail <- Final_Comparison %>%
  filter(Check_WASPAS == "Sesuai") %>%
  select(
    ID_Unik, 
    NILAI_IDM_2024,
    STATUS_IDM_2024,
    Skor_SAW,         
    Kat_SAW,          
    Skor_WP,          
    Kat_WP,           
    Skor_WASPAS,      
    Kat_WASPAS,       
    Check_WASPAS
  )
head(Desa_sama_Detail, 20)

## # A tibble: 20 × 10
##    ID_Unik        NILAI_IDM_2024 STATUS_IDM_2024 Skor_SAW Kat_SAW Skor_WP Kat_WP
##    <chr>                   <dbl> <chr>              <dbl> <chr>     <dbl> <chr> 
##  1 ACEH - ACEH S…          0.744 MAJU               0.744 MAJU      0.727 MAJU  
##  2 ACEH - ACEH S…          0.610 BERKEMBANG         0.610 BERKEM…   0.607 BERKE…
##  3 ACEH - ACEH S…          0.618 BERKEMBANG         0.618 BERKEM…   0.614 BERKE…
##  4 ACEH - ACEH S…          0.602 BERKEMBANG         0.603 BERKEM…   0.600 BERKE…
##  5 ACEH - ACEH S…          0.723 MAJU               0.723 MAJU      0.721 MAJU  
##  6 ACEH - ACEH S…          0.617 BERKEMBANG         0.617 BERKEM…   0.617 BERKE…
##  7 ACEH - ACEH S…          0.615 BERKEMBANG         0.615 BERKEM…   0.613 BERKE…
##  8 ACEH - ACEH S…          0.698 BERKEMBANG         0.698 BERKEM…   0.694 BERKE…
##  9 ACEH - ACEH S…          0.810 MAJU               0.810 MAJU      0.809 MAJU  
## 10 ACEH - ACEH S…          0.687 BERKEMBANG         0.687 BERKEM…   0.685 BERKE…
## 11 ACEH - ACEH S…          0.679 BERKEMBANG         0.679 BERKEM…   0.677 BERKE…
## 12 ACEH - ACEH S…          0.734 MAJU               0.734 MAJU      0.729 MAJU  
## 13 ACEH - ACEH S…          0.802 MAJU               0.802 MAJU      0.796 MAJU  
## 14 ACEH - ACEH S…          0.790 MAJU               0.790 MAJU      0.785 MAJU  
## 15 ACEH - ACEH S…          0.697 BERKEMBANG         0.697 BERKEM…   0.689 BERKE…
## 16 ACEH - ACEH S…          0.814 MAJU               0.814 MAJU      0.811 MAJU  
## 17 ACEH - ACEH S…          0.688 BERKEMBANG         0.687 BERKEM…   0.679 BERKE…
## 18 ACEH - ACEH S…          0.663 BERKEMBANG         0.663 BERKEM…   0.652 BERKE…
## 19 ACEH - ACEH S…          0.718 MAJU               0.718 MAJU      0.715 MAJU  
## 20 ACEH - ACEH S…          0.657 BERKEMBANG         0.657 BERKEM…   0.651 BERKE…
## # ℹ 3 more variables: Skor_WASPAS <dbl>, Kat_WASPAS <chr>, Check_WASPAS <chr>

Calculate Match and Missmatch Totals

ringkasan_total <- table(Final_Comparison$Check_WASPAS)
ringkasan_total

## 
## Mismatch   Sesuai 
##     4069    71196

ringkasan_detail <- Final_Comparison %>%
  group_by(Check_WASPAS) %>%
  summarise(
    Jumlah_Desa = n(),
    Persentase = (n() / nrow(Final_Comparison)) * 100
  )
ringkasan_detail

## # A tibble: 2 × 3
##   Check_WASPAS Jumlah_Desa Persentase
##   <chr>              <int>      <dbl>
## 1 Mismatch            4069       5.41
## 2 Sesuai             71196      94.6

Identification

#identifikasi 
Perbedaan_SAW_WP <- Final_Comparison %>%
  filter(Kat_SAW != Kat_WP) %>%
  select(ID_Unik, IKS_2024, IKE_2024, IKL_2024, 
         Skor_SAW, Kat_SAW, 
         Skor_WP, Kat_WP)

Calculate Category Discrepancies Between SAW & WP

jumlah_beda_internal <- nrow(Perbedaan_SAW_WP)
print(paste("Jumlah desa dengan perbedaan kategori SAW vs WP:", jumlah_beda_internal))

## [1] "Jumlah desa dengan perbedaan kategori SAW vs WP: 7506"

head(Perbedaan_SAW_WP, 20)

## # A tibble: 20 × 8
##    ID_Unik            IKS_2024 IKE_2024 IKL_2024 Skor_SAW Kat_SAW Skor_WP Kat_WP
##    <chr>                 <dbl>    <dbl>    <dbl>    <dbl> <chr>     <dbl> <chr> 
##  1 ACEH - ACEH SELAT…    0.709    0.55     0.867    0.708 MAJU      0.696 BERKE…
##  2 ACEH - ACEH SELAT…    0.874    0.717    0.533    0.708 MAJU      0.694 BERKE…
##  3 ACEH - ACEH SELAT…    0.669    0.533    0.6      0.601 BERKEM…   0.598 TERTI…
##  4 ACEH - ACEH SELAT…    0.703    0.45     0.667    0.607 BERKEM…   0.595 TERTI…
##  5 ACEH - ACEH SELAT…    0.76     0.467    0.6      0.609 BERKEM…   0.597 TERTI…
##  6 ACEH - ACEH SELAT…    0.903    0.75     0.8      0.818 MANDIRI   0.815 MAJU  
##  7 ACEH - ACEH SELAT…    0.754    0.4      0.667    0.607 BERKEM…   0.586 TERTI…
##  8 ACEH - ACEH SELAT…    0.731    0.6      0.8      0.710 MAJU      0.705 BERKE…
##  9 ACEH - ACEH SELAT…    0.789    0.5      0.533    0.607 BERKEM…   0.595 TERTI…
## 10 ACEH - ACEH SELAT…    0.674    0.467    0.667    0.603 BERKEM…   0.594 TERTI…
## 11 ACEH - ACEH SELAT…    0.674    0.433    0.4      0.503 TERTIN…   0.489 SANGA…
## 12 ACEH - ACEH SELAT…    0.686    0.467    0.333    0.495 TERTIN…   0.474 SANGA…
## 13 ACEH - ACEH SELAT…    0.703    0.517    0.267    0.495 TERTIN…   0.459 SANGA…
## 14 ACEH - ACEH SELAT…    0.737    0.6      0.2      0.512 TERTIN…   0.446 SANGA…
## 15 ACEH - ACEH SELAT…    0.749    0.533    0.533    0.605 BERKEM…   0.597 TERTI…
## 16 ACEH - ACEH SELAT…    0.629    0.467    0.4      0.498 TERTIN…   0.490 SANGA…
## 17 ACEH - ACEH SELAT…    0.766    0.45     0.6      0.605 BERKEM…   0.591 TERTI…
## 18 ACEH - ACEH TENGG…    0.76     0.633    0.733    0.709 MAJU      0.707 BERKE…
## 19 ACEH - ACEH TENGG…    0.783    0.75     0.6      0.711 MAJU      0.706 BERKE…
## 20 ACEH - ACEH TENGG…    0.674    0.583    0.867    0.708 MAJU      0.699 BERKE…

Analyze Average Categories for SAW & WP

library(dplyr)
#SAW
rata_rata_SAW <- Final_Comparison %>%
  group_by(Kat_SAW) %>%
  summarise(
    Jumlah_Desa = n(),
    Rerata_Skor_SAW = mean(Skor_SAW),
    Rerata_Nilai_IDM_Asli = mean(NILAI_IDM_2024)
  ) %>%
  arrange(desc(Rerata_Skor_SAW))
rata_rata_SAW

## # A tibble: 5 × 4
##   Kat_SAW           Jumlah_Desa Rerata_Skor_SAW Rerata_Nilai_IDM_Asli
##   <chr>                   <int>           <dbl>                 <dbl>
## 1 MANDIRI                 17205           0.859                 0.859
## 2 MAJU                    23064           0.756                 0.756
## 3 BERKEMBANG              24532           0.660                 0.660
## 4 TERTINGGAL               6101           0.547                 0.547
## 5 SANGAT TERTINGGAL        4363           0.425                 0.425

#WP
rata_rata_WP <- Final_Comparison %>%
  group_by(Kat_WP) %>%
  summarise(
    Jumlah_Desa = n(),
    Rerata_Skor_WP = mean(Skor_WP),
    Rerata_Nilai_IDM_Asli = mean(NILAI_IDM_2024)
  ) %>%
  arrange(desc(Rerata_Skor_WP))
rata_rata_WP

## # A tibble: 5 × 4
##   Kat_WP            Jumlah_Desa Rerata_Skor_WP Rerata_Nilai_IDM_Asli
##   <chr>                   <int>          <dbl>                 <dbl>
## 1 MANDIRI                 15383          0.860                 0.864
## 2 MAJU                    22550          0.759                 0.766
## 3 BERKEMBANG              24810          0.660                 0.669
## 4 TERTINGGAL               6867          0.554                 0.573
## 5 SANGAT TERTINGGAL        5655          0.410                 0.444