让我们定义一个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)