R语言绘图(3)-金字塔条形图

所用R包: ggplot2

1.数据准备

# 定义一个函数,用于生成每个变量的绘图所用数据
generate_test_data <- function(variable) {
  # 统计每列中大于 1、2、3。。。。的个数
  count_values <- function(column) {
    c(
      sum(column < 0, na.rm = TRUE),
      sum(column == 0, na.rm = TRUE),
      sum(column == 1, na.rm = TRUE),
      sum(column >= 2, na.rm = TRUE),
      sum(column >= 3, na.rm = TRUE),
      sum(column >= 4, na.rm = TRUE),
      sum(column >= 5, na.rm = TRUE),
      sum(column >= 6, na.rm = TRUE),
      sum(column >= 7, na.rm = TRUE),
      sum(column >= 8, na.rm = TRUE),
      sum(column >= 9, na.rm = TRUE),
      sum(column >= 10, na.rm = TRUE),
      sum(column >= 11, na.rm = TRUE)
    )
  }
  # 生成绘图数据集
  test <- tibble("labs"=rep(c("Worsen","0","1","≥2","≥3","≥4","≥5","≥6","≥7","≥8","≥9","≥10","≥11"),2),
                 "group"=c(rep("group1",13),rep("group2",13)),
                 "value"=c(count_values(subset(adam,分组==1)[[variable]])/0.28,count_values(subset(adam,分组==2)[[variable]])/0.21))#除以各组总数求百分比
  # 设置因子水平
  test$labs = factor(test$labs, levels=c("Worsen","0","1","≥2","≥3","≥4","≥5","≥6","≥7","≥8","≥9","≥10","≥11"))
  return(test)
}

2. 绘图

plot <- function(variable,xlabel) {
  # 生成数据
  test_data <- generate_test_data(variable)
  # 绘图
  p <- ggplot(test_data, aes(x = labs)) +
    geom_bar(data = subset(test_data, group == "group2"), aes(y = value), fill = "skyblue", stat = "identity") +
    geom_bar(data = subset(test_data, group == "group1"), aes(y = -value), fill = "tomato", stat = "identity") +
    geom_text(data = subset(test_data, group == "group2"), aes(y = value, label = paste0(round(value, 1), "%")), vjust = 0.5, hjust = -0.1) + 
    geom_text(data = subset(test_data, group == "group1"), aes(y = -value, label = paste0(round(value, 1), "%")), vjust = 0.5, hjust = 1.2) +
    geom_hline(yintercept = 0, colour = "white", lwd = 2) +
    geom_vline(xintercept = "0", linetype = "dashed", colour = "black") +
    coord_flip(ylim = c(-100, 100)) + 
    scale_fill_brewer(palette = 'Set1') +
    scale_y_continuous(breaks = seq(-100, 100, 50), labels = c(100, 50, 0, 50, 100)) +
    labs(y = "Percent", x = xlabel) +  #需更改对应纵轴标签
    ggtitle("group1 n=28                   group2 n=21") +
    theme_bw() +
    theme(
      plot.title = element_text(hjust = 0.5),
      panel.border = element_blank(),  # 移除图形四周边框
      axis.line.y = element_line(arrow = grid::arrow(type = "closed", length = unit(0.15, "inches"))),  # 设置 y 轴为箭头
      axis.line.x = element_line(),    # 恢复 x 轴的边框
      axis.ticks.x = element_line(),   # 添加 x 轴刻度
      legend.position = "none"         # 取消图例
    )
  return(p)
  }
p <- plot("dfadl1","ADL score at week1")
p

# 保存图像到指定目录
ggsave(filename = "ADLweek1.png", plot = p, width = 11, height = 6)

3.数据及图形示例

暂无评论

发送评论 编辑评论


				
|´・ω・)ノ
ヾ(≧∇≦*)ゝ
(☆ω☆)
(╯‵□′)╯︵┴─┴
 ̄﹃ ̄
(/ω\)
∠( ᐛ 」∠)_
(๑•̀ㅁ•́ฅ)
→_→
୧(๑•̀⌄•́๑)૭
٩(ˊᗜˋ*)و
(ノ°ο°)ノ
(´இ皿இ`)
⌇●﹏●⌇
(ฅ´ω`ฅ)
(╯°A°)╯︵○○○
φ( ̄∇ ̄o)
ヾ(´・ ・`。)ノ"
( ง ᵒ̌皿ᵒ̌)ง⁼³₌₃
(ó﹏ò。)
Σ(っ °Д °;)っ
( ,,´・ω・)ノ"(´っω・`。)
╮(╯▽╰)╭
o(*////▽////*)q
>﹏<
( ๑´•ω•) "(ㆆᴗㆆ)
😂
😀
😅
😊
🙂
🙃
😌
😍
😘
😜
😝
😏
😒
🙄
😳
😡
😔
😫
😱
😭
💩
👻
🙌
🖕
👍
👫
👬
👭
🌚
🌝
🙈
💊
😶
🙏
🍦
🍉
😣
Source: github.com/k4yt3x/flowerhd
颜文字
Emoji
小恐龙
花!
上一篇
下一篇