如何用丝带和线条组合和修改ggplot2图例?

SS_*_*ous 5 plot r ggplot2

我对以下情节的图例有几个问题: 在此处输入图片说明

  • 丝带和线条被分成 2 个不同的图例,但我希望它们被合并:图例中的线条应该具有与具有相同名称的丝带相对应的背景填充(并且对于“官方税收”条目是透明的)。
  • 图例中的线条因颜色而异,但它们应因颜色和线型而异。

似乎我需要使用scale_manualguide_legend选项,但我所有的尝试都惨遭失败。

这是创建绘图的代码。plotDumping是绘制绘图、为绘图updateData生成数据框和 'updateLabels' 为绘图生成脚注的函数。

library(ggplot2)
library(grid)
library(gridExtra)
library(scales)

max_waste_volume <- 2000 
Illegal_dumping_fine_P <- 300000
Illigal_landfilling_fine_P1 <- 500000
Fine_probability_k <- 0.5
Official_tax_Ta <- 600

# mwv = max_waste_volume
# P = Illegal_dumping_fine_P
# P1 = Illigal_landfilling_fine_P1
# k = Fine_probability_k
# Ta = Official_tax_Ta


updateData <- function(mwv, k, P1, P, Ta){

    # creates and(or) updates global data frame to provide data for the plot

    new_data <<- NULL
    new_data <<- as.data.frame(0:mwv)
    names(new_data) <<- 'V'
    new_data$IlD <<- k*P1/new_data$V
    new_data$IlD_fill <<- new_data$IlD
    new_data$IlD_fill[new_data$IlD_fill > Ta] <<- NA # we don't want ribbon to 
    new_data$IlL <<- Ta-k*P/new_data$V
}

updateLabels <- function(k, P1, P, Ta){

    ### creates footnote caption for the plot

    prob <- paste('Fining probability = ', k, sep = '')
    landfilling_fine <- paste('Illegal landfilling fine = ', P1, sep = '')
    dumping_fine <- paste('Illegal dumping fine = ', P, sep = '')
    tax <- paste('Official tax = ', Ta, sep = '')
    note <<- paste(prob, landfilling_fine, sep = '; ')
    note <<- paste(note, dumping_fine, sep = '; ')
    note <<- paste(note, tax, sep = '; ')
    note
}


plotDumping <- function(mwv, 
                        P,
                        P1,
                        k,
                        Ta){

  ### this function draws the plot

  # initialise plot data
  updateData(mwv, k, P1, P, Ta)
  updateLabels(k, P1, P, Ta)

  # draw the plot
  profit <- ggplot(data=new_data, aes(x = new_data$V)) +
    geom_ribbon(show_guide = T, alpha = 0.25, ymax = Ta, 
                aes(ymin = new_data$IlD_fill,
                    fill = "Illegal landfill owner's\nprofitable ratio\n")) +
    geom_ribbon(show_guide = F, alpha = 0.25, ymin = 0, 
                aes(ymax = new_data$IlL, 
                    fill = "Waste owner's\nprofitable ratio")) + 
    geom_line(data=new_data, 
              aes(y = new_data$IlD, col = "Illegal landfill owner's\nprofitable ratio\n"), 
              size = 1,
              linetype = 4) +
    geom_line(data=new_data, 
              aes(y = new_data$IlL, col = "Waste owner's\nprofitable ratio"), 
              size = 1,
              linetype = 5) + 
    geom_line(y = Ta, 
              aes(col = "Official tax"), 
              size = 1.5,
              linetype = 1)+ 
    xlim(c(0, max(new_data$V)))+
    ylim(c(0, Ta*1.5))+
    theme(axis.text.x = element_text(angle=0, hjust = 0),
          axis.title = element_text(face = 'bold', size = 14),
          title = element_text(face = 'bold', size = 16),
          legend.position = 'right',
          legend.title = element_blank(),
          legend.text = element_text(size = 12),
          legend.key.width = unit(1, 'cm'))+
    labs(title="Profitable ratio between the volume \nof illegally disposed waste \nand costs of illegal waste disposure",
         x="Waste volume, cubic meters",
         y="Cost per cubic meter, RUB")

   # add a footnote about paramaters used for the current plot
   profit <- arrangeGrob(profit, sub = textGrob(note, 
                                           x = 0, 
                                           hjust = -0.1, 
                                           vjust=0.1, 
                                           gp = gpar(fontface = "italic", fontsize = 12)))

 # show plot
 print(profit)
}

# draw the plot
plotDumping(max_waste_volume, 
                         Illegal_dumping_fine_P,
                         Illigal_landfilling_fine_P1,
                         Fine_probability_k,
                         Official_tax_Ta)
Run Code Online (Sandbox Code Playgroud)

sha*_*dow 2

如果您将线型放入函数中,您还可以使用您的版本来获取正确的线型aes。然而,这样你的代码就会变得更加麻烦。在调用之前考虑重塑您的数据ggplot。那么你就完全不用担心传说了。

# reshape data ...
new_data$Ta <- Ta
new_data$zero <- 0
require(reshape2)
dta <- melt(new_data, id.vars="V", measure.vars=c("IlD", "IlL", "Ta"))
dta.lower <- melt(new_data, id.vars="V", measure.vars=c("IlD_fill", "zero", "Ta"))
dta.upper <- melt(new_data, id.vars="V", measure.vars=c("Ta", "IlL", "Ta"))
dta <- cbind(dta, lower=dta.lower$value, upper=dta.upper$value)
dta$name <- factor(NA, levels=c("Illegal landfill owner's\nprofitable ratio\n",
                                "Waste owner's\nprofitable ratio", 
                                "Official tax"))
dta$name[dta$variable=="IlD"] <- "Illegal landfill owner's\nprofitable ratio\n"
dta$name[dta$variable=="IlL"] <- "Waste owner's\nprofitable ratio"
dta$name[dta$variable=="Ta"] <- "Official tax"
Run Code Online (Sandbox Code Playgroud)

现在绘图命令变得更加容易和透明:

ggplot(dta, aes(x=V, y=value, ymin=lower, ymax=upper, 
                color=name, fill=name, linetype=name)) +
  geom_line(size=1.2) + ylim(c(0, Ta*1.5)) +
  geom_ribbon(alpha=.25, linetype=0) +
  theme(axis.text.x = element_text(angle=0, hjust = 0),
        axis.title = element_text(face = 'bold', size = 14),
        title = element_text(face = 'bold', size = 16),
        legend.position = 'right',
        legend.title = element_blank(),
        legend.text = element_text(size = 12),
        legend.key.width = unit(2, 'cm'))+
  scale_linetype_manual(values=c(4, 5, 1)) +
  labs(title="Profitable ratio between the volume \nof illegally disposed waste \nand costs of illegal waste disposure",
       x="Waste volume, cubic meters",
       y="Cost per cubic meter, RUB")
Run Code Online (Sandbox Code Playgroud)