1 들어가며 1 2

단어가 모이면 토픽이 되고, 토픽이 모이면 문서가 되는 방식을 상상하는 것이 필요하다.

토픽 모형

토픽(topic)은 문서 모임을 추상화한 것으로 토픽을 듣게 되면 토픽을 구성할 단어를 어림 짐작할 수 있게 된다. 예를 들어, 전쟁이라고 하면 총, 군인, 탱크, 비행기 등이 관련된 단어로 연관된다. 여러 토픽이 모여서 문서가 되고, 문서는 여러 토픽을 담게 된다.

토픽 모형(topci modeling)은 문서로부터 모형을 적합시켜 토픽을 찾아내는 과정으로 정의할 수 있다. 토픽모형을 활용함으로써 문서를 분류하는데 종종 활용된다. 특히, LDA(Latent Dirichlet Allocation) 모형이 가장 많이 활용되고 있다.

1.1 작업흐름

자연어 텍스트에서 토픽모형을 개발하는 순서는 대략 다음과 같다.

  1. 텍스트를 DTM을 변환시킨다.
    • 명사를 추출할 경우와, 동사를 추출할 경우로 나눠서 살펴볼 수도 있다.
  2. LDA는 DTM을 입력값을 받아 문서별로 토픽에 대한 연관성을 나타내는 행렬과 토픽에 단어가 속할 확률 행렬을 출력값으로 반환한다.
    • 제어 매개변수(control parameter)를 적절히 설정한다.
  3. 출력된 행렬은 세부적으로 정보를 확인할 때 필요하고 우선, 시각매체를 사용하여 시각화한다.
    • \(\beta\) 행렬은 토픽에 단어가 포함될 확률
    • \(\gamma\) 행렬은 문서에 토픽이 포함될 확률

1.2 헬로월드

문장을 금융 관련 문서1, 문서2를 준비하고, 식당관련 문장을 문서3, 문서4로 준비한다. 문서5는 금융과 식당이 뒤섞이도록 준비한다. 이를 topicmodels 팩키지를 활용하여 LDA 분석작업을 수행한다. 그리고 나서 결과값을 문서-토픽 행렬로 표현하고 좀더 직관적으로 볼 수 있도록 ggplot으로 시각화한다.

library(tidyverse)
library(tidytext)
library(RmecabKo)
library(topicmodels)

## 예제 데이터
sample_text <- c("부실 대출로 인해서 은행은 벌금을 지불하는데 동의했다",
                 "은행에 대출을 늦게 갚은 경우, 은행에서 지연에 대해 이자를 물릴 것이다.", 
                 "시내에 새로운 식당이 생겼습니다.",
                 "테헤란로에 맛집 식당이 있습니다.",
                 "새로 개장하려고 하는 식당 대출을 어떻게 상환할 계획입니까?")

sample_df <- tibble(
  document = paste0("문서", 1:5),
  text = sample_text
)

## BOW 데이터 변환
sample_bow <- sample_df %>% 
  mutate(nouns = map(text, nouns)) %>% 
  unnest(nouns) %>% 
  group_by(document) %>% 
  count(nouns, sort = TRUE)

## DTM 변환
sample_dtm <- sample_bow %>% 
  cast_dtm(document = document, term = nouns, value = n) %>% 
  as.matrix

## LDA 모형 적합
sample_lda <- LDA(sample_dtm, k = 2,  method="Gibbs", control=list(alpha=1, delta=0.1, seed=1357))

## 토픽 결과 - 행렬
tidy(sample_lda, matrix="gamma") %>% 
  arrange(document) %>% 
  spread(topic, gamma)
# A tibble: 5 x 3
  document   `1`   `2`
  <chr>    <dbl> <dbl>
1 문서1    0.333 0.667
2 문서2    0.222 0.778
3 문서3    0.75  0.25 
4 문서4    0.8   0.2  
5 문서5    0.286 0.714
## 토픽 결과 - 시각화
### 문서 - 토픽

doc_topic_g <- tidy(sample_lda, matrix="gamma") %>% 
  mutate(topic = as.factor(topic)) %>% 
  ggplot(aes(x = document, y=gamma)) + 
    geom_col(aes(fill = topic), position=position_dodge()) +
    labs(title="금융, 식당 분류 토픽모형",
         subtitle = "문서 토픽 행렬")

### 토픽 - 단어
topic_word_g <- tidy(sample_lda, matrix="beta") %>% 
  ggplot(aes(x = term, y=beta)) + 
    geom_col(aes(fill=as.factor(topic)), position=position_dodge()) +
    labs(title="금융, 식당 분류 토픽모형",
         subtitle = "토픽 단어 행렬") +
    theme(axis.text.x = element_text(angle=90),
          legend.position = "none")

cowplot::plot_grid(doc_topic_g, topic_word_g)

2 토픽갯수 - AssociatedPress

토픽 갯수 k를 선택하는 방식은 크게 두가지로 나눠진다.

  1. 수작업: 적당한 k를 잡아 토픽 모형을 구축한 후에 토픽에 포함된 단어를 보고 품질검사를 해서 몇번 반복하는 과정을 거쳐서 최적 k 선정.
  2. 자동화: 로그-우도비(Log Likelihood)와 Perplexity 값을 가능한 k값에 적합을 시키고 가장 최적값에 해당되는 토픽갯수를 선정.
    • Perplexity는 확률모델이 얼마나 실제 관측점을 잘 예측하는지를 나타내는 지표로 널리 사용되고 있다. 3

2.1 임의 토픽갯수 지정

topicmodels 팩키지에 포함된 AssociatedPress 데이터를 사용해서 토픽을 3개로 지정한 후에 토픽 모형을 구축하고 로그-우도비(Log Likelihood)와 Perplexity 값을 계산해 본다.

library(topicmodels)
data("AssociatedPress")

ap_tidy <- tidy(AssociatedPress)
ap_tidy
# A tibble: 302,031 x 3
   document term       count
      <int> <chr>      <dbl>
 1        1 adding         1
 2        1 adult          2
 3        1 ago            1
 4        1 alcohol        1
 5        1 allegedly      1
 6        1 allen          1
 7        1 apparently     2
 8        1 appeared       1
 9        1 arrested       1
10        1 assault        1
# … with 302,021 more rows
ap_dtm <- ap_tidy %>% 
  anti_join(stop_words, by = c(term = "word")) %>%
  cast_dtm(document, term, count)

ap_lda <- LDA(ap_dtm, k = 3, control = list(seed = 1357))

logLik(ap_lda)
'log Lik.' -3059461 (df=30403)
perplexity(object = ap_lda, newdata =  AssociatedPress)
[1] 3358.053

2.2 최적 토픽갯수

최적 토픽갯수를 정하기 위해서 토픽 갯수를 달리하면서 모형성능평가를 위해서 로그-우도비(Log Likelihood)와 Perplexity값을 산정한다.

loglik_v     <- vector("numeric", 10) 
perplexity_v <- vector("numeric", 10) 

for (i in 2:10) {
  cat("... ", i, "\n")
  tmp_mod  <- LDA(ap_dtm, k=i, method="Gibbs", control=list(alpha=0.5, iter=1000, seed=12345, thin=3))
  loglik_v[i] <- logLik(tmp_mod)
  perplexity_v[i] <- perplexity(tmp_mod, newdata =  AssociatedPress)
}

topic_k_df <- tibble(
  topic_k = 1:10,
  loglik = loglik_v,
  perplexity = perplexity_v)

topic_k_df %>% write_rds("data/topic_k_df.rds")

토픽 k 갯수에 따라 모형성능 지표를 ggplot으로 시각화하여 적절한 토픽 k를 선정하는데 참조한다.

topic_k_df <- read_rds("data/topic_k_df.rds")

topic_k_df %>%
  filter(topic_k != 1) %>% 
  gather(metric, value, -topic_k) %>% 
  ggplot(aes(x=topic_k, y=value)) +
    geom_line() +
    geom_point() +
    facet_wrap(~metric, scales = "free")

2.3 토픽 시각화

일단 6개 토픽을 선정하여 이를 시각화한다.

ap_six_lda <- LDA(ap_dtm, k = 6, control = list(seed = 1357))

ap_six_lda_tidy <- tidy(ap_six_lda)

top_terms <- ap_six_lda_tidy %>%
  group_by(topic) %>%
  top_n(5, beta) %>%
  ungroup() %>%
  arrange(topic, -beta)
top_terms
# A tibble: 30 x 3
   topic term         beta
   <int> <chr>       <dbl>
 1     1 dukakis   0.00640
 2     1 people    0.00559
 3     1 school    0.00420
 4     1 time      0.00398
 5     1 president 0.00395
 6     2 soviet    0.00882
 7     2 people    0.00604
 8     2 workers   0.00593
 9     2 percent   0.00496
10     2 union     0.00450
# … with 20 more rows
top_terms %>%
  mutate(term = factor(term, levels = rev(unique(term)))) %>% 
  ggplot(aes(term, beta, fill = factor(topic))) +
  geom_bar(alpha = 0.8, stat = "identity", show.legend = FALSE) +
  facet_wrap(~ topic, scales = "free", ncol = 2) +
  coord_flip()

2.4 토픽 → 단어구름

우선 단어가 매우 작은 소수점이라… 단어구름(wordcloud)에서는 양수만 받기 때문에 적당한 숫자를 곱해서 준비를 하고 이를 wordcloud() 함수에 넣어 단어구름 시각화를 한다.

library(wordcloud)

ap_six_lda_tidy_wc <- ap_six_lda_tidy %>% 
  mutate(n = round(beta * 10000, 0)) %>% 
  filter(topic == 1) %>% 
  arrange(-n)

wordcloud(words = ap_six_lda_tidy_wc$term, 
          freq = ap_six_lda_tidy_wc$n,
          min.freq = 3)

총 6개의 토픽이 있으니… 나머지도 유사한 방식으로 시각화하여 붙여 시각화하는 것도 좋을 듯 싶다.

3 LDA 시각화 4

3.1 데이터

먼저, 데이터 스크립트를 참조하여 데이터를 “data/reviews” 디렉토리에 가져와서 작업을 수행한 후에 reviews.rdata 파일로 준비시킨다.

if (!file.exists("data/reviews")) {
  tmp <- tempfile(fileext = ".tar.gz")
  download.file("http://www.cs.cornell.edu/people/pabo/movie-review-data/review_polarity.tar.gz", 
                tmp, quiet = TRUE)
  untar(tmp, exdir = "data/reviews")
  unlink(tmp)
}

path <- file.path("data", "reviews", "txt_sentoken")
pos <- list.files(file.path(path, "pos"))
neg <- list.files(file.path(path, "neg"))
pos.files <- file.path(path, "pos", pos)
neg.files <- file.path(path, "neg", neg)
all.files <- c(pos.files, neg.files)
txt <- lapply(all.files, readLines)
nms <- gsub("data/reviews/txt_sentoken", "", all.files)
reviews <- setNames(txt, nms)
reviews <- sapply(reviews, function(x) paste(x, collapse = " "))

save(reviews, file = "data/reviews/reviews.rdata", compress = "xz")

3.2 텍스트 데이터 전처리

# read in some stopwords:
library(tm)
stop_words <- stopwords("SMART")

# pre-processing:
reviews <- gsub("'", "", reviews)  # remove apostrophes
reviews <- gsub("[[:punct:]]", " ", reviews)  # replace punctuation with space
reviews <- gsub("[[:cntrl:]]", " ", reviews)  # replace control characters with space
reviews <- gsub("^[[:space:]]+", "", reviews) # remove whitespace at beginning of documents
reviews <- gsub("[[:space:]]+$", "", reviews) # remove whitespace at end of documents
reviews <- tolower(reviews)  # force to lowercase

# tokenize on space and output as a list:
doc.list <- strsplit(reviews, "[[:space:]]+")

# compute the table of terms:
term.table <- table(unlist(doc.list))
term.table <- sort(term.table, decreasing = TRUE)

# remove terms that are stop words or occur fewer than 5 times:
del <- names(term.table) %in% stop_words | term.table < 5
term.table <- term.table[!del]
vocab <- names(term.table)

# now put the documents into the format required by the lda package:
get.terms <- function(x) {
  index <- match(x, vocab)
  index <- index[!is.na(index)]
  rbind(as.integer(index - 1), as.integer(rep(1, length(index))))
}
documents <- lapply(doc.list, get.terms)

3.3 토픽모형 적합

# Compute some statistics related to the data set:
D <- length(documents)  # number of documents (2,000)
W <- length(vocab)  # number of terms in the vocab (14,568)
doc.length <- sapply(documents, function(x) sum(x[2, ]))  # number of tokens per document [312, 288, 170, 436, 291, ...]
N <- sum(doc.length)  # total number of tokens in the data (546,827)
term.frequency <- as.integer(term.table) 

# MCMC and model tuning parameters:
K <- 20
G <- 5000
alpha <- 0.02
eta <- 0.02

# Fit the model:
library(lda)
set.seed(357)
t1 <- Sys.time()
fit <- lda.collapsed.gibbs.sampler(documents = documents, K = K, vocab = vocab, 
                                   num.iterations = G, alpha = alpha, 
                                   eta = eta, initial = NULL, burnin = 0,
                                   compute.log.likelihood = TRUE)
t2 <- Sys.time()
t2 - t1  # about 24 minutes on laptop

3.4 토픽모형 시각화

theta <- t(apply(fit$document_sums + alpha, 2, function(x) x/sum(x)))
phi <- t(apply(t(fit$topics) + eta, 2, function(x) x/sum(x)))

MovieReviews <- list(phi = phi,
                     theta = theta,
                     doc.length = doc.length,
                     vocab = vocab,
                     term.frequency = term.frequency)

library(LDAvis)

# create the JSON object to feed the visualization:
json <- createJSON(phi = MovieReviews$phi, 
                   theta = MovieReviews$theta, 
                   doc.length = MovieReviews$doc.length, 
                   vocab = MovieReviews$vocab, 
                   term.frequency = MovieReviews$term.frequency)

serVis(json, out.dir = 'viz', open.browser = TRUE)

실행결과

  1. Chris Bail (Duke University), “Topic Modeling”↩

  2. unhewk Kim (Aug 15, 2017), “환자 불편 상담에 관한 Latent Dirichlet Allocation 분석”↩

  3. 토픽 모델링 결과 평가법 : Perplexity와 Topic Coherence …↩

  4. A topic model for movie reviews↩