Pemodelan topik ulasan tamu hotel berbintang di Bali berbasis LDA

# Contoh kode R: Text Mining and LDA Topic Modelling
suppressPackageStartupMessages({
  library(ggplot2)
  library(patchwork)
  library(dplyr)
  library(tidytext)
  library(topicmodels)
})
set.seed(42)
# ---- Gaya grafik ----
pal <- c("#1f6feb", "#e8590c", "#2f9e44", "#ae3ec9", "#f59f00")
warna <- list(bg = "#f4f6fa", panel = "#ffffff", teks = "#1f2933", redup = "#5f6b78", grid = "#e3e8ee", bar = "#1d3557")
tata <- 1
theme_set(theme_minimal(base_size = 11) + theme(legend.position = "bottom"))

# ---- Data sintetis: korpus dokumen pendek dari campuran 3 topik ----
n_dok <- sample(seq(300, 500, by = 10), 1)
kata_topik <- list(c("layanan", "cepat", "ramah", "petugas", "antrian", "pelayanan"), c("harga", "mahal", "murah", "biaya", "diskon", "tarif"), c("aplikasi", "error", "login", "update", "fitur", "lambat"))        # kata khas tiap topik
kata_henti <- c("yang", "dan", "di", "ke", "dari", "ini", "itu", "untuk", "dengan", "saya", "kami", "sudah", "tidak",
                "ada", "juga", "karena", "tapi", "jadi", "sangat", "bisa", "akan", "lagi", "masih", "atau", "pada",
                "sih", "aja", "ya", "lebih", "kalau", "sekali", "banget", "mau", "harus", "kok", "nya")
kata_umum <- sample(c("bagus", "kurang", "mohon", "semoga", "baru", "sering", "hari", "cukup", "pengalaman", "tolong",
                     "kali", "minggu", "pertama", "kemarin", "terus", "puas", "kecewa", "lumayan", "biasa", "oke"),
                   sample(8:14, 1))                     # kosakata umum yang muncul lintas topik
gamma_rand <- function(a) { g <- rgamma(length(a), a); g / sum(g) }   # Dirichlet lewat gamma
campuran <- t(replicate(n_dok, gamma_rand(rep(runif(1, 0.25, 0.45), 3))))
buat_dok <- function(th) {
  L <- sample(10:25, 1)
  jenis <- sample(c("topik", "henti", "umum"), L, replace = TRUE, prob = c(0.58, 0.32, 0.10))
  kata <- character(L)
  for (i in seq_len(L)) {
    kata[i] <- switch(jenis[i],
                      topik = { tp <- sample(1:3, 1, prob = th); sample(kata_topik[[tp]], 1, prob = 6:1) },
                      henti = sample(kata_henti, 1),
                      umum = sample(kata_umum, 1))
  }
  paste(kata, collapse = " ")
}
teks <- apply(campuran, 1, buat_dok)
efek <- sample(c(-1, 0, 1)) * runif(3, 0.7, 1.2)            # efek tiap topik terhadap sentimen/rating
laten <- as.numeric(scale(campuran %*% efek))
sentimen <- 50 + 10 * (0.85 * laten + rnorm(n_dok, 0, 0.55))
rating <- 30 + 6 * (0.75 * laten + rnorm(n_dok, 0, 0.6))
rating <- if (30 <= 5) pmin(pmax(round(rating), 1), 5) else round(rating, 1)   # bintang 1-5 bila skala kecil
d <- data.frame(hotel_guest_reviews = sprintf("D%03d", seq_len(n_dok)), teks = teks,
                sentiment_score = round(sentimen, 2), guest_rating = rating)
write.csv(d, "data_contoh.csv", row.names = FALSE)

# ---- Pra-proses: tokenisasi, buang kata henti, frekuensi kata ----
tok <- tidytext::unnest_tokens(data.frame(dokumen = d$hotel_guest_reviews, teks = d$teks), kata, teks)
tok <- dplyr::filter(tok, !kata %in% kata_henti)
frek <- dplyr::count(tok, kata, sort = TRUE)
print(head(frek, 15))

# ---- Document-term matrix dan LDA (k = 3, Gibbs sampling, alpha tetap 0.3 untuk dokumen pendek) ----
hit <- dplyr::count(tok, dokumen, kata)
dtm <- tidytext::cast_dtm(hit, dokumen, kata, n)
print(dtm)
lda <- topicmodels::LDA(dtm, k = 3, method = "Gibbs",
                        control = list(seed = sample.int(100000, 1), alpha = 0.3, delta = 0.1, burnin = 300, iter = 1000))
post <- topicmodels::posterior(lda)
beta <- post$terms                                   # p(kata | topik)
gam <- post$topics                                   # proporsi topik per dokumen
perpleks <- topicmodels::perplexity(lda, dtm)
print(topicmodels::terms(lda, 6))
kata_atas <- apply(beta, 1, function(b) colnames(beta)[which.max(b)])
label_topik <- sprintf("T%d: %s", 1:3, kata_atas)

# ---- Topik dominan per dokumen dan hubungannya dengan rating ----
dg <- data.frame(dokumen = rownames(gam), gam, check.names = FALSE)
names(dg)[2:4] <- label_topik
dg <- merge(d, dg, by.x = "hotel_guest_reviews", by.y = "dokumen")
dg$topik <- factor(label_topik[max.col(as.matrix(dg[label_topik]), ties.method = "first")], levels = label_topik)
print(aggregate(cbind(sentiment_score, guest_rating) ~ topik, data = dg, FUN = mean))
kw <- kruskal.test(guest_rating ~ topik, data = dg)
print(kw)
rerata_rating <- tapply(dg$guest_rating, dg$topik, mean)
rerata_rating <- rerata_rating[!is.na(rerata_rating)]
r_sr <- cor(dg$sentiment_score, dg$guest_rating, method = "spearman")


# ---- Grafik ----
warna_topik <- setNames(pal[1:3], label_topik)
bt <- do.call(rbind, lapply(1:3, function(j) {
  o <- order(beta[j, ], decreasing = TRUE)[1:6]
  data.frame(topik = label_topik[j], kata = colnames(beta)[o], beta = beta[j, o])
}))
bt$topik <- factor(bt$topik, levels = label_topik)
p1 <- ggplot(bt, aes(beta, tidytext::reorder_within(kata, beta, topik), fill = topik)) +
  geom_col(alpha = 0.9, width = 0.75, show.legend = FALSE) +
  tidytext::scale_y_reordered() +
  facet_wrap(~topik, scales = "free_y", nrow = 1) +
  scale_fill_manual(values = warna_topik) +
  scale_x_continuous(breaks = scales::breaks_pretty(3)) +
  labs(title = "Top terms per topic (beta)", x = "Beta = P(term | topic)", y = NULL)
p2 <- ggplot(dg, aes(topik, guest_rating, colour = topik)) +
  geom_boxplot(outlier.shape = NA, fill = NA, width = 0.55, linewidth = 0.6) +
  geom_jitter(width = 0.18, height = if (30 <= 5) 0.15 else 0, alpha = 0.3, size = 1) +
  stat_summary(fun = mean, geom = "point", shape = 18, size = 3.6, colour = warna$teks) +
  scale_colour_manual(values = warna_topik, guide = "none") +
  labs(title = if (kw$p.value < 0.001) "Rating by dominant topic (KW p < 0.001)" else
                 sprintf("Rating by dominant topic (KW p = %.3f)", kw$p.value),
       x = "Dominant topic", y = "guest_rating")
dg$bin <- if (length(unique(dg$guest_rating)) <= 7) dg$guest_rating else
  ave(dg$guest_rating, cut(dg$guest_rating, unique(quantile(dg$guest_rating, seq(0, 1, 0.2))), include.lowest = TRUE))
pr <- do.call(rbind, lapply(label_topik, function(tj) {
  a <- aggregate(dg[[tj]], by = list(bin = dg$bin), FUN = mean)
  data.frame(bin = a$bin, prop = a$x, topik = tj)
}))
pr$topik <- factor(pr$topik, levels = label_topik)
p3 <- ggplot(pr, aes(bin, prop, colour = topik)) +
  geom_line(linewidth = 1) +
  geom_point(size = 2) +
  scale_colour_manual(values = warna_topik, name = NULL) +
  scale_y_continuous(labels = scales::percent) +
  labs(title = "Mean topic share across rating levels", x = "guest_rating", y = "Mean topic proportion")
p_hasil <- if (tata == 1) (p1 / (p2 | p3)) + plot_layout(heights = c(1, 1.15)) else
  ((p2 | p3) / p1) + plot_layout(heights = c(1.15, 1))

print(p_hasil)