Loading Package

library(readxl)
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
library(cluster)
## Warning: package 'cluster' was built under R version 4.3.3
library(factoextra)
## Warning: package 'factoextra' was built under R version 4.3.3
## Loading required package: ggplot2
## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
library(mclust)
## Warning: package 'mclust' was built under R version 4.3.3
## Package 'mclust' version 6.1.1
## Type 'citation("mclust")' for citing this R package in publications.
library(kernlab)      # spectral clustering
## Warning: package 'kernlab' was built under R version 4.3.3
## 
## Attaching package: 'kernlab'
## The following object is masked from 'package:ggplot2':
## 
##     alpha
library(car)
## Warning: package 'car' was built under R version 4.3.3
## Loading required package: carData
## Warning: package 'carData' was built under R version 4.3.3
## 
## Attaching package: 'car'
## The following object is masked from 'package:dplyr':
## 
##     recode
library(ggcorrplot)
## Warning: package 'ggcorrplot' was built under R version 4.3.3
library(ggrepel)
## Warning: package 'ggrepel' was built under R version 4.3.3
library(psych)
## Warning: package 'psych' was built under R version 4.3.3
## 
## Attaching package: 'psych'
## The following object is masked from 'package:car':
## 
##     logit
## The following object is masked from 'package:kernlab':
## 
##     alpha
## The following object is masked from 'package:mclust':
## 
##     sim
## The following objects are masked from 'package:ggplot2':
## 
##     %+%, alpha
library(fpc)
## Warning: package 'fpc' was built under R version 4.3.3
library(clusterSim)
## Warning: package 'clusterSim' was built under R version 4.3.3
## Loading required package: MASS
## 
## Attaching package: 'MASS'
## The following object is masked from 'package:dplyr':
## 
##     select
library(clusterCrit)
## Warning: package 'clusterCrit' was built under R version 4.3.3
library(ggplot2)
library(sf)
## Warning: package 'sf' was built under R version 4.3.3
## Linking to GEOS 3.11.2, GDAL 3.8.2, PROJ 9.3.1; sf_use_s2() is TRUE

Import Data

data <- read_excel("C:/Users/Nabila/OneDrive/Dokumen/RStudio/PDM SMT 5/data_tbp2.xlsx")
cat("Total missing values:", sum(is.na(data)), "\n")
## Total missing values: 0
data$`Jumlah Penduduk` <- data$`Jumlah Penduduk` * 1000

head(data)
## # A tibble: 6 × 13
##   Provinsi         Perawat Bidan Kefarmasian `Kesehatan Masyarakat`
##   <chr>              <dbl> <dbl>       <dbl>                  <dbl>
## 1 Aceh               21435 21767        3165                   3890
## 2 Sumatera Utara     25787 27122        3970                   3167
## 3 Sumatera Barat     12236  9313        2548                   1430
## 4 Riau               12185 10246        2634                   1392
## 5 Jambi               8425  7512        1635                   1059
## 6 Sumatera Selatan   17309 15942        2971                   2217
## # ℹ 8 more variables: `Kesehatan Lingkungan` <dbl>, `Tenaga Gizi` <dbl>,
## #   `Tenaga Medis (Dokter)` <dbl>, `Psikologi Klinis` <dbl>,
## #   `Keterapian Fisik` <dbl>, `Keteknisan Medis` <dbl>,
## #   `Teknik Biomedika` <dbl>, `Jumlah Penduduk` <dbl>

Seleksi Data Numerik

data_num <- data %>% 
  dplyr::select(where(is.numeric))

Exploratory Data Analysis

Korelasi

cor_mat <- cor(data_num)
round(cor_mat, 2)
##                       Perawat Bidan Kefarmasian Kesehatan Masyarakat
## Perawat                  1.00  0.89        0.98                 0.60
## Bidan                    0.89  1.00        0.82                 0.82
## Kefarmasian              0.98  0.82        1.00                 0.51
## Kesehatan Masyarakat     0.60  0.82        0.51                 1.00
## Kesehatan Lingkungan     0.87  0.92        0.82                 0.85
## Tenaga Gizi              0.96  0.92        0.92                 0.72
## Tenaga Medis (Dokter)    0.94  0.76        0.92                 0.42
## Psikologi Klinis         0.82  0.64        0.85                 0.37
## Keterapian Fisik         0.95  0.77        0.96                 0.46
## Keteknisan Medis         0.98  0.84        0.98                 0.54
## Teknik Biomedika         0.99  0.83        0.98                 0.51
## Jumlah Penduduk          0.96  0.87        0.96                 0.53
##                       Kesehatan Lingkungan Tenaga Gizi Tenaga Medis (Dokter)
## Perawat                               0.87        0.96                  0.94
## Bidan                                 0.92        0.92                  0.76
## Kefarmasian                           0.82        0.92                  0.92
## Kesehatan Masyarakat                  0.85        0.72                  0.42
## Kesehatan Lingkungan                  1.00        0.94                  0.71
## Tenaga Gizi                           0.94        1.00                  0.83
## Tenaga Medis (Dokter)                 0.71        0.83                  1.00
## Psikologi Klinis                      0.67        0.74                  0.84
## Keterapian Fisik                      0.77        0.86                  0.94
## Keteknisan Medis                      0.85        0.94                  0.92
## Teknik Biomedika                      0.82        0.92                  0.97
## Jumlah Penduduk                       0.80        0.91                  0.89
##                       Psikologi Klinis Keterapian Fisik Keteknisan Medis
## Perawat                           0.82             0.95             0.98
## Bidan                             0.64             0.77             0.84
## Kefarmasian                       0.85             0.96             0.98
## Kesehatan Masyarakat              0.37             0.46             0.54
## Kesehatan Lingkungan              0.67             0.77             0.85
## Tenaga Gizi                       0.74             0.86             0.94
## Tenaga Medis (Dokter)             0.84             0.94             0.92
## Psikologi Klinis                  1.00             0.91             0.87
## Keterapian Fisik                  0.91             1.00             0.97
## Keteknisan Medis                  0.87             0.97             1.00
## Teknik Biomedika                  0.86             0.97             0.98
## Jumlah Penduduk                   0.72             0.88             0.94
##                       Teknik Biomedika Jumlah Penduduk
## Perawat                           0.99            0.96
## Bidan                             0.83            0.87
## Kefarmasian                       0.98            0.96
## Kesehatan Masyarakat              0.51            0.53
## Kesehatan Lingkungan              0.82            0.80
## Tenaga Gizi                       0.92            0.91
## Tenaga Medis (Dokter)             0.97            0.89
## Psikologi Klinis                  0.86            0.72
## Keterapian Fisik                  0.97            0.88
## Keteknisan Medis                  0.98            0.94
## Teknik Biomedika                  1.00            0.94
## Jumlah Penduduk                   0.94            1.00
ggcorrplot(
  cor(data_num, use = "pairwise.complete.obs"),
  hc.order = TRUE,
  type = "lower",
  lab = TRUE
)

Deteksi Outlier

# Deteksi outlier (IQR)
detect_outliers_iqr <- function(x) {
  Q1 <- quantile(x, 0.25, na.rm = TRUE)
  Q3 <- quantile(x, 0.75, na.rm = TRUE)
  IQRv <- IQR(x, na.rm = TRUE)
  lower <- Q1 - 1.5 * IQRv
  upper <- Q3 + 1.5 * IQRv
  which(x < lower | x > upper)
}

outlier_list <- lapply(data_num, detect_outliers_iqr)
print(outlier_list)
## $Perawat
## [1] 11 12 13 15
## 
## $Bidan
## [1]  2 12 13 15
## 
## $Kefarmasian
## [1] 11 12 13 15
## 
## $`Kesehatan Masyarakat`
## integer(0)
## 
## $`Kesehatan Lingkungan`
## [1] 12 13 15 27
## 
## $`Tenaga Gizi`
## [1] 12 13 15
## 
## $`Tenaga Medis (Dokter)`
## [1] 11 12 13 15
## 
## $`Psikologi Klinis`
## [1] 11 12 13 14 15
## 
## $`Keterapian Fisik`
## [1] 11 12 13 15
## 
## $`Keteknisan Medis`
## [1] 11 12 13 15
## 
## $`Teknik Biomedika`
## [1] 11 12 13 15
## 
## $`Jumlah Penduduk`
## [1] 12 13 15
boxplot(data_num, main = "Outlier Semua Variabel")

Diagnostik Data

Cek Multikolinearitas

vif_model <- lm(data_num[[1]] ~ ., data = data_num)
vif(vif_model)
## Warning in summary.lm(object, ...): essentially perfect fit: summary may be
## unreliable
##                 Perawat                   Bidan             Kefarmasian 
##               357.81598                29.38698               217.04330 
##  `Kesehatan Masyarakat`  `Kesehatan Lingkungan`           `Tenaga Gizi` 
##                10.82399                33.42960                59.10213 
## `Tenaga Medis (Dokter)`      `Psikologi Klinis`      `Keterapian Fisik` 
##                95.31899                10.17798                84.27099 
##      `Keteknisan Medis`      `Teknik Biomedika`       `Jumlah Penduduk` 
##               106.70752               259.47365                76.62807

Uji KMO

kmo_result <- KMO(data_num)
kmo_result
## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = data_num)
## Overall MSA =  0.84
## MSA for each item = 
##               Perawat                 Bidan           Kefarmasian 
##                  0.86                  0.80                  0.76 
##  Kesehatan Masyarakat  Kesehatan Lingkungan           Tenaga Gizi 
##                  0.75                  0.86                  0.93 
## Tenaga Medis (Dokter)      Psikologi Klinis      Keterapian Fisik 
##                  0.78                  0.85                  0.84 
##      Keteknisan Medis      Teknik Biomedika       Jumlah Penduduk 
##                  0.90                  0.91                  0.78

Uji Bartlett’s

bartlett_result <- cortest.bartlett(
  cor(data_num),
  n = nrow(data_num)
)
bartlett_result
## $chisq
## [1] 991.0781
## 
## $p.value
## [1] 4.379062e-165
## 
## $df
## [1] 66

Principal Component Analysis (PCA)

pca_result <- prcomp(
  data_num,
  center = TRUE,
  scale. = TRUE
)

eigenvalues <- pca_result$sdev^2
prop_var    <- eigenvalues / sum(eigenvalues)
cum_var     <- cumsum(prop_var)

data.frame(
  PC         = paste0("PC", seq_along(eigenvalues)),
  Eigenvalue = eigenvalues,
  Proporsi   = prop_var,
  Kumulatif  = cum_var
)
##      PC   Eigenvalue     Proporsi Kumulatif
## 1   PC1 10.226075996 0.8521729997 0.8521730
## 2   PC2  1.120995008 0.0934162506 0.9455893
## 3   PC3  0.304114859 0.0253429049 0.9709322
## 4   PC4  0.125729504 0.0104774586 0.9814096
## 5   PC5  0.083302850 0.0069419041 0.9883515
## 6   PC6  0.058743480 0.0048952900 0.9932468
## 7   PC7  0.036036719 0.0030030599 0.9962499
## 8   PC8  0.023532041 0.0019610034 0.9982109
## 9   PC9  0.011613545 0.0009677954 0.9991787
## 10 PC10  0.005575676 0.0004646397 0.9996433
## 11 PC11  0.002509648 0.0002091374 0.9998524
## 12 PC12  0.001770676 0.0001475563 1.0000000
plot(
  eigenvalues,
  type = "b",
  xlab = "Principal Component",
  ylab = "Eigenvalue"
)

pca_scores <- as.data.frame(pca_result$x)
data_pca <- as.matrix(pca_scores[, 1:2])

Penentuan Jumlah KLaster (k)

K-Medoids

k_range <- 2:6
sil_kmed <- numeric(length(k_range))
  
for (i in seq_along(k_range)) {
    k <- k_range[i]
    pam_tmp <- pam(data_pca, k = k)
sil <- silhouette(pam_tmp$clustering,
                  dist(data_pca))
    sil_kmed[i] <- mean(sil[, "sil_width"])
  }
  
# Data Frame
df_kmed <- data.frame(
    Metode = "K-Medoids",
    K = k_range,
    Silhouette = sil_kmed
  )
df_kmed
##      Metode K Silhouette
## 1 K-Medoids 2  0.7804345
## 2 K-Medoids 3  0.5877555
## 3 K-Medoids 4  0.4160245
## 4 K-Medoids 5  0.4607601
## 5 K-Medoids 6  0.5012297
k_opt_kmed <- df_kmed$K[which.max(df_kmed$Silhouette)]

# Plot Silhouette
plot(
    k_range, sil_kmed,
    type = "b", pch = 19,
    xlab = "Jumlah Klaster (k)",
    ylab = "Silhouette Index",
    main = "Tuning Jumlah Klaster K-Medoids"
  )
  abline(v = k_opt_kmed, lty = 2, col = "red")

GMM

k_range <- 2:6
sil_gmm <- numeric(length(k_range))
bic_gmm <- numeric(length(k_range))

for (i in seq_along(k_range)) {
  k <- k_range[i]
  gmm_tmp <- Mclust(data_pca, G = k, verbose = FALSE)
  sil <- silhouette(gmm_tmp$classification, dist(data_pca))
  sil_gmm[i] <- mean(sil[, "sil_width"])
  bic_gmm[i] <- max(gmm_tmp$bic)
}

# Data Frame
df_gmm <- data.frame(
  Metode = "GMM",
  K = k_range,
  Silhouette = sil_gmm,
  BIC = bic_gmm
)
df_gmm
##   Metode K Silhouette       BIC
## 1    GMM 2  0.7560847 -241.3543
## 2    GMM 3  0.5572465 -239.7693
## 3    GMM 4  0.5557908 -235.6264
## 4    GMM 5  0.4025244 -234.0796
## 5    GMM 6  0.5117878 -232.5772
k_opt_gmm <- df_gmm$K[which.max(df_gmm$Silhouette)]

# Plot Silhouette
plot(
  k_range, sil_gmm,
  type = "b", pch = 19,
  xlab = "Jumlah Klaster (k)",
  ylab = "Silhouette Index",
  main = "Tuning Jumlah Klaster GMM (Silhouette)"
)
abline(v = k_opt_gmm, lty = 2, col = "red")

# Plot BIC
plot(
  k_range, bic_gmm,
  type = "b", pch = 19,
  xlab = "Jumlah Klaster (k)",
  ylab = "BIC",
  main = "Tuning Jumlah Klaster GMM (BIC)"
)
abline(v = k_range[which.min(bic_gmm)], lty = 2, col = "blue")

k dipilih berdasarkan Silhouette (tertinggi), dengan BIC sebagai validasi kompleksitas model (terendah)

Spectral

k_range <- 2:6
sil_spec <- numeric(length(k_range))

for (i in seq_along(k_range)) {
  k <- k_range[i]
  
  spec_tmp <- specc(
    data_pca,
    centers = k,
    kernel = "rbfdot"
  )
  
  cl <- as.integer(spec_tmp)
  sil <- silhouette(cl, dist(data_pca))
  sil_spec[i] <- mean(sil[, "sil_width"])
}

# Data Frame
df_spec <- data.frame(
  Metode = "Spectral",
  K = k_range,
  Silhouette = sil_spec
)
df_spec
##     Metode K Silhouette
## 1 Spectral 2  0.7804345
## 2 Spectral 3  0.2441622
## 3 Spectral 4  0.4404547
## 4 Spectral 5  0.4649247
## 5 Spectral 6  0.3724160
k_opt_spec <- df_spec$K[which.max(df_spec$Silhouette)]

# Plot Silhouette
plot(
  k_range, sil_spec,
  type = "b", pch = 19,
  xlab = "Jumlah Klaster (k)",
  ylab = "Silhouette Index",
  main = "Tuning Jumlah Klaster Spectral Clustering"
)
abline(v = k_opt_spec, lty = 2, col = "red")

Metode Klastering

K-Medoids

set.seed(123)
kmedoids_res <- pam(data_pca, k = k_opt_kmed)
kmedoids <- factor(kmedoids_res$clustering)

table(kmedoids)
## kmedoids
##  1  2 
## 31  3

GAUSSIAN MIXTURE MODEL (GMM)

gmm_final <- Mclust(data_pca, G = k_opt_gmm)
gmm <- factor(gmm_final$classification)

summary(gmm_final)
## ---------------------------------------------------- 
## Gaussian finite mixture model fitted by EM algorithm 
## ---------------------------------------------------- 
## 
## Mclust EVV (ellipsoidal, equal volume) model with 2 components: 
## 
##  log-likelihood  n df       BIC       ICL
##       -103.0453 34 10 -241.3543 -241.3543
## 
## Clustering table:
##  1  2 
##  4 30
table(gmm)
## gmm
##  1  2 
##  4 30

SPECTRAL CLUSTERING

set.seed(123)
spectral_res <- specc(
  data_pca,
  centers = k_opt_spec,
  kernel  = "rbfdot"
)

spectral <- factor(as.integer(spectral_res))
table(spectral)
## spectral
##  1  2 
## 31  3

Evaluasi Klaster

# Konversi label klaster ke numerik
cl_kmed <- as.numeric(kmedoids)
cl_spec <- as.numeric(spectral)
cl_gmm <- gmm_final$classification

Silhouette Score

# Fungsi Silhouette
hitung_silhouette <- function(data, cluster) {
  sil <- silhouette(cluster, dist(data))
  mean(sil[, "sil_width"])
}

Dunn-Index

dunn_kmed <- cluster.stats(
  d = dist(data_pca),
  clustering = cl_kmed
)$dunn

dunn_gmm <- cluster.stats(
  d = dist(data_pca),
  clustering = cl_gmm
)$dunn

dunn_spec <- cluster.stats(
  d = dist(data_pca),
  clustering = cl_spec
)$dunn

Davies-Bound Index

db_kmed <- index.DB(data_pca, cl_kmed)$DB
db_gmm <- index.DB(data_pca, cl_gmm)$DB
db_spec <- index.DB(data_pca, cl_spec)$DB

Calinski-Harabasz Score

hitung_ch <- function(data, cluster) {
  intCriteria(
    as.matrix(data),
    as.integer(cluster),
    "Calinski_Harabasz"
  )$calinski_harabasz
}

Gabungan Evaluasi Klaster

data.frame(
  Metode = c("K-Medoids", "GMMM", "Spectral"),
  Silhouette = c(
    hitung_silhouette(data_pca, cl_kmed),
    hitung_silhouette(data_pca, cl_gmm),
    hitung_silhouette(data_pca, cl_spec)
  ),
  Dunn = c(dunn_kmed, dunn_gmm, dunn_spec),
  Davies_Bouldin = c(db_kmed, db_gmm, db_spec),
  CH_Score = c(
    hitung_ch(data_pca, cl_kmed),
    hitung_ch(data_pca, cl_gmm),
    hitung_ch(data_pca, cl_spec)
  )
)
##      Metode Silhouette      Dunn Davies_Bouldin CH_Score
## 1 K-Medoids  0.7804345 0.8462686      0.2128929 78.83529
## 2      GMMM  0.7560847 0.7000952      0.4774531 84.37198
## 3  Spectral  0.7804345 0.8462686      0.2128929 78.83529

Meskipun K-Medoids dan Spectral Clustering menghasilkan nilai indeks evaluasi internal yang identik, pemilihan metode terbaik tidak hanya didasarkan pada kualitas struktur klaster, tetapi juga mempertimbangkan konsistensi hasil dan kemudahan interpretasi. K-Medoids dipilih karena memberikan representasi klaster yang lebih mudah diinterpretasikan melalui medoid yang merupakan observasi nyata, serta menunjukkan tingkat konvergensi yang lebih konsisten pada seluruh iterasi pengujian dibandingkan Spectral Clustering yang sensitif terhadap parameter kernel.

Profil dan Klasifikasi Klaster

data_with_cluster <- data %>%
  mutate(cluster = factor(kmedoids_res$clustering))

(summary_by_cluster <- data_with_cluster %>%
  group_by(cluster) %>%
  summarise(
    across(
      where(is.numeric),
      list(mean = ~ mean(.x, na.rm = TRUE)),
      .names = "{col}_{fn}"
    )
  ))
## # A tibble: 2 × 13
##   cluster Perawat_mean Bidan_mean Kefarmasian_mean `Kesehatan Masyarakat_mean`
##   <fct>          <dbl>      <dbl>            <dbl>                       <dbl>
## 1 1             11724.      7781.            2237.                       1351.
## 2 2             69312      32705.           19899.                       3214.
## # ℹ 8 more variables: `Kesehatan Lingkungan_mean` <dbl>,
## #   `Tenaga Gizi_mean` <dbl>, `Tenaga Medis (Dokter)_mean` <dbl>,
## #   `Psikologi Klinis_mean` <dbl>, `Keterapian Fisik_mean` <dbl>,
## #   `Keteknisan Medis_mean` <dbl>, `Teknik Biomedika_mean` <dbl>,
## #   `Jumlah Penduduk_mean` <dbl>
kategori_klaster <- summary_by_cluster %>%
  mutate(
    skor_rata = rowMeans(
      dplyr::select(., ends_with("_mean")),
      na.rm = TRUE
    ),
    Kategori = case_when(
      skor_rata == max(skor_rata) ~ "Ketersediaan Tenaga Kesehatan Tinggi",
      skor_rata == min(skor_rata) ~ "Ketersediaan Tenaga Kesehatan Rendah"
    )
  ) %>%
  dplyr::select(cluster, Kategori)
# anggota per klaster
# Anggota per klaster
k_optimal <- 2

print(table(data_with_cluster$cluster))
## 
##  1  2 
## 31  3
for (i in 1:k_optimal) {
  cat("\n--- Klaster", i, "---\n")
  print(data_with_cluster$Provinsi[data_with_cluster$cluster == i])
}
## 
## --- Klaster 1 ---
##  [1] "Aceh"                       "Sumatera Utara"            
##  [3] "Sumatera Barat"             "Riau"                      
##  [5] "Jambi"                      "Sumatera Selatan"          
##  [7] "Bengkulu"                   "Lampung"                   
##  [9] "Kepulauan Bangka Belitung"  "Kepulauan Riau"            
## [11] "DKI Jakarta"                "Daerah Istimewa Yogyakarta"
## [13] "Banten"                     "Bali"                      
## [15] "Nusa Tenggara Barat"        "Nusa Tenggara Timur"       
## [17] "Kalimantan Barat"           "Kalimantan Tengah"         
## [19] "Kalimantan Selatan"         "Kalimantan Timur"          
## [21] "Kalimantan Utara"           "Sulawesi Utara"            
## [23] "Sulawesi Tengah"            "Sulawesi Selatan"          
## [25] "Sulawesi Tenggara"          "Gorontalo"                 
## [27] "Sulawesi Barat"             "Maluku"                    
## [29] "Maluku Utara"               "Papua Barat"               
## [31] "Papua"                     
## 
## --- Klaster 2 ---
## [1] "Jawa Barat"  "Jawa Tengah" "Jawa Timur"
data_final <- data_with_cluster %>%
  left_join(kategori_klaster, by = "cluster")
head(data_final)
## # A tibble: 6 × 15
##   Provinsi         Perawat Bidan Kefarmasian `Kesehatan Masyarakat`
##   <chr>              <dbl> <dbl>       <dbl>                  <dbl>
## 1 Aceh               21435 21767        3165                   3890
## 2 Sumatera Utara     25787 27122        3970                   3167
## 3 Sumatera Barat     12236  9313        2548                   1430
## 4 Riau               12185 10246        2634                   1392
## 5 Jambi               8425  7512        1635                   1059
## 6 Sumatera Selatan   17309 15942        2971                   2217
## # ℹ 10 more variables: `Kesehatan Lingkungan` <dbl>, `Tenaga Gizi` <dbl>,
## #   `Tenaga Medis (Dokter)` <dbl>, `Psikologi Klinis` <dbl>,
## #   `Keterapian Fisik` <dbl>, `Keteknisan Medis` <dbl>,
## #   `Teknik Biomedika` <dbl>, `Jumlah Penduduk` <dbl>, cluster <fct>,
## #   Kategori <chr>

Visualisasi Hasil Klaster

Visualisasi K-Medoids Klaster

p <- fviz_cluster(
  kmedoids_res,
  data = data,
  geom = "point",
  ellipse.type = "convex",
  palette = "jco",
  ggtheme = theme_minimal()
)

df_plot <- p$data

df_plot$daerah <- data$Provinsi 

p + 
  geom_text_repel(
    data = df_plot,
    aes(x = x, y = y, label = daerah, color = cluster),
    size = 2.5,             
    max.overlaps = 15,     
    segment.color = NA    
  ) +
  guides(color = guide_legend(title = "Cluster")) +
  labs(title = "Visualisasi Klaster K-Medoids") +
  theme(
    plot.title = element_text(face = "bold", size = 14)
  )
## Warning: ggrepel: 3 unlabeled data points (too many overlaps). Consider
## increasing max.overlaps

Visualisasi ke Peta Wilayah

# Shapefile provinsi Indonesia
shp_path <- "D:/STATISTIKA RECAP/SEMESTER 5/Sains Data Spasial/BATAS PROVINSI DESEMBER 2019 DUKCAPIL/BATAS PROVINSI DESEMBER 2019 DUKCAPIL/BATAS_PROVINSI_DESEMBER_2019_DUKCAPIL.shp"

ind_sf <- st_read(shp_path, quiet = TRUE)
unique(ind_sf$PROVINSI)
##  [1] "ACEH"                       "BALI"                      
##  [3] "BANTEN"                     "BENGKULU"                  
##  [5] "DAERAH ISTIMEWA YOGYAKARTA" "DKI JAKARTA"               
##  [7] "GORONTALO"                  "JAMBI"                     
##  [9] "JAWA BARAT"                 "JAWA TENGAH"               
## [11] "JAWA TIMUR"                 "KALIMANTAN BARAT"          
## [13] "KALIMANTAN SELATAN"         "KALIMANTAN TENGAH"         
## [15] "KALIMANTAN TIMUR"           "KALIMANTAN UTARA"          
## [17] "KEPULAUAN BANGKA BELITUNG"  "KEPULAUAN RIAU"            
## [19] "LAMPUNG"                    "MALUKU"                    
## [21] "MALUKU UTARA"               "NUSA TENGGARA BARAT"       
## [23] "NUSA TENGGARA TIMUR"        "PAPUA"                     
## [25] "PAPUA BARAT"                "RIAU"                      
## [27] "SULAWESI BARAT"             "SULAWESI SELATAN"          
## [29] "SULAWESI TENGAH"            "SULAWESI TENGGARA"         
## [31] "SULAWESI UTARA"             "SUMATERA BARAT"            
## [33] "SUMATERA SELATAN"           "SUMATERA UTARA"
# Normalisasi nama provinsi
ind_sf <- ind_sf %>%
  mutate(PROVINSI_norm = toupper(trimws(PROVINSI)))

data_with_cluster <- data_with_cluster %>%
  mutate(provinsi_norm = toupper(trimws(Provinsi)))

# Join data klaster dengan shapefile
ind_sf <- ind_sf %>%
  left_join(
    data_with_cluster %>%
      dplyr::select(provinsi_norm, cluster),
    by = c("PROVINSI_norm" = "provinsi_norm")
  ) %>%
  rename(Cluster = cluster)

ind_sf <- st_make_valid(ind_sf) %>%
  st_transform(3857)


ind_sf_centroid <- ind_sf %>%
  filter(Cluster != "Data Tidak Lengkap") %>%
  mutate(
    centroid = st_centroid(geometry),
    lon = st_coordinates(centroid)[, 1],
    lat = st_coordinates(centroid)[, 2]
  )

ggplot() +
  geom_sf(
    data = ind_sf,
    aes(fill = Cluster),
    color = "grey40",
    size = 0.2
  ) +
  geom_text_repel(
    data = ind_sf_centroid,
    aes(x = lon, y = lat, label = PROVINSI_norm),
    size = 2.2,
    segment.size = 0.2,
    max.overlaps = 20
  ) +
  scale_fill_manual(
    values = c(
      "1" = "#fc8d62",
      "2" = "#66c2a5",
      "Data Tidak Lengkap" = "grey85"
    ),
    name = "Klaster"
  ) +
  labs(
    title = "Peta Klaster Ketersediaan Tenaga Kesehatan per Provinsi (2023)",
    subtitle = "Hasil Klasterisasi KMedoids berdasarkan Komponen Utama (PCA)",
    caption = "Sumber data: Badan Pusat Statistik Indonesia, 2023"
  ) +
  theme_minimal() +
  theme(
    legend.position = "right",
    plot.title = element_text(face = "bold")
  )

LS0tDQp0aXRsZTogIlBlcmJhbmRpbmdhbiBNZXRvZGUgS2xhc3RlcmluZyBkYWxhbSBQZW5nZWxvbXBva2FuIFByb3ZpbnNpIEJlcmRhc2Fya2FuIEp1bWxhaCBUZW5hZ2EgS2VzZWhhdGFuIGRpIEluZG9uZXNpYSBUYWh1biAyMDIzIg0KYXV0aG9yOiAiS2Vsb21wb2sgSyINCmRhdGU6ICJgciBTeXMuRGF0ZSgpYCINCm91dHB1dDogb3BlbmludHJvOjpsYWJfcmVwb3J0DQotLS0NCg0KIyBMb2FkaW5nIFBhY2thZ2UNCmBgYHtyfQ0KbGlicmFyeShyZWFkeGwpDQpsaWJyYXJ5KGRwbHlyKQ0KbGlicmFyeShjbHVzdGVyKQ0KbGlicmFyeShmYWN0b2V4dHJhKQ0KbGlicmFyeShtY2x1c3QpDQpsaWJyYXJ5KGtlcm5sYWIpICAgICAgIyBzcGVjdHJhbCBjbHVzdGVyaW5nDQpsaWJyYXJ5KGNhcikNCmxpYnJhcnkoZ2djb3JycGxvdCkNCmxpYnJhcnkoZ2dyZXBlbCkNCmxpYnJhcnkocHN5Y2gpDQpsaWJyYXJ5KGZwYykNCmxpYnJhcnkoY2x1c3RlclNpbSkNCmxpYnJhcnkoY2x1c3RlckNyaXQpDQpsaWJyYXJ5KGdncGxvdDIpDQpsaWJyYXJ5KHNmKQ0KYGBgDQoNCiMgSW1wb3J0IERhdGENCmBgYHtyfQ0KZGF0YSA8LSByZWFkX2V4Y2VsKCJDOi9Vc2Vycy9OYWJpbGEvT25lRHJpdmUvRG9rdW1lbi9SU3R1ZGlvL1BETSBTTVQgNS9kYXRhX3RicDIueGxzeCIpDQpjYXQoIlRvdGFsIG1pc3NpbmcgdmFsdWVzOiIsIHN1bShpcy5uYShkYXRhKSksICJcbiIpDQoNCmRhdGEkYEp1bWxhaCBQZW5kdWR1a2AgPC0gZGF0YSRgSnVtbGFoIFBlbmR1ZHVrYCAqIDEwMDANCg0KaGVhZChkYXRhKQ0KYGBgDQoNCiMgU2VsZWtzaSBEYXRhIE51bWVyaWsNCmBgYHtyfQ0KZGF0YV9udW0gPC0gZGF0YSAlPiUgDQogIGRwbHlyOjpzZWxlY3Qod2hlcmUoaXMubnVtZXJpYykpDQpgYGANCg0KIyBFeHBsb3JhdG9yeSBEYXRhIEFuYWx5c2lzDQojIyBLb3JlbGFzaQ0KYGBge3J9DQpjb3JfbWF0IDwtIGNvcihkYXRhX251bSkNCnJvdW5kKGNvcl9tYXQsIDIpDQoNCmdnY29ycnBsb3QoDQogIGNvcihkYXRhX251bSwgdXNlID0gInBhaXJ3aXNlLmNvbXBsZXRlLm9icyIpLA0KICBoYy5vcmRlciA9IFRSVUUsDQogIHR5cGUgPSAibG93ZXIiLA0KICBsYWIgPSBUUlVFDQopDQpgYGANCg0KIyMgRGV0ZWtzaSBPdXRsaWVyDQpgYGB7cn0NCiMgRGV0ZWtzaSBvdXRsaWVyIChJUVIpDQpkZXRlY3Rfb3V0bGllcnNfaXFyIDwtIGZ1bmN0aW9uKHgpIHsNCiAgUTEgPC0gcXVhbnRpbGUoeCwgMC4yNSwgbmEucm0gPSBUUlVFKQ0KICBRMyA8LSBxdWFudGlsZSh4LCAwLjc1LCBuYS5ybSA9IFRSVUUpDQogIElRUnYgPC0gSVFSKHgsIG5hLnJtID0gVFJVRSkNCiAgbG93ZXIgPC0gUTEgLSAxLjUgKiBJUVJ2DQogIHVwcGVyIDwtIFEzICsgMS41ICogSVFSdg0KICB3aGljaCh4IDwgbG93ZXIgfCB4ID4gdXBwZXIpDQp9DQoNCm91dGxpZXJfbGlzdCA8LSBsYXBwbHkoZGF0YV9udW0sIGRldGVjdF9vdXRsaWVyc19pcXIpDQpwcmludChvdXRsaWVyX2xpc3QpDQoNCmJveHBsb3QoZGF0YV9udW0sIG1haW4gPSAiT3V0bGllciBTZW11YSBWYXJpYWJlbCIpDQpgYGANCg0KIyBEaWFnbm9zdGlrIERhdGENCiMjIENlayBNdWx0aWtvbGluZWFyaXRhcw0KYGBge3J9DQp2aWZfbW9kZWwgPC0gbG0oZGF0YV9udW1bWzFdXSB+IC4sIGRhdGEgPSBkYXRhX251bSkNCnZpZih2aWZfbW9kZWwpDQpgYGANCg0KIyMgVWppIEtNTw0KYGBge3J9DQprbW9fcmVzdWx0IDwtIEtNTyhkYXRhX251bSkNCmttb19yZXN1bHQNCmBgYA0KDQojIyBVamkgQmFydGxldHQncw0KYGBge3J9DQpiYXJ0bGV0dF9yZXN1bHQgPC0gY29ydGVzdC5iYXJ0bGV0dCgNCiAgY29yKGRhdGFfbnVtKSwNCiAgbiA9IG5yb3coZGF0YV9udW0pDQopDQpiYXJ0bGV0dF9yZXN1bHQNCmBgYA0KDQojIFByaW5jaXBhbCBDb21wb25lbnQgQW5hbHlzaXMgKFBDQSkNCmBgYHtyfQ0KcGNhX3Jlc3VsdCA8LSBwcmNvbXAoDQogIGRhdGFfbnVtLA0KICBjZW50ZXIgPSBUUlVFLA0KICBzY2FsZS4gPSBUUlVFDQopDQoNCmVpZ2VudmFsdWVzIDwtIHBjYV9yZXN1bHQkc2Rldl4yDQpwcm9wX3ZhciAgICA8LSBlaWdlbnZhbHVlcyAvIHN1bShlaWdlbnZhbHVlcykNCmN1bV92YXIgICAgIDwtIGN1bXN1bShwcm9wX3ZhcikNCg0KZGF0YS5mcmFtZSgNCiAgUEMgICAgICAgICA9IHBhc3RlMCgiUEMiLCBzZXFfYWxvbmcoZWlnZW52YWx1ZXMpKSwNCiAgRWlnZW52YWx1ZSA9IGVpZ2VudmFsdWVzLA0KICBQcm9wb3JzaSAgID0gcHJvcF92YXIsDQogIEt1bXVsYXRpZiAgPSBjdW1fdmFyDQopDQoNCnBsb3QoDQogIGVpZ2VudmFsdWVzLA0KICB0eXBlID0gImIiLA0KICB4bGFiID0gIlByaW5jaXBhbCBDb21wb25lbnQiLA0KICB5bGFiID0gIkVpZ2VudmFsdWUiDQopDQoNCnBjYV9zY29yZXMgPC0gYXMuZGF0YS5mcmFtZShwY2FfcmVzdWx0JHgpDQpgYGANCg0KYGBge3J9DQpkYXRhX3BjYSA8LSBhcy5tYXRyaXgocGNhX3Njb3Jlc1ssIDE6Ml0pDQpgYGANCg0KIyBQZW5lbnR1YW4gSnVtbGFoIEtMYXN0ZXIgKGspDQojIyBLLU1lZG9pZHMNCmBgYHtyfQ0Ka19yYW5nZSA8LSAyOjYNCnNpbF9rbWVkIDwtIG51bWVyaWMobGVuZ3RoKGtfcmFuZ2UpKQ0KICANCmZvciAoaSBpbiBzZXFfYWxvbmcoa19yYW5nZSkpIHsNCiAgICBrIDwtIGtfcmFuZ2VbaV0NCiAgICBwYW1fdG1wIDwtIHBhbShkYXRhX3BjYSwgayA9IGspDQpzaWwgPC0gc2lsaG91ZXR0ZShwYW1fdG1wJGNsdXN0ZXJpbmcsDQogICAgICAgICAgICAgICAgICBkaXN0KGRhdGFfcGNhKSkNCiAgICBzaWxfa21lZFtpXSA8LSBtZWFuKHNpbFssICJzaWxfd2lkdGgiXSkNCiAgfQ0KICANCiMgRGF0YSBGcmFtZQ0KZGZfa21lZCA8LSBkYXRhLmZyYW1lKA0KICAgIE1ldG9kZSA9ICJLLU1lZG9pZHMiLA0KICAgIEsgPSBrX3JhbmdlLA0KICAgIFNpbGhvdWV0dGUgPSBzaWxfa21lZA0KICApDQpkZl9rbWVkDQoNCmtfb3B0X2ttZWQgPC0gZGZfa21lZCRLW3doaWNoLm1heChkZl9rbWVkJFNpbGhvdWV0dGUpXQ0KDQojIFBsb3QgU2lsaG91ZXR0ZQ0KcGxvdCgNCiAgICBrX3JhbmdlLCBzaWxfa21lZCwNCiAgICB0eXBlID0gImIiLCBwY2ggPSAxOSwNCiAgICB4bGFiID0gIkp1bWxhaCBLbGFzdGVyIChrKSIsDQogICAgeWxhYiA9ICJTaWxob3VldHRlIEluZGV4IiwNCiAgICBtYWluID0gIlR1bmluZyBKdW1sYWggS2xhc3RlciBLLU1lZG9pZHMiDQogICkNCiAgYWJsaW5lKHYgPSBrX29wdF9rbWVkLCBsdHkgPSAyLCBjb2wgPSAicmVkIikNCg0KYGBgDQoNCiMjIEdNTQ0KYGBge3J9DQprX3JhbmdlIDwtIDI6Ng0Kc2lsX2dtbSA8LSBudW1lcmljKGxlbmd0aChrX3JhbmdlKSkNCmJpY19nbW0gPC0gbnVtZXJpYyhsZW5ndGgoa19yYW5nZSkpDQoNCmZvciAoaSBpbiBzZXFfYWxvbmcoa19yYW5nZSkpIHsNCiAgayA8LSBrX3JhbmdlW2ldDQogIGdtbV90bXAgPC0gTWNsdXN0KGRhdGFfcGNhLCBHID0gaywgdmVyYm9zZSA9IEZBTFNFKQ0KICBzaWwgPC0gc2lsaG91ZXR0ZShnbW1fdG1wJGNsYXNzaWZpY2F0aW9uLCBkaXN0KGRhdGFfcGNhKSkNCiAgc2lsX2dtbVtpXSA8LSBtZWFuKHNpbFssICJzaWxfd2lkdGgiXSkNCiAgYmljX2dtbVtpXSA8LSBtYXgoZ21tX3RtcCRiaWMpDQp9DQoNCiMgRGF0YSBGcmFtZQ0KZGZfZ21tIDwtIGRhdGEuZnJhbWUoDQogIE1ldG9kZSA9ICJHTU0iLA0KICBLID0ga19yYW5nZSwNCiAgU2lsaG91ZXR0ZSA9IHNpbF9nbW0sDQogIEJJQyA9IGJpY19nbW0NCikNCmRmX2dtbQ0KDQprX29wdF9nbW0gPC0gZGZfZ21tJEtbd2hpY2gubWF4KGRmX2dtbSRTaWxob3VldHRlKV0NCg0KIyBQbG90IFNpbGhvdWV0dGUNCnBsb3QoDQogIGtfcmFuZ2UsIHNpbF9nbW0sDQogIHR5cGUgPSAiYiIsIHBjaCA9IDE5LA0KICB4bGFiID0gIkp1bWxhaCBLbGFzdGVyIChrKSIsDQogIHlsYWIgPSAiU2lsaG91ZXR0ZSBJbmRleCIsDQogIG1haW4gPSAiVHVuaW5nIEp1bWxhaCBLbGFzdGVyIEdNTSAoU2lsaG91ZXR0ZSkiDQopDQphYmxpbmUodiA9IGtfb3B0X2dtbSwgbHR5ID0gMiwgY29sID0gInJlZCIpDQoNCiMgUGxvdCBCSUMNCnBsb3QoDQogIGtfcmFuZ2UsIGJpY19nbW0sDQogIHR5cGUgPSAiYiIsIHBjaCA9IDE5LA0KICB4bGFiID0gIkp1bWxhaCBLbGFzdGVyIChrKSIsDQogIHlsYWIgPSAiQklDIiwNCiAgbWFpbiA9ICJUdW5pbmcgSnVtbGFoIEtsYXN0ZXIgR01NIChCSUMpIg0KKQ0KYWJsaW5lKHYgPSBrX3JhbmdlW3doaWNoLm1pbihiaWNfZ21tKV0sIGx0eSA9IDIsIGNvbCA9ICJibHVlIikNCmBgYA0KDQprIGRpcGlsaWggYmVyZGFzYXJrYW4gU2lsaG91ZXR0ZSAodGVydGluZ2dpKSwgZGVuZ2FuIEJJQyBzZWJhZ2FpIHZhbGlkYXNpIGtvbXBsZWtzaXRhcyBtb2RlbCAodGVyZW5kYWgpDQoNCiMjIFNwZWN0cmFsDQpgYGB7cn0NCmtfcmFuZ2UgPC0gMjo2DQpzaWxfc3BlYyA8LSBudW1lcmljKGxlbmd0aChrX3JhbmdlKSkNCg0KZm9yIChpIGluIHNlcV9hbG9uZyhrX3JhbmdlKSkgew0KICBrIDwtIGtfcmFuZ2VbaV0NCiAgDQogIHNwZWNfdG1wIDwtIHNwZWNjKA0KICAgIGRhdGFfcGNhLA0KICAgIGNlbnRlcnMgPSBrLA0KICAgIGtlcm5lbCA9ICJyYmZkb3QiDQogICkNCiAgDQogIGNsIDwtIGFzLmludGVnZXIoc3BlY190bXApDQogIHNpbCA8LSBzaWxob3VldHRlKGNsLCBkaXN0KGRhdGFfcGNhKSkNCiAgc2lsX3NwZWNbaV0gPC0gbWVhbihzaWxbLCAic2lsX3dpZHRoIl0pDQp9DQoNCiMgRGF0YSBGcmFtZQ0KZGZfc3BlYyA8LSBkYXRhLmZyYW1lKA0KICBNZXRvZGUgPSAiU3BlY3RyYWwiLA0KICBLID0ga19yYW5nZSwNCiAgU2lsaG91ZXR0ZSA9IHNpbF9zcGVjDQopDQpkZl9zcGVjDQoNCmtfb3B0X3NwZWMgPC0gZGZfc3BlYyRLW3doaWNoLm1heChkZl9zcGVjJFNpbGhvdWV0dGUpXQ0KDQojIFBsb3QgU2lsaG91ZXR0ZQ0KcGxvdCgNCiAga19yYW5nZSwgc2lsX3NwZWMsDQogIHR5cGUgPSAiYiIsIHBjaCA9IDE5LA0KICB4bGFiID0gIkp1bWxhaCBLbGFzdGVyIChrKSIsDQogIHlsYWIgPSAiU2lsaG91ZXR0ZSBJbmRleCIsDQogIG1haW4gPSAiVHVuaW5nIEp1bWxhaCBLbGFzdGVyIFNwZWN0cmFsIENsdXN0ZXJpbmciDQopDQphYmxpbmUodiA9IGtfb3B0X3NwZWMsIGx0eSA9IDIsIGNvbCA9ICJyZWQiKQ0KYGBgDQoNCiMgTWV0b2RlIEtsYXN0ZXJpbmcNCiMjIEstTWVkb2lkcw0KDQpgYGB7cn0NCnNldC5zZWVkKDEyMykNCmttZWRvaWRzX3JlcyA8LSBwYW0oZGF0YV9wY2EsIGsgPSBrX29wdF9rbWVkKQ0Ka21lZG9pZHMgPC0gZmFjdG9yKGttZWRvaWRzX3JlcyRjbHVzdGVyaW5nKQ0KDQp0YWJsZShrbWVkb2lkcykNCmBgYA0KDQojIyBHQVVTU0lBTiBNSVhUVVJFIE1PREVMIChHTU0pDQpgYGB7cn0NCmdtbV9maW5hbCA8LSBNY2x1c3QoZGF0YV9wY2EsIEcgPSBrX29wdF9nbW0pDQpnbW0gPC0gZmFjdG9yKGdtbV9maW5hbCRjbGFzc2lmaWNhdGlvbikNCg0Kc3VtbWFyeShnbW1fZmluYWwpDQp0YWJsZShnbW0pDQpgYGANCg0KIyMgU1BFQ1RSQUwgQ0xVU1RFUklORw0KYGBge3J9DQpzZXQuc2VlZCgxMjMpDQpzcGVjdHJhbF9yZXMgPC0gc3BlY2MoDQogIGRhdGFfcGNhLA0KICBjZW50ZXJzID0ga19vcHRfc3BlYywNCiAga2VybmVsICA9ICJyYmZkb3QiDQopDQoNCnNwZWN0cmFsIDwtIGZhY3Rvcihhcy5pbnRlZ2VyKHNwZWN0cmFsX3JlcykpDQp0YWJsZShzcGVjdHJhbCkNCmBgYA0KDQojIEV2YWx1YXNpIEtsYXN0ZXINCmBgYHtyfQ0KIyBLb252ZXJzaSBsYWJlbCBrbGFzdGVyIGtlIG51bWVyaWsNCmNsX2ttZWQgPC0gYXMubnVtZXJpYyhrbWVkb2lkcykNCmNsX3NwZWMgPC0gYXMubnVtZXJpYyhzcGVjdHJhbCkNCmNsX2dtbSA8LSBnbW1fZmluYWwkY2xhc3NpZmljYXRpb24NCmBgYA0KDQojIyBTaWxob3VldHRlIFNjb3JlDQpgYGB7cn0NCiMgRnVuZ3NpIFNpbGhvdWV0dGUNCmhpdHVuZ19zaWxob3VldHRlIDwtIGZ1bmN0aW9uKGRhdGEsIGNsdXN0ZXIpIHsNCiAgc2lsIDwtIHNpbGhvdWV0dGUoY2x1c3RlciwgZGlzdChkYXRhKSkNCiAgbWVhbihzaWxbLCAic2lsX3dpZHRoIl0pDQp9DQpgYGANCg0KIyMgRHVubi1JbmRleA0KYGBge3J9DQpkdW5uX2ttZWQgPC0gY2x1c3Rlci5zdGF0cygNCiAgZCA9IGRpc3QoZGF0YV9wY2EpLA0KICBjbHVzdGVyaW5nID0gY2xfa21lZA0KKSRkdW5uDQoNCmR1bm5fZ21tIDwtIGNsdXN0ZXIuc3RhdHMoDQogIGQgPSBkaXN0KGRhdGFfcGNhKSwNCiAgY2x1c3RlcmluZyA9IGNsX2dtbQ0KKSRkdW5uDQoNCmR1bm5fc3BlYyA8LSBjbHVzdGVyLnN0YXRzKA0KICBkID0gZGlzdChkYXRhX3BjYSksDQogIGNsdXN0ZXJpbmcgPSBjbF9zcGVjDQopJGR1bm4NCmBgYA0KDQojIyBEYXZpZXMtQm91bmQgSW5kZXgNCmBgYHtyfQ0KZGJfa21lZCA8LSBpbmRleC5EQihkYXRhX3BjYSwgY2xfa21lZCkkREINCmRiX2dtbSA8LSBpbmRleC5EQihkYXRhX3BjYSwgY2xfZ21tKSREQg0KZGJfc3BlYyA8LSBpbmRleC5EQihkYXRhX3BjYSwgY2xfc3BlYykkREINCmBgYA0KDQojIyBDYWxpbnNraS1IYXJhYmFzeiBTY29yZQ0KYGBge3J9DQpoaXR1bmdfY2ggPC0gZnVuY3Rpb24oZGF0YSwgY2x1c3Rlcikgew0KICBpbnRDcml0ZXJpYSgNCiAgICBhcy5tYXRyaXgoZGF0YSksDQogICAgYXMuaW50ZWdlcihjbHVzdGVyKSwNCiAgICAiQ2FsaW5za2lfSGFyYWJhc3oiDQogICkkY2FsaW5za2lfaGFyYWJhc3oNCn0NCmBgYA0KDQojIyBHYWJ1bmdhbiBFdmFsdWFzaSBLbGFzdGVyDQpgYGB7cn0NCmRhdGEuZnJhbWUoDQogIE1ldG9kZSA9IGMoIkstTWVkb2lkcyIsICJHTU1NIiwgIlNwZWN0cmFsIiksDQogIFNpbGhvdWV0dGUgPSBjKA0KICAgIGhpdHVuZ19zaWxob3VldHRlKGRhdGFfcGNhLCBjbF9rbWVkKSwNCiAgICBoaXR1bmdfc2lsaG91ZXR0ZShkYXRhX3BjYSwgY2xfZ21tKSwNCiAgICBoaXR1bmdfc2lsaG91ZXR0ZShkYXRhX3BjYSwgY2xfc3BlYykNCiAgKSwNCiAgRHVubiA9IGMoZHVubl9rbWVkLCBkdW5uX2dtbSwgZHVubl9zcGVjKSwNCiAgRGF2aWVzX0JvdWxkaW4gPSBjKGRiX2ttZWQsIGRiX2dtbSwgZGJfc3BlYyksDQogIENIX1Njb3JlID0gYygNCiAgICBoaXR1bmdfY2goZGF0YV9wY2EsIGNsX2ttZWQpLA0KICAgIGhpdHVuZ19jaChkYXRhX3BjYSwgY2xfZ21tKSwNCiAgICBoaXR1bmdfY2goZGF0YV9wY2EsIGNsX3NwZWMpDQogICkNCikNCmBgYA0KDQpNZXNraXB1biBLLU1lZG9pZHMgZGFuIFNwZWN0cmFsIENsdXN0ZXJpbmcgbWVuZ2hhc2lsa2FuIG5pbGFpIGluZGVrcyBldmFsdWFzaSBpbnRlcm5hbCB5YW5nIGlkZW50aWssIHBlbWlsaWhhbiBtZXRvZGUgdGVyYmFpayB0aWRhayBoYW55YSBkaWRhc2Fya2FuIHBhZGEga3VhbGl0YXMgc3RydWt0dXIga2xhc3RlciwgdGV0YXBpIGp1Z2EgbWVtcGVydGltYmFuZ2thbiBrb25zaXN0ZW5zaSBoYXNpbCBkYW4ga2VtdWRhaGFuIGludGVycHJldGFzaS4gSy1NZWRvaWRzIGRpcGlsaWgga2FyZW5hIG1lbWJlcmlrYW4gcmVwcmVzZW50YXNpIGtsYXN0ZXIgeWFuZyBsZWJpaCBtdWRhaCBkaWludGVycHJldGFzaWthbiBtZWxhbHVpIG1lZG9pZCB5YW5nIG1lcnVwYWthbiBvYnNlcnZhc2kgbnlhdGEsIHNlcnRhIG1lbnVuanVra2FuIHRpbmdrYXQga29udmVyZ2Vuc2kgeWFuZyBsZWJpaCBrb25zaXN0ZW4gcGFkYSBzZWx1cnVoIGl0ZXJhc2kgcGVuZ3VqaWFuIGRpYmFuZGluZ2thbiBTcGVjdHJhbCBDbHVzdGVyaW5nIHlhbmcgc2Vuc2l0aWYgdGVyaGFkYXAgcGFyYW1ldGVyIGtlcm5lbC4NCg0KDQojIFByb2ZpbCBkYW4gS2xhc2lmaWthc2kgS2xhc3Rlcg0KYGBge3J9DQpkYXRhX3dpdGhfY2x1c3RlciA8LSBkYXRhICU+JQ0KICBtdXRhdGUoY2x1c3RlciA9IGZhY3RvcihrbWVkb2lkc19yZXMkY2x1c3RlcmluZykpDQoNCihzdW1tYXJ5X2J5X2NsdXN0ZXIgPC0gZGF0YV93aXRoX2NsdXN0ZXIgJT4lDQogIGdyb3VwX2J5KGNsdXN0ZXIpICU+JQ0KICBzdW1tYXJpc2UoDQogICAgYWNyb3NzKA0KICAgICAgd2hlcmUoaXMubnVtZXJpYyksDQogICAgICBsaXN0KG1lYW4gPSB+IG1lYW4oLngsIG5hLnJtID0gVFJVRSkpLA0KICAgICAgLm5hbWVzID0gIntjb2x9X3tmbn0iDQogICAgKQ0KICApKQ0KYGBgDQoNCmBgYHtyfQ0Ka2F0ZWdvcmlfa2xhc3RlciA8LSBzdW1tYXJ5X2J5X2NsdXN0ZXIgJT4lDQogIG11dGF0ZSgNCiAgICBza29yX3JhdGEgPSByb3dNZWFucygNCiAgICAgIGRwbHlyOjpzZWxlY3QoLiwgZW5kc193aXRoKCJfbWVhbiIpKSwNCiAgICAgIG5hLnJtID0gVFJVRQ0KICAgICksDQogICAgS2F0ZWdvcmkgPSBjYXNlX3doZW4oDQogICAgICBza29yX3JhdGEgPT0gbWF4KHNrb3JfcmF0YSkgfiAiS2V0ZXJzZWRpYWFuIFRlbmFnYSBLZXNlaGF0YW4gVGluZ2dpIiwNCiAgICAgIHNrb3JfcmF0YSA9PSBtaW4oc2tvcl9yYXRhKSB+ICJLZXRlcnNlZGlhYW4gVGVuYWdhIEtlc2VoYXRhbiBSZW5kYWgiDQogICAgKQ0KICApICU+JQ0KICBkcGx5cjo6c2VsZWN0KGNsdXN0ZXIsIEthdGVnb3JpKQ0KYGBgDQoNCmBgYHtyfQ0KIyBhbmdnb3RhIHBlciBrbGFzdGVyDQojIEFuZ2dvdGEgcGVyIGtsYXN0ZXINCmtfb3B0aW1hbCA8LSAyDQoNCnByaW50KHRhYmxlKGRhdGFfd2l0aF9jbHVzdGVyJGNsdXN0ZXIpKQ0KDQpmb3IgKGkgaW4gMTprX29wdGltYWwpIHsNCiAgY2F0KCJcbi0tLSBLbGFzdGVyIiwgaSwgIi0tLVxuIikNCiAgcHJpbnQoZGF0YV93aXRoX2NsdXN0ZXIkUHJvdmluc2lbZGF0YV93aXRoX2NsdXN0ZXIkY2x1c3RlciA9PSBpXSkNCn0NCmBgYA0KDQpgYGB7cn0NCmRhdGFfZmluYWwgPC0gZGF0YV93aXRoX2NsdXN0ZXIgJT4lDQogIGxlZnRfam9pbihrYXRlZ29yaV9rbGFzdGVyLCBieSA9ICJjbHVzdGVyIikNCmhlYWQoZGF0YV9maW5hbCkNCmBgYA0KDQojIFZpc3VhbGlzYXNpIEhhc2lsIEtsYXN0ZXINCiMjIFZpc3VhbGlzYXNpIEstTWVkb2lkcyBLbGFzdGVyDQpgYGB7cn0NCnAgPC0gZnZpel9jbHVzdGVyKA0KICBrbWVkb2lkc19yZXMsDQogIGRhdGEgPSBkYXRhLA0KICBnZW9tID0gInBvaW50IiwNCiAgZWxsaXBzZS50eXBlID0gImNvbnZleCIsDQogIHBhbGV0dGUgPSAiamNvIiwNCiAgZ2d0aGVtZSA9IHRoZW1lX21pbmltYWwoKQ0KKQ0KDQpkZl9wbG90IDwtIHAkZGF0YQ0KDQpkZl9wbG90JGRhZXJhaCA8LSBkYXRhJFByb3ZpbnNpIA0KDQpwICsgDQogIGdlb21fdGV4dF9yZXBlbCgNCiAgICBkYXRhID0gZGZfcGxvdCwNCiAgICBhZXMoeCA9IHgsIHkgPSB5LCBsYWJlbCA9IGRhZXJhaCwgY29sb3IgPSBjbHVzdGVyKSwNCiAgICBzaXplID0gMi41LCAgICAgICAgICAgICANCiAgICBtYXgub3ZlcmxhcHMgPSAxNSwgICAgIA0KICAgIHNlZ21lbnQuY29sb3IgPSBOQSAgICANCiAgKSArDQogIGd1aWRlcyhjb2xvciA9IGd1aWRlX2xlZ2VuZCh0aXRsZSA9ICJDbHVzdGVyIikpICsNCiAgbGFicyh0aXRsZSA9ICJWaXN1YWxpc2FzaSBLbGFzdGVyIEstTWVkb2lkcyIpICsNCiAgdGhlbWUoDQogICAgcGxvdC50aXRsZSA9IGVsZW1lbnRfdGV4dChmYWNlID0gImJvbGQiLCBzaXplID0gMTQpDQogICkNCg0KYGBgDQoNCg0KIyMgVmlzdWFsaXNhc2kga2UgUGV0YSBXaWxheWFoDQpgYGB7cn0NCiMgU2hhcGVmaWxlIHByb3ZpbnNpIEluZG9uZXNpYQ0Kc2hwX3BhdGggPC0gIkQ6L1NUQVRJU1RJS0EgUkVDQVAvU0VNRVNURVIgNS9TYWlucyBEYXRhIFNwYXNpYWwvQkFUQVMgUFJPVklOU0kgREVTRU1CRVIgMjAxOSBEVUtDQVBJTC9CQVRBUyBQUk9WSU5TSSBERVNFTUJFUiAyMDE5IERVS0NBUElML0JBVEFTX1BST1ZJTlNJX0RFU0VNQkVSXzIwMTlfRFVLQ0FQSUwuc2hwIg0KDQppbmRfc2YgPC0gc3RfcmVhZChzaHBfcGF0aCwgcXVpZXQgPSBUUlVFKQ0KdW5pcXVlKGluZF9zZiRQUk9WSU5TSSkNCg0KIyBOb3JtYWxpc2FzaSBuYW1hIHByb3ZpbnNpDQppbmRfc2YgPC0gaW5kX3NmICU+JQ0KICBtdXRhdGUoUFJPVklOU0lfbm9ybSA9IHRvdXBwZXIodHJpbXdzKFBST1ZJTlNJKSkpDQoNCmRhdGFfd2l0aF9jbHVzdGVyIDwtIGRhdGFfd2l0aF9jbHVzdGVyICU+JQ0KICBtdXRhdGUocHJvdmluc2lfbm9ybSA9IHRvdXBwZXIodHJpbXdzKFByb3ZpbnNpKSkpDQoNCiMgSm9pbiBkYXRhIGtsYXN0ZXIgZGVuZ2FuIHNoYXBlZmlsZQ0KaW5kX3NmIDwtIGluZF9zZiAlPiUNCiAgbGVmdF9qb2luKA0KICAgIGRhdGFfd2l0aF9jbHVzdGVyICU+JQ0KICAgICAgZHBseXI6OnNlbGVjdChwcm92aW5zaV9ub3JtLCBjbHVzdGVyKSwNCiAgICBieSA9IGMoIlBST1ZJTlNJX25vcm0iID0gInByb3ZpbnNpX25vcm0iKQ0KICApICU+JQ0KICByZW5hbWUoQ2x1c3RlciA9IGNsdXN0ZXIpDQoNCmluZF9zZiA8LSBzdF9tYWtlX3ZhbGlkKGluZF9zZikgJT4lDQogIHN0X3RyYW5zZm9ybSgzODU3KQ0KDQoNCmluZF9zZl9jZW50cm9pZCA8LSBpbmRfc2YgJT4lDQogIGZpbHRlcihDbHVzdGVyICE9ICJEYXRhIFRpZGFrIExlbmdrYXAiKSAlPiUNCiAgbXV0YXRlKA0KICAgIGNlbnRyb2lkID0gc3RfY2VudHJvaWQoZ2VvbWV0cnkpLA0KICAgIGxvbiA9IHN0X2Nvb3JkaW5hdGVzKGNlbnRyb2lkKVssIDFdLA0KICAgIGxhdCA9IHN0X2Nvb3JkaW5hdGVzKGNlbnRyb2lkKVssIDJdDQogICkNCg0KZ2dwbG90KCkgKw0KICBnZW9tX3NmKA0KICAgIGRhdGEgPSBpbmRfc2YsDQogICAgYWVzKGZpbGwgPSBDbHVzdGVyKSwNCiAgICBjb2xvciA9ICJncmV5NDAiLA0KICAgIHNpemUgPSAwLjINCiAgKSArDQogIGdlb21fdGV4dF9yZXBlbCgNCiAgICBkYXRhID0gaW5kX3NmX2NlbnRyb2lkLA0KICAgIGFlcyh4ID0gbG9uLCB5ID0gbGF0LCBsYWJlbCA9IFBST1ZJTlNJX25vcm0pLA0KICAgIHNpemUgPSAyLjIsDQogICAgc2VnbWVudC5zaXplID0gMC4yLA0KICAgIG1heC5vdmVybGFwcyA9IDIwDQogICkgKw0KICBzY2FsZV9maWxsX21hbnVhbCgNCiAgICB2YWx1ZXMgPSBjKA0KICAgICAgIjEiID0gIiNmYzhkNjIiLA0KICAgICAgIjIiID0gIiM2NmMyYTUiLA0KICAgICAgIkRhdGEgVGlkYWsgTGVuZ2thcCIgPSAiZ3JleTg1Ig0KICAgICksDQogICAgbmFtZSA9ICJLbGFzdGVyIg0KICApICsNCiAgbGFicygNCiAgICB0aXRsZSA9ICJQZXRhIEtsYXN0ZXIgS2V0ZXJzZWRpYWFuIFRlbmFnYSBLZXNlaGF0YW4gcGVyIFByb3ZpbnNpICgyMDIzKSIsDQogICAgc3VidGl0bGUgPSAiSGFzaWwgS2xhc3RlcmlzYXNpIEtNZWRvaWRzIGJlcmRhc2Fya2FuIEtvbXBvbmVuIFV0YW1hIChQQ0EpIiwNCiAgICBjYXB0aW9uID0gIlN1bWJlciBkYXRhOiBCYWRhbiBQdXNhdCBTdGF0aXN0aWsgSW5kb25lc2lhLCAyMDIzIg0KICApICsNCiAgdGhlbWVfbWluaW1hbCgpICsNCiAgdGhlbWUoDQogICAgbGVnZW5kLnBvc2l0aW9uID0gInJpZ2h0IiwNCiAgICBwbG90LnRpdGxlID0gZWxlbWVudF90ZXh0KGZhY2UgPSAiYm9sZCIpDQogICkNCg0KDQpgYGANCg0K