대통령 지지율 여론조사데이터는 위키백과: 대한민국의 대통령 지지율과 나무위키, 문재인/지지율에 데이터가 잘 정리되어 있다. 처음 위키백과: 대한민국의 대통령 지지율를 통해 대통령 지지율을 작업했지만, 나무위키 문재인/지지율 데이터가 더 좋은 자료구조로 충실히 정리되어 있다.
위키백과: 대한민국의 대통령 지지율 데이터 자료형태가 바뀌어서 데이터 크롤링 로직은 동일하고 데이터 전처리 과정만 코드를 수정(2019-05-06).
library(tidyverse)
library(rvest)
library(lubridate)
namu_url <- "https://ko.wikipedia.org/wiki/%EB%8C%80%ED%95%9C%EB%AF%BC%EA%B5%AD%EC%9D%98_%EB%8C%80%ED%86%B5%EB%A0%B9_%EC%A7%80%EC%A7%80%EC%9C%A8"
# Sys.setlocale("LC_ALL", "C")
moon_dat <- namu_url %>%
read_html() %>%
html_nodes(xpath='//*[@id="mw-content-text"]/div/table[1]') %>%
html_table(fill=TRUE) %>%
.[[1]]
# Sys.setlocale("LC_ALL", "Korean")
moon_part_one_df <- moon_dat %>%
set_names(c("날짜1", "갤럽1", "리얼미터1", "날짜2", "갤럽2", "리얼미터2", "날짜3", "갤럽3", "리얼미터3")) %>%
filter(row_number() >=3) %>%
select(`날짜1`, `갤럽1`, `리얼미터1`) %>%
filter(! row_number() %in% c(1,2,3)) %>%
rename(`날짜` = `날짜1`,
`갤럽` = `갤럽1`,
`리얼미터` = `리얼미터1`) %>%
mutate(`갤럽` = str_extract(`갤럽`, "^\\d.+\\.\\d") %>% as.numeric) %>%
mutate(`리얼미터` = str_extract(`리얼미터`, "^\\d.+\\.\\d") %>% as.numeric)
moon_part_two_df <- moon_dat %>%
set_names(c("날짜1", "갤럽1", "리얼미터1", "날짜2", "갤럽2", "리얼미터2", "날짜3", "갤럽3", "리얼미터3")) %>%
select(`날짜2`, `갤럽2`, `리얼미터2`) %>%
filter(row_number() >=3) %>%
rename(`날짜` = `날짜2`,
`갤럽` = `갤럽2`,
`리얼미터` = `리얼미터2`) %>%
filter(! row_number() %in% c(1,2,3)) %>%
mutate(`갤럽` = str_extract(`갤럽`, "^\\d.+\\.\\d") %>% as.numeric) %>%
mutate(`리얼미터` = str_extract(`리얼미터`, "^\\d.+\\.\\d") %>% as.numeric) %>%
filter(!str_detect(`날짜`, "NA"))
moon_part_three_df <- moon_dat %>%
set_names(c("날짜1", "갤럽1", "리얼미터1", "날짜2", "갤럽2", "리얼미터2", "날짜3", "갤럽3", "리얼미터3")) %>%
select(`날짜3`, `갤럽3`, `리얼미터3`) %>%
filter(row_number() >=3) %>%
rename(`날짜` = `날짜3`,
`갤럽` = `갤럽3`,
`리얼미터` = `리얼미터3`) %>%
filter(! row_number() %in% c(1,2,3)) %>%
mutate(`갤럽` = str_extract(`갤럽`, "^\\d.+\\.\\d") %>% as.numeric) %>%
mutate(`리얼미터` = str_extract(`리얼미터`, "^\\d.+\\.\\d") %>% as.numeric) %>%
filter(!str_detect(`날짜`, "NA"))
moon_dat <- bind_rows(moon_part_one_df, moon_part_two_df) %>%
bind_rows(moon_part_three_df) %>%
tbl_df
moon_dat <- moon_dat %>%
mutate(`연도` = str_extract(`날짜`, "^\\d{4}") %>% as.integer) %>%
mutate(`월` = str_extract(`날짜`, "\\b\\d{1,2}월\\b") %>% str_remove(., "월") %>% as.integer) %>%
mutate(`주` = str_extract(`날짜`, "\\b((?!주)\\d{1}주$)\\b") %>% str_remove(., "주") %>% as.integer)
korean_week_df <- tibble(
`조사날짜` = seq(ymd("2017-01-01"), Sys.Date(), 1)
) %>%
mutate(`주차` = week(`조사날짜`),
`연도` = year(`조사날짜`),
`월` = month(`조사날짜`)) %>%
group_by(`연도`, `월`) %>%
mutate(`한국주` = `주차` - min(`주차`) +1 ) %>%
group_by(`연도`, `월`, `한국주`) %>%
summarise(`조사날짜` = min(`조사날짜`))
moon_df <- left_join(moon_dat, korean_week_df, by=c("연도" = "연도", "월"="월", "주"="한국주")) %>%
select(`날짜`, `조사날짜`, `갤럽`, `리얼미터`)
moon_df %>% write_csv("data/moon_df.csv")
대통령 지지율을 취임초부터 현재 2020-04-03 까지 주별로 시각화한다.
library(tidyverse)
library(extrafont)
loadfonts()
moon_df <- read_csv("data/moon_df.csv")
moon_df %>%
select(-`날짜`) %>%
gather(`조사기관`, `지지율`, -`조사날짜`) %>%
ggplot(aes(x=`조사날짜`, y=`지지율`, color=`조사기관`)) +
geom_line() +
geom_point() +
scale_x_date(date_labels = "%Y-%m") +
theme_minimal(base_family = "NanumGothic") +
scale_color_manual(values = c("gray30", "skyblue")) +
labs(x="", y="지지율(%)", title="문재인 대통령 지지율") +
theme(legend.position = "top")
대통령 취임 전체 시점과 더불어 2019년부터 가장 최근 시점 조사 일자까지 두 조사기관 지지율 추이를 시각화한다.
moon_g <- moon_df %>%
select(-`날짜`) %>%
gather(`조사기관`, `지지율`, -`조사날짜`) %>%
ggplot(aes(x=`조사날짜`, y=`지지율`, color=`조사기관`)) +
geom_line() +
geom_point() +
scale_x_date(date_labels = "%Y-%m") +
theme_minimal(base_family = "NanumGothic") +
scale_color_manual(values = c("gray30", "skyblue")) +
labs(x="", y="지지율(%)", title="문재인 대통령 지지율") +
theme(legend.position = "top") +
coord_cartesian(xlim = c(lubridate::ymd("2019-01-01"), Sys.Date()))
plotly::ggplotly(moon_g)