1 참된 데이터 시각화

1.1 데이터 시각화 비고 1

동일한 데이터를 4가지 방식으로 시각화할 경우 추하고(ugly), 악의적으로 나쁘게(bad), 틀리게(wrong) 작성할 수도 있다.

devtools::install_github("clauswilke/dviz.supp")
library(dviz.supp)

df <- tibble(
  type = c("A", "B", "C"),
  value = c(3, 5, 4),
  expand = c(4, 5, 4.5)
)
p1 <- ggplot(df, aes(type, value)) + 
  geom_col(fill = "#56B4E9", width = 0.65, alpha = 0.9) +
  scale_y_continuous(limits = c(0, 5.2), expand = c(0, 0)) +
  scale_x_discrete(name = NULL) +
  coord_cartesian(clip = "off") +
  theme_dviz_hgrid(12) +
  theme(
    axis.line = element_blank(),
    plot.margin = margin(18, 12, 0, 0)
  )
p2 <- ggplot(df, aes(type, value)) + 
  geom_col(fill = c("#CCFF00FF", "#00FFFFFF", "#CC00FFFF"), width = 0.75) +
  scale_y_continuous(limits = c(0, 5.2), expand = c(0, 0)) +
  scale_x_discrete(name = NULL) +
  coord_cartesian(clip = "off") +
  theme_dviz_hgrid(12) +
  theme(
    axis.line = element_blank(),
    axis.title = element_text(family = "Comic Sans MS", size = 15),
    axis.text.x = element_text(family = "Times", size = 10),
    axis.text.y = element_text(family = "Arial", size = 13),
    panel.grid = element_line(color = "black"),
    axis.ticks = element_line(color = "black"),
    plot.margin = margin(18, 12, 1.5, 1.5)
  )
p3 <- ggplot(df, aes(type, value)) + 
  geom_col(fill = "#56B4E9", width = 0.65, alpha = 0.9) +
  geom_point(aes(y = expand), shape = NA) +
  scale_y_continuous(expand = c(0, 0)) +
  scale_x_discrete(name = NULL) +
  facet_wrap(~type, scales = "free") +
  coord_cartesian(clip = "off") +
  theme_dviz_hgrid(12) +
  theme(
    axis.line = element_blank(),
    strip.text = element_blank(),
    plot.margin = margin(18, 12, 1.5, 1.5)
  )
p3a <- ggplot(df, aes(type, value)) + 
  geom_col(color = "black", fill = NA, width = .5) +
  scale_y_continuous(limits = c(0, 5.2), expand = c(0, 0)) +
  scale_x_discrete(name = NULL) +
  coord_cartesian(clip = "off") +
  theme_dviz_grid(12) +
  background_grid(
    major = "y", minor = "none",
    colour.major = "grey30", colour.minor = "black",
    size.major = 0.5,
    size.minor = 0.2
  ) +
  theme(
    axis.ticks = element_line(color = "grey30"),
    plot.margin = margin(18, 12, 1.5, 1.5)
  )
p4 <- ggplot(df, aes(type, value)) + 
  geom_col(fill = "#56B4E9", width = 0.65, alpha = 0.9) +
  coord_cartesian(xlim = c(0.4, 3.6), ylim = c(2, 6.2), expand = FALSE, clip = "on") +
  scale_y_continuous(breaks = 2:4, name = "", labels = c("", "", "")) +
  scale_x_discrete(name = NULL) +
  theme_dviz_hgrid(12) +
  theme(
    panel.grid.major.y = element_blank(),
    axis.ticks.y = element_blank(),
    plot.margin = margin(18, 12, 1.5, 1.5)
  )
cowplot::plot_grid(
  p1, NULL, stamp_ugly(p2),
  NULL, NULL, NULL,
  stamp_bad(p3), NULL, stamp_wrong(p4),
  rel_widths = c(1, .1, 1),
  rel_heights = c(1, .15, 1),
  labels = c("a", "", "b", "", "", "", "c", "", "d")
)
(ref:ugly-bad-wrong-examples)

(ref:ugly-bad-wrong-examples)

1.2 시계열 데이터 사례비교

시계열 데이터도 예외는 아니다. 시간의 흐름에 따라 최근 인기를 얻고 있는 Preprints 논문서비스 건수를 시각할 때 단순히 점을 찍게 되면 전반적인 추세를 파악할 수도 있으나, 그보다는 점을 선으로 연결시키고 각 논문 서비스마다 색상을 달리하게 되면 더 좋아지지만, 가장 나은 방법은 점을 없애고 각 논문 서비스마다 시계열 말미에 라벨을 붙이는 것이 시각적인 인지부하를 최소화하게 되는 시각화 산출물이 된다.

library(lubridate)
biorxiv_growth <- preprint_growth %>% filter(archive == "bioRxiv") %>%
  filter(count > 0) 

preprint_growth %>% filter(archive %in% c("bioRxiv", "arXiv q-bio", "PeerJ Preprints")) %>%
  filter(count > 0) %>%
  mutate(archive = factor(archive, levels = c("bioRxiv", "arXiv q-bio", "PeerJ Preprints")))-> preprints

preprint_g <- ggplot(preprints, aes(date, count, color = archive, fill = archive, shape = archive)) + 
  geom_point(color = "white", size = 2) +
  scale_shape_manual(values = c(21, 22, 23),
                     name = NULL) + 
  scale_y_continuous(limits = c(0, 600), expand = c(0, 0),
                name = "preprints / month") + 
  scale_x_date(name = "year",
               limits = c(min(biorxiv_growth$date), ymd("2017-01-01"))) +
  scale_color_manual(values = c("#0072b2", "#D55E00", "#009e73"),
                     name = NULL) +
  scale_fill_manual(values = c("#0072b2", "#D55E00", "#009e73"),
                     name = NULL) +
  theme_dviz_open() +
  theme(legend.title.align = 0.5,
        legend.position = c(0.1, .9),
        legend.just = c(0, 1),
        plot.margin = margin(14, 7, 3, 1.5))

trendline_g <- ggplot(preprints, aes(date, count, color = archive, fill = archive, shape = archive)) + 
  geom_line(size = 0.75) + geom_point(color = "white", size = 2) +
  scale_y_continuous(limits = c(0, 600), expand = c(0, 0),
                name = "preprints / month") + 
  scale_x_date(name = "year",
               limits = c(min(biorxiv_growth$date), ymd("2017-01-01"))) +
  scale_color_manual(values = c("#0072b2", "#D55E00", "#009e73"),
                     name = NULL) +
  scale_fill_manual(values = c("#0072b2", "#D55E00", "#009e73"),
                     name = NULL) +
  scale_shape_manual(values = c(21, 22, 23),
                     name = NULL) + 
  theme_dviz_open() +
  theme(legend.title.align = 0.5,
        legend.position = c(0.1, .9),
        legend.just = c(0, 1),
        plot.margin = margin(14, 7, 3, 1.5))

preprints_final <- filter(preprints, date == lubridate::ymd("2017-01-01"))

trendline_best_g <- ggplot(preprints) +
  aes(date, count, color = archive, fill = archive, shape = archive) + 
  geom_line(size = 1) + 
  #geom_point(color = "white", size = 2) +
  scale_y_continuous(
    limits = c(0, 600), expand = c(0, 0),
    name = "preprints / month",
    sec.axis = dup_axis(
      breaks = preprints_final$count,
      labels = c("arXiv\nq-bio", "PeerJ\nPreprints", "bioRxiv"),
      name = NULL)
  ) + 
  scale_x_date(name = "year",
               limits = c(min(biorxiv_growth$date), ymd("2017-01-01")),
               expand = expand_scale(mult = c(0.02, 0))) +
  scale_color_manual(values = c("#0072b2", "#D55E00", "#009e73"),
                     name = NULL) +
  scale_fill_manual(values = c("#0072b2", "#D55E00", "#009e73"),
                     name = NULL) +
  scale_shape_manual(values = c(21, 22, 23),
                     name = NULL) + 
  coord_cartesian(clip = "off") +
  theme_dviz_open() +
  theme(legend.position = "none") +
  theme(axis.line.y.right = element_blank(),
        axis.ticks.y.right = element_blank(),
        axis.text.y.right = element_text(margin = margin(0, 0, 0, 0)),
        plot.margin = margin(14, 7, 3, 1.5))

cowplot::plot_grid(stamp_bad(preprint_g), trendline_g, trendline_best_g, nrow=2)

1.3 데이터 픽셀 비율 2 3 4

시각화의 중요한 원칙중의 하나는 화면 전체 픽셀(pixel)과 정보를 표현하는 픽셀 비율을 최대화하는 것이다. 흔히 데이터와 픽셀 비율(data to pixel ratio)로 계량화하는데 데이터-픽셀 비율이 낮는 경와 데이터-픽셀 비율이 높은 경우를 다음 사례를 통해 쉽게 파악할 수 있다.

데이터와 픽셀 비율

1.4 Aesthetics

시각화를 할 경우 위치(position), 모양(shape), 크기(size), 색상(color), 선굵기(line width), 선유형(line type)을 사용하여 좌표계(coordinate system), 척도(scale)와 결합하여 시각화 결과물을 제작한다.

aes_pos <- ggdraw() + 
  geom_segment(data = data.frame(x = c(0, 0.5),
                                 xend = c(1, 0.5),
                                 y = c(0.5, 0),
                                 yend = c(0.5, 1)),
                aes(x = x, y = y, xend = xend, yend = yend),
                arrow = arrow(length = grid::unit(12, "pt")), size = .75) +
  draw_text("y", .5, 1, size = 12, vjust = 1, hjust = 2.5, family = dviz_font_family) +
  draw_text("x", 1, .5, size = 12, vjust = 2, hjust = 1, family = dviz_font_family) + 
  coord_cartesian(xlim = c(-.2, 1.2), ylim = c(-.2, 1.2))

aes_color <- ggdraw() +
  geom_tile(data = data.frame(x = 0.15 + .2333*(0:3)),
            aes(x, y = .5, fill = factor(x)), width = .2, height = .6) +
  scale_fill_OkabeIto(guide = "none")

aes_shape <- ggdraw() +
  geom_point(data = data.frame(x = (.5 + 0:3)/4),
             aes(x, y = .5, shape = factor(x)), size = 8, fill = "grey80") +
  scale_shape_manual(values = 21:24)

aes_size <- ggdraw() +
  geom_point(data = data.frame(x = (.5 + 0:3)/4),
             aes(x, y = .5, size = factor(x)), shape = 21, fill = "grey80") +
  scale_size_manual(values = c(2, 5, 8, 11))

aes_lwd <- ggdraw() +
  geom_segment(data = data.frame(x = rep(0.05, 4),
                                 xend = rep(0.95, 4),
                                 y = (1.5 + 0:3)/6,
                                 yend = (1.5 + 0:3)/6,
                                 size = 4:1),
               aes(x = x, y = y, xend = xend, yend = yend, size = size)) +
  scale_size_identity()

aes_ltp <- ggdraw() +
  geom_segment(data = data.frame(x = rep(0.05, 4),
                                 xend = rep(0.95, 4),
                                 y = (1.5 + 0:3)/6,
                                 yend = (1.5 + 0:3)/6,
                                 linetype = 4:1),
               aes(x = x, y = y, xend = xend, yend = yend, linetype = linetype), size = 1) +
  scale_linetype_identity()

plot_grid(aes_pos, aes_shape, aes_size,
          aes_color, aes_lwd, aes_ltp,
          ncol = 3,
          labels = c("position", "shape", "size", "color", "line width", "line type"),
          label_x = 0.05, label_y = 0.95, hjust = 0, vjust = 1)

데이터값을 aesthetics에 매핑시켜려며, 데이터값이 aesthetics 특정값에 대응되는 것을 명세하여야 한다. scales를 통해서 데이터값과 aesthetics 값 사이의 매핑이 이뤄진다.

df <- data.frame(x = c(1:4))

scale_num <- ggplot(df, aes(x)) + 
  geom_point(size = 3, color = "#0072B2", y = 1) + 
  scale_y_continuous(limits = c(0.8, 1.2), expand = c(0, 0), breaks = 1, label = "position  ") +
  scale_x_continuous(limits = c(.7, 4.4), breaks = 1:5, labels = c("1", "2", "3", "4", "5"), name = NULL, position = "top") +
  theme_dviz_grid() +
  theme(axis.ticks.length = grid::unit(0, "pt"),
        axis.text = element_text(size = 14),
        axis.title.y = element_blank(),
        axis.ticks.y = element_blank())
scale_color <- ggplot(df, aes(x, color = factor(x), fill = factor(x))) + 
  geom_point(size = 5, shape = 22, y = 1) + 
  scale_y_continuous(limits = c(0.8, 1.2), expand = c(0, 0), breaks = 1, label = "color  ") +
  scale_x_continuous(limits = c(.7, 4.4), breaks = NULL) +
  scale_color_manual(values = darken(c("#0082A6", "#4EBBB9", "#9CDFC2", "#D8F0CD"), .1), guide = "none") +
  scale_fill_manual(values = c("#0082A6", "#4EBBB9", "#9CDFC2", "#D8F0CD"), guide = "none") +
  theme_dviz_grid() +
  theme(axis.ticks.length = grid::unit(0, "pt"),
        axis.text.x = element_blank(),
        axis.text.y = element_text(size = 14),
        axis.title = element_blank(),
        axis.ticks = element_blank(),
        panel.grid.major = element_blank()) 

scale_shape <- ggplot(df, aes(x, shape = factor(x))) + 
  geom_point(size = 4, color = "grey30", y = 1, fill = "grey80") + 
  scale_y_continuous(limits = c(0.8, 1.2), expand = c(0, 0), breaks = 1, label = "shape  ") +
  scale_x_continuous(limits = c(.7, 4.4), breaks = NULL) +
  scale_shape_manual(values = 21:24, guide = "none") +
  theme_dviz_grid() +
  theme(axis.ticks.length = grid::unit(0, "pt"),
        axis.text.x = element_blank(),
        axis.text.y = element_text(size = 14),
        axis.title = element_blank(),
        axis.ticks = element_blank(),
        panel.grid.major = element_blank()) 

cowplot::plot_grid(scale_num, scale_shape, scale_color, ncol = 1)

2 강조(하이라이트) 5

gghighlight 팩키지를 통해 직접 특정부분을 강조하는 시각화 산출물을 작성해도 좋지만, “Anatomy of gghighlight” 블로그 내용을 바탕으로 강조(하이라이트)하는 원칙을 살펴보자.

2.1 강조(하이라이트) 원리 6

붓꽃 iris 데이터를 배경을 깔고 종별로 히스토그램을 비교하는 시각화 산출물을 작성해 보자.

이를 위해서 먼저 iris_bg 데이터프레임을 하나 제작하고 Sepal.Width 변수로 히스토그램을 작성한다. iris_bg 배경 데이터프레임으로 히스토그램을 만들고 facet_warp() 함수로 종별로 히스토그램을 완성시킨다. 원리는 geom_histogram() 첫번째 히스토그램은 iris_bg 데이터프레임을 활용하여 종족이 없는 Sepal.Width 전체 종에 대한 히스토그램을 만들고, 두번째 히스토그램은 디폴트 설정된 색이 반영된 iris 데이터프레임에 대한 색상을 얻게된 히스토그램이 제작된다. 마지막으로 facet_wrap()으로 붓꽃 종별로 히스토그램이 나뉘어서 시각화된다.

library(tidyverse)

iris_bg <- iris[, -5]  # Background Data - full without the 5th column (Species)

ggplot(iris, aes(x = Sepal.Width)) +
  geom_histogram(data = iris_bg, fill = "grey") +
  geom_histogram() +
  facet_wrap(~ Species)

색상도 각 붓꽃 종별로 넣고 보기좋게 작업한 코드는 다음과 같다.

ggplot(iris, aes(x = Sepal.Width, fill = Species)) +
  geom_histogram(data = iris_bg, fill = "grey", alpha = .5) +
  geom_histogram(colour = "black") +
  facet_wrap(~ Species) +
  guides(fill = FALSE) +  # to remove the legend
  theme_bw()              # for clean look overall

gghighlight 팩키지를 활용하여 붓꽃 종별로 강조 하이라이트를 수월히 할 수 있다.

library(gghighlight)

species_g <- ggplot(iris, aes(Sepal.Length, fill = Species)) +
  geom_histogram() +
  theme(legend.position = "top")

species_highlight_g <- ggplot(iris, aes(Sepal.Length, fill = Species)) +
  geom_histogram() +
  gghighlight() +
  facet_wrap(~ Species)

cowplot::plot_grid(species_g, species_highlight_g)

3 강조(하이라이트) 사례

3.1 막대그래프 강조(하이라이트)

3.1.1 막대그래프 색상

geom_bar() 함수에 fill= 인자를 if_else()와 결합하여 색상을 달리 차별화 시킨다.

library(bbplot)
library(tidyverse)
library(gapminder)
library(extrafont)
loadfonts()

top_five_df <- gapminder %>%
  filter(year == 2007 & continent == "Africa") %>%
  top_n(5, wt=lifeExp)

top_five_df %>% 
  ggplot(aes(x = fct_reorder(country, lifeExp), y = lifeExp)) +
  geom_bar(stat="identity", position="identity", 
           fill=if_else(top_five_df$country == "Tunisia", "#1380A1", "#dddddd")) +
  geom_hline(yintercept = 0, size = 1, colour="#333333") +
  theme_minimal(base_family="NanumGothic") +
  coord_flip() +
  labs(title="레위니옹(Reunion)이 장수국가",
       subtitle = "아프리카 2007년 기대수명 상위국가") +
  theme(panel.grid.major.x = element_line(color="#cbcbcb"), 
        panel.grid.major.y=element_blank()) +
  labs(x="", y="기대수명")

3.1.2 막대그래프 + 라벨

geom_label() 함수에 aes() 함수 내부에 label= 인자를 넣어 라벨을 붙일 수 있고, 라벨 색상을 color= 인자에 if_else()를 조합시켜 강조하여 가시성을 높인다.

top_five_df <- gapminder %>%
  filter(year == 2007 & continent == "Africa") %>%
  top_n(5, wt=lifeExp)

top_five_df %>% 
  ggplot(aes(x = fct_reorder(country, lifeExp), y = lifeExp)) +
  geom_bar(stat="identity", position="identity", 
           fill=if_else(top_five_df$country == "Tunisia", "#1380A1", "#dddddd")) +
  geom_hline(yintercept = 0, size = 1, colour="#333333") +
  theme_minimal(base_family="NanumGothic") +
  coord_flip() +
  labs(title="레위니옹(Reunion)이 장수국가",
       subtitle = "아프리카 2007년 기대수명 상위국가") +
  theme(panel.grid.major.x = element_line(color="#cbcbcb"), 
        panel.grid.major.y=element_blank()) +
  labs(x="", y="기대수명") +
  geom_label(aes(x = country, 
                 y = lifeExp - 6, 
                 label = round(lifeExp, 0)), 
             hjust = 0, 
             vjust = 0.5, 
             colour = if_else(top_five_df$country == "Tunisia", "red", "#dddddd"), 
             fill = NA, 
             label.size = NA,
             family="Nanum Pen Script", 
             size = 10)

3.2 선그래프 강조(하이라이트)

3.2.1 선그래프 색상

geom_line() 선그래프 색상을 scale_colour_manual() 함수에 value= 인자를 달리하여 차별화할 수 있다.

oceania_df <- gapminder %>%
  filter(continent == "Oceania") 

oceania_df %>% 
  ggplot(aes(x = year, y = lifeExp, colour = country)) +
    geom_line(size = 1) +
    scale_colour_manual(values = c("#FAAB18", "#dddddd")) +
    theme_minimal(base_family = "NanumGothic") +
    labs(title="호주가 장수국가",
         subtitle = "호주와 뉴질랜드 기대수명 비교") +
    theme(legend.position = "top") +
    labs(x="", y="기대수명")

3.2.2 선그래프 색상 + 라벨

또한, geom_label()과 geom_curve()를 사용하여 특정 지점에 화살표를 넣어 라벨을 붙여 강조하는 것도 가능하다.

oceania_df <- gapminder %>%
  filter(continent == "Oceania") 

oceania_df %>% 
  ggplot(aes(x = year, y = lifeExp, colour = country)) +
    geom_line(size = 1) +
    scale_colour_manual(values = c("#FAAB18", "#dddddd")) +
    theme_minimal(base_family = "NanumGothic") +
    labs(title="호주가 장수국가",
         subtitle = "호주와 뉴질랜드 기대수명 비교") +
    theme(legend.position = "top") +
    labs(x="", y="기대수명") +
    geom_label(aes(x = 1990, y = 73, label = "호주 \n 장수국가!!!"), 
             hjust = 0, 
             vjust = 0.5, 
             lineheight = 0.8,
             colour = "#FAAB18", 
             fill = "white", 
             label.size = NA, 
             family="Nanum Pen Script", 
             size = 6) + 
     geom_curve(aes(x = 1990, y = 73, xend = 1975, yend = 72), 
                   colour = "#555555", 
                   curvature = -0.3,
                   size=0.7,
                   arrow = arrow(length = unit(0.05, "npc")))

3.3 히스토그램 강조(하이라이트) 7

3.3.1 단변량 히스토그램

변수를 하나 뽑아 geom_histogram()을 작성한다. geom_density()와 겹쳐 시각화를 할 수도 있고, geom_rug()와 결합하여 빈도가 높은 곳을 시각적으로 강조할 수도 있다. 마지막으로

orig_hist_g <- faithful %>% 
  ggplot(aes(x=eruptions)) +
    geom_histogram()

density_hist_g <- faithful %>% 
  ggplot(aes(x=eruptions)) +
    geom_histogram(binwidth = 0.1) +
    geom_density(aes(y=..count.. * 0.1 ))

rug_hist_g <- faithful %>% 
  ggplot(aes(x=eruptions)) +
    geom_histogram(binwidth = 0.1) +
    geom_density(aes(y= 0.1 * ..count..)) +
    geom_rug()

deco_hist_g <- faithful %>% 
  ggplot(aes(x=eruptions)) +
    geom_histogram(binwidth = 0.1, fill="skyblue") +
    geom_density(aes(y=0.1 * ..count..)) +
    geom_rug(colour="red") +
    labs(x="분출 시간(단위: 분)", y="빈도수",
         title="유명한 간헐철(Geyser) 데이터 분출시간") +
    theme_minimal(base_family = "NanumGothic") 

cowplot::plot_grid(orig_hist_g, density_hist_g, rug_hist_g, deco_hist_g)

3.3.2 집단 비교

집단간 분포 비교를 위해서 종전 히스토그램과 밀도그래프(density plot)외에 최근에 바이올린(violin) 그래프와 능선(ridge) 그래프도 많이 사용되고 있다.

library(ggridges)

iris_df <- iris %>% tbl_df()

hist_group_g <- iris_df %>% 
  ggplot(aes(x=Sepal.Width, fill=Species)) +
    geom_histogram()  +
    labs(title="종별 히스토그램") +
    theme(legend.position = "top")

density_group_g <- iris_df %>% 
  ggplot(aes(x=Sepal.Width, fill=Species)) +
    geom_density(alpha=0.3) +
    labs(title="종별 밀도그래프") +
    theme(legend.position = "top")

boxplot_group_g <- iris_df %>% 
  ggplot(aes(y=Sepal.Width, fill=Species)) +
    geom_boxplot(alpha=0.3)   +
    labs(title="종별 상자그림")

violin_group_g <- iris_df %>% 
  ggplot(aes(y=Sepal.Width, x=Species)) +
    geom_violin(color = NA,
                fill = "lightseagreen",
                alpha = .5,
                na.rm = TRUE,
                scale = "count") +
    labs(title="종별 바이올린 그래프")

violin_boxplot_group_g <- iris_df %>% 
  ggplot(aes(y=Sepal.Width, x=Species)) +
    geom_violin(color = NA,
                fill = "lightseagreen",
                alpha = .5,
                na.rm = TRUE,
                scale = "count") +
    geom_boxplot(outlier.size = 2, 
                 colour = "lightseagreen",
                 fill = "black",
                 na.rm = TRUE,
                 width = .1) +
    labs(title="종별 바이올린 + 상자그림")


ridge_group_g <- iris_df %>% 
  ggplot(aes(x=`Sepal.Width`, y=Species)) +
    geom_density_ridges(scale = 1.1, 
                        fill = "lightseagreen", 
                        alpha=0.3)   +
    labs(title="종별 능선그래프")

raincloud_group_g <- iris_df %>% 
  ggplot(aes(x=`Sepal.Width`, y=Species)) +
    geom_density_ridges(jittered_points = TRUE, 
                        position = "raincloud",
                        scale = 0.7, 
                        fill = "lightseagreen", 
                        alpha=0.3)    +
    labs(title="종별 능선 + 강우그래프")
  
cowplot::plot_grid(hist_group_g, density_group_g,
                   violin_group_g, violin_boxplot_group_g,
                   ridge_group_g, raincloud_group_g)

3.3.3 집단 비교 - 벌꿀무리

과거 stripchart를 사용해서 각 개별 관측점을 집단별로 비교하는 시각화를 많이 사용했는데 최근 geom_beeswarm()을 사용해서 이를 대체하고 있다.

  1. geom_jitter() + stat_summary()을 조합시키면 stripchart 기능을 ggplot에서 구현시킬 수 있다.
  2. 점그림(dotplot)은 beeswarm 그래프와 동일하지는 않지만 유사한 기능을 구현할 수 있다.
  3. ggbeeswarm은 관측점을 점으로 찍어 직관적으로 집단간 비교도 수월하게 시각적한다.
library(ggbeeswarm)

# Stripchart
strip_g <- iris_df %>% 
  ggplot(aes(x = Species, y = Sepal.Width)) +
  geom_jitter(position = position_jitter(height = 0, width = .1), 
              fill = "lightseagreen", 
              colour = "lightseagreen",
              alpha = .5) + 
  stat_summary(fun.y = median, 
               fun.ymin = median, 
               fun.ymax = median, 
               geom = "crossbar", 
               width = 0.5) +
  coord_cartesian(ylim = c(2, 4.5)) +
  labs(x="", y="", title="스트립차트(stripchart)")

# dotplot
dotplot_g <- iris_df %>% 
  ggplot(aes(x = Species, y = Sepal.Width)) +
    geom_dotplot(stackdir = "center", 
                 binaxis = "y", 
                 binwidth = .1,
                 binpositions = "all",
                 stackratio = 1.5, 
                 fill = "lightseagreen", 
                 colour = "lightseagreen") +
    coord_cartesian(ylim = c(2, 4.5)) +
    labs(x="", y="", title="점그래프(Dot plot)")

# beeswarm
beeswarm_g <- iris_df %>% 
  ggplot(aes(x = Species, y = Sepal.Width)) +
    geom_quasirandom(fill = "lightseagreen", 
                     colour = "lightseagreen") +
    coord_cartesian(ylim = c(2, 4.5)) +
    labs(x="", y="", title="벌꿀무리 그래프")

# 상자그림 + 점그림
boxplot_dotplot_g <- iris_df %>% 
  ggplot(aes(x = Species, y = Sepal.Width)) +
    geom_boxplot(outlier.shape = NA) + 
    geom_jitter(fill = "lightseagreen", 
                colour = "lightseagreen",
                na.rm = TRUE,
                position = position_jitter(height = 0, width = .1),
                alpha = .5) + 
    coord_cartesian(ylim = c(2, 4.5)) +
    labs(x="", y="", title="상자그림 + 점그림")

cowplot::plot_grid(strip_g, dotplot_g,
                   beeswarm_g, boxplot_dotplot_g)

4 자주 사용되는 시각화

4.1 라벨 붙은 시계열

시계열 데이터에 마지막에 라벨을 붙이게 되면 가시성이 좋아진다. BLOGR 님이 작성한 Label line ends in time series with ggplot2 코드를 참조하여 ggplot으로 코드를 작성한다.

orange_ends <- Orange %>% 
  group_by(Tree) %>% 
  top_n(1, age) %>% 
  pull(circumference)

Orange %>% 
  mutate(Tree = factor(Tree, levels=c(4,2,5,1,3))) %>%
  ggplot(aes(age, circumference, color = Tree)) +
    geom_line(size = 2, alpha = .8) +
    theme_minimal(base_family = "NanumGothic") +
    scale_x_continuous(expand = c(0, 0), label=scales::comma) +
    scale_y_continuous(sec.axis = sec_axis(~ ., breaks = orange_ends)) +
    labs(title = "오렌지 나무 성장곡선",
        subtitle = "R 내장된 Orange 데이터셋",
         x = "일별 경과 시간", y = "직경 (mm)", 
         caption = "@drsimonj 원작")

4.2 막대그래프 그룹별 색상

TV 시리즈별 색상을 달리할 경우 RColorBrewer 팩키지 생상 팔레트를 범주형에 맞춰 각 시리즈별로 가장 잘 구분될 수 있도록 색상을 칠해 시각화를 한다.

ratings <- read_csv("http://bit.ly/cs631-ratings",
                    na = c("", "NA", "N/A"))

# 데이터 준비
ratings_bonanza1 <- ratings %>% 
  mutate(ep_id = row_number(),
         series = as.factor(series)) %>% 
  select(ep_id, viewers_7day, series)

# 시각화
barplot_pal <- RColorBrewer::brewer.pal(n=8, name = "Accent")

ggplot(ratings_bonanza1, aes(x = ep_id, y = viewers_7day, 
                             fill = series)) +
  geom_col(alpha = .9) +
  theme_minimal() +
  ggtitle("Series 8 was a Big Setback in Viewers",
          subtitle= "7-Day Viewers across All Series/Episodes") +
  theme(legend.position = "bottom",
        text = element_text(family = "Lato"),
        axis.text.x = element_blank(),
        axis.ticks.x = element_blank(),
        axis.title.x = element_blank()) + 
  scale_fill_manual(values = barplot_pal) +
  scale_x_continuous(expand = c(0, 0)) +
  guides(fill = guide_legend(nrow = 1))

4.3 롤리팝(lolli-pop) 그래프 8

롤리팝(Lollipop) 그래프는 막대그래프와 클리블랜드 점그래프를 합성한 것으로 한축에는 연속형, 다른 한축에는 범주형을 두고 사용자의 관심을 점그래프로 집중시키는데 효과적이다.

막대그래프 → 점그래프 → 롤리팝 그래프로 뼈대 골격을 만들어 나간다.

# 데이터 -----
ohio_top15 <- midwest %>%
        filter(state == "OH") %>%
        select(county, percollege) %>%
        top_n(15, wt=percollege) %>%
        arrange(percollege) %>%
        mutate(county = factor(county, levels = .$county))

ohio_barplot_g <- ggplot(ohio_top15, aes(county, percollege)) +
        geom_col() +
        coord_flip()

ohio_dotplot_g <- ggplot(ohio_top15, aes(county, percollege)) +
        geom_point() +
        coord_flip()

ohio_lollipop_g <- ggplot(ohio_top15, aes(percollege, county)) +
        geom_segment(aes(x = 0, y = county, 
                         xend = percollege, yend = county), color = "grey50") +
        geom_point()

cowplot::plot_grid(ohio_barplot_g, ohio_dotplot_g, ohio_lollipop_g, nrow=1)

평균값에서 얼마나 차이가 있느냐를 롤리팝 그래프로 시각화하는 패턴이 많이 사용된다. 이를 위해서, 앞서와 마찬가지로 사우이 15개 카운티를 뽑아내고 평균을 구하고 평균이상, 평균이하에 대한 요인(factor)도 함께 만들어낸다.

ohio <- midwest %>%
        filter(state == "OH") %>%
        select(county, percollege) %>%
        top_n(15, wt=percollege) %>%
        arrange(percollege) %>%
        mutate(Avg = mean(percollege, na.rm = TRUE),
               Above = ifelse(percollege - Avg > 0, TRUE, FALSE),
               county = factor(county, levels = .$county))

comparison_lollipop_g <- ggplot(ohio, aes(percollege, county, color = Above)) +
        geom_segment(aes(x = Avg, y = county, 
                         xend = percollege, yend = county), color = "grey50") +
        geom_point()

ggplot(ohio, aes(percollege, county, color = Above, label=round(percollege,1))) +
        geom_segment(aes(x = Avg, y = county, 
                         xend = percollege, yend = county), color = "grey50") +
        geom_point(size=7) +
        annotate("text", x = 30, y = "WOOD", label = "평균이상", color = "#00BFC4", size = 5, hjust = -0.1, vjust = 1) +
        annotate("text", x = 30, y = "WOOD", label = "평균이하", color = "#F8766D", size = 5, hjust = -0.1, vjust = -1) +
        geom_text(color="black", size=3) +
        theme_minimal(base_family = "NanumGothic") +
        labs(x="대졸 비율(%)", y="",
             title="오하이오주 카운티별 대졸비율 비교")  +
        geom_segment(aes(x = 30, xend = 30 , y = "WOOD", yend = "HANCOCK"), size=1,
                     arrow = arrow(length = unit(0.2,"cm")), color = "#00BFC4") +
        geom_segment(aes(x = 30, xend = 30 , y = "MONTGOMERY", yend = "DELAWARE"), size=1,
                     arrow = arrow(length = unit(0.2,"cm")), color = "#F8766D") +
        theme(legend.position = "none")

4.4 추세선 강조 + 라벨

geom_line()을 두개 포함시켜 강조하고하는 색상을 별도로 지정하고 선굵기도 달리한다. 라벨도 동일한 방법으로 geom_text()를 두개 포함시켜 강조하고자하는 색상과 글꼴크기도 달리 지정한다.

ratings %>% 
  mutate(episode = as.factor(episode)) %>% 
  ggplot(aes(x = episode, y = viewers_7day, group = series)) +
    geom_line(data = filter(ratings, !series == 8), alpha = .25) +
    geom_line(data = filter(ratings, series == 8), color = "#CF2154", size=1) +
    theme_minimal(base_family = "NanumGothic") + 
    labs(x = "에피소드", y="1주일 시청자수", title="여덟번째 스리즈가 문제네!!!") +
    geom_text(data = filter(ratings, episode == 1 & series %in% c(1:7)), color = "gray",
              aes(label = paste0(series, " 회차 ")), vjust = -1, family = "NanumGothic") +
    geom_text(data = filter(ratings, episode == 10 & series == 8), color = "#CF2154",
              aes(label = paste0(series, " 회차 ")), vjust = -1, family = "Nanum Pen Script")

4.5 아령(dumbbell) 그래프

TV 시리즈별로 회차를 달리하여 첫번째와 가장 마지막 시청자수를 비교하여 시각화하는데 아령(dumbbell) 그래프가 효과적이다. 이를 위해서 ggplot()에 들어가는 자료형을 미리 준비하고 이에 맞춰 geom_line()과 geom_point()를 결합시켜 시각화한다.

ratings_dumbbell_df <- ratings %>% 
  select(series, episode, viewers_7day) %>% 
  group_by(series) %>% 
  filter(episode == 1 | episode == max(episode)) %>% 
  mutate(episode = ifelse(episode == 1,"1회차", "최종회")) %>% 
  ungroup() %>% 
  mutate(series = as.factor(series))

ratings_dumbbell_df
# A tibble: 16 x 3
   series episode viewers_7day
   <fct>  <chr>          <dbl>
 1 1      1회차           2.24
 2 1      최종회          2.75
 3 2      1회차           3.1 
 4 2      최종회          5.06
 5 3      1회차           3.85
 6 3      최종회          6.74
 7 4      1회차           6.6 
 8 4      최종회          9.45
 9 5      1회차           8.51
10 5      최종회         13.5 
11 6      1회차          11.6 
12 6      최종회         15.0 
13 7      1회차          13.6 
14 7      최종회         15.9 
15 8      1회차           9.46
16 8      최종회         10.0 
# RColorBrewer::display.brewer.all()
dumbbell_pal <- RColorBrewer::brewer.pal(n=3, name="Set1")

ratings_dumbbell_df %>% 
  ggplot(aes(x = viewers_7day, y = fct_rev(series), color = episode, group = series)) +
    geom_line(size = .75) +
    geom_point(size = 2.5) +
    theme_minimal() +
    scale_color_manual(values = dumbbell_pal) +
    labs(title = "아령 그래프 사례", y = "회차", x = "시청자수 (백만명)",
         color = "회차") +
    theme(text = element_text(family = "NanumGothic"),
          legend.position = "top")

4.6 경사(Slope) 그래프 9

터프티(tufte) 스타일 경사그래프를 ggplot과 dplyr을 조합시켜 구현한다. 이를 위해서 먼저 ggplot의 기본기능을 활용하여 경사그래프를 시각화한다.

ratings_dumbbell_df %>% 
  ggplot(aes(x = episode, y = viewers_7day, group = series)) +
    geom_point(data = filter(ratings_dumbbell_df, !series == 8), alpha = .25) +
    geom_point(data = filter(ratings_dumbbell_df, series == 8), color = "#CF2154") +
    geom_line(data = filter(ratings_dumbbell_df, !series == 8), alpha = .25) +
    geom_line(data = filter(ratings_dumbbell_df, series == 8),color = "#CF2154") +
    theme_minimal(base_family = "NanumGothic") +
    labs(title = "경사그래프(Slopegraph) 사례", x="에피소드", y="주별 시청자수 (단위: 백만)") +
    geom_text(data = filter(ratings_dumbbell_df, episode == "최종회" & series %in% c(1:7)), color = "gray",
              aes(label = series), vjust = -1, family = "Nanum Pen Script", hjust = .5) +
    geom_text(data = filter(ratings_dumbbell_df, episode == "최종회" & series == 8), color = "#CF2154",
              aes(label = paste0(series, " 회차")), vjust = -1, family = "Nanum Pen Script", size=5)

slopegraph 팩키지로 대동단결하는 분위기다. 이를 바탕으로 경사그래프를 시각해보자.

# devtools::install_github("leeper/slopegraph")
library(slopegraph)

data(cancer)
cancer %>% head
          Year.5 Year.10 Year.15 Year.20
Prostate      99      95      87      81
Thyroid       96      96      94      95
Testis        95      94      91      88
Melanomas     89      87      84      83
Breast        86      78      71      75
Hodgkin's     85      80      74      67
slopegraph(cancer, col.lines = 'gray', col.lab = "black", 
           xlim = c(-.5, 5.5), cex.lab = 0.5, cex.num = 0.5,
           xlabels = c('5 Year','10 Year','15 Year','20 Year'))

slopegraph는 Base 그래픽을 기본으로 제공한다. 자료구조도 rownames를 갖는 전통적인 데이터프레임이다. 기본 Base 그래픽을 염두에 두고 상기 TV 연속물 경사그래프를 다음과 같이 작성할 수 있다.

series_cols <- c(rep("darkgray", 7), "red")

ratings_dumbbell_df %>% 
  spread(episode, viewers_7day) %>% 
  as.data.frame() %>% 
  column_to_rownames(var="series") %>% 
  slopegraph(., col.lines = series_cols, col.lab = series_cols, 
            cex.lab = 1.5, cex.num = 1.0,
            xlim = c(-0.5, 3.5), 
            xlabels = c('첫회','최종회'))

slopegraph() 함수 대신 ggslopegraph() 함수를 사용하게 되면 ggplot()으로도 시각화를 할 수 있다.

ratings_dumbbell_df %>% 
  spread(episode, viewers_7day) %>% 
  as.data.frame() %>% 
  column_to_rownames(var="series") %>% 
  ggslopegraph(offset.x = 0.06, yrev = FALSE,
               col.lines = series_cols, col.lab = series_cols,
               main="경사그래프 사례 - ggplot") +
     theme_minimal(base_family = "NanumGothic")

4.7 시계열 데이터 비교

거시경제 등 시계열을 많이 다루는 분야에서 관심갖는 변수 2개이상을 시간의 흐름에 따라 비교하여 시각화하는 경우가 많고 다음과 같은 시각화 방법으로 R코드를 작성한다.

# 데이터셋 준비

CA_house_prices <- 
  filter(house_prices, state == "California", year(date) > 2000) %>%
  mutate(
    label = ifelse(
      date %in% c(ymd("2005-01-01"), ymd("2007-07-01"), 
                  ymd("2010-01-01"), ymd("2012-07-01"), ymd("2015-01-01")),
      format(date, "%b %Y"), ""),
    nudge_x = case_when(
      label == "Jan 2005" ~ -0.003,
      TRUE ~ 0.003
    ),
    nudge_y = case_when(
      label == "Jan 2005" ~ 0.01,
      label %in% c("Jul 2007", "Jul 2012") ~ 0.01,
      TRUE ~ -0.01
    ),
    hjust = case_when(
      label == "Jan 2005" ~ 1,
      TRUE ~ 0
    )
  )

p1 <- ggplot(CA_house_prices, aes(date, house_price_perc)) +
  geom_line(size = 1, color = "#0072b2") +
  scale_y_continuous(
    limits = c(-0.3, .32), expand = c(0, 0),
    breaks = c(-.3, -.15, 0, .15, .3),
    name = "12-month change\nin house prices", labels = scales::percent_format(accuracy = 1)
  ) + 
  scale_x_date(name = "", expand = c(0, 0)) +
  coord_cartesian(clip = "off") +
  theme_dviz_grid() +
  theme(
    axis.line = element_blank(),
    plot.margin = margin(12, 1.5, 0, 1.5)
  )
p2 <- ggplot(CA_house_prices, aes(date, unemploy_perc/100)) +
  geom_line(size = 1, color = "#0072b2") +
  scale_y_continuous(
    limits = c(0.037, 0.143),
    name = "unemployment\nrate", labels = scales::percent_format(accuracy = 1),
    expand = c(0, 0)
  ) +
  scale_x_date(name = "year", expand = c(0, 0)) +
  theme_dviz_grid() +
  theme(
    axis.line = element_blank(),
    plot.margin = margin(6, 1.5, 3, 1.5)
  )
 
plot_grid(p1, p2, align = 'v', ncol = 1, labels = "auto")
(ref:house-price-unemploy)

(ref:house-price-unemploy)

5 불확실성 시각화

5.1 들어가며

ggplot 팩키지에 geom_pointrange()가 기본디폴트로 설정되어 있는데 다른 요약 aesthethics에는 다양한 함수가 제공되고 있다.

  • geom_errorbar()
  • geom_errorbar()
  • geom_pointrange()
  • geom_linerange()
  • geom_crossbar()

상기 geom_*와 대응하여 Hmisc 팩키지에 요약 통계량 함수(summary function)이 stat_summary() 함수로 포팅되어 ggplot에 녹여져있다. 공통적으로 y, ymax, ymin값을 반환시킨다.

  • mean_cl_normal()
  • mean_sdl()
  • mean_cl_boot()
  • median_hilow()

먼저 데이터를 준비하자. - 표준정규분포 - n - 오른쪽으로 치우친 분포 - s (Johnson distribution with skewness 2.2 and kurtosis 13) - 급첨분포(leptikurtic distribution) - k (Johnson distribution with skewness 0 and kurtosis 30) - 이봉분포(bimodal distribution) - mm (평균 -0.95, 0.95 와 표준편차 0.31)

# 데이터 -----
library(SuppDists) # install.packages("SuppDists")

findParams <- function(mu, sigma, skew, kurt) {
  value <- .C("JohnsonMomentFitR", as.double(mu), as.double(sigma), 
    as.double(skew), as.double(kurt - 3), gamma = double(1), 
    delta = double(1), xi = double(1), lambda = double(1), 
    type = integer(1), PACKAGE = "SuppDists")
   list(gamma = value$gamma, delta = value$delta, 
    xi = value$xi, lambda = value$lambda, 
    type = c("SN", "SL", "SU", "SB")[value$type])  
}
n <- rnorm(100)
s <- rJohnson(100, findParams(0, 1, 2.2, 13))
k <- rJohnson(100, findParams(0, 1, 0, 30))
mm <- rnorm(100, rep(c(-1, 1), each = 50) * sqrt(0.9), sqrt(0.1))

four_df <- data.frame(
  dist = factor(rep(c("n", "s", "k", "mm"), each = 100), c("n", "s", "k", "mm")),
  vals = c(n, s, k, mm))

library(Hmisc)

mean_se_g <- ggplot(four_df, aes(x = dist, y = vals, group=1)) +
  stat_summary(fun.data = "mean_se")

errorbar_g <- ggplot(four_df, aes(x = dist, y = vals)) +
    stat_summary(fun.y = "median", colour = "red", size = 2, geom = "point") +
  stat_summary(fun.data = "mean_cl_normal", 
               geom ="errorbar",
               color="red") 

group_errorbar_g <- ggplot(four_df, aes(x = dist, y = vals, group=1)) +
  stat_summary(fun.data = "mean_cl_normal", 
               geom ="errorbar",
               color="red") +
  stat_summary(fun.y = mean, geom = "line") 

cowplot::plot_grid(mean_se_g, errorbar_g, group_errorbar_g, ncol=3)

5.2 모평균 추정 시각화

모집단에서 나온 아래 관측점으로 표현하고 이를 평균낸 “표본 평균”을 오렌지 수직막대로 “표본 표준편차”도 함께 시각화하여 도식화시킬 수 있다.

set.seed(452061)

empty_theme <- theme_dviz_open(12, rel_small = 1, rel_large = 1) +
  theme(
    axis.line = element_blank(),
    axis.text = element_blank(),
    axis.ticks = element_blank(),
    axis.ticks.length = grid::unit(0, "pt")
  )

x <- c(seq(-4, 4, length.out = 200))
df_norm <- data.frame(
  x,
  y = dnorm(x)
)

sd_x <- c(-1, 1)
sd_y <- dnorm(sd_x)

df_annot <- data.frame(
  x = c(0.05, sd_x[2] + 0.04, -Inf),
  y = c(dnorm(0) * 0.4, sd_y[2] * 1.01, Inf), #sd_y[1] * 1.1
  hjust = c(0, 0, 0),
  vjust = c(1, 0.5, 1),
  label = c("평균", "표준편차", "모집단 분포")
)


p1 <- df_norm %>% 
  ggplot(aes(x, y)) +
    geom_area(fill = "lightblue") +
    geom_segment( # 표준편차
      data = data.frame(x = 1), x = 0, xend = sd_x[2], y = sd_y[1], yend = sd_y[2],
      arrow = arrow(angle = 90, length = grid::unit(3, "pt"), ends = "both", type = "closed"),
      inherit.aes = FALSE
    ) +
    geom_segment( # 모평균 수직선
      data = data.frame(x = 1), x = 0, xend = 0, y = 0, yend = dnorm(0),
      linetype = 2,
      inherit.aes = FALSE
    ) +
    geom_text(data = df_annot,
      aes(x, y, label = label, hjust = hjust, vjust = vjust),
      family = dviz_font_family,
      size = c(12, 12, 14)/.pt
    ) +
    scale_x_continuous(
      limits = c(-4, 4), expand = c(0, 0),
      breaks = 0, # workaround to fix missing axis line
      name = "관심을 갖는 변수"
    ) +
    scale_y_continuous(breaks = NULL, name = NULL, expand = expand_scale(mult = c(0, 0.1))) +
    empty_theme +
    theme(axis.line.x = element_line(), axis.title.x = element_text(hjust = 1))


df_sample <- data.frame(x = rnorm(15),  y = 0)

df_annot2 <- data.frame(
  x = c(mean(df_sample$x) + 0.05, sort(df_sample$x)[2],
        mean(df_sample$x) + sd(df_sample$x) + 0.05, -Inf),
  y = c(-0.15, 0.12, .13 + 0.01, Inf),
  hjust = c(0, 0.3, 0, 0),
  vjust = c(0.5, 0.5, 0.5, 1),
  label = c("표본 평균", "관측점", "표본 표준편차", "표본")
)


p2 <- df_sample %>% 
  ggplot(aes(x, y)) +
    geom_point(
      size = 3, fill = "lightblue", shape = 21, stroke = 0.5,
      position = position_jitter(width = 0, height = 0.01, seed = 127)) +
    geom_segment( # 표본평균을 표식하는 수직막대
      data = data.frame(x = 1),
      aes(x = mean(df_sample$x), xend = mean(df_sample$x), y = -.2, yend = .2),
      size = 1.5,
      color = "#D55E00",
      inherit.aes = FALSE) +
    geom_segment( # horizontal bar representing sd
      data = data.frame(x = 1),
      x = mean(df_sample$x), xend = mean(df_sample$x) + sd(df_sample$x), y = .13, yend = .13,
      arrow = arrow(angle = 90, length = grid::unit(3, "pt"), ends = "both", type = "closed"),
      inherit.aes = FALSE) +
    geom_text(
      data = df_annot2,
      aes(x, y, label = label, hjust = hjust, vjust = vjust),
      family = dviz_font_family,
      size = c(12, 12, 12, 14)/.pt) +
    scale_x_continuous(limits = c(-4, 4), expand = c(0, 0), breaks = NULL, name = NULL) +
    scale_y_continuous(expand = c(0.1, 0), breaks = NULL, name = NULL) +
    empty_theme

plot_grid(p1, p2, ncol = 1, rel_heights = c(1, .4, 1), align = 'v')

5.3 신뢰구간

cacao 데이터프레임에서 캐나다만 필터링하여 데이터프레임을 만든 후에 신뢰구간별 통계량을 계산한 후에 ggplot으로 시각화한다.

library(emmeans)
point_color <- darken("#009E73", .3)

cacao_single <- cacao %>% 
  filter(location == "Canada")

cacao_fit <- lm(rating ~ 1, data = cacao_single)

CI_df <- data.frame(type = c(0.8, 0.95, 0.99)) %>%
  mutate(df = map(type, ~broom::tidy(emmeans(cacao_fit, ~ 1, options = list(level = .x))))) %>%
  unnest() %>%
  select(type, estimate, std.error, conf.low, conf.high) %>%
  mutate(type = paste0(signif(100*type, 2), "% 신뢰구간"))

CI_df <- rbind(CI_df,
  data.frame(
    type = "standard error",
    estimate = CI_df$estimate[1],
    std.error = CI_df$std.error[1],
    conf.low = CI_df$estimate[1] - CI_df$std.error[1],
    conf.high = CI_df$estimate[1] + CI_df$std.error[1]),
  data.frame(
    type = "standard deviation",
    estimate = mean(cacao_single$rating),
    std.error = CI_df$std.error[1],
    conf.low = mean(cacao_single$rating) - sd(cacao_single$rating),
    conf.high = mean(cacao_single$rating) + sd(cacao_single$rating)),
  data.frame(
    type = "sample", estimate = mean(cacao_single$rating), std.error = NA,
    conf.low = NA, conf.high = max(cacao_single$rating))
) %>%
  mutate(
    type = fct_relevel(factor(type), "sample", "standard deviation", "standard error"),
    label = case_when(
      type == "sample" ~ NA_character_,
      type == "standard deviation" ~ "+/- 표준편차",
      type == "standard error" ~ "+/- 표준오차",
      TRUE ~ as.character(type) #paste0("mean +/- ", type)
    )
  )

label_x <- filter(CI_df, type == "standard deviation")$conf.high + 0.04

ggplot(CI_df, aes(estimate, type)) + 
  geom_point(
    data = cacao_single, aes(rating, "sample"), 
    position = position_jitter(height = 0.6, width = 0.02, seed = 7843),
    color = point_color,
    size = 0.3) +
  geom_errorbarh(aes(xmin = conf.low, xmax = conf.high), height = 0.2, na.rm = TRUE) +
  geom_point(size = 2, color = "#D55E00") +
  geom_label(
    aes(label_x, label = label), hjust = 0, nudge_y = 0.01, na.rm = TRUE,
    family = dviz_font_family,
    size = 12/.pt,
    label.size = 0) +
  geom_label(
    data = filter(CI_df, type == "sample"),
    aes(conf.high + 0.06, label = type), hjust = 0, nudge_y = 0.01,
        family = dviz_font_family,
        size = 12/.pt,
        label.size = 0) +
  geom_text(
    data = filter(CI_df, type == "sample"),
    aes(estimate, label = "mean"), hjust = 0.2, vjust = 0, nudge_y = 0.2,
    family = dviz_font_family,
    size = 12/.pt) +
  scale_x_continuous(
    limits = c(1.95, 4.1),
    expand = c(0, 0),
    name = "쵸콜릿 선호도 평가" ) +
  scale_y_discrete(
    name = NULL,
    limits = rev(levels(CI_df$type)),
    expand = expand_scale(add = c(0.6, 0.8)),
    breaks = NULL) +
  coord_cartesian(clip = "off") +
  theme_dviz_vgrid(12, rel_small = 1) +
  theme(
    plot.margin = margin(3, 73, 3, 1.5),
    axis.line.x = element_line(),
    axis.ticks.x = element_line(color = "black"),
    axis.title.x = element_text(hjust = 1)
  )

cacao_CA <- filter(cacao, location == "Canada")

fit_CA <- lm(rating ~ 1, data = cacao_CA)

CI_CA_df <- data.frame(level = c(0.99, 0.95, 0.8)) %>%
  mutate(df = map(level, ~broom::tidy(emmeans(fit_CA, ~ 1, options = list(level = .x))))) %>%
  unnest() %>%
  select(level, estimate, conf.low, conf.high) %>%
  mutate(
    level = paste0(signif(100*level, 2), "%"),
    type = "CI",
    location = "Canada"
  )

CI_CA_sd_df <- data.frame(
    level = NA,
    estimate = mean(cacao_CA$rating),
    conf.low = mean(cacao_CA$rating) - sd(cacao_CA$rating),
    conf.high = mean(cacao_CA$rating) + sd(cacao_CA$rating),
    type = "original data",
    location = "Canada")

ggplot(rbind(CI_CA_df, CI_CA_sd_df), aes(estimate, interaction(location, type))) + 
  geom_point(
    data = cacao_CA, # draw two separate layers to get jittering right relative to previous figure
    aes(rating, interaction(location, "original data")),
    position = position_jitter(height = 0.6, width = 0.02, seed = 7843),
    color = point_color,
    size = 0.3) +
  geom_errorbarh(
    data = CI_CA_sd_df,
    aes(y = interaction(location, "original data"), xmin = conf.low, xmax = conf.high),
    height = 0.2) +
  geom_errorbarh(
    data = CI_CA_df,
    aes(y = interaction(location, "CI"), xmin = conf.low, xmax = conf.high, color = level, size = level),
    height = 0) +
  geom_errorbarh(
    data = CI_CA_df,
    aes(y = interaction(location, "CI"), xmin = conf.low, xmax = conf.high, color = level),
    height = 0.2) +
  geom_point(size = 2, color = "#D55E00") +
  geom_label(
    data = data.frame(
      estimate = 4.06,
      location = c("Canada"),
      type = "original data",
      label = c(
        paste0("캐나다,\nn = ", nrow(cacao_CA))
      )
    ),
    aes(label = label), hjust = 0, vjust = 0.5, nudge_y = 0.01,
    family = dviz_font_family,
    size = 12/.pt,
    label.size = 0
  ) +
  scale_x_continuous(
    limits = c(1.95, 4.1),
    expand = c(0, 0),
    name = "쵸코릿 선호도 평가"
  ) +
  scale_y_discrete(
    name = NULL,
    limits = rev(c("Canada.original data", "Canada.CI")),
    # expand = expand_scale(add = c(1, 0.8)),
    breaks = NULL
  ) +
  scale_fill_manual(
    aesthetics = c("color", "fill"),
    name = "신뢰구간",
    values = c(
     `80%` = desaturate(darken("#0072B2", .2), .3),
     `95%` = desaturate(lighten("#0072B2", .2), .3),
     `99%` = desaturate(lighten("#0072B2", .4), .3)
    ),
    guide = guide_legend(
      direction = "horizontal",
      title.position = "top",
      label.position = "bottom"
    )
  ) +
  scale_size_manual(
    name = "신뢰구간",
    values = c(
     `80%` = 1.5,
     `95%` = 1,
     `99%` = 0.5
    ),
    guide = guide_legend(
      direction = "horizontal",
      title.position = "top",
      label.position = "bottom"
    )
  ) +
  coord_cartesian(clip = "off") +
  theme_dviz_vgrid(12, rel_small = 1) +
  theme(
    plot.margin = margin(3, 73, 3, 1.5),
    axis.line.x = element_line(),
    axis.ticks.x = element_line(color = "black"),
    axis.title.x = element_text(hjust = 1),
    legend.position = c(0, 0.01),
    legend.justification = c(0, 0),
    legend.key.height = grid::unit(6, "pt"),
    legend.key.width = grid::unit(24, "pt"),
    legend.spacing.x = grid::unit(6, "pt"),
    legend.spacing.y = grid::unit(3, "pt"),
    legend.box.background = element_rect(fill = "white", color = NA),
    legend.box.spacing = grid::unit(0, "pt"),
    legend.title.align = 0.5
  )

  1. Claus O. Wilke, “Fundamentals of Data Visualization”, O’Reilly Media, Inc.↩

  2. Peter Prevos (February 24, 2019), “Strategic Data Science: Creating Value With Data Big and Small”, The Lucid Manager↩

  3. BBC - bbplot↩

  4. “BBC Visual and Data Journalism cookbook for R graphics”↩

  5. Hiroaki Yutani (June 3, 2018), “Anatomy of gghighlight”↩

  6. BLOGR (2016), “Plotting background data for groups with ggplot2”↩

  7. CS631: Principles & Practice of Data Visualization (Spring 2018)↩

  8. UC Business Analytics R Programming Guide , “Lollipop Charts”↩

  9. Chuck Powell (2018-06-22), “Visualizing Data in R - Creating Slopegraphs with R”↩