【原】让我们定义一个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./post/2016/03/24/github-style-waffle-plots-in-r/