前言

ggpol 是 ggplot2 的一個(gè)擴(kuò)展包亿汞，添加了一些圖形。主要可以繪制 parliament diagrams（議會(huì)圖），也可以方便的繪制金字塔圖桐早，以及箱線圖和散點(diǎn)圖的混合等逊笆。

下面我們簡(jiǎn)要介紹一下如何使用 ggpol 繪制對(duì)應(yīng)的圖形栈戳。

使用

安裝導(dǎo)入，推薦安裝開(kāi)發(fā)版难裆，功能更全

# 從 bioconductor 安裝
BiocManager::install("ggpol")

# 從 CRAN 安裝
install.packages("ggpol")

# 安裝開(kāi)發(fā)版
if (!require(devtools)) {
    install.packages('devtools')
}
devtools::install_github('erocoar/ggpol')

library(ggpol)

1. 半圓弧形柱狀圖

使用 geom_arcbar 可以繪制只有 180 度子檀，也就是半圓的圓弧形條形圖镊掖。

其中 aes 函數(shù)中的 參數(shù)：

• shares：與扇形的大小成正比，
• r0：指定圓弧的內(nèi)半徑褂痰，
• r1：指定圓弧的外半徑

還有其他參數(shù) color亩进、fill、linetype缩歪、alpha 用于指定顏色归薛、線型和透明度。

data <- tibble(
  months = factor(month.name, levels = month.name),
  sales = sample(30:90, 12),
  colors = RColorBrewer::brewer.pal(12, "Paired")
)

ggplot(data) +
  geom_arcbar(aes(shares = sales, r0 = 6, r1 = 10, fill = month.name), sep = 0.1) +
  scale_fill_manual(values = data$colors) +
  coord_fixed() +
  theme_void()

2. Parliament diagrams

geom_parliament 可以繪制 parliament diagrams匪蝙，該圖像類似于半圓形的弧形柱狀圖主籍。使用 seats 參數(shù)來(lái)設(shè)置，以點(diǎn)來(lái)表示每個(gè)分組的成員骗污。

data <- tibble(
  months = factor(month.name, levels = month.name),
  sales = sample(1:100, 12),
  colors = RColorBrewer::brewer.pal(12, "Paired")
)

ggplot(data) +
  geom_parliament(aes(seats = sales, fill = month.name)) +
  scale_fill_manual(values = data$colors, labels = month.name) +
  coord_fixed() +
  theme_void()

3. 條形圖文本注釋

使用 geom_bartext 為條形圖添加文本信息崇猫，可以避免文本之間的重疊。如果文本之間存在堆疊需忿，會(huì)在水平或豎直方向添加偏移來(lái)避免文本重疊诅炉。

目前在開(kāi)發(fā)版中的具有較好的展示，穩(wěn)定版可能在某些情況下交疊的文本無(wú)法分開(kāi)屋厘。

geom_bartext 接受與 geom_text 一樣的參數(shù)涕烧，還有一個(gè) dir 參數(shù)，可選的值為 h 和 v汗洒，分別表示在水平和豎直方向添加偏移议纯。

spacing 參數(shù)可以設(shè)置文本之間的最小間隔，單位為 NPC

df <- tibble(
  L = rep(LETTERS[1:2], each = 4),
  l = rep(letters[1:4], 2),
  val = c(96.5, 1, 2, 0.5, 48, 0.7, 0.3, 51)
)

p1 <- ggplot(df, aes(x = L, y = val, fill = l)) +
  geom_bar(stat = "identity") +
  geom_text(aes(label = scales::percent(val / 100)), position = position_stack(vjust = 0.5)) +
  ggtitle("GeomText")

p2 <- ggplot(df, aes(x = L, y = val, fill = l)) +
  geom_bar(stat = "identity") +
  geom_bartext(aes(label = scales::percent(val / 100)), position = position_stack(vjust = 0.5)) +
  ggtitle("GeomBartext")

p1 + p2

4. 圓形

geom_circle 可以繪制指定半徑的圓溢谤，而不是像 geom_point 函數(shù)中設(shè)置 size 參數(shù)瞻凤。

data.frame(x = sample(1:10, 6), y = sample(1:10, 6),
           r = sample(1:2, 6, replace = TRUE)) %>%
  ggplot() + geom_circle(aes(x = x, y = y, r = r, fill = gl(6, 1))) +
  coord_fixed()

5. 時(shí)序高亮

geom_tshighlight 可以用來(lái)高亮?xí)r間序列中的一個(gè)時(shí)段，是對(duì) geom_rect 的封裝世杀，

ggplot(economics, aes(x = date, y = unemploy)) +
  geom_line() +
  geom_tshighlight(
    aes(xmin = as.Date("01/01/1990", format = "%d/%m/%Y"), 
        xmax = as.Date("01/01/2000", format = "%d/%m/%Y")),
    alpha = 0.005, fill = "blue"
  )

6. geom_boxjitter

geom_boxjitter 用于繪制混合的箱線圖：一半箱線圖和一半 jitter 散點(diǎn)圖阀参，以及可選的誤差線。

如果要設(shè)置點(diǎn)的填充色瞻坝， 則需要指定 jitter.shape 為 21-25

df <- data.frame(
  score = rgamma(150, 4, 1), 
  gender = sample(c("M", "F"), 150, replace = TRUE), 
  genotype = factor(sample(1:3, 150, replace = TRUE))
)

ggplot(df) + 
  geom_boxjitter(aes(x = genotype, y = score, fill = gender),
                 jitter.shape = 21, jitter.color = NA, 
                 jitter.params = list(height = 0, width = 0.04),
                 outlier.color = NA, errorbar.draw = TRUE) +
  scale_fill_manual(values = c("#fb8072", "#80b1d3")) +
  theme_minimal()

如果我們關(guān)注離群點(diǎn)蛛壳，想對(duì)這些點(diǎn)進(jìn)行高亮，可以設(shè)置 outlier.intersect = TRUE所刀，并用 outlier.shape 和 outlier.size 來(lái)設(shè)置點(diǎn)的形狀和大小

ggplot(df) + 
  geom_boxjitter(aes(x = genotype, y = score, fill = gender),
                 jitter.shape = 21, jitter.color = NA, 
                 jitter.params = list(height = 0, width = 0.04),
                 outlier.color = "black", errorbar.draw = TRUE,
                 outlier.intersect = TRUE, outlier.shape = 24,
                 outlier.size = 1.5) +
  scale_fill_manual(values = c("#fb8072", "#80b1d3")) +
  theme_minimal()

如果將 boxplot.expand 參數(shù)設(shè)置為 TRUE衙荐，則會(huì)隱藏 jitter 點(diǎn)圖，其功能就類似于 geom_boxplot 繪制完整的箱線圖浮创，但添加了誤差線

ggplot(df) + 
  geom_boxjitter(aes(x = genotype, y = score, fill = gender),
                 errorbar.draw = TRUE, boxplot.expand = TRUE,
                 errorbar.length = 0.4, varwidth = TRUE) +
  scale_fill_manual(values = c("#fb8072", "#80b1d3")) +
  theme_minimal()

7. 混淆矩陣

geom_confmat 可以用于繪制混淆矩陣忧吟，本質(zhì)上就是一個(gè)熱圖。

x <- sample(LETTERS[seq(4)], 50, replace = TRUE)
y <- sample(LETTERS[seq(4)], 50, replace = TRUE)

ggplot() + 
  geom_confmat(aes(x = x, y = y), normalize = TRUE, text.perc = TRUE)

8. 軸共享分面

facet_share 用于生成具有共享軸標(biāo)簽的分面圖斩披，由于該函數(shù)只是實(shí)驗(yàn)性的溜族，目前只支持兩個(gè)分面共享同一個(gè)軸胸嘴。

如果想要將軸以鏡像的方式放置，需要將其中一個(gè)分面乘上 -1斩祭，如果想要水平方式，則將放置在左邊的分面乘上 -1乡话，如果是豎直放置摧玫，則將下面的分面乘上 -1。但是這樣會(huì)改變軸標(biāo)簽绑青，需要設(shè)置 reverse_num = TRUE

可以用來(lái)展示對(duì)稱的人口金字塔圖

df <- data.frame(sex = sample(c("M", "F"), 1000, replace = TRUE),
                 age = rnorm(1000, 45, 12))

df$age_bins <- cut(df$age, 15)
df$count <- 1
df <- aggregate(count ~ sex + age_bins, data = df, length)


df_h <- df
df_h$count <- ifelse(df_h$sex == "F", df_h$count * -1, df_h$count)

ggplot(df_h, aes(x = age_bins, y = count, fill = sex)) + 
  geom_bar(stat = "identity") +
  facet_share(~sex, dir = "h", scales = "free", reverse_num = TRUE) + 
  coord_flip() +
  scale_fill_manual(values = c("#fb8072", "#80b1d3"))

如果想要豎直放置诬像，需要對(duì)第二個(gè)因子乘以 -1

df_v <- df
df_v$count <- ifelse(df_v$sex == levels(factor(df_v$sex))[2], df_v$count * -1, df_v$count)

ggplot(df_v, aes(x = age_bins, y = count, fill = sex)) + 
  geom_bar(stat = "identity") +
  facet_share(~sex, dir = "v", scales = "free", reverse_num = TRUE)

但是運(yùn)行上面的代碼，我得到了一行報(bào)錯(cuò)信息

 Error in unit(c(axes$x$bottom[[1]]$children$axis$heights[[tick_idx]],  : 
  'list' object cannot be coerced to type 'double' 

是類型轉(zhuǎn)換出現(xiàn)了問(wèn)題闸婴。通過(guò)下載閱讀源碼進(jìn)行試調(diào)坏挠，找到報(bào)錯(cuò)的代碼所在文件（facet_share.R），在代碼前添加一行打印命令

print(axes$x$bottom[[1]]$children$axis$heights[[tick_idx]])
shared_axis <- gtable::gtable_matrix(
          "shared.ax.x", shared_axis,
          widths = unit(1, "npc"),
          heights = unit(c(axes$x$bottom[[1]]$children$axis$heights[[tick_idx]], 1,
                           axes$x$bottom[[1]]$children$axis$heights[[tick_idx]]),
                         c("pt", "grobwidth", "pt"),
                         list(NULL, axes$x$bottom[[1]]$children$axis$grobs[[lab_idx]], NULL)),
          clip = "off")

同時(shí)邪乍，重新加載函數(shù)降狠，還要收到導(dǎo)入用到的包

library(grid)
library(rlang)

source("Downloads/facet_share.R")
ggplot(df_v, aes(x = age_bins, y = count, fill = sex)) + 
  geom_bar(stat = "identity") +
  facet_share(~sex, dir = "v", scales = "free", reverse_num = TRUE)

打印出了

2.75points 

是一個(gè) unit 對(duì)象，也就是坐標(biāo)系統(tǒng)的度量單位庇楞。通過(guò)查閱 unit 函數(shù)榜配，發(fā)現(xiàn)函數(shù)的第一個(gè)參數(shù)需要傳入一個(gè)數(shù)值向量，也就是說(shuō)

c(axes$x$bottom[[1]]$children$axis$heights[[tick_idx]], 1,
                           axes$x$bottom[[1]]$children$axis$heights[[tick_idx]])

必須是一個(gè)數(shù)值向量吕晌，我們?cè)俅蛴】纯?/p>

source("Downloads/facet_share.R")
ggplot(df_v, aes(x = age_bins, y = count, fill = sex)) + 
  geom_bar(stat = "identity") +
  facet_share(~sex, dir = "v", scales = "free", reverse_num = TRUE)

輸出了一個(gè)嵌套的 list

[[1]]
[[1]][[1]]
[1] 2.75

[[1]][[2]]
NULL

[[1]][[3]]
[1] 8


[[2]]
[1] 1

[[3]]
[[3]][[1]]
[1] 2.75

[[3]][[2]]
NULL

[[3]][[3]]
[1] 8

問(wèn)題就在這里蛋褥，數(shù)值 1 肯定不會(huì)錯(cuò)，錯(cuò)的應(yīng)該是另外兩個(gè) unit 對(duì)象睛驳，可以嘗試將這兩個(gè)對(duì)象轉(zhuǎn)換為數(shù)值型烙心。將 heights 的值改為

heights = unit(c(as.numeric(axes$x$bottom[[1]]$children$axis$heights[[tick_idx]]), 1,
                           as.numeric(axes$x$bottom[[1]]$children$axis$heights[[tick_idx]])),
                         c("pt", "grobwidth", "pt"),
                         list(NULL, axes$x$bottom[[1]]$children$axis$grobs[[lab_idx]], NULL))

再運(yùn)行代碼，就得到了我們想要的圖形了乏沸。

source("Downloads/facet_share.R")
ggplot(df_v, aes(x = age_bins, y = count, fill = sex)) + 
  geom_bar(stat = "identity") +
  facet_share(~sex, dir = "v", scales = "free", reverse_num = TRUE)

標(biāo)簽都擠到一塊了淫茵，將其旋轉(zhuǎn) 90 度，刻度線也不要了

ggplot(df_v, aes(x = age_bins, y = count, fill = sex)) + 
  geom_bar(stat = "identity") +
  facet_share(~sex, dir = "v", scales = "free", reverse_num = TRUE) +
  theme(axis.text = element_text(angle = 90, size = 6), axis.ticks.length.x = unit(0, "cm"))

但是下面的空白有點(diǎn)大屎蜓，再設(shè)置一下痘昌。只需先獲取 ggplot 對(duì)象，然后設(shè)置對(duì)象的高度就行

p <- ggplot(df_v, aes(x = age_bins, y = count, fill = sex)) + 
  geom_bar(stat = "identity") +
  facet_share(~sex, dir = "v", scales = "free", reverse_num = TRUE) +
  theme(axis.text = element_text(angle = 90, size = 6), axis.ticks.length.x = unit(0, "cm"))

gp <- ggplotGrob(p)
gp$heights[15] <- unit(0, 'cm')

grid.newpage()
grid.draw(gp)

嗯炬转，這樣就好多了辆苔。

你可能要問(wèn)，為什么我能知道要設(shè)置 15 個(gè)扼劈，哈哈哈驻啤，我也是通過(guò)觀察和不斷的嘗試。先打印圖形對(duì)象的高度屬性荐吵，發(fā)現(xiàn)是一個(gè)數(shù)值向量

> gp$heights
 [1] 5.5points                          0cm                                0cm                               
 [4] 0cm                                0cm                                0cm                               
 [7] 0.59683986336016cm                 1null                              sum(0.456897744568977cm, 11points)
[10] 0cm                                5.5points                          0cm                               
[13] 0.59683986336016cm                 1null                              1.08935240677321cm                
[16] 1grobheight                        0cm                                0points                           
[19] 5.5points 

看到第 15 個(gè)值是最大的骑冗，與圖形下面間距最大相符赊瞬，所以蠻設(shè)置看下。然后就行了贼涩。