在函数调用后使用rasterGrob添加annotation_custom

时间:2016-03-10 20:21:06

标签: r ggplot2 grid

为标题道歉,我知道这很糟糕。

我正在尝试创建瀑布图功能。所以,我正在尝试创建一个基本的情节,人们可以根据自己的意愿配置。然而,我遇到了一个问题,为情节添加了渐变。例如:

我有这个df:

> wfDF
                 category   value sign id    end  start labels
1         Basic Materials  0.0024  pos  1 0.0024 0.0000 0.0024
2          Communications  0.0492  pos  2 0.0516 0.0024 0.0516
3      Consumer, Cyclical  0.0268  pos  3 0.0784 0.0516 0.0784
4  Consumer, Non-cyclical  0.0245  pos  4 0.1029 0.0784 0.1029
5             Diversified -0.0037  neg  5 0.0992 0.1029 0.1029
6                  Energy -0.0040  neg  6 0.0952 0.0992 0.0992
7               Financial  0.0445  pos  7 0.1397 0.0952 0.1397
8              Industrial  0.0006  pos  8 0.1403 0.1397 0.1403
9              Technology -0.0059  neg  9 0.1344 0.1403 0.1403
10                  Total  0.1345  pos 10 0.0000 0.1344 0.1344

使用此代码:

ggplot(wfDF, aes(category, fill = sign, color = sign)) + guides(fill = FALSE, color=FALSE) +
  ggtitle("Risk by Industry") + 
  annotation_custom(g, xmin=-Inf, xmax=Inf, ymin=-Inf, ymax=Inf) +
  theme(plot.title = element_text(vjust=1.5, face="bold", size = 20),
        axis.title.x = element_blank(), axis.title.y = element_blank()) +
  geom_rect(aes(x = category, xmin = id - 0.475, xmax = id + 0.475, ymin = end, ymax = start)) +
  scale_fill_manual(values=c("red", "forestgreen")) + 
  scale_color_manual(values=c("black", "black")) + 
  scale_y_continuous(labels = percent) +     
  scale_x_discrete("", breaks = levels(wfDF$category), labels = gsub(" ", "\n", levels(wfDF$category))) + 
  geom_text(data = wfDF, aes(id, labels, label = paste0(value*100, "%")), vjust = -.5, size = 5, fontface = 4)

生成此图表:

enter image description here

看起来很棒。我正在尝试编写一个函数,它将使用任何类别和值集来完成所有这些操作,并允许添加或使用任何颜色或自定义。我有这个功能:

waterfall <- function(categories, values, has.total = FALSE, offset = .475, labelType = c("decimal", "percent")) {
  library(scales)
  library(grid)
  library(ggplot2)
  library(dplyr)

  theData <- data.frame("category" = as.character(categories), "value" = as.numeric(values))
  if (labelType == "percent") theData$value = theData$value/100
  if (!has.total) theData <- theData %>% rbind(.,list("Total", sum(.$val)))
  theData$sign <- ifelse(theData$val >= 0, "pos","neg")
  theData <- data.frame(category = factor(theData$category, levels = unique(theData$category)),
                           value = round(theData$value,4),
                           sign = factor(theData$sign, levels = unique(theData$sign)))
  theData$id <- seq_along(theData$value)
  theData$end <- cumsum(theData$value)
  theData$end <- c(head(theData$end, -1), 0)
  theData$start <- c(0, head(theData$end, -1))
  theData$labels <- paste0(theData$value*100, "%")
  theData$labellocs <- pmax(theData$end,theData$start)

  theGG <- ggplot(theData, aes(category, fill = sign, color = sign)) + 
    geom_rect(aes(x = category, xmin = id - offset, xmax = id + offset, ymin = end, ymax = start)) +
    scale_x_discrete("", breaks = levels(theData$category), labels = gsub(" ", "\n", levels(theData$category))) + 
    geom_text(data = theData, aes(id, labellocs, label = labels), vjust = -.5, size = 5, fontface = 4)
    return(theGG)
}

 waterfall(categories = riskDecomp$ID, values = riskDecomp$val, labelType = "percent")

这产生了一个相当丑陋的基本事物:

enter image description here

但是,如果我尝试运行以下内容:

test <- waterfall(categories = riskDecomp$ID, values = riskDecomp$val, labelType = "percent")
g <- rasterGrob(blues9, width=unit(1,"npc"), height = unit(1,"npc"), interpolate = TRUE)
  test + guides(fill = FALSE, color=FALSE) +
  ggtitle("Risk Decomposition") + 
  annotation_custom(g, xmin=-Inf, xmax=Inf, ymin=-Inf, ymax=Inf) + 
  theme(plot.title = element_text(vjust=1.5, face="bold", size = 20),
        axis.title.x = element_blank(), axis.title.y = element_blank()) +
  scale_fill_manual(values=c("red", "forestgreen")) + 
  scale_color_manual(values=c("black", "black")) + 
  scale_y_continuous(labels = percent)

我得到了这个废话:

enter image description here

rasterGrob似乎覆盖了整个情节的其余部分。我能找到的唯一解决方法是将渐变添加到函数内部。哪种删除功能的定制。有没有办法来解决这个问题?要修复凹凸的顺序?如果这有意义吗?

1 个答案:

答案 0 :(得分:1)

您可以手动更改图层的顺序,

library(grid)
library(ggplot2)

g <- rasterGrob(matrix(blues9, ,1), interpolate=TRUE,
                width=unit(1,"npc"), height=unit(1,"npc"))

p <- qplot(rnorm(10), rnorm(10)) +
  annotation_custom(g)

nl <- length(p$layers)
p$layers <- c(p$layers[[nl]], p$layers[-nl])
p

enter image description here