Do it! 쉽게 배우는 R 텍스트 마이닝 - 06 토픽 모델링: 어떤 주제로 글을 썼을까?

Do it! 쉽게 배우는 R 텍스트 마이닝

---

<br>

.pull-left[
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
<img src="https://raw.githubusercontent.com/youngwoos/Doit_textmining/main/cover.png" width="70%" height="70%" />
]

- [네이버책](https://book.naver.com/bookdb/book_detail.nhn?bid=17891971)
  - [yes24](http://bit.ly/3oUuJOB)
  - [알라딘](http://bit.ly/3oXOSDn)
  - [교보문고](https://bit.ly/2LtNOcB)
]

---

06 토픽 모델링:  
어떤 주제로 글을 썼을까?

---

<br-back-20>

We'll make

<br-back-40>

---

<br-back-40>

and

<br-back-40>

---

<br>

---

06-1 토픽 모델링 개념 알아보기

---

#### 토픽 모델링(topic modeling)
- 텍스트의 핵심 주제를 찾아 비슷한 내용끼리 분류하는 분석 방법
- 다량의 텍스트를 분석할 때 유용
  
<img src="../Image/06/06_3_1.png" width="70%" />

---

##### 토픽 모델 예시: 문서 3개로 만든 모델

<br10>

- 문서의 토픽
  - 문서 1: 고양이 관련 내용
  - 문서 2: 음식 관련 내용
  - 문서 3: 고양이, 음식 모두 관련 내용
]

<br10>

<img src="../Image/etc/06_1_table_1.png" width="523" style="display: block; margin: auto;" />
]

- 토픽 모델을 이용하면
  - 단어가 어떤 토픽에 등장할 확률이 더 높은지 알 수 있다
  - 단어 등장 확률을 보고 토픽의 핵심 단어를 알 수 있다
]

<img src="../Image/etc/06_1_table_2.png" width="60%" style="display: block; margin: auto;" />
]

---

- 토픽 모델을 이용하면
  - 문서가 어떤 토픽에 등장할 확률이 높은지 알 수 있다
  - 확률을 이용해 문서를 토픽별로 분류할 수 있다 → 다량의 문서 분석할 때 특히 유용
  - 문서가 어떤 주제로 구성되는지 파악할 수 있다

<br10>

---

#### LDA 모델
- LDA(Latent Dirichlet Allocation, 잠재 디리클레 할당): 가장 널리 사용되는 토픽 모델링 알고리즘

##### LDA 모델의 가정 1. 토픽은 여러 단어의 혼합으로 구성된다

- 한 토픽에 여러 단어가 서로 다른 확률로 포함된다
- 같은 단어가 여러 토픽에 서로 다른 확률로 포함된다

<br10>

---

##### LDA 모델의 가정 2. 문서는 토픽들의 혼합으로 구성된다

- 문서에는 여러 토픽의 단어가 서로 다른 비율로 들어 있음
- 단어 확률이 더 높은 쪽으로 문서 분류

<br10>

<div class="figure" style="text-align: center">
<img src="../Image/06/Blei_ICML_2012_edit.png" alt="Latent Dirichlet allocation(LDA): bit.ly/easytext_62" width="50%" />
<p class="caption">Latent Dirichlet allocation(LDA): bit.ly/easytext_62</p>
</div>

<br>

---

6.2 LDA 모델 만들기

---

#### 전처리하기

##### 1. 기본적인 전처리

- **중복 문서 제거하기**: `dplyr::distinct()`
  - 중복 문서가 있으면 계산량 늘어나 모델 만드는 시간 오래 걸림
  - 한 토픽에 내용이 똑같은 문서가 여러 개 들어 있는 문제 생김

- **짧은 문서 제거하기**:
  - 토픽 모델은 여러 문서에 공통으로 사용된 단어를 이용해 만듦
  - 짧은 문서는 다른 문서와 공통으로 사용된 단어가 적어 모델 만드는 데 적합하지 않음

---

```r
# 기생충 기사 댓글 불러오기
library(readr)
library(dplyr)

raw_news_comment <- read_csv("news_comment_parasite.csv") %>%
  mutate(id = row_number())

library(stringr)
library(textclean)

# 기본적인 전처리
news_comment <- raw_news_comment %>%
  mutate(reply = str_replace_all(reply, "[^가-힣]", " "),
         reply = str_squish(reply)) %>%

# 중복 댓글 제거
  distinct(reply, .keep_all = T) %>%

# 짧은 문서 제거 - 3 단어 이상 추출
  filter(str_count(reply, boundary("word")) >= 3)
```

---

##### 2. 명사 추출하기

- 문서의 주제는 명사로 결정되므로 명사 추출해 모델 만드는 경우가 많음
- 댓글에 중복 사용된 단어 제거: 문서에 같은 단어 여러 번 사용되면 내용 관계없이 사용 빈도 때문에 특정 토픽으로 분류될 가능성 높음

```r
library(tidytext)
library(KoNLP)

# 명사 추출
comment <- news_comment %>%
  unnest_tokens(input = reply,
                output = word,
                token = extractNoun,
                drop = F) %>%
  filter(str_count(word) > 1) %>%

# 댓글 내 중복 단어 제거
  group_by(id) %>%
  distinct(word, .keep_all = T) %>%
  ungroup() %>%
  select(id, word)
```

---

```r
comment
```

```
## # A tibble: 21,457 x 2
##       id word    
##    <int> <chr>   
##  1     1 우리    
##  2     1 행복    
##  3     2 시국    
##  4     2 감사    
##  5     2 하다    
##  6     2 진심    
##  7     3 우리나라
##  8     3 영화감독
##  9     3 영감    
## 10     3 봉감    
## # ... with 21,447 more rows
```

---

##### 3. 빈도 높은 단어 제거하기

- '영화', '기생충' 등은 거의 모든 댓글에 들어 있음
- 빈도가 매우 높은 단어가 포함된 상태로 토픽 모델을 만들면 대부분의 토픽에 똑같은 단어가 주요 단어로 등장해 토픽의 특징을 파악하기 어려우므로 제거

```r
count_word <- comment %>%
  add_count(word) %>%
  filter(n <= 200) %>%
  select(-n)
```

---

##### 4. 불용어 제거하기, 유의어 처리하기

<br10>

##### 4.1 불용어, 유의어 확인하기
- 불용어(Stop word): 분석에서 제외할 단어
  - `"들이"`, `"하다"`, `"하게"`처럼 의미를 알 수 없는 단어
  - 텍스트 해석에 도움이 되지 않으므로 제거해야 함

<br>

- 빈도 높은 단어 추출해 불용어 확인, 표현은 다르지만 의미가 비슷한 유의어가 있는지 확인

```r
# 불용어, 유의어 확인하기
count_word %>%
  count(word, sort = T) %>%
  print(n = 200)
```

---

```
## # A tibble: 6,022 x 2
##    word           n
##    <chr>      <int>
##  1 작품상       200
##  2 자랑         193
##  3 블랙리스트   173
##  4 조국         170
##  5 한국         165
##  6 대박         148
##  7 세계         140
##  8 수상         135
##  9 미국         128
## 10 들이         123
## 11 정치         108
## 12 역사         102
## 13 오스카       101
## 14 우리나라      96
## 15 감독상        93
## 16 진심          93
## 17 좌파          90
## 18 작품          87
## 19 한국영화      87
## 20 사람          86
## # ... with 6,002 more rows
```

---

##### 4.2 불용어 목록 만들기

```r
# 불용어 목록 만들기
stopword <- c("들이", "하다", "하게", "하면", "해서", "이번", "하네",
              "해요", "이것", "니들", "하기", "하지", "한거", "해주",
              "그것", "어디", "여기", "까지", "이거", "하신", "만큼")
```

---

##### 4.3 불용어 제거하고 유의어 수정하기

```r
# 불용어, 유의어 처리하기
count_word <- count_word %>%
  filter(!word %in% stopword) %>%
  mutate(word = recode(word,
                       "자랑스럽습니" = "자랑",
                       "자랑스럽" = "자랑",
                       "자한" = "자유한국당",
                       "문재" = "문재인",
                       "한국의" = "한국",
                       "그네" = "박근혜",
                       "추카" = "축하",
                       "정경" = "정경심",
                       "방탄" = "방탄소년단"))
```

---

.box[
<br-back-20>
.info[<svg viewBox="0 0 512 512" style="height:1em;position:relative;display:inline-block;top:.1em;fill:#FF7333;" xmlns="http://www.w3.org/2000/svg">  <path d="M505.12019,19.09375c-1.18945-5.53125-6.65819-11-12.207-12.1875C460.716,0,435.507,0,410.40747,0,307.17523,0,245.26909,55.20312,199.05238,128H94.83772c-16.34763.01562-35.55658,11.875-42.88664,26.48438L2.51562,253.29688A28.4,28.4,0,0,0,0,264a24.00867,24.00867,0,0,0,24.00582,24H127.81618l-22.47457,22.46875c-11.36521,11.36133-12.99607,32.25781,0,45.25L156.24582,406.625c11.15623,11.1875,32.15619,13.15625,45.27726,0l22.47457-22.46875V488a24.00867,24.00867,0,0,0,24.00581,24,28.55934,28.55934,0,0,0,10.707-2.51562l98.72834-49.39063c14.62888-7.29687,26.50776-26.5,26.50776-42.85937V312.79688c72.59753-46.3125,128.03493-108.40626,128.03493-211.09376C512.07526,76.5,512.07526,51.29688,505.12019,19.09375ZM384.04033,168A40,40,0,1,1,424.05,128,40.02322,40.02322,0,0,1,384.04033,168Z"></path></svg> 불용어 목록을 파일로 만들어 활용하기]

<br10>

```r
# tibble 구조로 불용어 목록 만들기
stopword <- tibble(word = c("들이", "하다", "하게", "하면", "해서", "이번", "하네",
                            "해요", "이것", "니들", "하기", "하지", "한거", "해주",
                            "그것", "어디", "여기", "까지", "이거", "하신", "만큼")

# 불용어 목록 저장하기
library(readr)
write_csv(stopword, "stopword.csv")

# 불용어 목록 불러오기
stopword <- read_csv("stopword.csv")
```

```r
# 불용어 제거하기 - filter()
count_word <- count_word %>%
  filter(!word %in% stopword$word)

# 불용어 제거하기 - dplyr::anti_join()
count_word <- count_word %>%
  anti_join(stopword, by = "word")
```
<br-back-20>
]

---

#### LDA 모델 만들기

##### 1. DTM 만들기
- DTM(Document-Term Matrix, 문서 단어 행렬): 행은 문서, 열은 단어로 구성해 빈도를 나타낸 행렬

##### 1.1 문서별 단어 빈도 구하기

```r
# 문서별 단어 빈도 구하기
count_word_doc <- count_word %>%
  count(id, word, sort = T)

count_word_doc
```

---

```
## # A tibble: 17,592 x 3
##       id word           n
##    <int> <chr>      <int>
##  1    35 한국           2
##  2   206 자랑           2
##  3   566 자랑           2
##  4   578 자랑           2
##  5   598 자랑           2
##  6  1173 한국           2
##  7  1599 한국           2
##  8  1762 한국           2
##  9  2240 한국           2
## 10  2307 방탄소년단     2
## # ... with 17,582 more rows
```

---

##### 1.2 DTM 만들기

- `tidytext::cast_dtm()`
  - `document` : 문서 구분 기준
  - `term` : 단어
  - `value` : 단어 빈도

```r
install.packages("tm")

# DTM 만들기
dtm_comment <- count_word_doc %>%
  cast_dtm(document = id, term = word, value = n)

dtm_comment
```

```
## <<DocumentTermMatrix (documents: 3203, terms: 5995)>>
## Non-/sparse entries: 17592/19184393
## Sparsity           : 100%
## Maximal term length: 35
## Weighting          : term frequency (tf)
```
<svg viewBox="0 0 352 512" style="height:1em;position:relative;display:inline-block;top:.1em;" xmlns="http://www.w3.org/2000/svg">  <path d="M176 80c-52.94 0-96 43.06-96 96 0 8.84 7.16 16 16 16s16-7.16 16-16c0-35.3 28.72-64 64-64 8.84 0 16-7.16 16-16s-7.16-16-16-16zM96.06 459.17c0 3.15.93 6.22 2.68 8.84l24.51 36.84c2.97 4.46 7.97 7.14 13.32 7.14h78.85c5.36 0 10.36-2.68 13.32-7.14l24.51-36.84c1.74-2.62 2.67-5.7 2.68-8.84l.05-43.18H96.02l.04 43.18zM176 0C73.72 0 0 82.97 0 176c0 44.37 16.45 84.85 43.56 115.78 16.64 18.99 42.74 58.8 52.42 92.16v.06h48v-.12c-.01-4.77-.72-9.51-2.15-14.07-5.59-17.81-22.82-64.77-62.17-109.67-20.54-23.43-31.52-53.15-31.61-84.14-.2-73.64 59.67-128 127.95-128 70.58 0 128 57.42 128 128 0 30.97-11.24 60.85-31.65 84.14-39.11 44.61-56.42 91.47-62.1 109.46a47.507 47.507 0 0 0-2.22 14.3v.1h48v-.05c9.68-33.37 35.78-73.18 52.42-92.16C335.55 260.85 352 220.37 352 176 352 78.8 273.2 0 176 0z"></path></svg>  `tm` 패키지 설치 필요

---

#### 2. LDA 모델 만들기 - `LDA()`

- `topicmodels::LDA()`
  - `k` : 토픽 수
  - `method` : 샘플링 방법. 일반적으로 깁스 샘플링(`"Gibbs"`) 가장 많이 사용
  - `control = list(seed = 1234))` : 난수 고정

```r
install.packages("topicmodels")
library(topicmodels)

# 토픽 모델 만들기
lda_model <- LDA(dtm_comment,
                 k = 8,
                 method = "Gibbs",
                 control = list(seed = 1234))
```

---

```r
# 모델 내용 확인
glimpse(lda_model)
```

```
## Formal class 'LDA_Gibbs' [package "topicmodels"] with 16 slots
##   ..@ seedwords      : NULL
##   ..@ z              : int [1:17604] 8 8 4 3 7 4 3 1 1 1 ...
##   ..@ alpha          : num 6.25
##   ..@ call           : language LDA(x = dtm_comment, k = 8, method = "Gibbs", control = list(seed = 1234))
##   ..@ Dim            : int [1:2] 3203 5995
##   ..@ control        :Formal class 'LDA_Gibbscontrol' [package "topicmodels"] with 14 slots
##   ..@ k              : int 8
##   ..@ terms          : chr [1:5995] "한국" "자랑" "방탄소년단" "박근혜" ...
##   ..@ documents      : chr [1:3203] "35" "206" "566" "578" ...
*##   ..@ beta           : num [1:8, 1:5995] -7.81 -10.22 -10.25 -5.83 -10.25 ...
*##   ..@ gamma          : num [1:3203, 1:8] 0.151 0.15 0.11 0.114 0.11 ...
##   ..@ wordassignments:List of 5
##   .. ..$ i   : int [1:17592] 1 1 1 1 1 1 1 1 1 1 ...
##   .. ..$ j   : int [1:17592] 1 98 99 100 101 102 103 104 105 106 ...
##   .. ..$ v   : num [1:17592] 8 4 3 7 4 3 7 2 8 6 ...
##   .. ..$ nrow: int 3203
##   .. ..$ ncol: int 5995
##   .. ..- attr(*, "class")= chr "simple_triplet_matrix"
##   ..@ loglikelihood  : num -126429
##   ..@ iter           : int 2000
##   ..@ logLiks        : num(0) 
##   ..@ n              : int 17604
```

---
- `@ beta : num [1:8, 1:5995]`
  - 단어가 각 토픽에 등장할 확률
  - 5,995개 단어로 모델

- `@ gamma : num [1:3203, 1:8]`
  - 문서가 각 토픽에 등장할 확률
  - 3,203개 문서로 모델 생성

---

6.3 토픽별 주요 단어 살펴보기

---

##### 6.3.1 토픽별 단어 확률, beta 추출하기

- 베타(beta, β): 단어가 각 토픽에 등장할 확률
- 베타를 보면 각 토픽에 등장할 가능성이 높은 주요 단어를 알 수 있다

##### beta 추출하기

- `tidytext::tidy()`

```r
term_topic <- tidy(lda_model, matrix = "beta")
term_topic
```
]
.pull-right-40[

```
## # A tibble: 47,960 x 3
##    topic term       beta
##    <int> <chr>     <dbl>
##  1     1 한국  0.000405 
##  2     2 한국  0.0000364
##  3     3 한국  0.0000353
##  4     4 한국  0.00295  
##  5     5 한국  0.0000353
##  6     6 한국  0.0000356
##  7     7 한국  0.00661  
##  8     8 한국  0.0593   
##  9     1 자랑  0.0181   
## 10     2 자랑  0.00440  
## # ... with 47,950 more rows
```
]

---

##### beta 살펴보기

- 모델을 5,995개 단어로 만들었으므로 토픽별 5,995 행

```r
# 토픽별 단어 수
term_topic %>%
  count(topic)
```

```
## # A tibble: 8 x 2
##   topic     n
##   <int> <int>
## 1     1  5995
## 2     2  5995
## 3     3  5995
## 4     4  5995
## 5     5  5995
## 6     6  5995
## 7     7  5995
## 8     8  5995
```

---
##### beta 살펴보기

- 확률 값이므로 한 토픽의 `beta`를 모두 다하면 `1`

```r
# 토픽 1의 beta 합계
term_topic %>%
  filter(topic == 1) %>%
  summarise(sum_beta = sum(beta))
```

```
## # A tibble: 1 x 1
##   sum_beta
##      <dbl>
## 1        1
```

---

##### 특정 단어의 토픽별 확률 살펴보기

- 특정 단어를 추출하면 단어가 어떤 토픽에 등장할 확률이 높은지 알 수 있다

```r
term_topic %>%
  filter(term == "작품상")
```

```
## # A tibble: 8 x 3
##   topic term        beta
##   <int> <chr>      <dbl>
## 1     1 작품상 0.0000368
## 2     2 작품상 0.000763 
## 3     3 작품상 0.0000353
## 4     4 작품상 0.0000364
## 5     5 작품상 0.0000353
*## 6     6 작품상 0.0695   
## 7     7 작품상 0.000727 
## 8     8 작품상 0.000388
```
]
---

#### 토픽별 주요 단어 살펴보기

##### 특정 토픽에서 beta가 높은 단어 살펴보기

```r
term_topic %>%
  filter(topic == 6) %>%
  arrange(-beta)
```

```
## # A tibble: 5,995 x 3
##    topic term        beta
##    <int> <chr>      <dbl>
##  1     6 작품상   0.0695 
##  2     6 감독상   0.0318 
##  3     6 한국영화 0.0228 
##  4     6 수상     0.0214 
##  5     6 각본상   0.0154 
##  6     6 나라     0.0143 
##  7     6 호감     0.0136 
##  8     6 감격     0.0129 
##  9     6 순간     0.0125 
## 10     6 눈물     0.00788
## # ... with 5,985 more rows
```

---

##### 모든 토픽의 주요 단어 살펴보기

- `topicmodels::terms()`

```r
terms(lda_model, 20) %>%
  data.frame()
```

```
##    Topic.1 Topic.2 Topic.3  Topic.4
## 1     작품    대박    조국     역사
## 2     진심  시상식  문재인 우리나라
## 3     정치    오늘    가족     세계
## 4     자랑    국민    문화   오스카
## 5 수상소감    소름  대통령     수상
```

```
##   Topic.5  Topic.6    Topic.7 Topic.8
## 1    자랑   작품상 블랙리스트    한국
## 2    우리   감독상     박근혜    미국
## 3    최고 한국영화       사람  한국인
## 4    감사     수상     송강호    세계
## 5    생각   각본상     이미경    좌파
```

---

#### 토픽별 주요 단어 시각화하기

##### 1. 토픽별로 beta가 가장 높은 단어 추출하기

```r
# 토픽별 beta 상위 10개 단어 추출
top_term_topic <- term_topic %>%
  group_by(topic) %>%
  slice_max(beta, n = 10)
```

---

#### 2. 막대 그래프 만들기

```r
install.packages("scales")
library(scales)
library(ggplot2)

ggplot(top_term_topic,
       aes(x = reorder_within(term, beta, topic),
           y = beta,
           fill = factor(topic))) +
  geom_col(show.legend = F) +
  facet_wrap(~ topic, scales = "free", ncol = 4) +
  coord_flip() +
  scale_x_reordered() +
  scale_y_continuous(n.breaks = 4,
                     labels = number_format(accuracy = .01)) +
  labs(x = NULL) +
  theme(text = element_text(family = "nanumgothic"))
```

---

---

06-4 문서를 토픽별로 분류하기

---

#### 문서별 토픽 확률 gamma 추출하기

- 감마(gamma, γ): 문서가 각 토픽에 등장할 확률
  - 감마를 이용하면 문서를 토픽별로 분류할 수 있다
  - 토픽의 주요 단어와 원문을 함께 살펴보면 토픽의 특징을 이해할 수 있다

##### gamma 추출하기

```r
doc_topic <- tidy(lda_model, matrix = "gamma")
doc_topic
```
]

```
## # A tibble: 25,624 x 3
##    document topic  gamma
##    <chr>    <int>  <dbl>
##  1 35           1 0.151 
##  2 206          1 0.15  
##  3 566          1 0.110 
##  4 578          1 0.114 
##  5 598          1 0.110 
##  6 1173         1 0.110 
##  7 1599         1 0.114 
##  8 1762         1 0.0962
##  9 2240         1 0.125 
## 10 2307         1 0.135 
## # ... with 25,614 more rows
```
]

---

#### gamma 살펴보기

- 모델을 3,203개 문서로 만들었으므로 토픽별 3,203 행

```r
doc_topic %>%
  count(topic)
```

```
## # A tibble: 8 x 2
##   topic     n
##   <int> <int>
## 1     1  3203
## 2     2  3203
## 3     3  3203
## 4     4  3203
## 5     5  3203
## 6     6  3203
## 7     7  3203
## 8     8  3203
```

---

#### gamma 살펴보기

- 확률 값이므로 한 문서의 `gamma`를 모두 더하면 1

```r
# 문서 1의 gamma 합계
doc_topic %>%
  filter(document == 1) %>%
  summarise(sum_gamma = sum(gamma))
```

```
## # A tibble: 1 x 1
##   sum_gamma
##       <dbl>
## 1         1
```

---

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

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

<br-10>

```r
# 문서별로 확률이 가장 높은 토픽 추출
doc_class <- doc_topic %>%
  group_by(document) %>%
  slice_max(gamma, n = 1)

doc_class
```
]
.pull-right[

```
## # A tibble: 5,328 x 3
## # Groups:   document [3,203]
##    document topic gamma
##    <chr>    <int> <dbl>
##  1 1            5 0.159
##  2 10           8 0.168
##  3 100          5 0.153
##  4 1000         7 0.15 
##  5 1001         1 0.137
##  6 1001         3 0.137
##  7 1001         7 0.137
##  8 1002         3 0.137
##  9 1002         7 0.137
## 10 1002         8 0.137
## # ... with 5,318 more rows
```

]

---

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

```r
# integer로 변환
doc_class$document <- as.integer(doc_class$document)

# 원문에 토픽 번호 부여
news_comment_topic <- raw_news_comment %>%
  left_join(doc_class, by = c("id" = "document"))
```
<svg viewBox="0 0 352 512" style="height:1em;position:relative;display:inline-block;top:.1em;" xmlns="http://www.w3.org/2000/svg">  <path d="M176 80c-52.94 0-96 43.06-96 96 0 8.84 7.16 16 16 16s16-7.16 16-16c0-35.3 28.72-64 64-64 8.84 0 16-7.16 16-16s-7.16-16-16-16zM96.06 459.17c0 3.15.93 6.22 2.68 8.84l24.51 36.84c2.97 4.46 7.97 7.14 13.32 7.14h78.85c5.36 0 10.36-2.68 13.32-7.14l24.51-36.84c1.74-2.62 2.67-5.7 2.68-8.84l.05-43.18H96.02l.04 43.18zM176 0C73.72 0 0 82.97 0 176c0 44.37 16.45 84.85 43.56 115.78 16.64 18.99 42.74 58.8 52.42 92.16v.06h48v-.12c-.01-4.77-.72-9.51-2.15-14.07-5.59-17.81-22.82-64.77-62.17-109.67-20.54-23.43-31.52-53.15-31.61-84.14-.2-73.64 59.67-128 127.95-128 70.58 0 128 57.42 128 128 0 30.97-11.24 60.85-31.65 84.14-39.11 44.61-56.42 91.47-62.1 109.46a47.507 47.507 0 0 0-2.22 14.3v.1h48v-.05c9.68-33.37 35.78-73.18 52.42-92.16C335.55 260.85 352 220.37 352 176 352 78.8 273.2 0 176 0z"></path></svg> `as.integer(doc_class$document)` 데이터셋 결합하기 위해 기준 변수 타입을 integer로 통일

---

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

```r
# 결합 확인
news_comment_topic %>%
  select(id, topic)
```

```
## # A tibble: 6,275 x 2
##       id topic
##    <int> <int>
##  1     1     5
##  2     2     1
##  3     2     5
##  4     2     6
##  5     3     2
##  6     3     8
##  7     4     4
##  8     5     5
##  9     5     6
## 10     6     3
## # ... with 6,265 more rows
```

---

##### 3. 토픽별 문서 수 살펴보기

```r
news_comment_topic %>%
  count(topic)
```

```
## # A tibble: 9 x 2
##   topic     n
##   <int> <int>
## 1     1   660
## 2     2   704
## 3     3   663
## 4     4   609
## 5     5   708
## 6     6   690
## 7     7   649
## 8     8   645
## 9    NA   947
```

---

##### 3. 토픽별 문서 수 살펴보기

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

```r
news_comment_topic <- news_comment_topic %>%
  na.omit()

news_comment_topic %>%
  count(topic)
```

```
## # A tibble: 8 x 2
##   topic     n
##   <int> <int>
## 1     1   660
## 2     2   704
## 3     3   663
## 4     4   609
## 5     5   708
## 6     6   690
## 7     7   649
## 8     8   645
```

---

#### 토픽별 문서 수와 단어 시각화하기

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

```r
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. 토픽별 문서 빈도 구하기

```r
count_topic <- news_comment_topic %>%
  count(topic)

count_topic
```

```
## # A tibble: 8 x 2
##   topic     n
##   <int> <int>
## 1     1   660
## 2     2   704
## 3     3   663
## 4     4   609
## 5     5   708
## 6     6   690
## 7     7   649
## 8     8   645
```

---

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

```r
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   660 작품, 진심, 정치, 자랑, 수상소감, 댓글               Topic 1   
## 2     2   704 대박, 시상식, 오늘, 국민, 소름, 정치                 Topic 2   
## 3     3   663 조국, 문재인, 가족, 문화, 대통령, 자랑               Topic 3   
## 4     4   609 역사, 우리나라, 세계, 오스카, 수상, 빨갱이           Topic 4   
## 5     5   708 자랑, 우리, 최고, 감사, 생각, 소식                   Topic 5   
## 6     6   690 작품상, 감독상, 한국영화, 수상, 각본상, 나라         Topic 6   
## 7     7   649 블랙리스트, 박근혜, 사람, 송강호, 이미경, 자유한국당 Topic 7   
## 8     8   645 한국, 미국, 한국인, 세계, 좌파, 배우                 Topic 8
```

---

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

```r
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)
```

---

---

06-5 토픽 이름 짓기

---

#### 토픽별 주요 문서 살펴보고 토픽 이름 짓기

##### 1. 원문을 읽기 편하게 전처리하기, gamma가 높은 순으로 정렬하기

- html 특수 문자 제거
- `gamma`가 높은 주요 문서가 먼저 출력되도록 정렬

```r
comment_topic <- news_comment_topic %>%
  mutate(reply = str_squish(replace_html(reply))) %>%
  arrange(-gamma)

comment_topic %>%
  select(gamma, reply)
```

---

```
## # A tibble: 5,328 x 2
##    gamma reply                                    
##    <dbl> <chr>                                    
##  1 0.264 "도서관서 여자화장실서 나오는 남자사서보~
##  2 0.260 "봉준호 송강호 블랙리스트 올리고 CJ 이미~
##  3 0.239 "보수정권때 블랙리스트에 오른 봉준호 송~ 
##  4 0.238 "도서관서 여자화장실서 나오는 남자사서보~
##  5 0.235 "당초 \"1917\"과 \"기생충\"의 접전을[초~ 
##  6 0.234 "박그네 밑에서 블랙리스트 있었는데 ㅋㅋ~ 
##  7 0.226 "위대한 박정희 삼성이 대한민국을 세계에 ~
##  8 0.225 "기생충 영화보고 좌빨이 얼마나 기생충인~ 
##  9 0.225 "봉준호 감독과 송강호 배우는 이명박그네 ~
## 10 0.224 "나중에 기생충 정부 영화 한편 나오겠네. ~
## # ... with 5,318 more rows
```

---

##### 2. 주요 단어가 사용된 문서 살펴보기

```r
# 토픽 1 내용 살펴보기
comment_topic %>%
  filter(topic == 1 & str_detect(reply, "작품")) %>%
  head(50) %>%
  pull(reply)
```

```
## [1] "봉감독의 'local'이라는 말에 발끈했나요? 미국 아카데미의 놀라운 변화입니다. 기생충이란 영화의 작품적 우수성 뿐만 아니라 '봉준호'라는 개인의 네임벨류와 인간적 매력과 천재성이 이번 아카데미 수상에 큰 역할을 한 것 같네요. 그의 각종 수상소감을 보면 면면히 드러나네요~~"                                                                                           
## [2] "이 작품을 기준으로 앞으로도 계속 쓰여질 것입니다. 진심으로 축하드립니다^^"                                                                                                                                                                                                                                                                                         
## [3] "이런 위대한 작품과 감독을 블랙리스트에 올려 대중에게서 뺏어 묻어버릴려고 했던 쥐닥정권 그걸 찬양하는 소시오패스일베충 벌래에게 무한한 저주가 함께하길 기원합니다.^^"                                                                                                                                                                                               
## [4] "폐쇄적이라는 평가를 받아온 오스카가 외국영화에 작품상을 주는걸 보니 또다른 의미의 권위가 느껴진다"                                                                                                                                                                                                                                                                 
## [5] "봉준호감독 대단하다 열등감이있는외모 안된다는 편견 자신과의 싸움 결국 그럭게 말하는자 들은 뭐하고사는지?우스꽝스럽다고 비꼬고 놀렸을만한 모습이지만 그들은 이런상 한번이라도 받을수있는 자격이있는지 암튼 대다하고 작품활동열심히 하셔서 멋진사람으로 기억되길,.,,외모비하하는 찌질이들은 아무재능없는 소인배가되고 결국 계속 악플 올렸다간 따돌림이나 당하겠지..."
```

---

```r
comment_topic %>%
  filter(topic == 1 & str_detect(reply, "진심")) %>%
  head(50) %>%
  pull(reply)
```

```
## [1] "한국문화는 1등수준. 정치는 개돼지 3등수준. 대한민국 문화수준을 엎 그레이드 한 봉준호감독에게 존경을 표한다. 월드컵4강.봉준호감독 오스카수상. 한국국민들 절대로 잊혀지지않는 대사건이다. 정말 진심으로 축하드립니다.특히 CJ가 한국영화 산업에 큰 발전에 국민의 한 사람으로 감사드린다."
## [2] "진심 축하드립니다. 대한민국 예술처럼 정치, 경제도 발전해서 살기좋은 나라가 되었으면 좋겠네요"                                                                                                                                                                                         
## [3] "이 작품을 기준으로 앞으로도 계속 쓰여질 것입니다. 진심으로 축하드립니다^^"                                                                                                                                                                                                            
## [4] "소름이 돋을 정도로 믿기지 않습니다! 진심으로 축하드립니다 살인의추억을 보고 우리나라에도 이렇게 훌륭한 영화를 만드는 감독이 있구나 느꼈고 그 이후로 계속 봉감독님 영화를 챙겨보게 되었는데 이제는 세계인도 인정해주는 감독이 되어 너무나도 벅찹니다 다시한번 진심으로 축하드립니다"   
## [5] "봉감독님 진심 축하드립니다! 아카데미에서 외국 영화 기생충이 4관왕을 차지했다는 것은 아카데미도 기류가 바뀌고 있다는 ... 험지에서 대단한 업적을 남긴 감독, 배우들, 스텝들에게 찬사를 보냅니다!"
```

---

```r
comment_topic %>%
  filter(topic == 1 & str_detect(reply, "정치")) %>%
  head(5) %>%
  pull(reply)
```

```
## [1] "한국문화는 1등수준. 정치는 개돼지 3등수준. 대한민국 문화수준을 엎 그레이드 한 봉준호감독에게 존경을 표한다. 월드컵4강.봉준호감독 오스카수상. 한국국민들 절대로 잊혀지지않는 대사건이다. 정말 진심으로 축하드립니다.특히 CJ가 한국영화 산업에 큰 발전에 국민의 한 사람으로 감사드린다."
## [2] "진심 축하드립니다. 대한민국 예술처럼 정치, 경제도 발전해서 살기좋은 나라가 되었으면 좋겠네요"                                                                                                                                                                                         
## [3] "좌좀세력, 태극기부대, 빨갱이, 일베애들과 이런것들을 이용애 먹는 정치인들만 없어지면 우리나라 엄청 발전할텐데...기업, 문화 모두 선진국인데 저런것들이 발목을 잡고 너무 깍아먹는다."                                                                                                    
## [4] "정치충들 상은 봉준호가 받았는데 왜 정치얘기를하고있냐"                                                                                                                                                                                                                                
## [5] "문화는 일류 정치는 삼류에 개막장"
```

---

#### 3. 토픽 이름 목록 만들기

- 댓글 내용을 토대로 토픽 번호와 이름으로 구성된 '토픽 이름 목록' 만들기

```r
# 토픽 이름 목록 만들기
name_topic <- tibble(topic = 1:8,
                     name = c("1. 작품상 수상 축하, 정치적 댓글 비판",
                              "2. 수상 축하, 시상식 감상",
                              "3. 조국 가족, 정치적 해석",
                              "4. 새 역사 쓴 세계적인 영화",
                              "5. 자랑스럽고 감사한 마음",
                              "6. 놀라운 4관왕 수상",
                              "7. 문화계 블랙리스트, 보수 정당 비판",
                              "8. 한국의 세계적 위상"))
```

---

#### 토픽 이름과 주요 단어 시각화하기

```r
# 토픽 이름 결합하기
top_term_topic_name <- top_term_topic %>%
  left_join(name_topic, name_topic, by = "topic")

top_term_topic_name
```

```
## # A tibble: 83 x 4
## # Groups:   topic [8]
##    topic term        beta name                                 
##    <int> <chr>      <dbl> <chr>                                
##  1     1 작품     0.0299  1. 작품상 수상 축하, 정치적 댓글 비판
##  2     1 진심     0.0240  1. 작품상 수상 축하, 정치적 댓글 비판
##  3     1 정치     0.0192  1. 작품상 수상 축하, 정치적 댓글 비판
##  4     1 자랑     0.0181  1. 작품상 수상 축하, 정치적 댓글 비판
##  5     1 수상소감 0.0166  1. 작품상 수상 축하, 정치적 댓글 비판
##  6     1 댓글     0.0151  1. 작품상 수상 축하, 정치적 댓글 비판
##  7     1 외국     0.0122  1. 작품상 수상 축하, 정치적 댓글 비판
##  8     1 경사     0.0107  1. 작품상 수상 축하, 정치적 댓글 비판
##  9     1 훌륭     0.00998 1. 작품상 수상 축하, 정치적 댓글 비판
## 10     1 좌파     0.00814 1. 작품상 수상 축하, 정치적 댓글 비판
## # ... with 73 more rows
```

---

```r
# 막대 그래프 만들기
ggplot(top_term_topic_name,
       aes(x = reorder_within(term, beta, name),
           y = beta,
           fill = factor(topic))) +
  geom_col(show.legend = F) +
  facet_wrap(~ name, scales = "free", ncol = 2) +
  coord_flip() +
  scale_x_reordered() +

labs(title = "영화 기생충 아카데미상 수상 기사 댓글 토픽",
       subtitle = "토픽별 주요 단어 Top 10",
       x = NULL, y = NULL) +

theme_minimal() +
  theme(text = element_text(family = "nanumgothic"),
        title = element_text(size = 12),
        axis.text.x = element_blank(),
        axis.ticks.x = element_blank())
```

---
<br-back-10>
<img src="06-topicModeling_files/figure-html/unnamed-chunk-65-1.png" width="43%" />

---

06-6 최적의 토픽 수 정하기

---

#### 토픽 수를 정하는 방법 알아보기

- 토픽 모델의 구조는 토픽 수에 따라 달라지므로 적절한 토픽 수를 정해야 한다
  - 토픽 수 너무 적으면 대부분의 단어가 한 토픽의 주요 단어가 되어 의미가 불분명해짐
  - 토픽 수 너무 많으면 여러 토픽에 주요 단어가 중복되어 토픽의 개성이 드러나지 않음

---

##### 방법 1. 모델의 내용을 보고 해석 가능성을 고려해 토픽 수 정하기
- 토픽 수 정하는 가장 일반적인 방법
- 분석가가 적당한 개수를 정해 모델을 만든 다음 내용을 보고 판단
  - (1) 주요 단어가 토픽을 잘 대표하는가?
  - (2) 문서가 비슷한 내용끼리 잘 분류되었는가?
  - (3) 모델이 텍스트를 해석하는 데 도움이 되는가?

- (-) 일일이 모델의 내용을 확인해야 하므로 시간이 많이 소요됨
- (-) 텍스트의 내용에 관한 전문 지식이 없으면 모델이 타당한지 판단하기 어려움

##### 방법 2. 여러 모델의 성능 지표를 비교해 토픽 수 정하기

- 토픽 수 바꾸어 가며 여러 모델 만들어 성능 지표 비교: 하이퍼파라미터 튜닝(hyperparameter tuning)
  - (+) 전문적인 지식 없어도 적당한 토픽 수를 정할 수 있음
  - (-) 여러 모델 만들어야 하므로 시간이 많이 소요됨
  - (-) 성능 지표 높다고 반드시 좋은 모델 X

---

##### 방법 3. 두 가지 방법을 함께 사용하기

- (1) 하이퍼파라미터 튜닝으로 몇 개의 후보 모델 선정
- (2) 후보 중 해석 가능성이 큰 모델 최종 선택

---

#### 하이퍼파라미터 튜닝으로 토픽 수 정하기

#### 1. 토픽 수 바꿔가며 LDA 모델 여러 개 만들기

- `ldatuning::FindTopicsNumber()`
  - `dtm` : Document Term Matrix
  - `topics` : 비교할 최소-최대 토픽 수
  - `return_models` : 모델 저장 여부(기본값 `FALSE`)
  - `control = list(seed = 1234))` : 난수 고정

```r
install.packages("ldatuning")
library(ldatuning)

models <- FindTopicsNumber(dtm = dtm_comment,
                           topics = 2:20,
                           return_models = T,
                           control = list(seed = 1234))
```

---

```r
models %>%
  select(topics, Griffiths2004)
```

```
##    topics Griffiths2004
## 1      20     -127213.1
## 2      19     -127445.4
## 3      18     -126984.0
## 4      17     -127317.9
## 5      16     -127139.2
## 6      15     -126643.9
## 7      14     -126742.4
## 8      13     -126720.4
## 9      12     -127429.4
## 10     11     -126677.9
## 11     10     -127039.5
## 12      9     -127133.2
## 13      8     -127234.1
## 14      7     -128079.5
## 15      6     -128948.9
## 16      5     -129672.9
## 17      4     -131006.8
## 18      3     -133171.8
## 19      2     -137154.4
```
]

<br><br><br>
.pull-right[

- `Griffiths2004`: 복잡도(perplexity)
  - 모델의 성능 지표, 텍스트를 설명하는 정도
  - 텍스트의 구조를 잘 설명할수록 큰값
]

---

##### 2. 최적 토픽 수 정하기

```r
FindTopicsNumber_plot(models)
```

<img src="06-topicModeling_files/figure-html/unnamed-chunk-69-1.png" width="60%" />
- x축: 토픽 수
- y축: 성능 지표를 0~1로 최대-최소 정규화(min-max normalization)한 값
   - 성능 좋을수록 큰 값. 후보 중 성능 가장 좋으면 1, 가장 나쁘면 0
- 토픽 수 늘려도 성능이 크게 향상되지 않고 등락 반복하기 시작하는 지점에서 토픽 수 결정

---

##### 3. 모델 추출하기

```r
# 토픽 수가 8개인 모델 추출하기
optimal_model <- models %>%
  filter(topics == 8) %>%
  pull(LDA_model) %>%              # 모델 추출
  .[[1]]                           # list 추출
```

---

- 토픽 수를 8개로 지정해 만든 모델과 동일

<br-back-30>

```r
# optimal_model
tidy(optimal_model, matrix = "beta")
```

```r
# lda_model
tidy(lda_model, matrix = "beta")
```

---

정리하기

---

### 정리하기

##### 1. LDA 모델 만들기

```r
# 문서별 단어 빈도 구하기
count_word_doc <- count_word %>%
  count(id, word, sort = T)

# DTM 만들기
dtm_comment <- count_word_doc %>%
  cast_dtm(document = id, term = word, value = n)

# LDA 모델 만들기
lda_model <- LDA(dtm_comment,
                 k = 8,
                 method = "Gibbs",
                 control = list(seed = 1234))
```

---

### 정리하기

##### 2. 토픽별 주요 단어 살펴보기

```r
# beta 추출
term_topic <- tidy(lda_model, matrix = "beta")

# 토픽별 beta 상위 단어 추출
top_term_topic <- term_topic %>%
  group_by(topic) %>%
  slice_max(beta, n = 10)
```

---

### 정리하기

##### 3. 문서를 토픽별로 분류하기

```r
# gamma 추출
doc_topic <- tidy(lda_model, matrix = "gamma")

# 문서별로 확률이 가장 높은 토픽 추출
doc_class <- doc_topic %>%
  group_by(document) %>%
  slice_max(gamma, n = 1)

# 변수 타입 통일
doc_class$document <- as.integer(doc_class$document)

# 문서에 확률이 가장 높은 토픽 번호 부여
news_comment_topic <- raw_news_comment %>%
  left_join(doc_class, by = c("id" = "document"))
```

---

### 정리하기

##### 4. 토픽별 주요 문서 살펴보기

```r
# 특정 토픽에서 gamma가 높은 문서 추출
news_comment_topic %>%
  filter(topic == 1) %>%
  arrange(-gamma) %>%
  select(reply)
```

---

### 분석 도전

**`speeches_roh.csv`에는 노무현 전 대통령의 연설문 780개가 들어있습니다. `speeches_roh.csv`를 이용해 문제를 해결해 보세요.**

Q1. `speeches_roh.csv`를 불러온 다음 연설문이 들어있는 `content`를 문장 기준으로 토큰화하세요.

Q2. 문장을 분석에 적합하게 전처리한 다음 명사를 추출하세요.

Q3. 연설문 내 중복 단어를 제거하고 빈도가 100회 이하인 단어를 추출하세요.

Q4. 추출한 단어에서 다음의 불용어를 제거하세요.

```r
stopword <- c("들이", "하다", "하게", "하면", "해서", "이번", "하네",
              "해요", "이것", "니들", "하기", "하지", "한거", "해주",
              "그것", "어디", "여기", "까지", "이거", "하신", "만큼")
```

Q5. 연설문별 단어 빈도를 구한 다음 DTM을 만드세요.

Q6. 토픽 수를 2~20개로 바꿔가며 LDA 모델을 만든 다음 최적 토픽 수를 구하세요.

---

### 분석 도전

**`speeches_roh.csv`에는 노무현 전 대통령의 연설문 780개가 들어있습니다. `speeches_roh.csv`를 이용해 문제를 해결해 보세요.**

Q7. 토픽 수가 9개인 LDA 모델을 추출하세요.

Q8. LDA 모델의 beta를 이용해 각 토픽에 등장할 확률이 높은 상위 10개 단어를 추출한 다음 <br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;토픽별 주요 단어를 나타낸 막대 그래프를 만드세요.

Q9. LDA 모델의 gamma를 이용해 연설문 원문을 확률이 가장 높은 토픽으로 분류하세요.

Q10. 토픽별 문서 수를 출력하세요.

Q11. 문서가 가장 많은 토픽의 연설문을 gamma가 높은 순으로 출력하고 내용이 비슷한지 살펴보세요.

---

Q1. `speeches_roh.csv`를 불러온 다음 연설문이 들어있는 `content`를 문장 기준으로 토큰화하세요.

```r
speeches_raw <- read_csv(here::here("data/speeches_roh.csv"))
```

```r
# 연설문 불러오기
library(readr)
speeches_raw <- read_csv("speeches_roh.csv")

# 문장 기준 토큰화
library(dplyr)
library(tidytext)
speeches <- speeches_raw %>%
  unnest_tokens(input = content,
                output = sentence,
                token = "sentences",
                drop = F)
```

---
Q2. 문장을 분석에 적합하게 전처리한 다음 명사를 추출하세요.

```r
# 전처리
library(stringr)
speeches <- speeches %>%
  mutate(sentence = str_replace_all(sentence, "[^가-힣]", " "),
         sentence = str_squish(sentence))

# 명사 추출
library(tidytext)
library(KoNLP)
library(stringr)
nouns_speeches <- speeches %>%
  unnest_tokens(input = sentence,
                output = word,
                token = extractNoun,
                drop = F) %>%
  filter(str_count(word) > 1)
```

---

Q3. 연설문 내 중복 단어를 제거하고 빈도가 100회 이하인 단어를 추출하세요.

```r
# 연설문 내 중복 단어 제거
nouns_speeches <- nouns_speeches %>%
  group_by(id) %>%
  distinct(word, .keep_all = T) %>%
  ungroup()

# 단어 빈도 100회 이하 단어 추출
nouns_speeches <- nouns_speeches %>%
  add_count(word) %>%
  filter(n <= 100) %>%
  select(-n)
```

---

Q4. 추출한 단어에서 다음의 불용어를 제거하세요.

```r
stopword <- c("들이", "하다", "하게", "하면", "해서", "이번", "하네",
              "해요", "이것", "니들", "하기", "하지", "한거", "해주",
              "그것", "어디", "여기", "까지", "이거", "하신", "만큼")

# 불용어 제거
nouns_speeches <- nouns_speeches %>%
  filter(!word %in% stopword)
```

---

Q5. 연설문별 단어 빈도를 구한 다음 DTM을 만드세요.

```r
# 연설문별 단어 빈도 구하기
count_word_doc <- nouns_speeches %>%
  count(id, word, sort = T)

# DTM 만들기
dtm_comment <- count_word_doc %>%
  cast_dtm(document = id, term = word, value = n)
```

---

Q6. 토픽 수를 2~20개로 바꿔가며 LDA 모델을 만든 다음 최적 토픽 수를 구하세요.

```r
# 토픽 수 바꿔가며 LDA 모델 만들기
library(ldatuning)
models <- FindTopicsNumber(dtm = dtm_comment,
                           topics = 2:20,
                           return_models = T,
                           control = list(seed = 1234))

# 최적 토픽 수 구하기
FindTopicsNumber_plot(models)
```

---

Q7. 토픽 수가 9개인 LDA 모델을 추출하세요.

```r
lda_model <- models %>%
  filter (topics == 9) %>%
  pull(LDA_model) %>%
 .[[1]]
```

---

```r
# beta 추출
term_topic <- tidy(lda_model, matrix = "beta")

# 토픽별 beta 상위 단어 추출
top_term_topic <- term_topic %>%
  group_by(topic) %>%
  slice_max(beta, n = 10)

top_term_topic
```

---

```
## # A tibble: 94 x 3
## # Groups:   topic [9]
##    topic term     beta
##    <int> <chr>   <dbl>
##  1     1 요구  0.00501
##  2     1 주장  0.00472
##  3     1 자신  0.00454
##  4     1 토론  0.00436
##  5     1 권력  0.00419
##  6     1 자체  0.00413
##  7     1 반대  0.00401
##  8     1 결단  0.00389
##  9     1 어렵  0.00383
## 10     1 선거  0.00377
## # ... with 84 more rows
```

---

```r
# 막대 그래프 만들기
library(ggplot2)
ggplot(top_term_topic,
       aes(x = reorder_within(term, beta, topic),
           y = beta,
           fill = factor(topic))) +
  geom_col(show.legend = F) +
  facet_wrap(~ topic, scales = "free", ncol = 3) +
  coord_flip () +
  scale_x_reordered() +
  labs(x = NULL)
```

---
<br-back-20>

---

Q9. LDA 모델의 gamma를 이용해 연설문 원문을 확률이 가장 높은 토픽으로 분류하세요.

```r
# gamma 추출
doc_topic <- tidy(lda_model, matrix = "gamma")

# 문서별로 확률이 가장 높은 토픽 추출
doc_class <- doc_topic %>%
  group_by(document) %>%
  slice_max(gamma, n = 1)

# 변수 타입 통일
doc_class$document <- as.integer(doc_class$document)

# 연설문 원문에 확률이 가장 높은 토픽 번호 부여
speeches_topic <- speeches_raw %>%
  left_join(doc_class, by = c("id" = "document"))
```

---

Q10. 토픽별 문서 수를 출력하세요.

```r
speeches_topic %>%
  count(topic)
```

```
## # A tibble: 9 x 2
##   topic     n
##   <int> <int>
## 1     1    67
## 2     2    44
## 3     3    62
## 4     4    71
## 5     5    84
## 6     6   134
## 7     7    84
## 8     8   119
## 9     9   148
```

---

Q11. 문서가 가장 많은 토픽의 연설문을 gamma가 높은 순으로 출력하고 내용이 비슷한지 살펴보세요.

```r
speeches_topic %>%
  filter(topic == 9) %>%
  arrange(-gamma) %>%
  select(content)
```

```
## # A tibble: 148 x 1
##    content                                        
##    <chr>                                          
##  1 안녕하십니까, 이처럼 따뜻하게 맞아주셔서 감사~ 
##  2 존경하는 룰라 대통령 각하 내외분, 그리고 귀빈 ~
##  3 존경하는 압델아지즈 부테플리카 알제리 대통령 ~ 
##  4 존경하는 압둘 라흐만 알 라쉬드 상의연합회 회장~
##  5 존경하는 바세스쿠 대통령 각하, 그리고 귀빈 여~ 
##  6 존경하는 일함 알리예프 대통령 각하 내외분, 그~ 
##  7 존경하는 키르츠네르 대통령 각하 내외분, 그리고~
##  8 존경하는,카리모프, 대통령 각하 내외분, 그리고 ~
##  9 2005년 5월 10일 존경하는 카리모프 대통령 각하 ~
## 10 존경하는 빌토르 바비욱 루마니아 상공회의소 회~ 
## # ... with 138 more rows
```