Sau khi học xong khóa Learn ggplot2 in R for Data Visualization của Clara Granell trên Udemy và hiểu một số câu lệnh cơ bản của package ggplot2, tôi thấy rất thích thú với các bài tập yêu cầu vẽ lại các biểu đồ cho trước. Nó yêu cầu bạn phải vận dụng nhiều kĩ năng phân tích cũng như (tất nhiên) search Google, Stackoverflow để cho ra kết quả cuối cùng sát nhất có thể.

Trong quá trình tìm kiếm tôi tìm thấy cuốn sách “Data Visualisation with R - 111 Examples” của Thomas Rahlf, có rất nhiều ví dụ đẹp nhưng lại vẽ bằng R-base. Nhìn qua code không gọn gàng nên tôi quyết định sẽ vẽ lại bằng package ggplot, như là một cơ hội để luyện tập và lên content cho blog này.

Quá trình học sử dụng jupyter notebook, sau khi xong xuôi sẽ export ra file markdown và đưa lên blog. Ngôn ngữ sử dụng lẫn cả tiếng Anh lẫn tiếng Việt để thuận tiện.

Giờ thì đến với biểu đồ đầu tiên: Bar Chart Simple

TL;DR:

What I have learned?

1. Load data from excel file using lib readxl
2. Shorten the way we call fct_reorder using operator %>%
3. How to highlight bar by using mapping aes fill, ifelse condition and scale_fill_manual
4. Draw zebra-like background using geom_rect
5. Increase the distance between label on y-axis and axis-line: axis.text margin
6. Add columns to dataframe to avoid out of variable syncing in different geom layers
7. Display out-of-plot geom_text by plot.margin & clip=off in coord
8. Changing font with extrafont. But I think we should left the majority of this work for image editor tools
9. Adding annotate to the plot and avoid using geom_text
10. How to use ggsave(): remove quotation mark in device does the magic (if not, font will be inappropriately rendered), specify w x h with unit of measure

Target result

http://www.datavisualisation-r.com/pdf/barcharts_simple.pdf

The figure shows the results of a 2010 survey carried out in different countries: How many percent of the respondents agreed with the statement “I Definitely Believe in God or a Supreme Being”?

Data are derived from an Ipsos survey that was ordered by the Thompson Reuters News Service and performed between 7 and 23 September 2010 in 24 countries. The study used an international sample of adults aged between 18 and 64 years from the USA and Canada, and aged between 16 and 64 years from all other countries. The unweighted basis of the respondents numbered 18,531 people. The survey included approximately 1000 people from each country, excluding Argentina, Indonesia, Mexico, Poland, Saudi Arabia, South Africa, South Korea, Sweden, Russia, and Turkey, where the sample size was approximately 500.

Load các library cần thiết

library(ggplot2)
library(viridis)
library(dplyr)
theme_set(theme_minimal()) 

#Import data from excel file with lib readxl
library(readxl)
ipsos <- read_excel("./myData/ipsos.xlsx")
ipsos

#Add thêm label thẳng vào dataframe để tránh việc gọi dataset nhiều lần
#Do ở dưới lúc đầu mapping y vào Country, sau lại để là Coulab nên fct_reorder 2 lần
library(forcats)

ipsos <- ipsos %>% 
    mutate(Coulab=paste0(Country, " ", Percent)) %>%
    mutate(Coulab=fct_reorder(Coulab, Percent)) %>%
    mutate(Country=fct_reorder(Country, Percent))
ipsos

options(repr.plot.width=10, repr.plot.height=6)

# Đầu tiên sẽ vẽ bar plot với highlight bar cho Brazil + Germany
# Tham khảo https://stackoverflow.com/questions/54103496/using-a-different-color-for-only-the-selected-bar-in-geom-bar

ggplot(ipsos, aes(x=Percent, y=Country)) +
    geom_col(aes(fill=ifelse(Country %in% c("Brazil", "Germany"), "Highlight", "Normal")), show.legend = F) + 
    scale_fill_manual(values=c("Highlight"="#ff00d2","Normal"="#becdd2"))

#Vẽ back ground màu đan xen theo trục x
#Tìm hiểu nhiều chỗ thì chỉ có 1 cách là vẽ đè thêm sử dụng geom_rect()
#Tuy nhiên nhìn kĩ màu sẽ thấy 2 bar highlighted pop up hẳn lên, còn background và normal bar sẽ hòa màu
#Như vậy sẽ phải vẽ 2 bar highlight riêng ở 1 layer khác trong plot (đè lên)

bg_rect <- data.frame(start = c(0,20,40,60,80), 
                      end = c(20,40,60,80,100), 
                      color = rep(c("#e8f7fc", "#def5fc"), length.out = 5))
bg_rect

#do data vẽ geom_rect khác với geom_col nên phải tách data về từng layer thay vì để chung ở plot ggplot()
#Tiếp tục tìm cách vẽ geo_col cho riêng 2 bar của Brazil và Germany

p1 <- ggplot() +
    geom_col(data = ipsos, mapping = aes(x=Percent, y=Country), fill="black") +
    geom_rect(data = bg_rect, mapping = aes(xmin = start,
                                            xmax = end, 
                                            ymin = 0, 
                                            ymax = 17),
                                            fill = bg_rect$color, alpha=0.8) +
    geom_col(data=ipsos, mapping = aes(x=Percent, y=Country, fill=ifelse(Country %in% c("Brazil", "Germany"), "Highlight", "Normal")), show.legend = F) + 
    scale_fill_manual(values=c("Highlight"="#ff00d2","Normal"="NA"))
p1

#Vẽ line average, một bài viết sử dụng geom_hline() nhưng không giống lắm
#Thử nghiệm geom_segment đơn giản

p1 <- p1 + geom_segment(aes(x=45, y=-1, xend=45, yend=18), 
                  color="#6ca6cd", linewidth=0.5)
p1

#Sửa label của y axis và x axis
#Dùng scale_y_discrete để control là gọn, tuy nhiên không control được thứ tự factor xuất hiện như dưới
#Đồng thời cũng khó để control việc bolder 1 element riêng biệt

p1 + scale_x_continuous(breaks = seq(0, 100, 20)) +
    scale_y_discrete(labels=paste(ipsos$Country, ipsos$Percent)) +
    labs(x=NULL, y=NULL) +
    theme(axis.text.y = element_text(margin=margin(r=-20)),
          panel.grid.major = element_blank(),
          panel.grid.minor = element_blank(),
          )

#Fixed lỗi thứ tự xuất hiện của label
#Tham khảo: https://stackoverflow.com/questions/69678086/using-scale-y-discrete-to-include-variables-in-label-names-reorders-labels-wit
#Lý do: original data.frame is out of sync with what the discrete scale perceives to be the order
#Giải pháp: mutate thêm cột label name trong data.frame ngay trước khi fct_reorder

ggplot() +
    geom_col(data = ipsos, mapping = aes(x=Percent, y=Coulab), fill="black") +
    geom_rect(data = bg_rect, mapping = aes(xmin = start,
                                            xmax = end, 
                                            ymin = 0, 
                                            ymax = 17),
                                            fill = bg_rect$color, alpha=0.8) +
    geom_col(data=ipsos, mapping = aes(x=Percent, y=Coulab, fill=ifelse(Country %in% c("Brazil", "Germany"), "Highlight", "Normal")), show.legend = F) + 
    scale_fill_manual(values=c("Highlight"="#ff00d2","Normal"="NA")) +
    geom_segment(aes(x=45, y=-0.5, xend=45, yend=17.5), 
                  color="#6ca6cd", linewidth=0.5) +
    scale_x_continuous(breaks = seq(0, 100, 20)) +
    labs(x=NULL, y=NULL) +
    theme(axis.text.y = element_text(margin=margin(r=-20)),
          panel.grid.major = element_blank(),
          panel.grid.minor = element_blank(),
          )

#Do đó sẽ sử dụng geom_text
#Nhưng không hiểu vì sao text lại bị hide đi rất kỳ lạ
#Lý do là geom_text vẽ ở vùng ngoài của plot, nên cần phải tăng plot margin lên
#Tham khảo: https://stackoverflow.com/questions/12409960/ggplot2-annotate-outside-of-plot
#Đồng thời tắt clip ở coord_cartesian
p1 + scale_x_continuous(breaks = seq(0, 100, 20)) +
    geom_text(data=ipsos, mapping=aes(x=-5, y=Country, label=paste(Country, Percent)), size=4, hjust=1) +
    labs(x=NULL, y=NULL) +
    coord_cartesian(clip="off") +
    theme(axis.text.y = element_blank(),
          panel.grid.major = element_blank(),
          panel.grid.minor = element_blank(),
          plot.margin = unit(c(1,1,1,4), "lines"),
         )

#Trong version trên chú ý label China 9 trông không được cân đối
#Xử lý bằng cách format lại số percent cho đồng nhất 2 ký tự
#Nhưng do font không phải dạng mono nên dù có add space vào trước trông vẫn lệch

p1 + scale_x_continuous(breaks = seq(0, 100, 20)) +
    geom_text(data=ipsos, mapping=aes(x=-5, y=Country, label=paste(Country, format(Percent, width=2))), size=4, hjust=1) +
    labs(x=NULL, y=NULL) +
    coord_cartesian(clip="off") +
    theme(axis.text.y = element_blank(),
          panel.grid.major = element_blank(),
          panel.grid.minor = element_blank(),
          plot.margin = unit(c(1,1,1,4), "lines"),
         )

#Quay về với cách trông không sạch sẽ cho lắm là add 2 layer geom_text

p1 + scale_x_continuous(breaks = seq(0, 100, 20)) +
    geom_text(data=ipsos, mapping=aes(x=-7, y=Country, label=Country), size=4, hjust=1) +
    geom_text(data=ipsos, mapping=aes(x=-3, y=Country, label=Percent), size=4, hjust=1) +
    labs(x=NULL, y=NULL) +
    coord_cartesian(clip="off") +
    theme(axis.text.y = element_blank(),
          panel.grid.major = element_blank(),
          panel.grid.minor = element_blank(),
          plot.margin = unit(c(1,1,1,4), "lines"),
         )

#Mapping aes fontface bold cho Germany nhanh gọn hơn bằng cách tạo thêm cột trong dataframe
ipsos <- mutate(ipsos,
                highlight_text=ifelse(Country == "Germany", "bold", "plain"))
ipsos

p1 + scale_x_continuous(breaks = seq(0, 100, 20)) +
    geom_text(data=ipsos, mapping=aes(x=-7, y=Country, label=Country, fontface=highlight_text), size=4, hjust=1) +
    geom_text(data=ipsos, mapping=aes(x=-3, y=Country, label=Percent, fontface=highlight_text), size=4, hjust=1) +
    labs(x=NULL, y=NULL) +
    coord_cartesian(clip="off") +
    theme(axis.text.y = element_blank(),
          panel.grid.major = element_blank(),
          panel.grid.minor = element_blank(),
          plot.margin = unit(c(1,1,1,4), "lines"),
         )

#Thử nghiệm thay đổi font
library(extrafont)
loadfonts(device = "win")

p1 + scale_x_continuous(breaks = seq(0, 100, 20)) +
    geom_text(data=ipsos, mapping=aes(x=-7, y=Country, label=Country, fontface=highlight_text), size=4, hjust=1) +
    geom_text(data=ipsos, mapping=aes(x=-3, y=Country, label=Percent, fontface=highlight_text), size=4, hjust=1) +
    labs(x=NULL, y=NULL,
         title="'I Definitely Believe in God or a Supreme Being'",
         subtitle="was said in 2010 in:",
         caption="Source: www.ipsos-na.com, Design: Stefan Fichtel, ixtract") +
    coord_cartesian(clip="off") +
    theme(axis.text.y = element_blank(),
          panel.grid.major = element_blank(),
          panel.grid.minor = element_blank(),
          plot.margin = unit(c(2,1,1,4), "lines"),
          text = element_text(family="Lato"),
          plot.title = element_text(family="Lato Black"),
          plot.caption = element_text(face="italic")
         )

#Add chú thích vào 1 chỗ nếu dùng geom_text khá costly bộ nhớ
#Và phải thêm 1 điểm vào data.frame riêng
#Thông thường nên dùng annotate()
#Tham khảo: https://stackoverflow.com/questions/10952832/ggplot2-is-there-a-fix-for-jagged-poor-quality-text-produced-by-geom-text


p1 + scale_x_continuous(breaks = seq(0, 100, 20)) +
    geom_text(data=ipsos, mapping=aes(x=-7, y=Country, label=Country, fontface=highlight_text, family = "Lato Light"), size=3, hjust=1) +
    geom_text(data=ipsos, mapping=aes(x=-3, y=Country, label=Percent, fontface=highlight_text, family = "Lato Light"), size=3, hjust=1) +
    annotate("text", x=44, y=17.5, label="Average 45", size=2, hjust=1, fontface="italic") +
    annotate("text", x=100, y=17.5, label="All values in percent", size=2, hjust=1, fontface="italic") +
    labs(x=NULL, y=NULL,
         title="'I Definitely Believe in God or a Supreme Being'",
         subtitle="was said in 2010 in:",
         caption="Source: www.ipsos-na.com, Design: Stefan Fichtel, ixtract") +
    coord_cartesian(clip="off") +
    theme(axis.text.y = element_blank(),
          panel.grid.major = element_blank(),
          panel.grid.minor = element_blank(),
          plot.margin = unit(c(2,1,1,4), "lines"),
          text = element_text(family="Lato Light"),
          plot.title = element_text(family="Lato Black"),
          plot.caption = element_text(face="italic")
         )

ggsave("6.1.1 Bar Chart Simple.svg", last_plot(), device=svg, width = 20, height = 12, units="cm")

ggsave("6.1.1 Bar Chart Simple.png", last_plot(), device=png, width = 20, height = 12, units="cm", bg="white")

Final result

!AWESOME! (below image is in svg type, so you can open it in a separate tab and zoom it in)

Debugging error

Thật là mệt mỏi khi phải gọi ipsos ở mỗi geom, nguyên nhân vì nếu để dataset ở plot (ggplot), thì ở geom_rect sẽ xuất hiện lỗi:

! Problem while computing aesthetics.
ℹ Error occurred in the 1st layer.
Caused by error in `FUN()`:
! object 'Percent' not found

Vấn đề này gây ra bởi geom_rect sẽ kế thừa (inherit) aesthetics từ plot (cụ thể là ipsos) rồi mới bắt đầu tính toán/mapping aes của bg_rect. Có 2 cách xử lý, ở đây chọn cách số 2:

• set lại mapping x=NULL, y=NULL trước khi mapping vào bg_rect dataframe
• thêm para: inherit.aes = FALSE

Tuy nhiên vấn đề lại xuất hiện khi add thêm các layer geom sau geom_rect này, lỗi:

ERROR while rich displaying an object: Error: Discrete value supplied to continuous scale

Tham khảo How To Fix The R Error: discrete value supplied to continuous scale thì lỗi này gây nên có thể do:

• Ở plot đầu tiên - layer 0, y = Country là mapping y với một discrete value (ở đây là factor, thông qua fct_reorder)
• Ở layer geom_rect thứ 2, việc vẽ rectangle hoặc một đoạn thẳng với xmin/ymin to xmax/ymax khiến axis y trở thành continuous scale
• Tiếp tục ở layer thứ 3, nếu thêm geom_col, hoặc chỉ cần geom_point, data được inherit từ plot - layer 0, vốn vẫn là discrete cho biến y, nhưng lại “supplied” cho axis y hiện đã là continous
• Giải pháp cần phải sửa ymin & ymax thành discrete để bảo toàn tính chất của y-axis
• Cụ thể sẽ set ymin=ipsos$Country[1] là phần tử đầu tiên, ymax = Country[length(Country)]) là phần tử cuối cùng của Country. (Lý do vì sao dùng x[length(x)] để gọi phần tử cuối cùng, tham khảo stackoverflow. Thật kỳ lạ là không thể gọi x[-1] như python)
• Trong R, nếu gọi c[-1] sẽ trả về vector c() bỏ đi phần tử thứ 1

Nhìn lại thì dataframe bg_rect rõ ràng có thể tính toán và gọi từ ipsos, ngay từ đầu khi tìm hiểu tôi đã bị đi sai theo hướng của bài post này. Tham khảo thêm nguồn này thì thấy cách dùng annotate cho các layer không liên quan tới data là hay nhất.

Đồng thời phát hiện ra việc set ymin/max thành +-Inf không làm thay đổi thuộc tính discrete/continuous của y-axis

Sửa lại:

ggplot(ipsos, aes(x=Percent, y=Country)) +
    annotate("rect", xmin=seq(0,80,20), xmax=seq(20,100,20),
                  ymin = -Inf,  ymax = +Inf, fill=rep(c("#e8f7fc", "#def5fc"), length.out = 5)) +
    geom_col()

FINAL OF FINAL

Here is my final version, which looks cleaner than the previous one.

#Try my plot in the neat way
ggplot(ipsos, aes(x=Percent, y=Coulab)) +
    geom_col(fill="black") +
    annotate("rect", xmin=seq(0,80,20), xmax=seq(20,100,20),
                  ymin = -0.5,  ymax = +17, fill=rep(c("#e8f7fc", "#def5fc"), length.out = 5), alpha=0.8) +
    geom_col(aes(fill=ifelse(Country %in% c("Brazil", "Germany"), "Highlight", "Normal")), show.legend = F) +
    scale_fill_manual(values=c("Highlight"="#ff00d2","Normal"="NA")) +
    geom_segment(aes(x=45, y=-1.5, xend=45, yend=+18), color="#6ca6cd", linewidth=0.5) +
    annotate("text", x=44, y=17.5, label="Average 45", size=2, hjust=1, fontface="italic") +
    annotate("text", x=100, y=17.5, label="All values in percent", size=2, hjust=1, fontface="italic") +
    scale_x_continuous(breaks = seq(0, 100, 20)) +
    scale_y_discrete() +
    labs(x=NULL, y=NULL,
         title="'I Definitely Believe in God or a Supreme Being'",
         subtitle="was said in 2010 in:",
         caption="Source: www.ipsos-na.com, Design: Stefan Fichtel, ixtract") +
    theme(axis.text.y = element_text(face = ifelse(levels(ipsos$Coulab) == "Germany 27", "bold", "plain")),
          panel.grid.major = element_blank(),
          panel.grid.minor = element_blank(),
          text = element_text(family="Lato"),
          plot.title = element_text(family="Lato Black"),
          plot.caption = element_text(face="italic"),
          )