ggplot2绘制瀑布图

版权声明：本文为博主原创文章，未经博主允许不得转载。 https://blog.csdn.net/arcers/article/details/80673596

1 绘图函数

1.1 参数说明

raw.data

数据类型：data.frame

column：value，数值数据，留存、增加用正数，减少用负数。

column：group，从’start’, ‘up’, ‘down’, ‘end’中取值，用于标注数值的类型。

col.s

数据类型：字符串

起始柱的颜色

col.u

数据类型：字符串

上升柱的颜色

col.d

数据类型：字符串

下降柱的颜色

col.e

数据类型：字符串

结束柱的颜色

width

数据类型：数值

柱的宽度

xlabs

数据类型：字符串向量

横轴标签

addline

数据类型： logical

是否在柱之间添加连线

1.2 函数代码

library(ggplot2)

water.full <- 
  function(raw.data, col.s = 'purple', col.u = 'orange', col.d = 'darkblue',
      col.e = 'purple', width = 35, xlabs = NA, addline = TRUE){
  num <- nrow(raw.data)
  end.val <- raw.data[which(raw.data$group == 'end'),'value']
  end <- c(cumsum(raw.data$value[-num]), end.val)
  start <- end - raw.data$value

  cols <- data.frame(
    group = c('start', 'up', 'down', 'end'),
    colour.names = c(col.s, col.u, col.d, col.e),
    stringsAsFactors = F
  )

  temp <- data.frame(
    id = 1:num,
    group = raw.data$group,
    value = raw.data$value,
    start = start,
    end = end, stringsAsFactors = F
  )

  data.clean <- merge(temp, cols, by.x = 'group', by.y = 'group')

  data.clean$group <- as.character(data.clean$group)
  data.clean <- data.clean[order(data.clean$id),]

  thetheme <- theme_light() + theme(
    # 字体
    title = element_text(size = 20, colour = 'black'),
    legend.text = element_text(size = 10),
    legend.title = element_text(size = 12),
    axis.text.x = element_text(size = 11, angle = 0),
    axis.text.y = element_text(size = 12),
    axis.title.x = element_text(size = 12),
    axis.title.y = element_text(size = 12),
    panel.background = element_rect(fill = 'white'),

    # 边框网格
    panel.grid.major.x = element_line(size = .2),
    panel.grid.minor.x = element_line(size = .2, linetype = 'dashed'),
    panel.grid.major.y = element_line(size = .2),
    panel.grid.minor.y = element_line(size = .2, linetype = 'dashed'),
    panel.border = element_blank(), 

    # 图例
    legend.position = 'none'
  )

  g <- ggplot(data.clean) +
    geom_segment(
      aes(x = id, y = start, xend = id, yend = end, col = group), 
      size = width) + 
    geom_text(
      aes(x = id, y = 0.5*(start + end), label = value), 
      col = 'white') +
    geom_hline(yintercept = 0, size = 1) +
    thetheme +
    scale_color_manual(
      values = c('start' = col.s, 'end' = col.e, 'up' = col.u,'down' = col.d)) +
    scale_y_continuous('')

  if (addline) {
    # 连接线
    lstart <- data.clean$start[-1]
    lend <- data.clean$end[-num]
    lstart[num - 1] <- lend[num - 1]
    df.line <- data.frame(
      lx.start = data.clean$id[-num],
      lx.end = data.clean$id[-1],
      ly = lstart
    )
    g <- g + 
      geom_segment(
        data = df.line,
        aes(x = lx.start, y = ly, xend = lx.end, yend = ly),
        linetype = 'dashed', size = 1
      )
  }

  if (length(xlabs) == 1) {
    g <- g + 
      scale_x_continuous('', 
         breaks = data.clean$id,labels = data.clean$group, expand = c(0.1, 0.1)
         ) 
  } else {
    g <- g + 
      scale_x_continuous('', 
        breaks = data.clean$id,labels = xlabs, expand = c(0.1, 0.1)
        ) 
  }

  return(g)
}

2 示例

2.1 数据

raw.data <- data.frame(
  group = c('start', 'down','up', 'up','end'),
  value = c(200, -100, 100,200, 400)
)

2.2 绘图

water.full(
  raw.data, 
  col.s = 'purple', col.u = 'orange', col.d = 'darkblue', col.e = 'purple', 
  xlabs = c('2017Q1', '减少', '新增', '新增','2018Q1'),
  width = 35, addline = T
)