前言

我們前面所介紹的圖形，基本上都是在笛卡爾坐標系上的圖形乳蛾。

今天，我們要介紹幾種繪制在極坐標上的圖形

南丁格爾玫瑰圖

南丁格爾玫瑰圖，即笛卡爾坐標系中的柱狀圖轉(zhuǎn)換為極坐標系之后的圖形像云。

因此，柱形會被拉伸為扇形蚂夕，堆積柱狀圖也就是堆積扇形圖迅诬，適用于比較大小相近的數(shù)值，x 軸為周期性變量的情況

示例

單數(shù)據(jù)型

count(mpg, class) %>%
  ggplot(aes(x = class, y = n)) +
  geom_col(aes(fill = class)) +
  geom_text(aes(y = n - 3, label = n), colour = "white") +
  coord_polar(theta = "x", start = 0) + 
  theme(
    panel.background = element_blank(),
    panel.grid.major = element_line(colour = "grey80",size=.25),
    axis.text.x=element_text(size = 13,colour="black", angle = seq(-20,-340, length.out = 7)),
    axis.ticks.y = element_blank(),
    axis.text.y = element_blank(),
    axis.title = element_blank(),
    legend.position = "none"
  )

堆積型

count(mpg, class, drv) %>%
  ggplot(aes(x = class, y = n))
  geom_col(aes(fill = drv)) +
  geom_text(aes(y = n - 3, label = n), colour = "white") +
  coord_polar(theta = "x", start = 0) + 
  theme(
    panel.background = element_blank(),
    panel.grid.major = element_line(colour = "grey80",size=.25),
    axis.text.x=element_text(size = 13,colour="black", angle = seq(-20,-340, length.out = 7)),
    axis.ticks.y = element_blank(),
    axis.text.y = element_blank(),
    axis.title = element_blank(),
    legend.position = "none"
  )

徑向柱狀圖

徑向柱狀圖也稱為圓形柱狀圖或星圖婿牍。

我們從 cBioPortal 網(wǎng)站下載了結(jié)直腸癌的一份 2015 年的 29 個樣本數(shù)據(jù)侈贷，然后提取突變基因與樣本信息。

https://github.com/dxsbiocc/learn/blob/main/data/mutation/data_mutations_mskcc.txt

我們提取突變頻率大于 3 的基因等脂，繪制單組徑向柱狀圖如下

df <- read_delim("~/Downloads/coad_caseccc_2015/data_mutations_mskcc.txt", delim = "\t")

select(df, Tumor_Sample_Barcode, Hugo_Symbol) %>%
  count(df, Hugo_Symbol) %>%
  filter(n > 3) %>%
  arrange(n) %>%
  ggplot(aes(Hugo_Symbol, n, fill = Hugo_Symbol)) +
  geom_col() +
  geom_text(aes(y = n - 2, label = n), colour = "white") +
  coord_polar(start = 0) +
  ylim(c(-10, 35)) +
  theme(
    panel.background = element_blank(),
    panel.grid.major = element_line(colour = "grey80",size=.25),
    axis.text.x = element_text(size = 9, colour="black", angle = seq(-10, -350, length.out = 27)),
    axis.ticks.y = element_blank(),
    axis.text.y = element_blank(),
    axis.title = element_blank(),
    legend.position = "none"
  )

我們根據(jù)突變頻率對基因進行排序俏蛮，只要做如下修改就行

ggplot(aes(factor(Hugo_Symbol, levels = Hugo_Symbol), n, fill = Hugo_Symbol))

那如果想要繪制多分組數(shù)據(jù)，要怎么做呢上遥？

這份數(shù)據(jù)實在是畫不出來效果搏屑，所以手動構(gòu)建了一份基因突變數(shù)據(jù)

# 設(shè)置空白柱子的個數(shù)
empty_bar = 2
# 自定義突變類型
mut_type <- c("Ins", "Del", "Mismatch", "Silent")
# 構(gòu)造數(shù)據(jù)
data <- tibble(
  gene=paste( "Gene ", seq(1,60), sep=""),
  group=c(rep('Ins', 10), rep('Mismatch', 30), rep('Del', 14), rep('Silent', 6)) ,
  value=sample(seq(10,100), 60, replace=T)
) %>%
  # 添加 NA 數(shù)據(jù)，用于在分組之間繪制空白柱形
  add_row(tibble(
    gene = rep(NA, empty_bar * length(mut_type)),
    group = rep(mut_type, empty_bar),
    value = gene
  )) %>%
  mutate(group = factor(group, levels = mut_type)) %>%
  # 排序粉楚，為了讓統(tǒng)一分組繪制在一起
  arrange(group)

# 構(gòu)造唯一標識睬棚，用作 x 軸，并按該順序繪制
data$id = 1:nrow(data)
# 添加顯示文本的角度
angle <- 90 - 360 * (data$id - 0.5) / nrow(data)
# 添加內(nèi)圈注釋
base_anno <- group_by(data, group) %>%
  summarise(start = min(id), end = max(id) - empty_bar) %>%
  mutate(mid = (start + end) / 2)
  
ggplot(data, aes(id, value, fill = group)) +
  geom_col(position = position_dodge2()) +
  geom_text(aes(y = value + 18, label = gene), size = 2.5, alpha = 0.6, 
            angle = ifelse(angle < -90, angle+180, angle)) +
  # 內(nèi)圈注釋
  geom_segment(data = base_anno, aes(x = start, y = -5, xend = end, yend = -5),
               colour = "grey40") +
  geom_text(data = base_anno, aes(x = mid, y = -18, label = group), 
            angle = c(-26, -100, -50, 26), colour = "grey40") +
  coord_polar() +
  ylim(-100,120) +
  theme(
    panel.background = element_blank(),
    axis.text = element_blank(),
    axis.ticks = element_blank(),
    axis.title = element_blank(),
    panel.grid = element_blank(),
  )

是不是也很簡單解幼。不對抑党，好像還是有點復(fù)雜的，但是還是很容易理解的撵摆。

繪制徑向熱力圖底靠，我們使用了比特幣從 2015-2018 年的價格數(shù)據(jù)

https://github.com/dxsbiocc/learn/blob/main/data/bit_data.csv

bit_data <- read_csv("~/Downloads/bit_data.csv")

group_by(bit_data, year, month) %>%
  summarise(value = mean(High), .groups = "drop") %>%
  ggplot(aes(factor(month), year, fill = value)) +
  geom_tile(width = 1, colour = "white") +
  coord_polar() +
  ylim(c(2010, 2020)) +
  scale_fill_gradientn(colours = rainbow(10)) +
  theme(
    panel.background = element_blank(),
    panel.grid.major = element_line(colour = "grey80",size=.25),
    axis.text.x = element_text(size = 9, colour="black", angle = seq(-10, -350, length.out = 12)),
    axis.ticks.y = element_blank(),
    axis.text.y = element_blank(),
    axis.title = element_blank()
  )

從內(nèi)圈到外圈，依次代表 2015-2018 年特铝，每圈有 12 段代表月份暑中，顏色深淺代表價格

我們還可以將每個年份數(shù)據(jù)分開壹瘟，同時還添加了一些隨機擾動，代表一些未知因素鳄逾。

group_by(bit_data, year, month) %>%
  summarise(value = mean(High)) %>%
  mutate(
    xmin = month,
    xmax = month + 1,
    ymin = (year - 2015) * 10 + 1,
    ymax = ymin + sample(1:5, n(), replace = TRUE)
    ) %>%
  ggplot(aes(fill = value)) +
  geom_rect(aes(xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax)) +
  scale_x_continuous(breaks = seq(1.5, 12.5, 1), labels = month.name) +
  scale_fill_gradientn(colours = rainbow(10)) +
  coord_polar() +
  ylim(c(-5, 40)) +
  theme(
    panel.background = element_blank(),
    panel.grid.major = element_line(colour = "grey80",size=.25),
    axis.text.x = element_text(size = 9, colour="black", angle = seq(-10, -350, length.out = 12)),
    axis.ticks.y = element_blank(),
    axis.text.y = element_blank(),
    axis.title = element_blank()
  )

哈哈稻轨，圖形看起來又不大一樣了。

代碼：
https://github.com/dxsbiocc/learn/blob/main/R/plot/polar_bar.R