华夫饼图:可视化展示利器(ggplot版本)

写在前面

不知何时起，我总是喜欢在推文前面写上写在前面，可能是表达我的一种心境吧。在家里的日子在不断的测试和完善流程，每当我累了的时候，总想去gogle找一些新鲜东西，然后修改，适最后合自己的模子，变成对自己功能强大的样子，慢慢的这种方式变成了习惯。

华夫饼干图

在本文中，我将展示如何使用ggplot2绘图包在R中创建各种样式的“华夫饼”图。我定义了超过物种华夫饼图的元素，这些元素当然都会来自ggplot和相关的R包，然后修改了一个gihub上的函数，用于出图，因为后面微生物领域需要哟一些华夫饼图的需求，所以我这里做了一些尝试，希望可以有一些思考。

首先，我将为模拟数据创建一个数据框，初始化数据类型：

library(dplyr)
d <- data_frame(
  date = as.Date(1:813, origin = "2018-01-01"),
  year = format(date, "%Y"),
  week = as.integer(format(date, "%W")) + 1,  # Week starts at 1
  day = factor(weekdays(date, TRUE),
               levels = rev(c("周一","周二","周三","周四","周五","周六","周日"))),
  hours = 0)
d

## # A tibble: 813 x 5
##    date       year   week day   hours
##    <date>     <chr> <dbl> <fct> <dbl>
##  1 2018-01-02 2018      2 周二      0
##  2 2018-01-03 2018      2 周三      0
##  3 2018-01-04 2018      2 周四      0
##  4 2018-01-05 2018      2 周五      0
##  5 2018-01-06 2018      2 周六      0
##  6 2018-01-07 2018      2 周日      0
##  7 2018-01-08 2018      3 周一      0
##  8 2018-01-09 2018      3 周二      0
##  9 2018-01-10 2018      3 周三      0
## 10 2018-01-11 2018      3 周四      0
## # ... with 803 more rows

然后模拟每个日期的工作时间。我将模拟周末和工作日分别工作的小时数，以使生成的数据更加真实，并模拟数据的缺失值（即没有工作的天数）。

set.seed(1)
# Simulate weekends
weekends <- dplyr::filter(d, grepl("S(at|un)", day))
# Hours worked are (might be) poisson distributed
weekends$hours <- rpois(nrow(weekends), lambda = 4)
# Simulate missing days with probability .7
weekends$na <- rbinom(nrow(weekends), 1, 0.7)
weekends$hours <- ifelse(weekends$na, NA, weekends$hours)
# Simulate weekdays
weekdays <- filter(d, !grepl("S(at|un)", day))
weekdays$hours <- rpois(nrow(weekdays), lambda = 8)  # Greater lambda
weekdays$na <- rbinom(nrow(weekdays), 1, 0.1)  # Smaller p(missing)
weekdays$hours <- ifelse(weekdays$na, NA, weekdays$hours)
# Concatenate weekends and weekdays and arrange by date
d <- bind_rows(weekends, weekdays) %>%
    arrange(date) %>%  # Arrange by date
    select(-na)  # Remove na column
d

## # A tibble: 813 x 5
##    date       year   week day   hours
##    <date>     <chr> <dbl> <fct> <int>
##  1 2018-01-02 2018      2 周二     NA
##  2 2018-01-03 2018      2 周三      7
##  3 2018-01-04 2018      2 周四      8
##  4 2018-01-05 2018      2 周五     NA
##  5 2018-01-06 2018      2 周六     NA
##  6 2018-01-07 2018      2 周日     12
##  7 2018-01-08 2018      3 周一     13
##  8 2018-01-09 2018      3 周二      9
##  9 2018-01-10 2018      3 周三      9
## 10 2018-01-11 2018      3 周四      4
## # ... with 803 more rows

华夫饼图功能函数

然后，我将创建一个绘制华夫饼图的函数。如果您具有类似的结构化数据，则可以复制粘贴该函数并将其用于数据）。

library(ggplot2)
library(viridis)  # Color palette
library(ggthemes)
library(ggcor)
gh_waffle <- function(data, pal = "D", dir = -1,type = 21){
    
    p <- ggplot(data, aes(x = week, y = day, fill = hours)) +
        scale_fill_viridis(name="Hours",
                           option = pal,  # Variable color palette
                           direction = dir,  # Variable color direction
                           na.value = "grey93",
                           limits = c(0, max(data$hours))) +
        # geom_tile(color = "white", size = 0.4) +
        facet_wrap("year", ncol = 1) +
        scale_x_continuous(
            expand = c(0, 0),
            breaks = seq(1, 52, length = 12),
            labels = c("Jan", "Feb", "Mar", "Apr", "May", "Jun",
                       "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")) +
        theme_tufte(base_family = "Helvetica") +
        theme(axis.title = element_blank(),
              axis.ticks = element_blank(),
              legend.position = "bottom",
              legend.key.width = unit(1, "cm"),
              strip.text = element_text(hjust = 0.01, face = "bold", size = 12))
    
    #圆形
if(type == 21){p = p +geom_point(color = "white", size = 4,pch = 21) }
#方形
if(type == 22){p = p +geom_point(color = "white", size = 3,pch = 22)}
#菱方形
if(type == 23){p = p +geom_point(color = "white", size = 3,pch = 23) }
#上三角
if(type == 24){p = p +geom_point(color = "white", size = 3,pch = 24) }
#下三角
if(type == 25){p = p +geom_point(color = "white", size = 3,pch = 25) }
#星形状图
if(type == "star"){p = p +geom_star() }
#饼图
if(type == "pie2"){p = p + geom_pie2(size = 0.5) }
    
    
    print(p)
}

使用华夫饼图功能

gh_waffle()接受三个参数，第一个data是具有以下列的数据框date：（类型：日期），year（数字或字符），week（数字），day（使日期从图的顶部到底部连续的有序因素）和hours（数字） 。第二个选项来pal指定由所使用的四个色调色板一个viridis，并且可以是“A”，“B”，“C”，或“D”。默认值为“ D”，这也是GitHub所使用的。最后一个选项dir指定色标的方向，可以是-1或1。GitHub的默认值为-1。

使用gh_waffle()默认设置，仅提供数据框d，将得到以下结果：

gh_waffle(d,pal = "D", dir = -1,type = 21)

方形

gh_waffle(d,pal = "D", dir = -1,type = 22)

菱形华夫饼图

gh_waffle(d,pal = "D", dir = -1,type = 23)

三角形华夫饼图

gh_waffle(d,pal = "D", dir = -1,type = 24)

gh_waffle(d,pal = "D", dir = -1,type = 25)

五角星的华夫饼图

厚哥的包，让我们可以使用五角星的华夫饼图

gh_waffle(d,pal = "D", dir = -1,type = "star")

饼图类型华夫饼图

gh_waffle(d,pal = "D", dir = -1,type = "pie2")

尝试不同配色方案

for (pal in c("A", "B", "C")) {
    gh_waffle(d,pal, dir = -1,type = "star")
}

reference

https://vuorre.netlify.com/post/2016/03/24/github-style-waffle-plots-in-r/