Problem

JTBC 뉴스룸에서는 다음과 같은 도표의 후보지지도 여론조사 결과를 보도.

JTBC 뉴스룸 2017. 2월

JTBC 뉴스룸 2017. 2월

막대의 높이에 의구심을 표한 시청자들의 항의에 직면함.

제대로 된 막대그래프를 그리면서 R Base plot과 ggplot에 대하여 학습.

Data Setup

candidates <- c("문재인", "안희정", "이재명", "안철수", "황교안")
week2 <- c(57, 20, 11, 2, 1)
week3 <- c(61, 24, 7, 1, 1)
rates.df <- data.frame(candidates, week2, week3, stringsAsFactors = FALSE)
rates.df
##   candidates week2 week3
## 1     문재인    57    61
## 2     안희정    20    24
## 3     이재명    11     7
## 4     안철수     2     1
## 5     황교안     1     1

Barplot(R Base)

par(family = "HCR Dotum LVT")
b1 <- barplot(t(as.matrix(rates.df[, 2:3])), 
        axes = FALSE, 
        ylim = c(0, 65), 
        beside = TRUE, 
        names.arg = rates.df[, 1], 
        legend.text = c("2주차", "3주차"), col = c("darkgrey", "blue"))
# axis(side = 2, 
#     at = as.vector(as.matrix(rates.df[, 2:3])), 
#     labels =  as.vector(as.matrix(rates.df[, 2:3])), las = 1)
text(x = b1[1, ], y = week2 + 2, labels = week2, col = "darkgrey")
text(x = b1[2, ], y = week3 + 2, labels = week3, col = "blue")
main.title <- "대선후보 지지도(%)"
sub.title <- "JTBC 정치부회의, 한국갤럽 2017. 2월 7-9일, 14-16일"
main.text <- "지지정당 : 더불어민주당"
title(main = main.title, sub = sub.title, cex.main = 2)
text(x = 8, y = 60, main.text, cex = 1.2)

ggplot

Data for ggplot

library(reshape2)
rates.df$candidates.f <- factor(candidates, levels = candidates)
rates.df
##   candidates week2 week3 candidates.f
## 1     문재인    57    61       문재인
## 2     안희정    20    24       안희정
## 3     이재명    11     7       이재명
## 4     안철수     2     1       안철수
## 5     황교안     1     1       황교안
str(rates.df)
## 'data.frame':    5 obs. of  4 variables:
##  $ candidates  : chr  "문재인" "안희정" "이재명" "안철수" ...
##  $ week2       : num  57 20 11 2 1
##  $ week3       : num  61 24 7 1 1
##  $ candidates.f: Factor w/ 5 levels "문재인","안희정",..: 1 2 3 4 5
rates.df.melt <- melt(rates.df[, 2:4], 
                      id.vars = "candidates.f", 
                      measure.vars = c("week2", "week3"), 
                      variable.name = "week", value.name = "rates")
rates.df.melt
##    candidates.f  week rates
## 1        문재인 week2    57
## 2        안희정 week2    20
## 3        이재명 week2    11
## 4        안철수 week2     2
## 5        황교안 week2     1
## 6        문재인 week3    61
## 7        안희정 week3    24
## 8        이재명 week3     7
## 9        안철수 week3     1
## 10       황교안 week3     1
str(rates.df.melt)
## 'data.frame':    10 obs. of  3 variables:
##  $ candidates.f: Factor w/ 5 levels "문재인","안희정",..: 1 2 3 4 5 1 2 3 4 5
##  $ week        : Factor w/ 2 levels "week2","week3": 1 1 1 1 1 2 2 2 2 2
##  $ rates       : num  57 20 11 2 1 61 24 7 1 1

Geom_bar

library(ggplot2)
source("./theme_kr.R")
g0 <- ggplot(data = rates.df.melt, 
             mapping = aes(x = candidates.f, y = rates, fill = week)) 
(g1 <- g0 + 
  geom_bar(stat = "identity", position = position_dodge())) 

# g1
g2 <- g1 +
  geom_text(mapping = aes(x = candidates.f, 
                          y = rates + 2, 
                          label = rates,
                          colour = week), 
            position = position_dodge(width = 1), 
            size = 5)
g2

g3 <- g2 +
  theme_bw() +
  theme.kr
g3

g4 <- g3 + 
    scale_fill_manual(name = "", 
                      values = c("darkgrey", "blue"), 
                      labels = c("2월 2주차", "2월 3주차")) +
    scale_colour_manual(name = "",
                        values = c("darkgrey", "blue"), 
                        labels = c("2월 2주차", "2월 3주차"))
g4

g5 <- g4 + 
    scale_x_discrete(name = "대선후보")
g5

g6 <- g5 +
    scale_y_continuous(name = "지지도", 
                       breaks = as.vector(as.matrix(rates.df[, 2:3])), 
                       labels = as.vector(as.matrix(rates.df[, 2:3])))
g6

g7 <- g6 +
    labs(title = main.title, subtitle = sub.title)
g7

g8 <- g7 +
  theme(plot.title = element_text(hjust = 0.5), 
        plot.subtitle = element_text(family = "HCR Dotum LVT"),
        legend.position = c(0.9, 0.7))
g8