1 KBS 8145번 여론조사
여론조사결과 등록현황 상세보기 KBS가 조사의뢰하고 (주)한국리서치가 조사기관우로 참여한 정기(정례)조사,대통령선거,정당지지도 (전국 정기(정례)조사 대통령선거 정당지지도 정치, 사회현안 등 ) 사례를 들어 데이터 추출방법을 살펴보자.
PDF → 이미지
이미지 파일
XML 페이지 이미지 메타파일
XML 페이지 텍스트 본문 https://www.nesdc.go.kr/files/result/202109/FILE_202109180931525561.pdf.files/FILE_202109180931525561.pdf.text.xml
1.1 페이지 메타 데이터
XML 페이지 이미지 메타파일에 포함된 XML 정보를 추후 작업이 가능한 형태로 데이터를 전처리 작업한다.
library(tidyverse)
library(xml2)
kbs_meta <- read_xml("https://www.nesdc.go.kr/files/result/202109/FILE_202109180931525561.pdf.files/FILE_202109180931525561.pdf.xml")
kbs_meta %>%
xml_attrs("title")named character(0)kbs_meta_nodes <- xml_find_all(kbs_meta, "//page")
kbs_meta_attributes <- kbs_meta_nodes[[1]] %>% xml_attrs(.) %>% names()
kbs_meta_df <- xml_attrs(kbs_meta_nodes) %>%
list2DF() %>%
janitor::clean_names()
row.names(kbs_meta_df) <- kbs_meta_attributes
kbs_meta_tbl <- kbs_meta_df %>%
rownames_to_column(var = "attributes") %>%
pivot_longer(cols = -attributes) %>%
pivot_wider(names_from = attributes, values_from = value) %>%
select(-name)
kbs_meta_tbl %>%
reactable::reactable()1.2 여론조사결과
여론조사 결과 본문을 페이지 단위로 추출하자.
 |
 |
kbs_survey <- read_xml("https://www.nesdc.go.kr/files/result/202109/FILE_202109180931525561.pdf.files/FILE_202109180931525561.pdf.text.xml")
## KBS 여론조사 페이지 ------
kbs_survey_page <- kbs_survey %>%
xml_children()
xml_length(kbs_survey_page) %>% length[1] 23## 특정 페이지 : 응답자 분포표 값 --------------
xml_siblings(kbs_survey_page)[[3]] %>%
xml_children() %>%
xml_contents() %>%
as.character() [1] "1"
[2] "응답자 분포표 (1)"
[3] " Base= 전체"
[4] " 조사완료 목표할당"
[5] " 가중 값 배율"
[6] "(B/A)"
[7] "사례수 (명 )"
[8] "(A)"
[9] " 비율(%)"
[10] " 사례수 (명 )"
[11] "(B)"
[12] " 비율(%)"
[13] "▣ 전체 ▣ (1,000) 100.0 (1,000) 100.0 1.0"
[14] "성별"
[15] " "
[16] "남자 (507) 50.7 (497) 49.7 1.0"
[17] "여자 (493) 49.3 (503) 50.3 1.0"
[18] "연령 "
[19] "18-29 세 (174) 17.4 (176) 17.6 1.0"
[20] "30-39 세 (152) 15.2 (152) 15.2 1.0"
[21] "40-49 세 (182) 18.2 (187) 18.7 1.0"
[22] "50-59 세 (198) 19.8 (193) 19.3 1.0"
[23] "60-69 세 (165) 16.5 (162) 16.2 1.0"
[24] "70세이상 (129) 12.9 (130) 13.0 1.0"
[25] "거주지역 "
[26] "서울 (188) 18.8 (189) 18.9 1.0"
[27] "인천 /경기 (313) 31.3 (313) 31.3 1.0"
[28] "대전 /세종 /충청 (108) 10.8 (107) 10.7 1.0"
[29] "광주 /전라 (99) 9.9 (98) 9.8 1.0"
[30] "대구 /경북 (99) 9.9 (99) 9.9 1.0"
[31] "부산 /울산 /경남 (150) 15 (150) 15.0 1.0"
[32] "강원 /제주 (43) 4.3 (44) 4.4 1.0" ## 특정 페이지 : 응답자 분포표 좌표 --------------
table_h <- xml_siblings(kbs_survey_page)[[3]] %>%
xml_children() %>%
xml_attr("h")
table_w <- xml_siblings(kbs_survey_page)[[3]] %>%
xml_children() %>%
xml_attr("w")
table_l <- xml_siblings(kbs_survey_page)[[3]] %>%
xml_children() %>%
xml_attr("w")2 KBS 8145번 페이지 이미지
2.1 여론조사 이미지 다운로드
<https://www.nesdc.go.kr/files/result/202109/FILE_202109180931525561.pdf.files/1.png> 같은 형식이라 KBS 8145 여론조사 결과를 이미지로 받아 낼 수가 있다. 이를 위해서 glue::glue() 함수로 다운로드할 URI 주소를 특정하고 download.file() 함수를 사용해서 로컬 디렉토리에 저장한다.
for(page in 1:23) {
page_url <- glue::glue("https://www.nesdc.go.kr/files/result/202109/FILE_202109180931525561.pdf.files/{page}.png")
print(page_url)
download.file(url = page_url, destfile = glue::glue("data/nesdc/kbs/kbs_{page}.png"), mode = 'wb')
}다운로드 결과는 fs::dir_ls() 함수를 사용해서 확인이 가능하다.
fs::dir_ls("data/nesdc/kbs/")data/nesdc/kbs/kbs_1.png data/nesdc/kbs/kbs_10.png data/nesdc/kbs/kbs_11.png
data/nesdc/kbs/kbs_12.png data/nesdc/kbs/kbs_13.png data/nesdc/kbs/kbs_14.png
data/nesdc/kbs/kbs_15.png data/nesdc/kbs/kbs_16.png data/nesdc/kbs/kbs_17.png
data/nesdc/kbs/kbs_18.png data/nesdc/kbs/kbs_19.png data/nesdc/kbs/kbs_2.png
data/nesdc/kbs/kbs_20.png data/nesdc/kbs/kbs_21.png data/nesdc/kbs/kbs_22.png
data/nesdc/kbs/kbs_23.png data/nesdc/kbs/kbs_3.png data/nesdc/kbs/kbs_4.png
data/nesdc/kbs/kbs_5.png data/nesdc/kbs/kbs_6.png data/nesdc/kbs/kbs_7.png
data/nesdc/kbs/kbs_8.png data/nesdc/kbs/kbs_9.png 다운로드 받은 여론조사결과를 일별할 수 있도록 쭉 살펴보자.
library(tidyverse)
library(slickR)
kbs_pages <- fs::dir_ls("data/nesdc/kbs/")
kbs_tbl <- tibble(file_path = kbs_pages)
slickR(kbs_tbl$file_path, height = 600)3 XML 파일 파싱
특정 페이지에서 좌표값과 함께 해당 영역의 텍스트를 추출하는 로직을 구현해보자.
library(xml2)
library(reactable)
kbs_survey <- read_xml("https://www.nesdc.go.kr/files/result/202109/FILE_202109180931525561.pdf.files/FILE_202109180931525561.pdf.text.xml")
## KBS 여론조사 페이지 ------
kbs_children <- xml_children(kbs_survey)
support_tbl <- kbs_children[7] %>%
xml_find_all(".//text") %>%
xml_text() %>%
enframe() %>%
mutate(구분 = case_when(str_detect(value, "성별") ~ "성별",
str_detect(value, "연령") ~ "연령",
str_detect(value, "거주지역") ~ "거주지역",
str_detect(value, "학력") ~ "학력",
str_detect(value, "직업") ~ "직업",
TRUE ~ as.character(NA))) %>%
fill(구분, .direction = "down")
column_name <- c("조사완료수", "가중조사수", "이재명", "윤석열", "홍준표", "이낙연", "유승민", "안철수", "추미애", "심상정", "최재형", "원희룡", "황교안", "김동연", "하태경", "김두관", "이정미", "그외", "없다", "모름", "계")
gender_tbl <- support_tbl %>%
filter(구분 == "성별") %>%
filter(value != "성별") %>%
select(value) %>%
mutate(value = str_trim(value)) %>%
mutate(split_value = map(value, str_split, pattern = " ")) %>%
select(split_value) %>%
pivot_longer(cols = everything()) %>%
unnest(value) %>%
mutate(name = c("남성", "여성")) %>%
unnest(value) %>%
filter(!value %in% c("남자", "여자")) %>%
mutate(varname = rep(column_name, 2)) %>%
pivot_wider(names_from = name, values_from = value)
gender_tbl %>%
reactable::reactable()데이터 과학자 이광춘 저작
kwangchun.lee.7@gmail.com