18 Cir-bar

18.1 PKG

Show/Hide Code

library(tidyverse) # 数据处理和可视化
library(hrbrthemes) # 主题和字体
# library(kableExtra) # 表格美化
library(viridis) # 色彩映射

18.2 基础

18.2.1 定义

极坐标条形图：各国武器销售情况, 这里没有显示 Y 轴刻度，因为每个条形上都标注了确切数值。

Show/Hide Code

# 从github加载数据集
data <- read_csv(
    "https://raw.githubusercontent.com/holtzy/data_to_viz/master/Example_dataset/7_OneCatOneNum.csv"
)

# 对数据进行排序和预处理
tmp <- data |>
    filter(!is.na(Value)) |> # 过滤掉Value为NA的行
    arrange(desc(Value)) |>  # 按Value降序排列
    mutate(Country = factor(Country, Country)) # 将Country设置为因子，顺序与数据一致

# 设置空白条的数量，用于美化图形
empty_bar = 10

# 添加空白行到数据末尾
to_add = matrix(NA, empty_bar, ncol(tmp))
colnames(to_add) = colnames(tmp)
tmp = rbind(tmp, to_add)
tmp$id = seq(1, nrow(tmp)) # 为每一行添加唯一id

# 获取每个标签的名称和y轴位置
label_tmp = tmp
number_of_bar = nrow(label_tmp)
# 计算每个标签的角度，使标签位于条形中心
angle = 90 - 360 * (label_tmp$id - 0.5) / number_of_bar
label_tmp$hjust <- ifelse(angle < -90, 1, 0) # 角度小于-90时右对齐，否则左对齐
label_tmp$angle <- ifelse(angle < -90, angle + 180, angle) # 角度小于-90时加180度，保证文字正向
label_tmp$Country <- gsub("United States", "US", label_tmp$Country) # 替换国家名
label_tmp$Country <- paste(
    label_tmp$Country,
    " (",
    label_tmp$Value,
    ")",
    sep = ""
) # 拼接国家名和数值

# 绘制极坐标条形图
ggplot(tmp, aes(x = as.factor(id), y = Value)) + # id作为x轴，必须为因子，否则首尾有空隙
    geom_bar(stat = "identity", fill = alpha("#69b3a2", 0.8)) + # 绘制条形
    ylim(-7000, 13000) + # 设置y轴范围
    theme_minimal() + # 极简主题
    theme(
        axis.text = element_blank(), # 去除坐标轴文字
        axis.title = element_blank(), # 去除坐标轴标题
        panel.grid = element_blank(), # 去除网格线
        plot.margin = unit(rep(-1, 4), "cm") # 设置负边距，减少空白
    ) +
    coord_polar(start = 0) + # 转换为极坐标
    geom_text(
        data = label_tmp,
        aes(x = id, y = Value + 200, label = Country),
        color = "black",
        fontface = "bold",
        alpha = 0.6,
        size = 2.5,
        angle = label_tmp$angle, # 设置标签角度
        hjust = label_tmp$hjust, # 设置对齐方式
        inherit.aes = FALSE
    ) + # 添加国家标签
    geom_text(
        aes(x = 24, y = 8000, label = "Who sells more weapons?"),
        color = "black",
        inherit.aes = FALSE
    ) # 添加中心标题

18.2.2 适用

圆形条形图确实很吸引眼球，但使得阅读每根条形之间的差异更加困难。

因此，圆形条形图只有在展示大量条形且能明显呈现出某种模式时才有意义。

圆形条形图在加入分组变量后更加有趣。

Show/Hide Code

# 构造虚拟数据集
data = data.frame(
    individual = paste("Mister ", seq(1, 60), sep = ""), # 生成60个个体名称
    group = c(rep('A', 10), rep('B', 30), rep('C', 14), rep('D', 6)), # 分组变量
    value = sample(seq(10, 100), 60, replace = TRUE) # 随机生成数值
)
data = data |> arrange(group, value) # 按分组和数值排序

# 设置每组末尾添加的空白条数量，用于分隔分组
empty_bar = 3
to_add = data.frame(matrix(NA, empty_bar * nlevels(factor(data$group)), ncol(data))) # 构造空白行
colnames(to_add) = colnames(data)
to_add$group = rep(levels(factor(data$group)), each = empty_bar) # 每组添加空白条
data = rbind(data, to_add) # 合并数据和空白条
data = data |> arrange(group) # 再次按分组排序
data$id = seq(1, nrow(data)) # 为每一行添加唯一id

# 获取每个标签的名称和y轴位置
label_data = data
number_of_bar = nrow(label_data)
# 计算每个标签的角度，使标签位于条形中心
angle = 90 - 360 * (label_data$id - 0.5) / number_of_bar
label_data$hjust <- ifelse(angle < -90, 1, 0) # 角度小于-90时右对齐，否则左对齐
label_data$angle <- ifelse(angle < -90, angle + 180, angle) # 角度小于-90时加180度，保证文字正向

# 构造分组基线数据，用于分组底部的线和分组标签
base_data = data |>
    group_by(group) |>
    summarize(start = min(id), end = max(id) - empty_bar) |>
    rowwise() |>
    mutate(title = mean(c(start, end)))

# 构造网格线数据，用于绘制圆环上的刻度线
grid_data = base_data
grid_data$end = grid_data$end[c(nrow(grid_data), 1:nrow(grid_data) - 1)] + 1
grid_data$start = grid_data$start - 1
grid_data = grid_data[-1, ]

# 绘制极坐标分组条形图
p = ggplot(data, aes(x = as.factor(id), y = value, fill = group)) + # id作为x轴，必须为因子
    geom_bar(
        aes(x = as.factor(id), y = value, fill = group),
        stat = "identity",
        alpha = 0.5
    ) +
    # 添加圆环刻度线
    geom_segment(
        data = grid_data,
        aes(x = end, y = 80, xend = start, yend = 80),
        colour = "grey",
        alpha = 1,
        size = 0.3,
        inherit.aes = FALSE
    ) +
    geom_segment(
        data = grid_data,
        aes(x = end, y = 60, xend = start, yend = 60),
        colour = "grey",
        alpha = 1,
        size = 0.3,
        inherit.aes = FALSE
    ) +
    geom_segment(
        data = grid_data,
        aes(x = end, y = 40, xend = start, yend = 40),
        colour = "grey",
        alpha = 1,
        size = 0.3,
        inherit.aes = FALSE
    ) +
    geom_segment(
        data = grid_data,
        aes(x = end, y = 20, xend = start, yend = 20),
        colour = "grey",
        alpha = 1,
        size = 0.3,
        inherit.aes = FALSE
    ) +
    # 添加刻度值文本
    annotate(
        "text",
        x = rep(max(data$id), 4),
        y = c(20, 40, 60, 80),
        label = c("20", "40", "60", "80"),
        color = "grey",
        size = 3,
        angle = 0,
        fontface = "bold",
        hjust = 1
    ) +
    geom_bar(
        aes(x = as.factor(id), y = value, fill = group),
        stat = "identity",
        alpha = 0.5
    ) +
    ylim(-100, 120) + # 设置y轴范围
    theme_minimal() + # 极简主题
    theme(
        legend.position = "none", # 不显示图例
        axis.text = element_blank(), # 去除坐标轴文字
        axis.title = element_blank(), # 去除坐标轴标题
        panel.grid = element_blank(), # 去除网格线
        plot.margin = unit(rep(-1, 4), "cm") # 设置负边距，减少空白
    ) +
    coord_polar() + # 转换为极坐标
    # 添加个体标签
    geom_text(
        data = label_data,
        aes(x = id, y = value + 10, label = individual, hjust = hjust),
        color = "black",
        fontface = "bold",
        alpha = 0.6,
        size = 2.5,
        angle = label_data$angle,
        inherit.aes = FALSE
    ) +
    # 添加分组底部基线
    geom_segment(
        data = base_data,
        aes(x = start, y = -5, xend = end, yend = -5),
        colour = "black",
        alpha = 0.8,
        size = 0.6,
        inherit.aes = FALSE
    ) +
    # 添加分组标签
    geom_text(
        data = base_data,
        aes(x = title, y = -18, label = group),
        hjust = c(1, 1, 0, 0),
        colour = "black",
        alpha = 0.8,
        size = 4,
        fontface = "bold",
        inherit.aes = FALSE
    )
p

18.2.3 变体

堆叠圆形条形图

Show/Hide Code

# 构造数据集，包含3个观测变量
data = data.frame(
    individual = paste("Mister ", seq(1, 60), sep = ""), # 个体名称
    group = c(rep('A', 10), rep('B', 30), rep('C', 14), rep('D', 6)), # 分组变量
    value1 = sample(seq(10, 100), 60, replace = TRUE), # 观测1
    value2 = sample(seq(10, 100), 60, replace = TRUE), # 观测2
    value3 = sample(seq(10, 100), 60, replace = TRUE)  # 观测3
)

# 转换为长格式，便于堆叠绘图
data = data |>
    tidyr::gather(key = "observation", value = "value", -c(1, 2))

# 设置每组末尾添加的空白条数量，用于分隔分组
empty_bar = 2
nObsType = nlevels(as.factor(data$observation))
to_add = data.frame(matrix(
    NA,
    empty_bar * nlevels(as.factor(data$group)) * nObsType,
    ncol(data)
))
colnames(to_add) = colnames(data)
to_add$group = rep(levels(as.factor(data$group)), each = empty_bar * nObsType)
data = rbind(data, to_add)
data = data |>
    arrange(group, individual)
data$id = rep(seq(1, nrow(data) / nObsType), each = nObsType) # 为每个个体分配唯一id

# 计算每个标签的名称和y轴位置（总和）
label_data = data |>
    group_by(id, individual) |>
    summarize(tot = sum(value, na.rm = TRUE))
number_of_bar = nrow(label_data)
# 计算每个标签的角度，使标签位于条形中心
angle = 90 - 360 * (label_data$id - 0.5) / number_of_bar
label_data$hjust <- ifelse(angle < -90, 1, 0) # 角度小于-90时右对齐，否则左对齐
label_data$angle <- ifelse(angle < -90, angle + 180, angle) # 角度小于-90时加180度，保证文字正向

# 构造分组基线数据，用于分组底部的线和分组标签
base_data = data |>
    group_by(group) |>
    summarize(start = min(id), end = max(id) - empty_bar) |>
    rowwise() |>
    mutate(title = mean(c(start, end)))

# 构造网格线数据，用于绘制圆环上的刻度线
grid_data = base_data
grid_data$end = grid_data$end[c(nrow(grid_data), 1:nrow(grid_data) - 1)] + 1
grid_data$start = grid_data$start - 1
grid_data = grid_data[-1, ]

# 绘制堆叠极坐标条形图
p = ggplot(data) +
    # 添加堆叠条形
    geom_bar(
        aes(x = as.factor(id), y = value, fill = observation),
        stat = "identity",
        alpha = 0.5
    ) +
    scale_fill_viridis(discrete = TRUE) +
    # 添加圆环刻度线
    geom_segment(
        data = grid_data,
        aes(x = end, y = 0, xend = start, yend = 0),
        colour = "grey",
        alpha = 1,
        size = 0.3,
        inherit.aes = FALSE
    ) +
    geom_segment(
        data = grid_data,
        aes(x = end, y = 50, xend = start, yend = 50),
        colour = "grey",
        alpha = 1,
        size = 0.3,
        inherit.aes = FALSE
    ) +
    geom_segment(
        data = grid_data,
        aes(x = end, y = 100, xend = start, yend = 100),
        colour = "grey",
        alpha = 1,
        size = 0.3,
        inherit.aes = FALSE
    ) +
    geom_segment(
        data = grid_data,
        aes(x = end, y = 150, xend = start, yend = 150),
        colour = "grey",
        alpha = 1,
        size = 0.3,
        inherit.aes = FALSE
    ) +
    geom_segment(
        data = grid_data,
        aes(x = end, y = 200, xend = start, yend = 200),
        colour = "grey",
        alpha = 1,
        size = 0.3,
        inherit.aes = FALSE
    ) +
    # 添加刻度值文本
    annotate(
        "text",
        x = rep(max(data$id, na.rm = TRUE), 5),
        y = c(0, 50, 100, 150, 200),
        label = c("0", "50", "100", "150", "200"),
        color = "grey",
        size = 2,
        angle = 0,
        fontface = "bold",
        hjust = 1
    ) +
    ylim(-150, max(label_data$tot, na.rm = TRUE)) + # 设置y轴范围
    theme_minimal() +
    theme(
        legend.position = "none", # 不显示图例
        axis.text = element_blank(), # 去除坐标轴文字
        axis.title = element_blank(), # 去除坐标轴标题
        panel.grid = element_blank(), # 去除网格线
        plot.margin = unit(rep(-1, 4), "cm") # 设置负边距，减少空白
    ) +
    coord_polar() + # 转换为极坐标
    # 添加个体标签
    geom_text(
        data = label_data,
        aes(x = id, y = tot + 10, label = individual, hjust = hjust),
        color = "black",
        fontface = "bold",
        alpha = 0.6,
        size = 1,
        angle = label_data$angle,
        inherit.aes = FALSE
    ) +
    # 添加分组底部基线
    geom_segment(
        data = base_data,
        aes(x = start, y = -5, xend = end, yend = -5),
        colour = "black",
        alpha = 0.8,
        size = 0.6,
        inherit.aes = FALSE
    ) +
    # 添加分组标签
    geom_text(
        data = base_data,
        aes(x = title, y = -18, label = group),
        hjust = c(1, 1, 0, 0),
        colour = "black",
        alpha = 0.8,
        size = 4,
        fontface = "bold",
        inherit.aes = FALSE
    )
p

18.2.4 注意

Show/Hide Code

# 创建数据集
data = data.frame(
    individual = paste("Mister ", seq(1, 30), sep = ""), # 生成30个个体名称
    group = c(rep('A', 10), rep('C', 14), rep('D', 6)), # 分组变量
    value = sample(seq(10, 100), 30, replace = TRUE) # 随机生成数值
)
data = data |> arrange(group, value) # 按分组和数值排序

# 设置每组末尾添加的空白条数量，用于分隔分组
empty_bar = 1
to_add = data.frame(matrix(NA, empty_bar * nlevels(factor(data$group)), ncol(data))) # 构造空白行
colnames(to_add) = colnames(data)
to_add$group = rep(levels(factor(data$group)), each = empty_bar) # 每组添加空白条
data = rbind(data, to_add) # 合并数据和空白条
data = data |> arrange(group) # 再次按分组排序
data$id = seq(1, nrow(data)) # 为每一行添加唯一id

# 获取每个标签的名称和y轴位置
label_data = data
number_of_bar = nrow(label_data)
# 计算每个标签的角度，使标签位于条形中心
angle = 90 - 360 * (label_data$id - 0.5) / number_of_bar # 角度减去0.5保证标签居中
label_data$hjust <- ifelse(angle < -90, 1, 0) # 角度小于-90时右对齐，否则左对齐
label_data$angle <- ifelse(angle < -90, angle + 180, angle) # 角度小于-90时加180度，保证文字正向

# 绘制极坐标条形图
p = ggplot(data, aes(x = as.factor(id), y = value, fill = group)) + # id作为x轴，必须为因子
    geom_bar(
        aes(x = as.factor(id), y = value, fill = group),
        stat = "identity",
        alpha = 0.5
    ) +
    ylim(-10, 120) + # 设置y轴范围
    theme_minimal() + # 极简主题
    theme(
        legend.position = "none", # 不显示图例
        axis.text = element_blank(), # 去除坐标轴文字
        axis.title = element_blank(), # 去除坐标轴标题
        panel.grid = element_blank(), # 去除网格线
        plot.margin = unit(rep(-1, 4), "cm") # 设置负边距，减少空白
    ) +
    coord_polar() + # 转换为极坐标
    # 添加个体标签
    geom_text(
        data = label_data,
        aes(x = id, y = value + 10, label = individual, hjust = hjust),
        color = "black",
        fontface = "bold",
        alpha = 0.6,
        size = 2.5,
        angle = label_data$angle,
        inherit.aes = FALSE
    )

p

内圆的比例必须很大（>1/2）否则条形图会严重倾斜, 如上图
适合 40 个以上条形
圆周上显示Y轴
排序: 自有顺序或数值排序
为了显示每个组的样本数, 不要使用条形图. 会丢失信息

18.3 Cir-bar

18.3.1 基本

Show/Hide Code

# Libraries
#| fig-cap: "基础极坐标条形图示例"

# 构造数据集
data <- data.frame(
    id = seq(1, 60), # 生成1到60的id
    individual = paste("Mister ", seq(1, 60), sep = ""), # 个体名称
    value = sample(seq(10, 100), 60, replace = TRUE) # 随机生成数值
)

# 绘制极坐标条形图
p <- ggplot(data, aes(x = as.factor(id), y = value)) + # id需转为因子，保证首尾无空隙
    geom_bar(stat = "identity", fill = alpha("blue", 0.3)) + # 添加条形，设置透明蓝色
    ylim(-100, 120) + # y轴范围，负值控制内圆比例，正值用于条形高度
    theme_minimal() + # 极简主题
    theme(
        axis.text = element_blank(), # 去除坐标轴文字
        axis.title = element_blank(), # 去除坐标轴标题
        panel.grid = element_blank(), # 去除网格线
        plot.margin = unit(rep(-2, 4), "cm") # 设置负边距，减少空白
    ) +
    coord_polar(start = 0) # 转换为极坐标
p

18.3.2 label

Show/Hide Code

# 构造数据集
data <- data.frame(
    id = seq(1, 60), # 生成1到60的id
    individual = paste("Mister ", seq(1, 60), sep = ""), # 个体名称
    value = sample(seq(10, 100), 60, replace = TRUE) # 随机生成数值
)

# ----- 下面部分为标签准备数据框 ---- #
# 获取每个标签的名称和y轴位置
label_data <- data

# 计算每个标签的角度，使标签位于条形中心
number_of_bar <- nrow(label_data)
angle <- 90 - 360 * (label_data$id - 0.5) / number_of_bar # 减去0.5保证标签居中

# 计算标签的对齐方式：右对齐或左对齐
# 如果在图的左侧，当前角度小于-90，标签右对齐
label_data$hjust <- ifelse(angle < -90, 1, 0)

# 翻转角度，使标签可读
label_data$angle <- ifelse(angle < -90, angle + 180, angle)
# ----- -------------------------------------- ---- #

# 开始绘图
p <- ggplot(data, aes(x = as.factor(id), y = value)) + # id需转为因子，保证首尾无空隙

    # 添加条形，设置透明蓝色
    geom_bar(stat = "identity", fill = alpha("skyblue", 0.7)) +

    # 设置y轴范围，负值控制内圆比例，正值用于条形高度
    ylim(-100, 120) +

    # 自定义主题：去除坐标轴标题和网格线
    theme_minimal() +
    theme(
        axis.text = element_blank(), # 去除坐标轴文字
        axis.title = element_blank(), # 去除坐标轴标题
        panel.grid = element_blank(), # 去除网格线
        plot.margin = unit(rep(-1, 4), "cm") # 调整边距，避免标签被截断
    ) +

    # 转换为极坐标
    coord_polar(start = 0) +

    # 添加标签，使用上面准备的label_data数据框
    geom_text(
        data = label_data,
        aes(x = id, y = value + 10, label = individual, hjust = hjust),
        color = "black",
        fontface = "bold",
        alpha = 0.6,
        size = 2.5,
        angle = label_data$angle,
        inherit.aes = FALSE
    )

p

18.3.3 gap

末尾空白:

Show/Hide Code

#| fig-cap: "带间隔的极坐标条形图示例"

# 构造数据集
data <- data.frame(
  individual=paste( "Mister ", seq(1,60), sep=""),
  group=c( rep('A', 10), rep('B', 30), rep('C', 14), rep('D', 6)) ,
  value=sample( seq(10,100), 60, replace=T)
)

# 设置空白条数量，用于在条形之间制造间隔
empty_bar <- 10

# 在原始数据集末尾添加空白行（NA），用于制造条形间隔
to_add <- matrix(NA, empty_bar, ncol(data)) # 构造空白行矩阵
colnames(to_add) <- colnames(data)          # 设置列名与原数据一致
data <- rbind(data, to_add)                 # 合并原数据和空白行
data$id <- seq(1, nrow(data))               # 为每一行分配唯一id

# 获取每个标签的名称和y轴位置
label_data <- data
number_of_bar <- nrow(label_data)           # 总条形数（含空白）
# 计算每个标签的角度，使标签位于条形中心
angle <- 90 - 360 * (label_data$id - 0.5) / number_of_bar # -0.5保证标签居中
# 计算标签的对齐方式：右对齐或左对齐
label_data$hjust <- ifelse(angle < -90, 1, 0)
# 翻转角度，使标签可读
label_data$angle <- ifelse(angle < -90, angle + 180, angle)

# 绘制极坐标条形图
p <- ggplot(data, aes(x = as.factor(id), y = value)) + # id需转为因子，保证首尾无空隙
    geom_bar(stat = "identity", fill = alpha("green", 0.3)) + # 添加条形，设置透明绿色
    ylim(-100, 120) +                                         # y轴范围，负值控制内圆比例
    theme_minimal() +                                         # 极简主题
    theme(
        axis.text = element_blank(),                          # 去除坐标轴文字
        axis.title = element_blank(),                         # 去除坐标轴标题
        panel.grid = element_blank(),                         # 去除网格线
        plot.margin = unit(rep(-1, 4), "cm")                  # 设置负边距，减少空白
    ) +
    coord_polar(start = 0) +                                  # 转换为极坐标
    # 添加标签，使用上面准备的label_data数据框
    geom_text(
        data = label_data,
        aes(x = id, y = value + 10, label = individual, hjust = hjust),
        color = "black",
        fontface = "bold",
        alpha = 0.6,
        size = 2.5,
        angle = label_data$angle,
        inherit.aes = FALSE
    )

p

组间空白

Show/Hide Code

# 构造数据集
data <- data.frame(
    individual = paste("Mister ", seq(1, 60), sep = ""), # 个体名称
    group = as.factor(c(rep('A', 10), rep('B', 30), rep('C', 14), rep('D', 6))), # 分组变量（必须为因子）
    value = sample(seq(10, 100), 60, replace = TRUE) # 随机生成数值
)

# 设置每组末尾添加的空白条数量，用于分隔分组
empty_bar <- 4
to_add <- data.frame(matrix(NA, empty_bar * nlevels(data$group), ncol(data))) # 构造空白行
colnames(to_add) <- colnames(data) # 设置空白行的列名与原数据一致
to_add$group <- rep(levels(data$group), each = empty_bar) # 每组添加空白条
data <- rbind(data, to_add) # 合并数据和空白条
data <- data |> arrange(group) # 按分组排序（新管道写法）
data$id <- seq(1, nrow(data)) # 为每一行添加唯一id

# 获取每个标签的名称和y轴位置
label_data <- data
number_of_bar <- nrow(label_data) # 总条形数（含空白）
# 计算每个标签的角度，使标签位于条形中心
angle <- 90 - 360 * (label_data$id - 0.5) / number_of_bar # -0.5保证标签居中
# 计算标签的对齐方式：右对齐或左对齐
label_data$hjust <- ifelse(angle < -90, 1, 0)
# 翻转角度，使标签可读
label_data$angle <- ifelse(angle < -90, angle + 180, angle)

# 绘制极坐标条形图
p <- ggplot(data, aes(x = as.factor(id), y = value, fill = group)) + # id需转为因子，保证首尾无空隙
    geom_bar(stat = "identity", alpha = 0.5) + # 添加条形，设置透明度
    ylim(-100, 120) + # y轴范围，负值控制内圆比例
    theme_minimal() + # 极简主题
    theme(
        legend.position = "none", # 不显示图例
        axis.text = element_blank(), # 去除坐标轴文字
        axis.title = element_blank(), # 去除坐标轴标题
        panel.grid = element_blank(), # 去除网格线
        plot.margin = unit(rep(-1, 4), "cm") # 设置负边距，减少空白
    ) +
    coord_polar() + # 转换为极坐标
    # 添加标签，使用上面准备的label_data数据框
    geom_text(
        data = label_data,
        aes(x = id, y = value + 10, label = individual, hjust = hjust),
        color = "black",
        fontface = "bold",
        alpha = 0.6,
        size = 2.5,
        angle = label_data$angle,
        inherit.aes = FALSE
    )

p

18.3.4 排序

Show/Hide Code

# 创建数据后用 data = data |> arrange(group, value) 排序

# 构造数据集
data <- data.frame(
  individual = paste("Mister ", seq(1, 60), sep = ""), # 个体名称
  group = as.factor(c(rep('A', 10), rep('B', 30), rep('C', 14), rep('D', 6))), # 分组变量（必须为因子）
  value = sample(seq(10, 100), 60, replace = TRUE) # 随机生成数值
)

data = data |> arrange(group, value) # <-- 就是这里, 组内排序

# 设置每组末尾添加的空白条数量，用于分隔分组
empty_bar <- 4
to_add <- data.frame(matrix(NA, empty_bar * nlevels(data$group), ncol(data))) # 构造空白行
colnames(to_add) <- colnames(data) # 设置空白行的列名与原数据一致
to_add$group <- rep(levels(data$group), each = empty_bar) # 每组添加空白条
data <- rbind(data, to_add) # 合并数据和空白条
data <- data |> arrange(group) # 按分组排序（新管道写法）
data$id <- seq(1, nrow(data)) # 为每一行添加唯一id

# 获取每个标签的名称和y轴位置
label_data <- data
number_of_bar <- nrow(label_data) # 总条形数（含空白）
# 计算每个标签的角度，使标签位于条形中心
angle <- 90 - 360 * (label_data$id - 0.5) / number_of_bar # -0.5保证标签居中
# 计算标签的对齐方式：右对齐或左对齐
label_data$hjust <- ifelse(angle < -90, 1, 0)
# 翻转角度，使标签可读
label_data$angle <- ifelse(angle < -90, angle + 180, angle)

# 绘制极坐标条形图
p <- ggplot(data, aes(x = as.factor(id), y = value, fill = group)) + # id需转为因子，保证首尾无空隙
    geom_bar(stat = "identity", alpha = 0.5) + # 添加条形，设置透明度
    ylim(-100, 120) + # y轴范围，负值控制内圆比例
    theme_minimal() + # 极简主题
    theme(
        legend.position = "none", # 不显示图例
        axis.text = element_blank(), # 去除坐标轴文字
        axis.title = element_blank(), # 去除坐标轴标题
        panel.grid = element_blank(), # 去除网格线
        plot.margin = unit(rep(-1, 4), "cm") # 设置负边距，减少空白
    ) +
    coord_polar() + # 转换为极坐标
    # 添加标签，使用上面准备的label_data数据框
    geom_text(
        data = label_data,
        aes(x = id, y = value + 10, label = individual, hjust = hjust),
        color = "black",
        fontface = "bold",
        alpha = 0.6,
        size = 2.5,
        angle = label_data$angle,
        inherit.aes = FALSE
    )

p

18.3.5 定制

加入了刻度线和分组标记:

Show/Hide Code

# 构造数据集
data <- data.frame(
  individual = paste("Mister ", seq(1, 60), sep = ""), # 个体名称
  group = as.factor(c(rep('A', 10), rep('B', 30), rep('C', 14), rep('D', 6))), # 分组变量（必须为因子）
  value = sample(seq(10, 100), 60, replace = TRUE) # 随机生成数值
)


# 设置每组末尾添加的空白条数量，用于分隔分组
empty_bar <- 3
to_add <- data.frame(matrix(NA, empty_bar * nlevels(data$group), ncol(data))) # 构造空白行


colnames(to_add) <- colnames(data) # 设置空白行的列名与原数据一致
to_add$group <- rep(levels(data$group), each = empty_bar) # 每组添加空白条, each 不循环添加
data <- rbind(data, to_add) # 合并数据和空白条
data <- data |> arrange(group) # 按分组排序
data$id <- seq(1, nrow(data)) # 为每一行添加唯一id

# 获取每个标签的名称和y轴位置
label_data <- data
number_of_bar <- nrow(label_data) # 总条形数（含空白）
# 计算每个标签的角度，使标签位于条形中心
angle <- 90 - 360 * (label_data$id - 0.5) / number_of_bar # -0.5保证标签居中
# 计算标签的对齐方式：右对齐或左对齐
label_data$hjust <- ifelse(angle < -90, 1, 0)
# 翻转角度，使标签可读
label_data$angle <- ifelse(angle < -90, angle + 180, angle)

# 构造分组基线数据，用于分组底部的线和分组标签
base_data <- data |>
  group_by(group) |>
  summarize(start = min(id), end = max(id) - empty_bar) |>
  rowwise() |>
  mutate(title = mean(c(start, end)))

# 构造网格线数据，用于绘制圆环上的刻度线
grid_data <- base_data
grid_data$end <- grid_data$end[c(nrow(grid_data), 1:nrow(grid_data) - 1)] + 1
grid_data$start <- grid_data$start - 1
grid_data <- grid_data[-1, ]

# 绘制极坐标条形图
ggplot(data, aes(x = as.factor(id), y = value, fill = group)) + # id需转为因子，保证首尾无空隙

  # 添加条形，设置透明度
  geom_bar(
    aes(x = as.factor(id), y = value, fill = group),
    stat = "identity",
    alpha = 0.5
  ) + 

  # 添加圆环的刻度线（y=80/60/40/20）
  geom_segment(
    data = grid_data,
    aes(x = end, y = 80, xend = start, yend = 80),
    colour = "grey",
    alpha = 1,
    linewidth = 0.3,
    inherit.aes = FALSE
  ) +
  geom_segment(
    data = grid_data,
    aes(x = end, y = 60, xend = start, yend = 60),
    colour = "grey",
    alpha = 1,
    linewidth = 0.3,
    inherit.aes = FALSE
  ) + 
  geom_segment(
    data = grid_data,
    aes(x = end, y = 40, xend = start, yend = 40),
    colour = "grey",
    alpha = 1,
    linewidth = 0.3,
    inherit.aes = FALSE
  ) +
  geom_segment(
    data = grid_data,
    aes(x = end, y = 20, xend = start, yend = 20),
    colour = "grey",
    alpha = 1,
    linewidth = 0.3,
    inherit.aes = FALSE
  ) +

  # 添加刻度值文本
  annotate(
    "text",
    x = rep(max(data$id), 4),
    y = c(20, 40, 60, 80),
    label = c("20", "40", "60", "80"),
    color = "grey",
    size = 3,
    angle = 0,
    fontface = "bold",
    hjust = 1
  ) + 

  # 再次添加条形，保证条形在刻度线上方
  geom_bar(
    aes(x = as.factor(id), y = value, fill = group),
    stat = "identity",
    alpha = 0.5
  ) +

  ylim(-100, 120) + # y轴范围，负值控制内圆比例
  theme_minimal() + # 极简主题
  theme(
    legend.position = "none", # 不显示图例
    axis.text = element_blank(), # 去除坐标轴文字
    axis.title = element_blank(), # 去除坐标轴标题
    panel.grid = element_blank(), # 去除网格线
    plot.margin = unit(rep(-1, 4), "cm") # 设置负边距，减少空白
  ) + 
  coord_polar() +  # 转换为极坐标

  # 添加标签，使用上面准备的label_data数据框
  geom_text(
    data = label_data,
    aes(x = id, y = value + 10, label = individual, hjust = hjust),
    color = "black",
    fontface = "bold",
    alpha = 0.6,
    size = 2.5,
    angle = label_data$angle,
    inherit.aes = FALSE
  ) + 

  # 添加分组底部基线
  geom_segment(
    data = base_data,
    aes(x = start, y = -5, xend = end, yend = -5),
    colour = "black",
    alpha = 0.8,
    linewidth = 0.6,
    inherit.aes = FALSE
  ) + 
  # 添加分组标签
  geom_text(
    data = base_data,
    aes(x = title, y = -18, label = group),
    hjust = c(1, 1, 0, 0),
    colour = "black",
    alpha = 0.8,
    size = 4,
    fontface = "bold",
    inherit.aes = FALSE
  )

18.4 Pearl

# Cir-bar {#sec-cir-bar} ## PKG ```{r} library(tidyverse) # 数据处理和可视化 library(hrbrthemes) # 主题和字体 # library(kableExtra) # 表格美化 library(viridis) # 色彩映射 ``` ## 基础 ### 定义极坐标条形图：各国武器销售情况, 这里没有显示 Y 轴刻度，因为每个条形上都标注了确切数值。 ```{r} #| fig-cap: "极坐标条形图：各国武器销售情况" # 从github加载数据集 data <- read_csv( "https://raw.githubusercontent.com/holtzy/data_to_viz/master/Example_dataset/7_OneCatOneNum.csv" ) # 对数据进行排序和预处理 tmp <- data |> filter(!is.na(Value)) |> # 过滤掉Value为NA的行 arrange(desc(Value)) |> # 按Value降序排列 mutate(Country = factor(Country, Country)) # 将Country设置为因子，顺序与数据一致 # 设置空白条的数量，用于美化图形 empty_bar = 10 # 添加空白行到数据末尾 to_add = matrix(NA, empty_bar, ncol(tmp)) colnames(to_add) = colnames(tmp) tmp = rbind(tmp, to_add) tmp$id = seq(1, nrow(tmp)) # 为每一行添加唯一id # 获取每个标签的名称和y轴位置 label_tmp = tmp number_of_bar = nrow(label_tmp) # 计算每个标签的角度，使标签位于条形中心 angle = 90 - 360 * (label_tmp$id - 0.5) / number_of_bar label_tmp$hjust <- ifelse(angle < -90, 1, 0) # 角度小于-90时右对齐，否则左对齐 label_tmp$angle <- ifelse(angle < -90, angle + 180, angle) # 角度小于-90时加180度，保证文字正向 label_tmp$Country <- gsub("United States", "US", label_tmp$Country) # 替换国家名 label_tmp$Country <- paste( label_tmp$Country, " (", label_tmp$Value, ")", sep = "" ) # 拼接国家名和数值 # 绘制极坐标条形图 ggplot(tmp, aes(x = as.factor(id), y = Value)) + # id作为x轴，必须为因子，否则首尾有空隙 geom_bar(stat = "identity", fill = alpha("#69b3a2", 0.8)) + # 绘制条形 ylim(-7000, 13000) + # 设置y轴范围 theme_minimal() + # 极简主题 theme( axis.text = element_blank(), # 去除坐标轴文字 axis.title = element_blank(), # 去除坐标轴标题 panel.grid = element_blank(), # 去除网格线 plot.margin = unit(rep(-1, 4), "cm") # 设置负边距，减少空白 ) + coord_polar(start = 0) + # 转换为极坐标 geom_text( data = label_tmp, aes(x = id, y = Value + 200, label = Country), color = "black", fontface = "bold", alpha = 0.6, size = 2.5, angle = label_tmp$angle, # 设置标签角度 hjust = label_tmp$hjust, # 设置对齐方式 inherit.aes = FALSE ) + # 添加国家标签 geom_text( aes(x = 24, y = 8000, label = "Who sells more weapons?"), color = "black", inherit.aes = FALSE ) # 添加中心标题 ``` ### 适用圆形条形图确实很吸引眼球，但使得阅读每根条形之间的差异更加困难。因此，圆形条形图只有在展示大量条形且能明显呈现出某种模式时才有意义。圆形条形图在加入分组变量后更加有趣。 ```{r} #| fig-cap: "分组极坐标条形图：分组比较示例" # 构造虚拟数据集 data = data.frame( individual = paste("Mister ", seq(1, 60), sep = ""), # 生成60个个体名称 group = c(rep('A', 10), rep('B', 30), rep('C', 14), rep('D', 6)), # 分组变量 value = sample(seq(10, 100), 60, replace = TRUE) # 随机生成数值 ) data = data |> arrange(group, value) # 按分组和数值排序 # 设置每组末尾添加的空白条数量，用于分隔分组 empty_bar = 3 to_add = data.frame(matrix(NA, empty_bar * nlevels(factor(data$group)), ncol(data))) # 构造空白行 colnames(to_add) = colnames(data) to_add$group = rep(levels(factor(data$group)), each = empty_bar) # 每组添加空白条 data = rbind(data, to_add) # 合并数据和空白条 data = data |> arrange(group) # 再次按分组排序 data$id = seq(1, nrow(data)) # 为每一行添加唯一id # 获取每个标签的名称和y轴位置 label_data = data number_of_bar = nrow(label_data) # 计算每个标签的角度，使标签位于条形中心 angle = 90 - 360 * (label_data$id - 0.5) / number_of_bar label_data$hjust <- ifelse(angle < -90, 1, 0) # 角度小于-90时右对齐，否则左对齐 label_data$angle <- ifelse(angle < -90, angle + 180, angle) # 角度小于-90时加180度，保证文字正向 # 构造分组基线数据，用于分组底部的线和分组标签 base_data = data |> group_by(group) |> summarize(start = min(id), end = max(id) - empty_bar) |> rowwise() |> mutate(title = mean(c(start, end))) # 构造网格线数据，用于绘制圆环上的刻度线 grid_data = base_data grid_data$end = grid_data$end[c(nrow(grid_data), 1:nrow(grid_data) - 1)] + 1 grid_data$start = grid_data$start - 1 grid_data = grid_data[-1, ] # 绘制极坐标分组条形图 p = ggplot(data, aes(x = as.factor(id), y = value, fill = group)) + # id作为x轴，必须为因子 geom_bar( aes(x = as.factor(id), y = value, fill = group), stat = "identity", alpha = 0.5 ) + # 添加圆环刻度线 geom_segment( data = grid_data, aes(x = end, y = 80, xend = start, yend = 80), colour = "grey", alpha = 1, size = 0.3, inherit.aes = FALSE ) + geom_segment( data = grid_data, aes(x = end, y = 60, xend = start, yend = 60), colour = "grey", alpha = 1, size = 0.3, inherit.aes = FALSE ) + geom_segment( data = grid_data, aes(x = end, y = 40, xend = start, yend = 40), colour = "grey", alpha = 1, size = 0.3, inherit.aes = FALSE ) + geom_segment( data = grid_data, aes(x = end, y = 20, xend = start, yend = 20), colour = "grey", alpha = 1, size = 0.3, inherit.aes = FALSE ) + # 添加刻度值文本 annotate( "text", x = rep(max(data$id), 4), y = c(20, 40, 60, 80), label = c("20", "40", "60", "80"), color = "grey", size = 3, angle = 0, fontface = "bold", hjust = 1 ) + geom_bar( aes(x = as.factor(id), y = value, fill = group), stat = "identity", alpha = 0.5 ) + ylim(-100, 120) + # 设置y轴范围 theme_minimal() + # 极简主题 theme( legend.position = "none", # 不显示图例 axis.text = element_blank(), # 去除坐标轴文字 axis.title = element_blank(), # 去除坐标轴标题 panel.grid = element_blank(), # 去除网格线 plot.margin = unit(rep(-1, 4), "cm") # 设置负边距，减少空白 ) + coord_polar() + # 转换为极坐标 # 添加个体标签 geom_text( data = label_data, aes(x = id, y = value + 10, label = individual, hjust = hjust), color = "black", fontface = "bold", alpha = 0.6, size = 2.5, angle = label_data$angle, inherit.aes = FALSE ) + # 添加分组底部基线 geom_segment( data = base_data, aes(x = start, y = -5, xend = end, yend = -5), colour = "black", alpha = 0.8, size = 0.6, inherit.aes = FALSE ) + # 添加分组标签 geom_text( data = base_data, aes(x = title, y = -18, label = group), hjust = c(1, 1, 0, 0), colour = "black", alpha = 0.8, size = 4, fontface = "bold", inherit.aes = FALSE ) p ``` ### 变体堆叠圆形条形图 ```{r} #| fig-cap: "堆叠圆形条形图：多变量分组比较示例" # 构造数据集，包含3个观测变量 data = data.frame( individual = paste("Mister ", seq(1, 60), sep = ""), # 个体名称 group = c(rep('A', 10), rep('B', 30), rep('C', 14), rep('D', 6)), # 分组变量 value1 = sample(seq(10, 100), 60, replace = TRUE), # 观测1 value2 = sample(seq(10, 100), 60, replace = TRUE), # 观测2 value3 = sample(seq(10, 100), 60, replace = TRUE) # 观测3 ) # 转换为长格式，便于堆叠绘图 data = data |> tidyr::gather(key = "observation", value = "value", -c(1, 2)) # 设置每组末尾添加的空白条数量，用于分隔分组 empty_bar = 2 nObsType = nlevels(as.factor(data$observation)) to_add = data.frame(matrix( NA, empty_bar * nlevels(as.factor(data$group)) * nObsType, ncol(data) )) colnames(to_add) = colnames(data) to_add$group = rep(levels(as.factor(data$group)), each = empty_bar * nObsType) data = rbind(data, to_add) data = data |> arrange(group, individual) data$id = rep(seq(1, nrow(data) / nObsType), each = nObsType) # 为每个个体分配唯一id # 计算每个标签的名称和y轴位置（总和） label_data = data |> group_by(id, individual) |> summarize(tot = sum(value, na.rm = TRUE)) number_of_bar = nrow(label_data) # 计算每个标签的角度，使标签位于条形中心 angle = 90 - 360 * (label_data$id - 0.5) / number_of_bar label_data$hjust <- ifelse(angle < -90, 1, 0) # 角度小于-90时右对齐，否则左对齐 label_data$angle <- ifelse(angle < -90, angle + 180, angle) # 角度小于-90时加180度，保证文字正向 # 构造分组基线数据，用于分组底部的线和分组标签 base_data = data |> group_by(group) |> summarize(start = min(id), end = max(id) - empty_bar) |> rowwise() |> mutate(title = mean(c(start, end))) # 构造网格线数据，用于绘制圆环上的刻度线 grid_data = base_data grid_data$end = grid_data$end[c(nrow(grid_data), 1:nrow(grid_data) - 1)] + 1 grid_data$start = grid_data$start - 1 grid_data = grid_data[-1, ] # 绘制堆叠极坐标条形图 p = ggplot(data) + # 添加堆叠条形 geom_bar( aes(x = as.factor(id), y = value, fill = observation), stat = "identity", alpha = 0.5 ) + scale_fill_viridis(discrete = TRUE) + # 添加圆环刻度线 geom_segment( data = grid_data, aes(x = end, y = 0, xend = start, yend = 0), colour = "grey", alpha = 1, size = 0.3, inherit.aes = FALSE ) + geom_segment( data = grid_data, aes(x = end, y = 50, xend = start, yend = 50), colour = "grey", alpha = 1, size = 0.3, inherit.aes = FALSE ) + geom_segment( data = grid_data, aes(x = end, y = 100, xend = start, yend = 100), colour = "grey", alpha = 1, size = 0.3, inherit.aes = FALSE ) + geom_segment( data = grid_data, aes(x = end, y = 150, xend = start, yend = 150), colour = "grey", alpha = 1, size = 0.3, inherit.aes = FALSE ) + geom_segment( data = grid_data, aes(x = end, y = 200, xend = start, yend = 200), colour = "grey", alpha = 1, size = 0.3, inherit.aes = FALSE ) + # 添加刻度值文本 annotate( "text", x = rep(max(data$id, na.rm = TRUE), 5), y = c(0, 50, 100, 150, 200), label = c("0", "50", "100", "150", "200"), color = "grey", size = 2, angle = 0, fontface = "bold", hjust = 1 ) + ylim(-150, max(label_data$tot, na.rm = TRUE)) + # 设置y轴范围 theme_minimal() + theme( legend.position = "none", # 不显示图例 axis.text = element_blank(), # 去除坐标轴文字 axis.title = element_blank(), # 去除坐标轴标题 panel.grid = element_blank(), # 去除网格线 plot.margin = unit(rep(-1, 4), "cm") # 设置负边距，减少空白 ) + coord_polar() + # 转换为极坐标 # 添加个体标签 geom_text( data = label_data, aes(x = id, y = tot + 10, label = individual, hjust = hjust), color = "black", fontface = "bold", alpha = 0.6, size = 1, angle = label_data$angle, inherit.aes = FALSE ) + # 添加分组底部基线 geom_segment( data = base_data, aes(x = start, y = -5, xend = end, yend = -5), colour = "black", alpha = 0.8, size = 0.6, inherit.aes = FALSE ) + # 添加分组标签 geom_text( data = base_data, aes(x = title, y = -18, label = group), hjust = c(1, 1, 0, 0), colour = "black", alpha = 0.8, size = 4, fontface = "bold", inherit.aes = FALSE ) p ``` ### 注意 ```{r} #| fig-cap: "内圆比例较小时的极坐标条形图, 严重倾斜" # 创建数据集 data = data.frame( individual = paste("Mister ", seq(1, 30), sep = ""), # 生成30个个体名称 group = c(rep('A', 10), rep('C', 14), rep('D', 6)), # 分组变量 value = sample(seq(10, 100), 30, replace = TRUE) # 随机生成数值 ) data = data |> arrange(group, value) # 按分组和数值排序 # 设置每组末尾添加的空白条数量，用于分隔分组 empty_bar = 1 to_add = data.frame(matrix(NA, empty_bar * nlevels(factor(data$group)), ncol(data))) # 构造空白行 colnames(to_add) = colnames(data) to_add$group = rep(levels(factor(data$group)), each = empty_bar) # 每组添加空白条 data = rbind(data, to_add) # 合并数据和空白条 data = data |> arrange(group) # 再次按分组排序 data$id = seq(1, nrow(data)) # 为每一行添加唯一id # 获取每个标签的名称和y轴位置 label_data = data number_of_bar = nrow(label_data) # 计算每个标签的角度，使标签位于条形中心 angle = 90 - 360 * (label_data$id - 0.5) / number_of_bar # 角度减去0.5保证标签居中 label_data$hjust <- ifelse(angle < -90, 1, 0) # 角度小于-90时右对齐，否则左对齐 label_data$angle <- ifelse(angle < -90, angle + 180, angle) # 角度小于-90时加180度，保证文字正向 # 绘制极坐标条形图 p = ggplot(data, aes(x = as.factor(id), y = value, fill = group)) + # id作为x轴，必须为因子 geom_bar( aes(x = as.factor(id), y = value, fill = group), stat = "identity", alpha = 0.5 ) + ylim(-10, 120) + # 设置y轴范围 theme_minimal() + # 极简主题 theme( legend.position = "none", # 不显示图例 axis.text = element_blank(), # 去除坐标轴文字 axis.title = element_blank(), # 去除坐标轴标题 panel.grid = element_blank(), # 去除网格线 plot.margin = unit(rep(-1, 4), "cm") # 设置负边距，减少空白 ) + coord_polar() + # 转换为极坐标 # 添加个体标签 geom_text( data = label_data, aes(x = id, y = value + 10, label = individual, hjust = hjust), color = "black", fontface = "bold", alpha = 0.6, size = 2.5, angle = label_data$angle, inherit.aes = FALSE ) p ``` - 内圆的比例必须很大（>1/2）否则条形图会严重倾斜, 如上图 - 适合 40 个以上条形 - 圆周上显示Y轴 - 排序: 自有顺序或数值排序 - 为了显示*每个组的样本数*, 不要使用条形图. 会丢失信息 ## Cir-bar ### 基本 ```{r} # Libraries #| fig-cap: "基础极坐标条形图示例" # 构造数据集 data <- data.frame( id = seq(1, 60), # 生成1到60的id individual = paste("Mister ", seq(1, 60), sep = ""), # 个体名称 value = sample(seq(10, 100), 60, replace = TRUE) # 随机生成数值 ) # 绘制极坐标条形图 p <- ggplot(data, aes(x = as.factor(id), y = value)) + # id需转为因子，保证首尾无空隙 geom_bar(stat = "identity", fill = alpha("blue", 0.3)) + # 添加条形，设置透明蓝色 ylim(-100, 120) + # y轴范围，负值控制内圆比例，正值用于条形高度 theme_minimal() + # 极简主题 theme( axis.text = element_blank(), # 去除坐标轴文字 axis.title = element_blank(), # 去除坐标轴标题 panel.grid = element_blank(), # 去除网格线 plot.margin = unit(rep(-2, 4), "cm") # 设置负边距，减少空白 ) + coord_polar(start = 0) # 转换为极坐标 p ``` ### label ```{r} #| fig-cap: "带标签的极坐标条形图示例" # 构造数据集 data <- data.frame( id = seq(1, 60), # 生成1到60的id individual = paste("Mister ", seq(1, 60), sep = ""), # 个体名称 value = sample(seq(10, 100), 60, replace = TRUE) # 随机生成数值 ) # ----- 下面部分为标签准备数据框 ---- # # 获取每个标签的名称和y轴位置 label_data <- data # 计算每个标签的角度，使标签位于条形中心 number_of_bar <- nrow(label_data) angle <- 90 - 360 * (label_data$id - 0.5) / number_of_bar # 减去0.5保证标签居中 # 计算标签的对齐方式：右对齐或左对齐 # 如果在图的左侧，当前角度小于-90，标签右对齐 label_data$hjust <- ifelse(angle < -90, 1, 0) # 翻转角度，使标签可读 label_data$angle <- ifelse(angle < -90, angle + 180, angle) # ----- -------------------------------------- ---- # # 开始绘图 p <- ggplot(data, aes(x = as.factor(id), y = value)) + # id需转为因子，保证首尾无空隙 # 添加条形，设置透明蓝色 geom_bar(stat = "identity", fill = alpha("skyblue", 0.7)) + # 设置y轴范围，负值控制内圆比例，正值用于条形高度 ylim(-100, 120) + # 自定义主题：去除坐标轴标题和网格线 theme_minimal() + theme( axis.text = element_blank(), # 去除坐标轴文字 axis.title = element_blank(), # 去除坐标轴标题 panel.grid = element_blank(), # 去除网格线 plot.margin = unit(rep(-1, 4), "cm") # 调整边距，避免标签被截断 ) + # 转换为极坐标 coord_polar(start = 0) + # 添加标签，使用上面准备的label_data数据框 geom_text( data = label_data, aes(x = id, y = value + 10, label = individual, hjust = hjust), color = "black", fontface = "bold", alpha = 0.6, size = 2.5, angle = label_data$angle, inherit.aes = FALSE ) p ``` ### gap 末尾空白: ```{r} #| fig-cap: "带间隔的极坐标条形图示例" # 构造数据集 data <- data.frame( individual=paste( "Mister ", seq(1,60), sep=""), group=c( rep('A', 10), rep('B', 30), rep('C', 14), rep('D', 6)) , value=sample( seq(10,100), 60, replace=T) ) # 设置空白条数量，用于在条形之间制造间隔 empty_bar <- 10 # 在原始数据集末尾添加空白行（NA），用于制造条形间隔 to_add <- matrix(NA, empty_bar, ncol(data)) # 构造空白行矩阵 colnames(to_add) <- colnames(data) # 设置列名与原数据一致 data <- rbind(data, to_add) # 合并原数据和空白行 data$id <- seq(1, nrow(data)) # 为每一行分配唯一id # 获取每个标签的名称和y轴位置 label_data <- data number_of_bar <- nrow(label_data) # 总条形数（含空白） # 计算每个标签的角度，使标签位于条形中心 angle <- 90 - 360 * (label_data$id - 0.5) / number_of_bar # -0.5保证标签居中 # 计算标签的对齐方式：右对齐或左对齐 label_data$hjust <- ifelse(angle < -90, 1, 0) # 翻转角度，使标签可读 label_data$angle <- ifelse(angle < -90, angle + 180, angle) # 绘制极坐标条形图 p <- ggplot(data, aes(x = as.factor(id), y = value)) + # id需转为因子，保证首尾无空隙 geom_bar(stat = "identity", fill = alpha("green", 0.3)) + # 添加条形，设置透明绿色 ylim(-100, 120) + # y轴范围，负值控制内圆比例 theme_minimal() + # 极简主题 theme( axis.text = element_blank(), # 去除坐标轴文字 axis.title = element_blank(), # 去除坐标轴标题 panel.grid = element_blank(), # 去除网格线 plot.margin = unit(rep(-1, 4), "cm") # 设置负边距，减少空白 ) + coord_polar(start = 0) + # 转换为极坐标 # 添加标签，使用上面准备的label_data数据框 geom_text( data = label_data, aes(x = id, y = value + 10, label = individual, hjust = hjust), color = "black", fontface = "bold", alpha = 0.6, size = 2.5, angle = label_data$angle, inherit.aes = FALSE ) p ``` 组间空白 ```{r} #| fig-cap: "带组间空白的极坐标条形图" # 构造数据集 data <- data.frame( individual = paste("Mister ", seq(1, 60), sep = ""), # 个体名称 group = as.factor(c(rep('A', 10), rep('B', 30), rep('C', 14), rep('D', 6))), # 分组变量（必须为因子） value = sample(seq(10, 100), 60, replace = TRUE) # 随机生成数值 ) # 设置每组末尾添加的空白条数量，用于分隔分组 empty_bar <- 4 to_add <- data.frame(matrix(NA, empty_bar * nlevels(data$group), ncol(data))) # 构造空白行 colnames(to_add) <- colnames(data) # 设置空白行的列名与原数据一致 to_add$group <- rep(levels(data$group), each = empty_bar) # 每组添加空白条 data <- rbind(data, to_add) # 合并数据和空白条 data <- data |> arrange(group) # 按分组排序（新管道写法） data$id <- seq(1, nrow(data)) # 为每一行添加唯一id # 获取每个标签的名称和y轴位置 label_data <- data number_of_bar <- nrow(label_data) # 总条形数（含空白） # 计算每个标签的角度，使标签位于条形中心 angle <- 90 - 360 * (label_data$id - 0.5) / number_of_bar # -0.5保证标签居中 # 计算标签的对齐方式：右对齐或左对齐 label_data$hjust <- ifelse(angle < -90, 1, 0) # 翻转角度，使标签可读 label_data$angle <- ifelse(angle < -90, angle + 180, angle) # 绘制极坐标条形图 p <- ggplot(data, aes(x = as.factor(id), y = value, fill = group)) + # id需转为因子，保证首尾无空隙 geom_bar(stat = "identity", alpha = 0.5) + # 添加条形，设置透明度 ylim(-100, 120) + # y轴范围，负值控制内圆比例 theme_minimal() + # 极简主题 theme( legend.position = "none", # 不显示图例 axis.text = element_blank(), # 去除坐标轴文字 axis.title = element_blank(), # 去除坐标轴标题 panel.grid = element_blank(), # 去除网格线 plot.margin = unit(rep(-1, 4), "cm") # 设置负边距，减少空白 ) + coord_polar() + # 转换为极坐标 # 添加标签，使用上面准备的label_data数据框 geom_text( data = label_data, aes(x = id, y = value + 10, label = individual, hjust = hjust), color = "black", fontface = "bold", alpha = 0.6, size = 2.5, angle = label_data$angle, inherit.aes = FALSE ) p ``` ### 排序 ```{r} #| fig-cap: "带组间空白的极坐标条形图(排序)" # 创建数据后用 data = data |> arrange(group, value) 排序 # 构造数据集 data <- data.frame( individual = paste("Mister ", seq(1, 60), sep = ""), # 个体名称 group = as.factor(c(rep('A', 10), rep('B', 30), rep('C', 14), rep('D', 6))), # 分组变量（必须为因子） value = sample(seq(10, 100), 60, replace = TRUE) # 随机生成数值 ) data = data |> arrange(group, value) # <-- 就是这里, 组内排序 # 设置每组末尾添加的空白条数量，用于分隔分组 empty_bar <- 4 to_add <- data.frame(matrix(NA, empty_bar * nlevels(data$group), ncol(data))) # 构造空白行 colnames(to_add) <- colnames(data) # 设置空白行的列名与原数据一致 to_add$group <- rep(levels(data$group), each = empty_bar) # 每组添加空白条 data <- rbind(data, to_add) # 合并数据和空白条 data <- data |> arrange(group) # 按分组排序（新管道写法） data$id <- seq(1, nrow(data)) # 为每一行添加唯一id # 获取每个标签的名称和y轴位置 label_data <- data number_of_bar <- nrow(label_data) # 总条形数（含空白） # 计算每个标签的角度，使标签位于条形中心 angle <- 90 - 360 * (label_data$id - 0.5) / number_of_bar # -0.5保证标签居中 # 计算标签的对齐方式：右对齐或左对齐 label_data$hjust <- ifelse(angle < -90, 1, 0) # 翻转角度，使标签可读 label_data$angle <- ifelse(angle < -90, angle + 180, angle) # 绘制极坐标条形图 p <- ggplot(data, aes(x = as.factor(id), y = value, fill = group)) + # id需转为因子，保证首尾无空隙 geom_bar(stat = "identity", alpha = 0.5) + # 添加条形，设置透明度 ylim(-100, 120) + # y轴范围，负值控制内圆比例 theme_minimal() + # 极简主题 theme( legend.position = "none", # 不显示图例 axis.text = element_blank(), # 去除坐标轴文字 axis.title = element_blank(), # 去除坐标轴标题 panel.grid = element_blank(), # 去除网格线 plot.margin = unit(rep(-1, 4), "cm") # 设置负边距，减少空白 ) + coord_polar() + # 转换为极坐标 # 添加标签，使用上面准备的label_data数据框 geom_text( data = label_data, aes(x = id, y = value + 10, label = individual, hjust = hjust), color = "black", fontface = "bold", alpha = 0.6, size = 2.5, angle = label_data$angle, inherit.aes = FALSE ) p ``` ### 定制加入了刻度线和分组标记: ```{r} #| fig-cap: "带组间空白的极坐标条形图" # 构造数据集 data <- data.frame( individual = paste("Mister ", seq(1, 60), sep = ""), # 个体名称 group = as.factor(c(rep('A', 10), rep('B', 30), rep('C', 14), rep('D', 6))), # 分组变量（必须为因子） value = sample(seq(10, 100), 60, replace = TRUE) # 随机生成数值 ) # 设置每组末尾添加的空白条数量，用于分隔分组 empty_bar <- 3 to_add <- data.frame(matrix(NA, empty_bar * nlevels(data$group), ncol(data))) # 构造空白行 colnames(to_add) <- colnames(data) # 设置空白行的列名与原数据一致 to_add$group <- rep(levels(data$group), each = empty_bar) # 每组添加空白条, each 不循环添加 data <- rbind(data, to_add) # 合并数据和空白条 data <- data |> arrange(group) # 按分组排序 data$id <- seq(1, nrow(data)) # 为每一行添加唯一id # 获取每个标签的名称和y轴位置 label_data <- data number_of_bar <- nrow(label_data) # 总条形数（含空白） # 计算每个标签的角度，使标签位于条形中心 angle <- 90 - 360 * (label_data$id - 0.5) / number_of_bar # -0.5保证标签居中 # 计算标签的对齐方式：右对齐或左对齐 label_data$hjust <- ifelse(angle < -90, 1, 0) # 翻转角度，使标签可读 label_data$angle <- ifelse(angle < -90, angle + 180, angle) # 构造分组基线数据，用于分组底部的线和分组标签 base_data <- data |> group_by(group) |> summarize(start = min(id), end = max(id) - empty_bar) |> rowwise() |> mutate(title = mean(c(start, end))) # 构造网格线数据，用于绘制圆环上的刻度线 grid_data <- base_data grid_data$end <- grid_data$end[c(nrow(grid_data), 1:nrow(grid_data) - 1)] + 1 grid_data$start <- grid_data$start - 1 grid_data <- grid_data[-1, ] # 绘制极坐标条形图 ggplot(data, aes(x = as.factor(id), y = value, fill = group)) + # id需转为因子，保证首尾无空隙 # 添加条形，设置透明度 geom_bar( aes(x = as.factor(id), y = value, fill = group), stat = "identity", alpha = 0.5 ) + # 添加圆环的刻度线（y=80/60/40/20） geom_segment( data = grid_data, aes(x = end, y = 80, xend = start, yend = 80), colour = "grey", alpha = 1, linewidth = 0.3, inherit.aes = FALSE ) + geom_segment( data = grid_data, aes(x = end, y = 60, xend = start, yend = 60), colour = "grey", alpha = 1, linewidth = 0.3, inherit.aes = FALSE ) + geom_segment( data = grid_data, aes(x = end, y = 40, xend = start, yend = 40), colour = "grey", alpha = 1, linewidth = 0.3, inherit.aes = FALSE ) + geom_segment( data = grid_data, aes(x = end, y = 20, xend = start, yend = 20), colour = "grey", alpha = 1, linewidth = 0.3, inherit.aes = FALSE ) + # 添加刻度值文本 annotate( "text", x = rep(max(data$id), 4), y = c(20, 40, 60, 80), label = c("20", "40", "60", "80"), color = "grey", size = 3, angle = 0, fontface = "bold", hjust = 1 ) + # 再次添加条形，保证条形在刻度线上方 geom_bar( aes(x = as.factor(id), y = value, fill = group), stat = "identity", alpha = 0.5 ) + ylim(-100, 120) + # y轴范围，负值控制内圆比例 theme_minimal() + # 极简主题 theme( legend.position = "none", # 不显示图例 axis.text = element_blank(), # 去除坐标轴文字 axis.title = element_blank(), # 去除坐标轴标题 panel.grid = element_blank(), # 去除网格线 plot.margin = unit(rep(-1, 4), "cm") # 设置负边距，减少空白 ) + coord_polar() + # 转换为极坐标 # 添加标签，使用上面准备的label_data数据框 geom_text( data = label_data, aes(x = id, y = value + 10, label = individual, hjust = hjust), color = "black", fontface = "bold", alpha = 0.6, size = 2.5, angle = label_data$angle, inherit.aes = FALSE ) + # 添加分组底部基线 geom_segment( data = base_data, aes(x = start, y = -5, xend = end, yend = -5), colour = "black", alpha = 0.8, linewidth = 0.6, inherit.aes = FALSE ) + # 添加分组标签 geom_text( data = base_data, aes(x = title, y = -18, label = group), hjust = c(1, 1, 0, 0), colour = "black", alpha = 0.8, size = 4, fontface = "bold", inherit.aes = FALSE ) ``` ## Pearl [![Hiking Locations in Washington](./image/washington.png)](https://r-graph-gallery.com/web-circular-barplot-with-R-and-ggplot2.html) [![环形棒棒糖图](./image/circular-lollipop.png)](https://r-graph-gallery.com/web-circular-lollipop-plot-with-ggplot2.html)