토픽 모델링 #3 토픽분류

토픽별로 분류 

(1) 문서별 토픽 확률 gamma 추출하기

감마(gamma, γ)

문서가 각 토픽에 등장할 확률 감마를 이용하면 문서를 토픽별로 분류할 수 있다

토픽의 주요 단어와 원문을 함께 살펴보면 토픽의 특징을 이해할 수 있다

 

 

#1 gamma 추출하기

doc_topic <- tidy(lda_model, matrix = "gamma") doc_topic # # A tibble: 28,504 x 3 # document topic  gamma # <chr>    <int>  <dbl> #   1 35           1 0.121  # 2 1173         1 0.127  # 3 1599         1 0.132  # 4 1762         1 0.155  # 5 2240         1 0.108  # 6 2307         1 0.104  # 7 2733         1 0.0992 # 8 2984         1 0.135  # 9 1            1 0.139  # 10 2            1 0.118  # # ... with 28,494 more rows

LDA 모델에서 추출

 

 

 

#2 gamma  보기

#2-1 토픽별 단어수

doc_topic %>%   count(topic) # # A tibble: 8 x 2 # topic     n # <int> <int> #   1     1  3563 # 2     2  3563 # 3     3  3563 # 4     4  3563 # 5     5  3563 # 6     6  3563 # 7     7  3563 # 8     8  3563

 

#2-2 토픽 1의 gamma  합계

확률 값이므로 한 토픽의 gamma 를 모두 더하면 1

doc_topic %>%   filter(document == 1) %>%   summarise(sum_gamma = sum(gamma)) # # A tibble: 1 x 1 # sum_gamma # <dbl> #   1         1

 

 

#3 문서를 확률이 가장 높은 토픽으로 분류하기

#3-1 문서별로 확률이 가장 높은 토픽 추출하기

doc_class <- doc_topic %>%   group_by(document) %>%   slice_max(gamma, n = 1) doc_class # # A tibble: 5,927 x 3 # # Groups:   document [3,563] # document topic gamma # <chr>    <int> <dbl> #   1 1            1 0.139 # 2 1            6 0.139 # 3 10           8 0.168 # 4 100          1 0.134 # 5 100          5 0.134 # 6 100          6 0.134 # 7 100          7 0.134 # 8 1000         6 0.153 # 9 1001         4 0.156 # 10 1002         2 0.134 # # ... with 5,917 more rows

 

#3-2 원문에 확률이 가장 높은 토픽 번호 부여하기

 - integer로 변환

doc_class$document <- as.integer(doc_class$document)

as.integer(doc_class$document) 데이터셋 결합하기 위해 기준 변수 타입을 integer로 통일

 

- 원문에 토픽 번호 부여

news_comment_topic <- raw_news_comment %>%   left_join(doc_class, by = c("id" = "document"))

left_join 함수 이용 :  by 인자에 값을 줄 때는 이름 있는 벡터를 사용해야한다. 
이벡터의 이름에 왼쪽 테이블의 키를 지정하고, 벡터의 값에 오른쪽 테이블의 키를 지정한다.

 

raw_news_comment           title   url      id           '기~  http~     1           [영~  http~     2           ‘기~  http~     3           ‘기~  http~     4

doc_class # # A tibble: 5,927 x 3 # # Groups:   document [3,563] # document topic gamma # <int> <int> <dbl> # 1        1     1 0.139 # 2        1     6 0.139 # 3       10     8 0.168 # 4      100     1 0.134 # 5      100     5 0.134 # 6      100     6 0.134 # 7      100     7 0.134 # 8     1000     6 0.153 # 9     1001     4 0.156 # 10     1002     2 0.134 # # ... with 5,917 more rows

 

 

 

 

#4 원문에 확률이 가장 높은 토픽 번호 부여하기

 - 결합확인

news_comment_topic %>%   select(id, topic) # # A tibble: 6,514 x 2 # id topic # <int> <int> #   1     1     1 # 2     1     6 # 3     2     2 # 4     2     5 # 5     2     7 # 6     3     2 # 7     3     7 # 8     4     6 # 9     5     3 # 10     5     5 # # ... with 6,504 more rows

 

 

#5 토픽별 문서 수 살펴보기

topic이 NA인 문서 제거

빈도가 높은 단어를 제거하는 전처리 작업을 거치지 않은 raw_news_comment에 doc_class를 결합했으므로 topic이 NA인 문서 있음

news_comment_topic <- news_comment_topic %>% na.omit()   # topic이 NA인 문서 제거 news_comment_topic %>% count(topic) # # A tibble: 8 x 2 # topic     n # <int> <int> #   1     1   720 # 2     2   804 # 3     3   773 # 4     4   711 # 5     5   778 # 6     6   761 # 7     7   747 # 8     8   633

 

 

 

(2) 토픽별 문서 수와 단어 시각화

 

#1. 토픽별 주요 단어 목록 만들기

top_terms <- term_topic %>%   group_by(topic) %>%   slice_max(beta, n = 6, with_ties = F) %>%   summarise(term = paste(term, collapse = ", ")) top_terms # # A tibble: 8 x 2 # topic term                                               # <int> <chr>                                              # 1     1 역사, 감독상, 스카, 미국, 인정, 각본상             # 2     2 대박, 진심, 국민, 감동, 우리나라, 한국인           # 3     3 조국, 자랑, 문재인, 가족, 경사, 얘기               # 4     4 블랙리스트, 박근혜, 송강호, 정권, 자유한국당, 정부 # 5     5 한국, 세계, 봉감독님, 한국영화, 최고, 감사         # 6     6 수상, 우리, 생각, 오늘, 시상식, 미국               # 7     7 사람, 배우, 정치, 나라, 소름, 수상소감             # 8     8 좌파, 호감, 빨갱이, 외국, 한국, 전세계

 

 

 

#2 토픽별 문서 빈도 구하기

count_topic <- news_comment_topic %>%   count(topic) count_topic # # A tibble: 8 x 2 # topic     n # <int> <int> #   1     1   720 # 2     2   804 # 3     3   773 # 4     4   711 # 5     5   778 # 6     6   761 # 7     7   747 # 8     8   633

 

 

#3 문서 빈도에 주요 단어 결합하기

count_topic_word <- count_topic %>%   left_join(top_terms, by = "topic") %>%   mutate(topic_name = paste("Topic", topic)) count_topic_word # # A tibble: 8 x 4 # topic     n term                                               topic_name # <int> <int> <chr>                                              <chr>      # 1     1   720 역사, 감독상, 스카, 미국, 인정, 각본상             Topic 1    # 2     2   804 대박, 진심, 국민, 감동, 우리나라, 한국인           Topic 2    # 3     3   773 조국, 자랑, 문재인, 가족, 경사, 얘기               Topic 3    # 4     4   711 블랙리스트, 박근혜, 송강호, 정권, 자유한국당, 정부 Topic 4    # 5     5   778 한국, 세계, 봉감독님, 한국영화, 최고, 감사         Topic 5    # 6     6   761 수상, 우리, 생각, 오늘, 시상식, 미국               Topic 6    # 7     7   747 사람, 배우, 정치, 나라, 소름, 수상소감             Topic 7    # 8     8   633 좌파, 호감, 빨갱이, 외국, 한국, 전세계             Topic 8

# > count_topic # # A tibble: 8 x 2 # topic     n # <int> <int> # 1     1   720 # 2     2   804 # 3     3   773 # 4     4   711 # 5     5   778 # 6     6   761 # 7     7   747 # 8     8   633 # > top_terms # # A tibble: 8 x 2 # topic term                                               # <int> <chr>                                              # 1     1 역사, 감독상, 스카, 미국, 인정, 각본상             # 2     2 대박, 진심, 국민, 감동, 우리나라, 한국인           # 3     3 조국, 자랑, 문재인, 가족, 경사, 얘기               # 4     4 블랙리스트, 박근혜, 송강호, 정권, 자유한국당, 정부 # 5     5 한국, 세계, 봉감독님, 한국영화, 최고, 감사         # 6     6 수상, 우리, 생각, 오늘, 시상식, 미국               # 7     7 사람, 배우, 정치, 나라, 소름, 수상소감             # 8     8 좌파, 호감, 빨갱이, 외국, 한국, 전세계

 

 

#4  토픽별 문서 수와 주요 단어로 막대 그래프 만들기

ggplot(count_topic_word,        aes(x = reorder(topic_name, n),            y = n,            fill = topic_name)) +   geom_col(show.legend = F) +   coord_flip() +   geom_text(aes(label = n) ,                              # 문서 빈도 표시             hjust = -0.2) +                                      # 막대 밖에 표시   geom_text(aes(label = term),                       # 주요 단어 표시             hjust = 1.03,                                        # 막대 안에 표시             col = "white",                                       # 색깔             fontface = "bold",                                 # 두껍게             family = "nanumgothic") +                   # 폰트   scale_y_continuous(expand = c(0, 0),         # y축-막대 간격 줄이기                      limits = c(0, 820)) +                   # y축 범위   labs(x = NULL)