Chapter 4 분석사례

이론기반 토픽모델링을 이용한 감염병보도 분석: 위험-기회모형의 적용

안도현

이론기반 토픽모델링을 감염병보도 분석에 적용했다. 이를 위해 위험-기회 모형을 적용해 주제어를 추출한 뒤, 이 주제어를 씨앗으로 투입해 이론기반 토픽모델링을 수행했다. 이를 통해 국내 감염병보도가 감염병 상황을 적절하게 반영하고 있는지에 대해 분석했다.

분석 절차는 다음과 같다.

• 자료준비
  
• 전처리
  
• 비지도LDA
  
• 씨앗주제어 구성
  
• 반지도LDA

4.1 자료준비

국내 주요 언론에서 코로나19 상황에 대한 위험과 기회를 어느 정도로 실재적인 측면을 반영하는지 가늠하기 위해, 코로나19 상황의 위험과 기회를 반영하는 주제어를 구성하고, 이 주제어를 통해 반지도학습 토픽모델링을 수행한다.

데이터는 tidyverse와 quanteda를 이용해 마련하고, LDA토픽모델링은 seededlda를 이용한다.

quanteda패키지는 dfm에 메타정보를 추가하는데 사용한다. quanteda에서는 한글형태소 분석기를 사용할 수 없기 때문에, tidyverse와 tidytext로 먼저 형태소분석한 데이터프레임을 만들어 quanteda에 투입한다.

4.1.0.1 패키지 로딩

pkg_v <- c(
  "tidyverse", "tidytext", "lubridate", "quanteda", "readtext", "seededlda")
purrr::map(pkg_v, require, ch = T)

## [[1]]
## [1] TRUE
## 
## [[2]]
## [1] TRUE
## 
## [[3]]
## [1] TRUE
## 
## [[4]]
## [1] TRUE
## 
## [[5]]
## [1] TRUE
## 
## [[6]]
## [1] TRUE

.

4.1.1 기사 자료 확보

말뭉치는 빅카인즈를 통해 확보한다. 코로나19 관련 기사를 추출하기 위해 다음의 방법을통해 기사를 검색해 다운로드 받는다. 빅카인즈는 저작권 문제로 기사는 200자만 제공하지만, 기사 전문에 대해 키워드를 제공한다. 이 키워드는 형태소 분석을 통한 추출한 명사에 해당한다.

1. 키워드 ((코로나19) OR (코로나) OR (코로나 바이러스) OR (신종 코로나바이러스) OR (COVID-19) OR (코비드19))

2. 세부 설정

• 언론사: 경향 국민 동아 문화 서울 세계 조선 중앙 한겨레 한국 KBS MBC SBS

• 분류 사회: 의료건강 인사, 부고, 동정 등 제외

• 기간: 2021년 5월 1일부터 10월 31일 2021-05-01 ~ 2021-10-31 16,288건 (분석편의를 위해 2만건을 넘기지 않도록 했다. 빅카인즈는 한번에 2만건 까지만 다운로드를 받을 수 있도록 했다. 2만건이 넘어가면 일반 개인 컴퓨터로는 분석시간이 오래 걸리는 문제도 있다.) .

다운로드 받은 파일을 작업디렉토리의 data폴더에 복사한다. 제대로 복사돼 있는지 확인.

list.files(path = 'data', pattern = '^News.*\\.xlsx$')

## [1] "NewsResult_20191101-20200430.xlsx" "NewsResult_20200501-20201031.xlsx"
## [3] "NewsResult_20201101-20210430.xlsx" "NewsResult_20210501-20211031.xlsx"

.

5월 ~ 10월에 해당하는 파일 선택.

file_path <- "data/NewsResult_20210501-20211031.xlsx"
readxl::read_excel(file_path) %>%
  glimpse()

## Rows: 16,288
## Columns: 19
## $ `뉴스 식별자`                  <chr> "01100701.20211031230241001", "01100201.2021~
## $ 일자                           <chr> "20211031", "20211031", "20211031", "2021~
## $ 언론사                         <chr> "세계일보", "국민일보", "KBS", "중앙일보", "KBS", "KBS~
## $ 기고자                         <chr> "정진수", "박용미", "오정현", "오병상(oh.byungsang@joo~
## $ 제목                           <chr> "길어진 방콕에 확 늘어난 몸무게 “심혈관질환 이상 없나요”", "새에덴교~
## $ `통합 분류1`                   <chr> "사회>의료_건강", "사회>의료_건강", "사회>의료_건강", "사회>의료_~
## $ `통합 분류2`                   <chr> "사회>여성", "지역>경기", "사회>여성", NA, "지역>충남", "사회~
## $ `통합 분류3`                   <chr> "사회>교육_시험", "지역>충남", NA, NA, "사회>의료_건강", "지~
## $ `사건/사고 분류1`              <chr> NA, NA, NA, NA, NA, NA, "범죄>기업범죄>거래제한", NA, N~
## $ `사건/사고 분류2`              <chr> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, N~
## $ `사건/사고 분류3`              <chr> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, N~
## $ 인물                           <chr> "김정환,이상지", "이,이재훈,김용선,소강석,김근수", "강영석", NA~
## $ 위치                           <chr> "의정부을지대학교병원,방콕", "용인,경기도", "한문현,전북,군산,전북지~
## $ 기관                           <chr> "대한비만학회,BRCA,게티이미지뱅크,서울아산병원,BRCA1,선우성,선종"~
## $ 키워드                         <chr> "방콕,몸무게,심혈관질환,게티,이미지,뱅크,연말,병원,건강검진,사람들,북새통~
## $ `특성추출(가중치순 상위 50개)` <chr> "대장암,유방암,고혈압,건강검진,간염,방사선,코로나19,유전자,난소암,ct,40세,코로나,~
## $ 본문                           <chr> "게티이미지뱅크 연말이면 많은 병원이 건강검진을 받으려는 사람들도 북새통을~
## $ URL                            <chr> "http://www.segye.com/content/html/2021~
## $ `분석제외 여부`                <lgl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, N~

.

분석에 필요한 열만 선택한다.

readxl::read_excel(file_path) %>%
  select(일자, 제목, 본문, 키워드, 언론사, cat = `통합 분류1`,  URL) -> vac_df
vac_df %>% head(3)

## # A tibble: 3 x 7
##   일자   제목         본문           키워드          언론사 cat    URL          
##   <chr>  <chr>        <chr>          <chr>           <chr>  <chr>  <chr>        
## 1 20211~ 길어진 방콕에 확 늘~ "게티이미지뱅크 연말이면~ 방콕,몸무게,심혈관질환,게~ 세계일보~ 사회>의료~ http://www.s~
## 2 20211~ 새에덴교회, 칼빈대 ~ "경기도 용인 새에덴교회~ 새에덴교회,칼빈대,교직원,~ 국민일보~ 사회>의료~ http://news.~
## 3 20211~ 전북, ‘단계적 일상~ "[KBS 전주]\n [~ 전북,단계,일상회복,집단,~ KBS    사회>의료~ https://news~

.

정제. 불용어 부호 중복기사 공백 등 제거

fullchar_v <- "ㆍ|ㅣ|‘|’|“|”|○|●|◎|◇|◆|□|■|△|▲|▽|▼|〓|◁|◀|▷|▶|♤|♠|♡|♥|♧|♣|⊙|◈|▣"

vac_df %>%
  # 인터뷰 기고 등 제거
  filter(!str_detect(제목, "(
    \\[인터뷰|\\인터뷰\\]|
    \\[전문|전문\\]|
    \\[기고|기고\\]|
    \\[Q|A\\]|
    \\[논담|논담\\]|
    \\[좌담회|좌담회\\]|
    답\\>|
    답\\]|
    \\<파워|
    \\[사람|사람\\]|
    \\[탐방|탐방\\]|
    \\[속보|속보\\]|
    \\[팩트|
    \\[브리핑|브리핑\\]|
    \\[시평|시평\\]|
    )")) %>% 
  # 중복기사 제거
  distinct(제목, .keep_all = T) %>%
  # 기사 공백제거
  mutate(제목 = str_squish(제목)) %>%
  # 기사 공백제거
  mutate(본문 = str_squish(본문)) %>%
  # 특수문자 제거
  mutate(키워드 = str_remove_all(키워드, "[^(\\w+|\\d+|,)]")) %>%
  mutate(키워드 = str_remove_all(키워드, fullchar_v)) %>%
  # 기사별 ID부여
  mutate(ID = factor(row_number())) %>%
  # 월별로 구분한 열 추가(lubridate 패키지) %>% 
  mutate(ym = str_sub(일자, 1, 6)) %>% 
  mutate(ym = as.integer(ym)) %>% 
  mutate(title = 제목) %>% 
  # 기사 제목과 본문 결합
  unite(제목, 본문, col = "text", sep = " ") %>% 
  #키워드 갯수 계산
  mutate(Nword = str_count(키워드, pattern = ',')) %>%
  relocate(Nword, after = 일자) %>%
  # 기사 분류 구분
  separate(cat, sep = ">", into = c("cat", "cat2")) %>%
  # IT_과학, 경제, 사회 만 선택
  select(-cat2) %>%
  # 분류 구분: 사회, 비사회
  relocate(cat, after = Nword) %>%
  mutate(catSoc = case_when(
    cat == "사회" ~ "사회면",
    cat == "지역" ~ "사회면",
    TRUE ~ "비사회면") ) -> vac2_df

vac2_df %>% glimpse()

## Rows: 15,553
## Columns: 11
## $ cat    <chr> "사회", "사회", "사회", "사회", "지역", "지역", "사회", "사회", "IT_과학", "사회", ~
## $ Nword  <int> 462, 79, 114, 163, 135, 132, 172, 53, 282, 180, 181, 263, 147, ~
## $ 일자   <chr> "20211031", "20211031", "20211031", "20211031", "20211031", "2021~
## $ text   <chr> "길어진 방콕에 확 늘어난 몸무게 “심혈관질환 이상 없나요” 게티이미지뱅크 연말이면 많은 병원이 건강검진을 받으려~
## $ 키워드 <chr> "방콕,몸무게,심혈관질환,게티,이미지,뱅크,연말,병원,건강검진,사람들,북새통,예약,대기,사례,1일,위드,코로나,시행,감~
## $ 언론사 <chr> "세계일보", "국민일보", "KBS", "중앙일보", "KBS", "KBS", "KBS", "KBS", "경향신문",~
## $ URL    <chr> "http://www.segye.com/content/html/2021/10/31/20211031508024.ht~
## $ ID     <fct> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, ~
## $ ym     <int> 202110, 202110, 202110, 202110, 202110, 202110, 202110, 202110,~
## $ title  <chr> "길어진 방콕에 확 늘어난 몸무게 “심혈관질환 이상 없나요”", "새에덴교회, 칼빈대 교직원에 독감 예방접종 봉사~
## $ catSoc <chr> "사회면", "사회면", "사회면", "사회면", "사회면", "사회면", "사회면", "사회면", "비사회면",~

.

정제 데이터 확인

vac2_df$ym %>% unique()

## [1] 202110 202109 202108 202107 202106 202105

.

사회 분류의 의료_건강만 선택했지만, 다른 영역의 기사도 포함된다.

vac2_df %>% count(cat, sort = T)

## # A tibble: 8 x 2
##   cat         n
##   <chr>   <int>
## 1 사회    11914
## 2 지역     1468
## 3 국제     1097
## 4 IT_과학   434
## 5 문화      234
## 6 정치      219
## 7 경제      177
## 8 스포츠     10

.

기사 길이 확인

vac2_df %>% .$Nword %>% summary()

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##     7.0   123.0   158.0   179.5   219.0  1527.0

.

기사의 길이가 일정 수준까지는 기사의 품질과 정비례의 관계가 있다는 전제하에 단어수가 70개 이상한 기사만 선택.

vac2_df %>%
  filter(Nword >= 70) -> vac2_df
vac2_df %>% .$Nword %>% summary()

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    70.0   130.0   164.0   189.1   225.0  1527.0

.

tidytext 방식으로 토큰화.

vac2_df %>%
  unnest_tokens(word, 키워드, token = "regex", pattern = ",") -> vac_tk
vac_tk %>% 
  select(ym, title, word) %>% 
  head(n = 5)

## # A tibble: 5 x 3
##       ym title                                                       word    
##    <int> <chr>                                                       <chr>   
## 1 202108 “백신예약 대란 없었다” LG CNS, 병목 현상 90% 이상 개선 완료 백신예약
## 2 202108 “백신예약 대란 없었다” LG CNS, 병목 현상 90% 이상 개선 완료 lg      
## 3 202108 “백신예약 대란 없었다” LG CNS, 병목 현상 90% 이상 개선 완료 cns     
## 4 202108 “백신예약 대란 없었다” LG CNS, 병목 현상 90% 이상 개선 완료 90      
## 5 202108 “백신예약 대란 없었다” LG CNS, 병목 현상 90% 이상 개선 완료 개선

.

토큰 빈도 계산

vac_tk %>% 
  count(word, sort = T) -> count_df 
count_df %>% head(n = 10)

## # A tibble: 10 x 2
##    word          n
##    <chr>     <int>
##  1 접종     113809
##  2 백신      96320
##  3 코로나19  42458
##  4 확진자    28675
##  5 감염      21406
##  6 환자      17946
##  7 정부      16702
##  8 예약      14485
##  9 방역      13600
## 10 발생      13562

.

tidytext방식(한 행에 하나의 값 배치)의 토큰을 각 기사의 행에 재배치 text2열에 할당한다. 다른 변수가 포함된 데이터프레임과 결합. quanteda로 dfm을 만들기 위해 필요한 작업. dfm에 개별 기사에 대한 변수가 포함돼 있어야 추가적인 분석이 가능하다.

combined_df <-
  vac_tk %>%
  group_by(ID) %>%
  summarise(text2 = str_flatten(word, " ")) %>%
  ungroup() %>%
  inner_join(vac2_df, by = "ID")

## `summarise()` ungrouping output (override with `.groups` argument)

combined_df %>% glimpse()

## Rows: 14,508
## Columns: 12
## $ ID     <fct> 1, 2, 3, 4, 5, 6, 7, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19,~
## $ text2  <chr> "방콕 몸무게 심혈관질환 게티 이미지 뱅크 연말 병원 건강검진 사람들 북새통 예약 대기 사례 1일 위드 코로나 시~
## $ cat    <chr> "사회", "사회", "사회", "사회", "지역", "지역", "사회", "IT_과학", "사회", "사회", ~
## $ Nword  <int> 462, 79, 114, 163, 135, 132, 172, 282, 180, 181, 263, 147, 162,~
## $ 일자   <chr> "20211031", "20211031", "20211031", "20211031", "20211031", "2021~
## $ text   <chr> "길어진 방콕에 확 늘어난 몸무게 “심혈관질환 이상 없나요” 게티이미지뱅크 연말이면 많은 병원이 건강검진을 받으려~
## $ 키워드 <chr> "방콕,몸무게,심혈관질환,게티,이미지,뱅크,연말,병원,건강검진,사람들,북새통,예약,대기,사례,1일,위드,코로나,시행,감~
## $ 언론사 <chr> "세계일보", "국민일보", "KBS", "중앙일보", "KBS", "KBS", "KBS", "경향신문", "KBS",~
## $ URL    <chr> "http://www.segye.com/content/html/2021/10/31/20211031508024.ht~
## $ ym     <int> 202110, 202110, 202110, 202110, 202110, 202110, 202110, 202110,~
## $ title  <chr> "길어진 방콕에 확 늘어난 몸무게 “심혈관질환 이상 없나요”", "새에덴교회, 칼빈대 교직원에 독감 예방접종 봉사~
## $ catSoc <chr> "사회면", "사회면", "사회면", "사회면", "사회면", "사회면", "사회면", "비사회면", "사회면",~

combined_df %>% saveRDS("combined.rds")

.

4.2 전처리

비지도 LDA로 토픽을 군집한 다음, 씨앗주제사전을 만들어, 반지도 LDA로 토픽을 군집하기 위해서는 먼저 quanteda패키지로 DFM(Data Feature Matrix)를 만들어야 한다. quanteda패키지의 DFM은 topicmodels패키지에서 사용하는 DTM(Data Term Matrix)에 해당한다. 행에 개별 단어(data), 열에는 주제(feature 또는 term)이 배치된 행렬(matrix)데이터다. .

4.2.1 말뭉치

먼저 말뭉치를 만든다음, dfm을 만든다.

quanteda패키지로 말뭉치를 만든다. text2열에 토큰화한 값이 있다. https://tutorials.quanteda.io/basic-operations/dfm/dfm/

combined_df %>% 
  corpus(text_field = "text2") -> c_corp
c_corp %>% glimpse()

##  'corpus' Named chr [1:14508] "방콕 몸무게 심혈관질환 게티 이미지 뱅크 연말 병원 건강검진 사람들 북새통 예약 대기 사례 1일 위드 코로나 시행 감"| __truncated__ ...
##  - attr(*, "names")= chr [1:14508] "text1" "text2" "text3" "text4" ...
##  - attr(*, "docvars")='data.frame':  14508 obs. of  14 variables:
##   ..$ docname_: chr [1:14508] "text1" "text2" "text3" "text4" ...
##   ..$ docid_  : Factor w/ 14508 levels "text1","text2",..: 1 2 3 4 5 6 7 8 9 10 ...
##   ..$ segid_  : int [1:14508] 1 1 1 1 1 1 1 1 1 1 ...
##   ..$ ID      : Factor w/ 15553 levels "1","2","3","4",..: 1 2 3 4 5 6 7 9 10 11 ...
##   ..$ cat     : chr [1:14508] "사회" "사회" "사회" "사회" ...
##   ..$ Nword   : int [1:14508] 462 79 114 163 135 132 172 282 180 181 ...
##   ..$ 일자    : chr [1:14508] "20211031" "20211031" "20211031" "20211031" ...
##   ..$ text    : chr [1:14508] "길어진 방콕에 확 늘어난 몸무게 “심혈관질환 이상 없나요” 게티이미지뱅크 연말이면 많은 병원이 건강검진을 받으려"| __truncated__ "새에덴교회, 칼빈대 교직원에 독감 예방접종 봉사 경기도 용인 새에덴교회(소강석 목사) 산하 메디컬처치(위원장 김용"| __truncated__ "전북, ‘단계적 일상회복’ 앞두고 집단감염 지속 [KBS 전주] [앵커] 전북에서 코로나19 확진자가 34명 늘었습니다. 곳"| __truncated__ "[오병상의 코멘터리] 위드코로나..‘최악의 겨울’될까? ━ 핼러윈 맞은 이태원 풍경에.. ━ 코로나대응 공동체의식 희"| __truncated__ ...
##   ..$ 키워드  : chr [1:14508] "방콕,몸무게,심혈관질환,게티,이미지,뱅크,연말,병원,건강검진,사람들,북새통,예약,대기,사례,1일,위드,코로나,시행,감"| __truncated__ "새에덴교회,칼빈대,교직원,봉사,독감,예방,접종,새에덴교회,경기도,용인,소강석,목사,산하,메디컬처치,위원장,김용선,"| __truncated__ "전북,단계,일상회복,집단,감염,지속,앵커,전북,코로나19,확진자,34명,집단감염,단계,일상,회복,시작,오정현,리포트,재"| __truncated__ "위드코,최악,겨울,핼러윈,이태원,풍경,희박,코로나대응,공동체,의식,코로나,1,위드,corona,시작,주말,핼러윈,파티,젊은"| __truncated__ ...
##   ..$ 언론사  : chr [1:14508] "세계일보" "국민일보" "KBS" "중앙일보" ...
##   ..$ URL     : chr [1:14508] "http://www.segye.com/content/html/2021/10/31/20211031508024.html" "http://news.kmib.co.kr/article/view.asp?arcid=0016419698&code=61171811&cp=kd" "https://news.kbs.co.kr/news/view.do?ncd=5313648&ref=DA" "https://www.joongang.co.kr/article/25019705" ...
##   ..$ ym      : int [1:14508] 202110 202110 202110 202110 202110 202110 202110 202110 202110 202110 ...
##   ..$ title   : chr [1:14508] "길어진 방콕에 확 늘어난 몸무게 “심혈관질환 이상 없나요”" "새에덴교회, 칼빈대 교직원에 독감 예방접종 봉사" "전북, ‘단계적 일상회복’ 앞두고 집단감염 지속" "[오병상의 코멘터리] 위드코로나..‘최악의 겨울’될까?" ...
##   ..$ catSoc  : chr [1:14508] "사회면" "사회면" "사회면" "사회면" ...
##  - attr(*, "meta")=List of 3
##   ..$ system:List of 6
##   .. ..$ package-version:Classes 'package_version', 'numeric_version'  hidden list of 1
##   .. ..$ r-version      :Classes 'R_system_version', 'package_version', 'numeric_version'  hidden list of 1
##   .. ..$ system         : Named chr [1:3] "Windows" "x86-64" "J"
##   .. .. ..- attr(*, "names")= chr [1:3] "sysname" "machine" "user"
##   .. ..$ directory      : chr "E:/data/textData/solution"
##   .. ..$ created        : Date[1:1], format: "2021-12-06"
##   .. ..$ source         : chr "data.frame"
##   ..$ object:List of 2
##   .. ..$ unit   : chr "documents"
##   .. ..$ summary:List of 2
##   ..$ user  : list()

.

말뭉치의 내용을 보다 간결하게 보기 위해서는 docvars()함수를 이용한다.

c_corp %>% docvars() %>% glimpse()

## Rows: 14,508
## Columns: 11
## $ ID     <fct> 1, 2, 3, 4, 5, 6, 7, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19,~
## $ cat    <chr> "사회", "사회", "사회", "사회", "지역", "지역", "사회", "IT_과학", "사회", "사회", ~
## $ Nword  <int> 462, 79, 114, 163, 135, 132, 172, 282, 180, 181, 263, 147, 162,~
## $ 일자   <chr> "20211031", "20211031", "20211031", "20211031", "20211031", "2021~
## $ text   <chr> "길어진 방콕에 확 늘어난 몸무게 “심혈관질환 이상 없나요” 게티이미지뱅크 연말이면 많은 병원이 건강검진을 받으려~
## $ 키워드 <chr> "방콕,몸무게,심혈관질환,게티,이미지,뱅크,연말,병원,건강검진,사람들,북새통,예약,대기,사례,1일,위드,코로나,시행,감~
## $ 언론사 <chr> "세계일보", "국민일보", "KBS", "중앙일보", "KBS", "KBS", "KBS", "경향신문", "KBS",~
## $ URL    <chr> "http://www.segye.com/content/html/2021/10/31/20211031508024.ht~
## $ ym     <int> 202110, 202110, 202110, 202110, 202110, 202110, 202110, 202110,~
## $ title  <chr> "길어진 방콕에 확 늘어난 몸무게 “심혈관질환 이상 없나요”", "새에덴교회, 칼빈대 교직원에 독감 예방접종 봉사~
## $ catSoc <chr> "사회면", "사회면", "사회면", "사회면", "사회면", "사회면", "사회면", "비사회면", "사회면",~

.

4.2.2 DFM 구성

dfm을 구성할 때 dfm()함수만을 이용하기도 하지만, dfm_trim()함수를 추가로 투입해 분석대상을 추려냄으로써 추출한 주제의 변별성을 높일 수 있다.

자세한 내용은 매뉴얼(https://quanteda.io/reference/dfm_trim.html) 참조.

여기서는 가장 빈번한 feature 5%를 추렸다. feature의 문서빈도 값을 10% 미만(max_docfreq = 0.1)으로 설정하고, 모든 문서의 feature 빈도 80% 이상(min_termfreq = 0.8)으로 설정.

topfeatures() 함수를 이용해 가장 빈번하게 등장하는 feature를 확인할 수 있따.

tokens() 함수를 이용해 불용어나 구두점 등 정제작업을 할수 있다. 이미 앞 단계에서 정제 작업을 수행했기 때문에 여기서는 사용하지 않는다.

c_corp %>% 
  #tokens(remove_punct = T) %>% 
  dfm() %>%
  dfm_trim(min_termfreq = 0.8, 
           # 
           termfreq_type = "quantile",
           max_docfreq = 0.1, 
           docfreq_type = "prop") -> c_dfm

c_dfm %>% topfeatures(n = 20)

##     병상     회분       건   부스터     추석     인력       씨     연휴 
##     4698     3934     3566     3533     3225     3097     2955     2949 
##       천        a     격리     신고   청소년 부스터샷     위드     승인 
##     2852     2823     2803     2795     2760     2690     2684     2511 
##     임상     연령     항체   감염병 
##     2485     2460     2453     2407

.

4.3 비지도 LDA

씨앗주제어를 추출하기 위해 먼저 비지도 LDA를 수행해 보도된 기사의 주제별 군집과 각 주제 별로 분포된 주제어를 확인한다. 여기서는 주제를 편의상 16개 (k = 16)로 설정했다.

set.seed(37)
c_dfm %>% textmodel_lda(k = 16) -> c_lda
c_lda %>% glimpse()

## List of 10
##  $ k        : int 16
##  $ max_iter : int 2000
##  $ last_iter: int 2000
##  $ alpha    : num 0.5
##  $ beta     : num 0.1
##  $ phi      : num [1:16, 1:13073] 1.90e-06 1.22e-06 1.00e-06 1.07e-06 7.91e-07 ...
##   ..- attr(*, "dimnames")=List of 2
##   .. ..$ : chr [1:16] "topic1" "topic2" "topic3" "topic4" ...
##   .. ..$ : chr [1:13073] "방콕" "몸무게" "심혈관질환" "게티" ...
##  $ theta    : num [1:14508, 1:16] 0.00178 0.03125 0.00769 0.005 0.01875 ...
##   ..- attr(*, "dimnames")=List of 2
##   .. ..$ : chr [1:14508] "text1" "text2" "text3" "text4" ...
##   .. ..$ : chr [1:16] "topic1" "topic2" "topic3" "topic4" ...
##  $ words    :Formal class 'dgCMatrix' [package "Matrix"] with 6 slots
##   .. ..@ i       : int [1:44638] 4 8 15 16 20 26 39 40 44 45 ...
##   .. ..@ p       : int [1:17] 0 2490 4654 7047 9735 12705 16166 18550 21222 23751 ...
##   .. ..@ Dim     : int [1:2] 13073 16
##   .. ..@ Dimnames:List of 2
##   .. ..@ x       : num [1:44638] 2 3 32 22 2 3 2 12 2 12 ...
##   .. ..@ factors : list()
##  $ data     :Formal class 'dfm' [package "quanteda"] with 8 slots
##   .. ..@ docvars :'data.frame':  14508 obs. of  14 variables:
##   .. ..@ meta    :List of 3
##   .. ..@ i       : int [1:982813] 0 199 207 1259 2421 2481 7347 7611 7624 7626 ...
##   .. ..@ p       : int [1:13074] 0 22 76 97 112 169 186 334 398 412 ...
##   .. ..@ Dim     : int [1:2] 14508 13073
##   .. ..@ Dimnames:List of 2
##   .. ..@ x       : num [1:982813] 1 2 1 1 1 2 1 8 10 4 ...
##   .. ..@ factors : list()
##  $ call     : language lda(x = x, k = k, label = label, max_iter = max_iter, alpha = alpha, beta = beta,      seeds = NULL, words = NULL| __truncated__
##  - attr(*, "class")= chr [1:3] "textmodel_lda" "textmodel" "list"

14,508개 문서의 982,813개의 단어에서 13,973개 단어를 16개의 주제로 분류했다.

phi열의 값이 토픽x단어 행렬이다. topicmodels나 stm패키지의 beta에 해당한다. 각 각 단어가 토픽별 할당되는 확률 값이다.

theta열의 값이 문서x토픽 행렬이다. topicmodels나 stm패키지의 gamma에 해당한다. 각 문서가 토픽별로 포함될 확률 값이다.

.

8개의 주제별로 전형적인 단어 10개(n = 10)를 추출해보자. 토픽별 단어의 phi값을 내림차순으로 산출한다.

c_lda %>% terms(n = 10) %>% as.data.frame() %>% 
  select(topic1:topic8)

##      topic1   topic2   topic3   topic4   topic5   topic6       topic7   topic8
## 1  청해부대   부스터       씨     허용     위드 이스라엘         병상   외국인
## 2      장병   청소년        a     식당     전환     의무         재택 집단감염
## 3    국방부 부스터샷     신고 인센티브 전문가들     세계         전담     부산
## 4      부대     승인       건     카페     내과     인도           개     대구
## 5      격리      fda     인정     면제     체계      cdc     재택치료     접촉
## 6      현지   임신부 이상반응     입국   치명률   의무화         이송   접촉자
## 7      음성     소아   인과성     패스     달성 현지시간         생활     경남
## 8       pcr 추가접종     의심       인     반장     실내         격리     요양
## 9      사태      cdc     남성   증명서   방대본   감염자 생활치료센터 요양병원
## 10     파병   어린이   혈전증     면회     전파     지침         경증     직원

c_lda %>% terms(n = 10) %>% as.data.frame() %>% 
  select(topic9:topic16)

##      topic9 topic10 topic11  topic12  topic13  topic14 topic15 topic16
## 1      임상    질환    인력     추석     휴가     회분  대통령    마음
## 2      항체    운동    학생     연휴   보건소     잔여    진료  간호사
## 3    치료제    수술  간호사       천   오접종     간격  감염병    걱정
## 4      시험    원인    학교 비수도권     의원     연령    보험    자신
## 5      교차    음식    노조   위중증     일본     수급  서비스    아이
## 6      허가    섭취    파업     연속     직원 사전예약    한국    사진
## 7    식약처    통증    공공     주말     안내   상반기    부담    의사
## 8      비교    피부  교직원     최다     보관     차질      억    치매
## 9    연구진    주의  교육부     차지 의료기관 잔여백신    비용    여성
## 10 교차접종    도움    요구 영상편집     주사   고령층    사업    불안

.

topic9를 phi값의 내림차 순으로 정렬해보면 topic1의 단어가 동일하게 산출된다.

c_lda$phi %>% t() %>% 
  as.data.frame() %>% 
  arrange(topic9 %>% desc) %>% 
  round(digits = 3) %>% 
  head(10)

##          topic1 topic2 topic3 topic4 topic5 topic6 topic7 topic8 topic9 topic10
## 임상      0.000  0.000  0.000      0  0.000  0.000      0      0  0.033   0.000
## 항체      0.001  0.005  0.000      0  0.001  0.000      0      0  0.025   0.000
## 치료제    0.000  0.000  0.000      0  0.000  0.000      0      0  0.019   0.000
## 시험      0.000  0.000  0.000      0  0.000  0.000      0      0  0.016   0.000
## 교차      0.000  0.002  0.001      0  0.000  0.000      0      0  0.014   0.000
## 허가      0.002  0.004  0.000      0  0.000  0.000      0      0  0.012   0.000
## 식약처    0.000  0.000  0.000      0  0.000  0.000      0      0  0.009   0.000
## 비교      0.000  0.001  0.000      0  0.003  0.001      0      0  0.007   0.001
## 연구진    0.000  0.001  0.000      0  0.000  0.000      0      0  0.007   0.001
## 교차접종  0.000  0.001  0.000      0  0.000  0.000      0      0  0.007   0.000
##          topic11 topic12 topic13 topic14 topic15 topic16
## 임상       0.000   0.000       0   0.000       0       0
## 항체       0.000   0.000       0   0.000       0       0
## 치료제     0.000   0.000       0   0.000       0       0
## 시험       0.005   0.000       0   0.000       0       0
## 교차       0.000   0.000       0   0.001       0       0
## 허가       0.000   0.000       0   0.001       0       0
## 식약처     0.000   0.000       0   0.000       0       0
## 비교       0.000   0.003       0   0.000       0       0
## 연구진     0.000   0.000       0   0.000       0       0
## 교차접종   0.000   0.000       0   0.002       0       0

각 토픽 단어를 통해 각 토픽의 제목을 다음과 같이 부여할 수 있다.

• topic1: 청해부대 감염

• topic2: 세계 추가접종

• topic3: 이상반응 청원

• topic4: 일상회복

• topic5: 돌파감염

• topic6: 기타:진료활동

• topic7: 집단면역

• topic8: 집단감염

• topic9: 치료제 승인

• topic10: 기타: 건강

• topic11: 기타: 노동

• topic12: 연휴 감염

• topic13: 백신수급

• topic14: 백신접종

• topic15: 치료

• topic16: 이상반응 .

씨앗주제어를 구성하기 위해 각 문서가 해당 주제에 속할 확률인 theta값을 확인한다.

주제1부터 주제8까지의 문서x토픽 행렬인 theta는 다음과 같다.

c_lda$theta %>% as.data.frame() -> clda_theta_df
clda_theta_df %>% 
  select(topic1:topic8) %>% 
  round(digits = 3) %>% head(3)

##       topic1 topic2 topic3 topic4 topic5 topic6 topic7 topic8
## text1  0.002  0.002  0.002   0.02  0.052  0.002  0.012  0.005
## text2  0.031  0.010  0.010   0.01  0.010  0.073  0.052  0.052
## text3  0.008  0.023  0.008   0.10  0.054  0.008  0.085  0.577

.

주제9부터 주제16까지의 문서x토픽 행렬인 theta는 다음과 같다.

c_lda$theta %>% as.data.frame() -> clda_theta_df
clda_theta_df %>% 
  select(topic9:topic16) %>% 
  round(digits = 3) %>% head(3)

##       topic9 topic10 topic11 topic12 topic13 topic14 topic15 topic16
## text1  0.002   0.763   0.002   0.002   0.002   0.005   0.016   0.112
## text2  0.010   0.010   0.115   0.010   0.302   0.010   0.135   0.156
## text3  0.008   0.023   0.008   0.023   0.008   0.038   0.023   0.008

.

text3은 topic8(집단감염)에 속할 확률이 0.562이고, 다른 토픽에 속할 확률은 0.002에서 0.085다. .

text3이 어떤 문서인지 해당 기사를 선택해 보자. 이를 위해서는 토픽모델링 산출물의 각 주제와 앞서 구성한 말뭉치를 결합해야 한다. 이를 위해 산출물에서 문서별 주제 할당 확률값인 theta 정보를 데이터프레임으로 저장하고, 말뭉치에서 변수(열)를 추출해 데이터프레임으로 저장한다.

먼저 토픽모델링 산출물에서 문서별 theta 값 추출한다. 벡터이므로 데이터프레임으로 변환한다. 말뭉치의 docvars()함수로 기사의 변수(열) 추출해 데이터프레임으로 저장한다.

c_corp %>% docvars() -> docvars_df  
docvars_df  %>% glimpse()

## Rows: 14,508
## Columns: 11
## $ ID     <fct> 1, 2, 3, 4, 5, 6, 7, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19,~
## $ cat    <chr> "사회", "사회", "사회", "사회", "지역", "지역", "사회", "IT_과학", "사회", "사회", ~
## $ Nword  <int> 462, 79, 114, 163, 135, 132, 172, 282, 180, 181, 263, 147, 162,~
## $ 일자   <chr> "20211031", "20211031", "20211031", "20211031", "20211031", "2021~
## $ text   <chr> "길어진 방콕에 확 늘어난 몸무게 “심혈관질환 이상 없나요” 게티이미지뱅크 연말이면 많은 병원이 건강검진을 받으려~
## $ 키워드 <chr> "방콕,몸무게,심혈관질환,게티,이미지,뱅크,연말,병원,건강검진,사람들,북새통,예약,대기,사례,1일,위드,코로나,시행,감~
## $ 언론사 <chr> "세계일보", "국민일보", "KBS", "중앙일보", "KBS", "KBS", "KBS", "경향신문", "KBS",~
## $ URL    <chr> "http://www.segye.com/content/html/2021/10/31/20211031508024.ht~
## $ ym     <int> 202110, 202110, 202110, 202110, 202110, 202110, 202110, 202110,~
## $ title  <chr> "길어진 방콕에 확 늘어난 몸무게 “심혈관질환 이상 없나요”", "새에덴교회, 칼빈대 교직원에 독감 예방접종 봉사~
## $ catSoc <chr> "사회면", "사회면", "사회면", "사회면", "사회면", "사회면", "사회면", "비사회면", "사회면",~

.

두 데이터프레임 결합

bind_cols(docvars_df, clda_theta_df) %>% 
  mutate(textID = factor(row_number()), .before = ID) -> theta_df
theta_df %>% glimpse()

## Rows: 14,508
## Columns: 28
## $ textID  <fct> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18,~
## $ ID      <fct> 1, 2, 3, 4, 5, 6, 7, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19~
## $ cat     <chr> "사회", "사회", "사회", "사회", "지역", "지역", "사회", "IT_과학", "사회", "사회",~
## $ Nword   <int> 462, 79, 114, 163, 135, 132, 172, 282, 180, 181, 263, 147, 162~
## $ 일자    <chr> "20211031", "20211031", "20211031", "20211031", "20211031", "202~
## $ text    <chr> "길어진 방콕에 확 늘어난 몸무게 “심혈관질환 이상 없나요” 게티이미지뱅크 연말이면 많은 병원이 건강검진을 받으~
## $ 키워드  <chr> "방콕,몸무게,심혈관질환,게티,이미지,뱅크,연말,병원,건강검진,사람들,북새통,예약,대기,사례,1일,위드,코로나,시행,~
## $ 언론사  <chr> "세계일보", "국민일보", "KBS", "중앙일보", "KBS", "KBS", "KBS", "경향신문", "KBS"~
## $ URL     <chr> "http://www.segye.com/content/html/2021/10/31/20211031508024.h~
## $ ym      <int> 202110, 202110, 202110, 202110, 202110, 202110, 202110, 202110~
## $ title   <chr> "길어진 방콕에 확 늘어난 몸무게 “심혈관질환 이상 없나요”", "새에덴교회, 칼빈대 교직원에 독감 예방접종 봉~
## $ catSoc  <chr> "사회면", "사회면", "사회면", "사회면", "사회면", "사회면", "사회면", "비사회면", "사회면"~
## $ topic1  <dbl> 0.001779359, 0.031250000, 0.007692308, 0.005000000, 0.01875000~
## $ topic2  <dbl> 0.001779359, 0.010416667, 0.023076923, 0.015000000, 0.00625000~
## $ topic3  <dbl> 0.001779359, 0.010416667, 0.007692308, 0.005000000, 0.00625000~
## $ topic4  <dbl> 0.019572954, 0.010416667, 0.100000000, 0.035000000, 0.21875000~
## $ topic5  <dbl> 0.051601423, 0.010416667, 0.053846154, 0.335000000, 0.20625000~
## $ topic6  <dbl> 0.001779359, 0.072916667, 0.007692308, 0.325000000, 0.03125000~
## $ topic7  <dbl> 0.012455516, 0.052083333, 0.084615385, 0.035000000, 0.00625000~
## $ topic8  <dbl> 0.005338078, 0.052083333, 0.576923077, 0.015000000, 0.35625000~
## $ topic9  <dbl> 0.001779359, 0.010416667, 0.007692308, 0.005000000, 0.00625000~
## $ topic10 <dbl> 0.763345196, 0.010416667, 0.023076923, 0.005000000, 0.01875000~
## $ topic11 <dbl> 0.001779359, 0.114583333, 0.007692308, 0.005000000, 0.03125000~
## $ topic12 <dbl> 0.001779359, 0.010416667, 0.023076923, 0.045000000, 0.05625000~
## $ topic13 <dbl> 0.001779359, 0.302083333, 0.007692308, 0.015000000, 0.00625000~
## $ topic14 <dbl> 0.005338078, 0.010416667, 0.038461538, 0.005000000, 0.00625000~
## $ topic15 <dbl> 0.016014235, 0.135416667, 0.023076923, 0.005000000, 0.01875000~
## $ topic16 <dbl> 0.112099644, 0.156250000, 0.007692308, 0.145000000, 0.00625000~

text3의 기사가 topic8(집단감염)에 포함될만 한지 다른 기사(text1)와 비교

theta_df %>% 
  filter(textID == 1 | textID == 3) %>% 
  pull(text)

## [1] "길어진 방콕에 확 늘어난 몸무게 “심혈관질환 이상 없나요” 게티이미지뱅크 연말이면 많은 병원이 건강검진을 받으려는 사람들도 북새통을 이룬다. 예약이 꽉 차 한 달 이상 대기하는 사례도 많다. 특히 1일부터는 ‘위드 코로나’가 시행되면서 신종 코로나바이러스 감염증(코로나19)으로 병원 방문과 건강검진을 미루던 사람들이 더 많이 몰릴 것으로 보인다. 그러나 건강검진은 “받았다”는 사실만으로 만족하고 끝내면 .."
## [2] "전북, ‘단계적 일상회복’ 앞두고 집단감염 지속 [KBS 전주] [앵커] 전북에서 코로나19 확진자가 34명 늘었습니다. 곳곳에서 집단감염이 이어지고 있는 가운데, 내일(1)부터 단계적 일상회복이 시작됩니다. 오정현 기자입니다. [리포트] 전라북도 감염 재생산지수는 일주일째 '유행 확산' 기준인 1을 웃돌고 있습니다. 크고 작은 집단감염이 곳곳에서 끊이지 않은 탓입니다. 군.."

개별 문서가 설정한 토픽에 해당할 확률의 총합은 1이다. 따라서 각 문서행 별로 토픽에 해당하는 확률을 모두 더하면 1이 된다. (참고: purrr패키지의 pmap()함수는 행을 순차적으로 계산.)

theta_df %>% 
  select(topic1:topic16) %>% 
  pmap(sum) %>% head(3)

## [[1]]
## [1] 1
## 
## [[2]]
## [1] 1
## 
## [[3]]
## [1] 1

토픽별로 할당된 확률을 더하면 각 토픽이 말뭉치에서 등장하는 정도를 파악할 수 있다.

theta_df %>% 
  select(topic1:topic16) %>% 
  map_dfc(sum) %>% t() %>% as.data.frame() %>% 
  arrange(V1 %>% desc)

##                V1
## topic12 1479.2586
## topic14 1466.0685
## topic5  1240.4583
## topic8  1122.3959
## topic6  1077.0033
## topic3  1003.6251
## topic4   924.2123
## topic2   910.6859
## topic16  758.0115
## topic9   711.8461
## topic15  685.1158
## topic13  665.7916
## topic7   643.5296
## topic11  641.7275
## topic10  636.3617
## topic1   541.9084

말뭉치에서 자주 등장하는 토픽이 topic 12(연휴감염), 2(세계 추가접종), 13(백신수급) 등이다.

topic12(연휴감염세계 추가접종)에 속할 확률이 높은 기사를 추리면 다음과 같다.

theta_df %>% 
  arrange(topic12 %>% desc) %>% 
  pull(title) %>% head(5)

## [1] "토요일 기준 5주만에 1400명대 '주말 효과' 영향"   
## [2] "확진자 1500명 육박 사흘 연속 요일 최대 확진자"   
## [3] "신규 확진 602명 나흘만에 다시 600명선 넘어"      
## [4] "코로나19 신규 확진자 429명 ‘이틀 연속 400명대’"
## [5] "신규 확진 1892명 수도권 74.6%, 일평균 역대 최다"

.

4.4 반지도 LDA

반지도학습 방식의 토픽모델링은 미리 구성한 주제어를 이용해 토픽을 군집하는 분석방법이다. 먼저 투입할 씨앗 주제어를 구성한다.

4.4.1 씨앗주제어 구성

비지도LDA로 구성한 토픽의 주제어를 이용해 씨앗주제어사전을 구성한다.

c_lda %>% terms(n = 5) %>% as.data.frame() -> c_ldaterm5_df 

c_lda %>% terms(n = 40) %>% 
  as.data.frame() %>% 
  writexl::write_xlsx("ldaterms.xlsx")

16개 토픽중 코로나19와 관련이 없는 토픽은 그대로 두고, 코로나19 관련 토픽의 단어만 재구성.

• topic1: 청해부대 감염

• topic2: 세계 추가접종

• topic3: 이상반응 청원

• topic4: 일상회복

• topic5: 돌파감염

• topic6: 기타:진료활동

• topic7: 집단면역

• topic8: 집단감염

• topic9: 치료제 승인

• topic10: 기타: 건강

• topic11: 기타: 노동

• topic12: 연휴 감염

• topic13: 백신수급

• topic14: 백신접종

• topic15: 치료

• topic16: 이상반응

재구성하는 주제는 위험-기회 모형을 적용해 위험(코로나19 감염, 허위정보), 유령위험(이상반응), 대응(백신접종, 병상, 검사) 관련어 5개로 구성했다.

사전은 quanteda패키지의 dictionary()함수로 구성한다. https://quanteda.io/reference/dictionary.html

c_ldaterm5_df %>% 
  select(topic6, topic9, topic10, topic11) %>% 
  as.list() -> ldaterm_noncovid_l

list(
  risk1감염 = c("감염", "위중증", "중증", "사망", "중환자"),
  #risk2허위 = c("허위정보", "가짜뉴스", "음모","음모론", "조작정보"),
  risk3이상 = c("이상반응", "부작용", "혈전", "혈전증", "심근염"),
  resp1검사 = c("진단", "검사", "진단검사", "선별", "진단"),
  resp2백신 = c("백신", "접종", "추가접종", "부스터", "부스터샷"),
  resp3병상 = c("병상", "의료기관", "병원", "보건소", "병실")
  ) -> ldaterm_covid_l

c(ldaterm_noncovid_l, ldaterm_covid_l) -> ldaterm_l
dictionary(ldaterm_l) -> dict_topic

.

4.4.2 seededlda

씨앗주제어사전을 투입해 반지도학습 LDA 수행한다. 분석결과는 terms()함수로 각 토픽 별로 10개씩 출력.

set.seed(37)
Sys.time() -> t1
c_dfm %>% 
  textmodel_seededlda(dictionary = dict_topic) -> c_slda
Sys.time() -> t2
t2 - t1

## Time difference of 6.14675 mins

terms(c_slda, 10)

##       topic6     topic9   topic10 topic11  risk1감염  risk3이상  resp1검사 
##  [1,] "이스라엘" "임상"   "질환"  "인력"   "위중증"   "이상반응" "선별"    
##  [2,] "세계"     "항체"   "원인"  "간호사" "중환자"   "혈전증"   "진단검사"
##  [3,] "의무"     "시험"   "수술"  "학교"   "추석"     "심근염"   "외국인"  
##  [4,] "cdc"      "치료제" "운동"  "학생"   "연휴"     "혈전"     "집단감염"
##  [5,] "인도"     "교차"   "음식"  "노조"   "천"       "씨"       "부산"    
##  [6,] "승인"     "독감"   "의사"  "공공"   "비수도권" "건"       "직원"    
##  [7,] "fda"      "허가"   "치매"  "감염병" "연속"     "a"        "격리"    
##  [8,] "현지시간" "형성"   "아이"  "진료"   "방대본"   "신고"     "청해부대"
##  [9,] "의무화"   "의학"   "여성"  "파업"   "최다"     "인정"     "접촉"    
## [10,] "성인"     "비교"   "마음"  "현장"   "주말"     "남성"     "양성"    
##       resp2백신  resp3병상 
##  [1,] "부스터"   "병상"    
##  [2,] "부스터샷" "보건소"  
##  [3,] "추가접종" "의료기관"
##  [4,] "회분"     "병실"    
##  [5,] "잔여"     "위드"    
##  [6,] "간격"     "체계"    
##  [7,] "연령"     "전환"    
##  [8,] "청소년"   "격리"    
##  [9,] "수급"     "허용"    
## [10,] "사전예약" "식당"

분석결과에서 문서별 theta값을 추출해 메타데이터가 포함된 데이터프레임과 결합한다. 이를 통해 각 주제별로 해당 주제에 속할 확률이 높은 문서를 찾을 수 있다.

c_slda$theta %>% as.data.frame() -> cslda_theta_df

# c_corp %>% docvars() -> docvars_df 

bind_cols(docvars_df, cslda_theta_df) %>% 
  mutate(textID = row_number(), .before = ID) -> slda_theta_df

slda_theta_df %>% glimpse()

## Rows: 14,508
## Columns: 21
## $ textID    <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 1~
## $ ID        <fct> 1, 2, 3, 4, 5, 6, 7, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, ~
## $ cat       <chr> "사회", "사회", "사회", "사회", "지역", "지역", "사회", "IT_과학", "사회", "사회~
## $ Nword     <int> 462, 79, 114, 163, 135, 132, 172, 282, 180, 181, 263, 147, 1~
## $ 일자      <chr> "20211031", "20211031", "20211031", "20211031", "20211031", "2~
## $ text      <chr> "길어진 방콕에 확 늘어난 몸무게 “심혈관질환 이상 없나요” 게티이미지뱅크 연말이면 많은 병원이 건강검진을 ~
## $ 키워드    <chr> "방콕,몸무게,심혈관질환,게티,이미지,뱅크,연말,병원,건강검진,사람들,북새통,예약,대기,사례,1일,위드,코로나,시~
## $ 언론사    <chr> "세계일보", "국민일보", "KBS", "중앙일보", "KBS", "KBS", "KBS", "경향신문", "KB~
## $ URL       <chr> "http://www.segye.com/content/html/2021/10/31/20211031508024~
## $ ym        <int> 202110, 202110, 202110, 202110, 202110, 202110, 202110, 2021~
## $ title     <chr> "길어진 방콕에 확 늘어난 몸무게 “심혈관질환 이상 없나요”", "새에덴교회, 칼빈대 교직원에 독감 예방접종~
## $ catSoc    <chr> "사회면", "사회면", "사회면", "사회면", "사회면", "사회면", "사회면", "비사회면", "사회~
## $ topic6    <dbl> 0.009009009, 0.011235955, 0.008130081, 0.398963731, 0.006535~
## $ topic9    <dbl> 0.091891892, 0.235955056, 0.008130081, 0.025906736, 0.045751~
## $ topic10   <dbl> 0.870270270, 0.213483146, 0.024390244, 0.056994819, 0.071895~
## $ topic11   <dbl> 0.005405405, 0.303370787, 0.040650407, 0.005181347, 0.006535~
## $ risk1감염 <dbl> 0.005405405, 0.011235955, 0.073170732, 0.067357513, 0.21568627~
## $ risk3이상 <dbl> 0.001801802, 0.123595506, 0.008130081, 0.005181347, 0.01960784~
## $ resp1검사 <dbl> 0.001801802, 0.033707865, 0.528455285, 0.025906736, 0.13725490~
## $ resp2백신 <dbl> 0.005405405, 0.011235955, 0.073170732, 0.005181347, 0.01960784~
## $ resp3병상 <dbl> 0.009009009, 0.056179775, 0.235772358, 0.409326425, 0.47712418~

slda_theta_df %>% 
  writexl::write_xlsx("slda_theta_df.xlsx")

4.5 검정

이론기반 토픽모델링에 의해 문서 분류가 의도대로 이뤄졌는지 확인한다. 이를 위해 각 주제별로 분류된 기사의 건수를 계산했다. 감염과 백신을 주제로 한 보도가 많았고, 병상, 검사, 이상에 대한 보도가 뒤를 이었다.

slda_theta_df %>% 
  select(topic6:resp3병상) %>% 
  map_dfc(sum) %>% t() %>% as.data.frame() %>% 
  arrange(V1 %>% desc) 

##                 V1
## risk1감염 2214.483
## resp2백신 2130.821
## topic6    1714.828
## resp3병상 1708.261
## resp1검사 1622.662
## risk3이상 1414.029
## topic11   1273.375
## topic10   1257.624
## topic9    1171.917

각 주제별로 분류된 기사가 구체적인 어떤 내용인지 기사 제목을 통해 확인해 본다. 먼저 각 주제에 속할 확률이 높은 10건의 기사를 추출했다.

slda_theta_df %>% 
  arrange(risk1감염 %>% desc) %>% 
  select(title, Nword) %>% 
  head(10)

##                                                                                        title
## 1                                   오후 6시까지 신규 확진 1263명...4차 대유행 파고 올라갔다
## 2  ‘수도권 중심 4차유행 본격화’ 3명 중 1명 변이 감염 당국 “지난주 델타가 알파의 배 이상”
## 3                                    월요일인데 1500명 육박 ‘또 최다’ “곧 2000명대” 우려
## 4                                              확진자 1500명 육박 사흘 연속 요일 최대 확진자
## 5                                      1500명대, 또 일요일 최다 전국 확산에 속속 ‘4단계’로
## 6                                            "코로나 단시간 통제 쉽지 않아 긴장 늦추면 폭증"
## 7                                  잇단 연휴에도 확진자 20% 떨어져...정부 "백신 효과 나타나"
## 8                        코로나19 수도권 비중 다시 70% 돌파 . 추석 이후 비수도권 재확산 우려
## 9                                              다시 2000명 안팎 수도권 이미 재확산 국면 진입
## 10                                                   신규 확진 2천87명 금요일 집계 기준 최다
##    Nword
## 1    170
## 2    225
## 3    247
## 4    135
## 5    253
## 6    183
## 7    148
## 8    199
## 9    285
## 10   152

이번에는 각 주제에 속할 확률이 낮은 10건의 기사를 추출했다. 상위 10건과 하위 10건의 기사 제목을 보면, 상위 10건이 그 문서 주제를 다룬 기사임을 알 수 있다.

slda_theta_df %>% 
  arrange(risk1감염 %>% desc) %>% 
  select(title, Nword) %>% 
  tail(10)

##                                                                                    title
## 14499                                      [코로나리포트] 코로나19, 마음 방역도 필요하다
## 14500                       백신 맞고 월경 이상? 여성들의 불안은 과민반응이 아니다[플랫]
## 14501                 회춘 비결은 ‘피’ 노화는 치료가능한 질병일까[서영아의 100세 카페]
## 14502 [농업이 IT(잇)다] 경노겸 한국축산데이터 “축산 디지털 전환과 원 헬스 부문 리더로”
## 14503            정창현 한국한의약진흥원장 “국민과 함께하는 한의약의 가치 만들겠습니다"
## 14504                 [모빌리티 인사이트] 택시처럼 의료 서비스도 호출한다, 의료 모빌리티
## 14505                                외국인 환자들, 푸드테라피에 관심 매년 10% 이상 증가
## 14506             [가만한 당신] 정신질환 진단의 과학적-윤리적 해이를 고발한 임상심리학자
## 14507                                "코로나 경험 잊고 단순한 '정상' 복귀는 심각한 실수"
## 14508                               [청해부대 인터뷰 논란] ②"문무대왕함은 지옥이었나?”
##       Nword
## 14499   956
## 14500   787
## 14501   766
## 14502   727
## 14503   729
## 14504   795
## 14505   885
## 14506  1009
## 14507   921
## 14508  1061

기사 본문도 추출해 확인해 본다.

slda_theta_df %>% 
  arrange(risk1감염 %>% desc) %>% head(5) %>% .$textID -> id_v

slda_theta_df %>% 
  filter(textID %in% id_v) %>% 
  pull(text)

## [1] "확진자 1500명 육박 사흘 연속 요일 최대 확진자 코로나19 4차 대유행의 확산세로 하루 확진자 총합이 사흘 연속 ‘요일별’ 최대치를 기록하고 있다. 10일 중앙방역대책본부(방대본)에 따르면 전날 0시 기준 국내 신규 확진자는 1492명이다. 직전일 1729명보다는 237명 줄어든 수치이지만, 주간 단위로 같은 요일을 비교하면 증가세는 더욱 가파른 추세다. 일요일(발표일 월요일) 기준 1492명은 .."                                                        
## [2] "월요일인데 1500명 육박 ‘또 최다’ “곧 2000명대” 우려 국내 코로나19 4차 대유행이 무서운 기세로 확산하면서 일일 신규 확진자가 5주째 1000명을 훌쩍 웃도는 네 자릿수를 이어가고 있다. 특히 통상 주 중반으로 접어드는 수요일부터는 확진자가 전일 대비 500여명씩 급증하는 패턴이 반복되고 있는 만큼 자칫 이번 주에 2000명 선을 넘을 수 있다는 우려도 나온다. 10일 중앙방역대책본부(방대본).."                                                 
## [3] "1500명대, 또 일요일 최다 전국 확산에 속속 ‘4단계’로 국내 코로나19 확산세가 진정될 기미를 보이지 않으면서 하루 신규 확진자는 벌써 한 달 넘게 1000명을 훌쩍 웃도는 네 자릿수를 이어가고 있다. 특히 수도권에 이어 비수도권의 확산세가 점점 더 거세진 영향으로 검사 건수가 대폭 줄어든 토요일에도 1700명대 확진자가 쏟아져 당국이 촉각을 세우고 있다. 토요일은 물론이고 일요일 기준 확진자도 이미 .."                                        
## [4] "오후 6시까지 신규 확진 1263명...4차 대유행 파고 올라갔다 신종 코로나바이러스 감염증(코로나19) 4차 대유행의 파고가 상승했다. 14일 오후 6시 기준 집계한 코로나19 신규 확진자는 1200명을 훌쩍 넘었다. 자정까지 더하면 1500~1600명대까지 환자가 나올 것으로 예상된다. 코로나19 사태 속 역대 최고 확진자 발생은 1615명(14일 0시 기준)였다. 1000명 선을 넘더니 1200명, 다시 1500.."                                                              
## [5] "‘수도권 중심 4차유행 본격화’ 3명 중 1명 변이 감염 당국 “지난주 델타가 알파의 배 이상” 코로나19 '4차 대유행'으로 수도권 사회적 거리두기 4단계 실시를 하루 앞둔 11일 오후 제주국제공항 3층 출발장에 관광을 마친 여행객들의 발걸음이 이어지고 있다. 제주=뉴시스 국내 신종 코로나바이러스 감염증(코로나19) ‘4차 대유행’이 본격화하는 가운데 수도권에서 전파력이 더 센 인도 유래 ‘델타형’ 변이 바이러스의 영향력이 계속해서 커지고 있.."

topics()함수는 각 문서의 할당확률이 높은 주제 산출.

topics(c_slda) %>% head()

## [1] topic10   topic11   resp1검사 resp3병상 resp3병상 resp1검사
## 9 Levels: topic6 topic9 topic10 topic11 risk1감염 risk3이상 ... resp3병상

기사의 개수뿐 아니라 각 주제 별로 할당 가능성(확률)을 계산해 비교할 수도 있다.

topics(c_slda) -> slda_theta_df$topic2

slda_theta_df$topic2 %>% table() %>% as.data.frame() %>% 
  arrange(Freq %>% desc) -> topic_freq_df
topic_freq_df

##           . Freq
## 1 risk1감염 2323
## 2 resp2백신 2277
## 3    topic6 1971
## 4 resp3병상 1663
## 5 resp1검사 1644
## 6 risk3이상 1401
## 7   topic10 1128
## 8   topic11 1107
## 9    topic9  994