写在前面

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

华夫饼干图

在本文中，我将展示如何使用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 1day = 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 dateselect(-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 palettedirection = dir,  # Variable color directionna.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/

猜你喜欢

10000+：菌群分析 宝宝与猫狗 梅毒狂想曲 提DNA发Nature Cell专刊 肠道指挥大脑

系列教程：微生物组入门 Biostar 微生物组  宏基因组

专业技能：学术图表 高分文章 生信宝典 不可或缺的人

一文读懂：宏基因组 寄生虫益处 进化树

必备技能：提问 搜索  Endnote

文献阅读 热心肠 SemanticScholar Geenmedical

扩增子分析：图表解读 分析流程 统计绘图

16S功能预测   PICRUSt  FAPROTAX  Bugbase Tax4Fun

在线工具：16S预测培养基 生信绘图

科研经验：云笔记  云协作 公众号

编程模板: Shell  R Perl

生物科普:  肠道细菌 人体上的生命 生命大跃进  细胞暗战 人体奥秘

写在后面

为鼓励读者交流、快速解决科研困难，我们建立了“宏基因组”专业讨论群，目前己有国内外5000+ 一线科研人员加入。参与讨论，获得专业解答，欢迎分享此文至朋友圈，并扫码加主编好友带你入群，务必备注“姓名-单位-研究方向-职称/年级”。PI请明示身份，另有海内外微生物相关PI群供大佬合作交流。技术问题寻求帮助，首先阅读《如何优雅的提问》学习解决问题思路，仍未解决群内讨论，问题不私聊，帮助同行。

学习16S扩增子、宏基因组科研思路和分析实战，关注“宏基因组”

点击阅读原文，跳转最新文章目录阅读