如何获得离散geom_rect的ggplot2函数以遵循alpha（透明度）值

Question

我刚刚问并回答了一个需要更多帮助的问题。链接在这里：How to gradient fill an annotation shape in ggplot2

我的问题是，对于我生成的代码，geom_rect不遵循alpha参数。渐变太暗。这是alpha为0.15且未应用渐变的图：

这里是具有渐变矩形的新图（最高alpha设置为0.1），显然它比0.15暗：

我已在下面包含我的代码。我不确定自己在做什么错，或者不确定是否有某些函数覆盖了geom_rect的alpha参数。另外，我得到一组错误：

“警告消息：1：删除了包含缺失值的50行（geom_rect）。2：删除了包含缺失值的50行（geom_rect）。3：删除了50个包含缺失值的行（geom_rect）。4：删除了包含缺失值的50行（geom_rect）。5：删除了包含缺失值的50行（geom_rect）。 “

我知道错误消息可能与某些较轻的geom_rects由于某些原因而被删除的事实有关，但是我不确定如何继续。

任何帮助将不胜感激。

library(lubridate)
NoOfHours <- as.numeric(ymd_hms("2019-6-1 00:00:00") - ymd_hms("2018-3-1 00:00:00"))*24 
data1 <- as.data.frame(ymd_hms("2018-3-01 8:00:00") + hours(0:NoOfHours))
colnames(data1) <- 'date' 
set.seed(10)
data1$level <- runif(nrow(data1), min = 0, max = 400)

library(readxl);library(lubridate); #loads the 'readxl' package.
#1.
Hours <- format(as.POSIXct(strptime(data1$date,"%Y-%m-%d %H:%M:%S",tz="")) ,format = "%H:%M:%S")
data1$hours <- Hours

Date <- format(as.POSIXct(strptime(data1$date,"%Y-%m-%d %H:%M:%S",tz="")) ,format = "%Y-%m-%d")
data1$date_date <- Date#output

month <- format(as.POSIXct(strptime(data1$date,"%Y-%m-%d %H:%M:%S",tz="")) ,format = "%m-%d")
data1$month<- month
#input the date here to select the start of the dataset, use the format: "yyyy-mm-dd". Then choose the end date by taking one full year of data. I.E. start = "2018-3-1", end = "2019-2-28"
start <- ceiling_date(ymd(data1$date_date[1]), "day", change_on_boundary = FALSE)
startdate <- as.Date(start) %m+% days(1)
enddate1 <- as.Date(startdate) %m+% years(1)
enddate<- as.Date(enddate1) %m-% days(1)

devicenumber <- "1"
Housename <- "level.tiff"
houseinfo <- c(devicenumber, Housename)

graphlimit <- 0 #need to define a limit for the graph
i<-200 #the initial lowest limit will always be 200
#this loop will now check for the highest levels of Radon and then graph a graphlimit that will encompass this maxima. This newly determined limit will allow different datasets to easily be automatically plotted with a range that is not too big or too small for the data.
if (max(data1$level) < (i+50)) {
  graphlimit <- i
} else {
while (max(data1$level)>(i+50)) {
  i<-i+200 }
  if(max(data1$level) < (i+50)) {graphlimit <- i
  }
}

library(openair)
yeardata <- selectByDate(data1, start = startdate, end = enddate, year = 2018:2019) #select for a defined set of years

library(ggplot2);library(extrafont)
graphlength <- graphlimit/(1350/1750)
innerlimit <- -(graphlength*(200/1750))
plotlimit <- graphlength+innerlimit #this sets the end limit of the outer plot ticks. This ratio was determined based on the largest dataset.

starttimedate <- ymd_hms(paste(startdate, "01:00:00"))
endtimedate <- ymd_hms(paste(enddate1, "01:00:00"))
#endtimedate2 <- ymd_hms(paste(floor_date(ymd(data1$date_date[1]), "year"), "01:00:00"))
NoOfhours <- as.numeric(ymd_hms(starttimedate) - ymd_hms("2018-01-01 00:00:00"))*24
NoOfHours <- (8760/12)*(month(startdate)-1)#as.numeric(ymd_hms(starttimedate) - ymd_hms(endtimedate2))*24  #need this to determine rotation. This will determine how many hours are between Jan 1-1 at 0:0:0 till the start of the dataset. 
NoOfHoursall <- as.numeric(ymd_hms(endtimedate) - ymd_hms(starttimedate))*24
date_vals <- seq(from = ceiling_date(ymd(startdate), "month", change_on_boundary = FALSE), length.out = 12, by = "months")
finalcell <- length(yeardata$date)
#HERE IS THE SOLUTION
#I created a few dataframes to represent the seasons with their start and end times. From there I modified a previous solution to create a gradient geom_rect function. 
spring <- data.frame(matrix(ncol = 0, nrow = 1))
  spring$seasonstartdate <- ymd_hms((yeardata$date[1]))
  spring$seasonenddates <- ymd_hms(yeardata$date[min(which(yeardata$date_date == ymd("2018-6-1")))])
  spring$colour <- "springgreen4"
   summer <- data.frame(matrix(ncol = 0, nrow = 1))
   summer$seasonstartdate <- ymd_hms(yeardata$date[min(which(yeardata$date_date == ymd("2018-6-1")))])
    summer$seasonenddates <- ymd_hms(yeardata$date[min(which(yeardata$date_date == ymd("2018-9-1")))])
    summer$colour <- "goldenrod2"
    fall <- data.frame(matrix(ncol = 0, nrow = 1))
   fall$seasonstartdate <- ymd_hms(yeardata$date[min(which(yeardata$date_date == ymd("2018-9-1")))])
    fall$seasonenddates <- ymd_hms(yeardata$date[min(which(yeardata$date_date == ymd("2018-12-1")))])
    fall$colour <- "orangered3"
     winter <- data.frame(matrix(ncol = 0, nrow = 1))
     winter$seasonstartdate <- ymd_hms(yeardata$date[min(which(yeardata$date_date == ymd("2018-12-1")))])
    winter$seasonenddates <- ymd_hms(yeardata$date[min(which(yeardata$date_date == ymd("2019-3-1")))])
    winter$colour <- "orangered3"
      spring1 <- data.frame(matrix(ncol = 0, nrow = 1))
  spring1$seasonstartdate <- ymd_hms(yeardata$date[min(which(yeardata$date_date == ymd("2019-3-1")))])
  spring1$seasonenddates <- ymd_hms(yeardata$date[finalcell])
  spring1$colour <- "springgreen4"

  ggplot_grad_rects <- function(n, ymin, ymax) {
  y_steps <- seq(from = ymin, to = ymax, length.out = n + 1)
  alpha_steps <- seq(from = 0, to = 0.2, length.out = n)
  rect_grad <- data.frame(ymin = y_steps[-(n + 1)], 
                          ymax = y_steps[-1], 
                          alpha = alpha_steps)
  rect_total <- merge(spring, rect_grad)
  rect_total2 <- merge(summer, rect_grad)
  rect_total3 <- merge(fall, rect_grad)
  rect_total4 <- merge(winter, rect_grad)
  rect_total5 <- merge(spring1, rect_grad)
    ggplot(yeardata)+
             geom_rect(data=rect_total, 
              aes(xmin=ymd_hms(seasonstartdate), xmax=ymd_hms(seasonenddates),
                  ymin=ymin, ymax=ymax, 
                  alpha=alpha), fill="springgreen4") +
             geom_rect(data=rect_total2, 
              aes(xmin=ymd_hms(seasonstartdate), xmax=ymd_hms(seasonenddates),
                  ymin=ymin, ymax=ymax, 
                  alpha=alpha), fill="goldenrod2") +
             geom_rect(data=rect_total3, 
              aes(xmin=ymd_hms(seasonstartdate), xmax=ymd_hms(seasonenddates),
                  ymin=ymin, ymax=ymax, 
                  alpha=alpha), fill="orangered3") +
             geom_rect(data=rect_total4, 
              aes(xmin=ymd_hms(seasonstartdate), xmax=ymd_hms(seasonenddates),
                  ymin=ymin, ymax=ymax, 
                  alpha=alpha), fill="cornflowerblue") +
             geom_rect(data=rect_total5, 
              aes(xmin=ymd_hms(seasonstartdate), xmax=ymd_hms(seasonenddates),
                  ymin=ymin, ymax=ymax, 
                  alpha=alpha), fill="springgreen4") +
    guides(alpha = FALSE)
}



plot <- ggplot_grad_rects(100, graphlimit, graphlength) +
 annotate("rect", xmin =  ((yeardata$date[1])), xmax =  (yeardata$date[min(which(yeardata$date_date == ymd("2018-6-1")))]), ymin = graphlimit, ymax = Inf, fill = "springgreen4", alpha = 0.15)+
  annotate("rect", xmin =  (yeardata$date[min(which(yeardata$date_date == ymd("2018-6-1")))]), xmax =  (yeardata$date[min(which(yeardata$date_date == ymd("2018-9-1")))]), ymin = graphlimit, ymax = Inf, fill = "goldenrod2", alpha = 0.15)+
  annotate("rect", xmin =  (yeardata$date[min(which(yeardata$date_date == ymd("2018-9-1")))]), xmax =  (yeardata$date[min(which(yeardata$date_date == ymd("2018-12-1")))]), ymin = graphlimit, ymax = Inf, fill = "orangered3", alpha = 0.15)+
  annotate("rect", xmin =  (yeardata$date[min(which(yeardata$date_date == ymd("2018-12-1")))]), xmax =  (yeardata$date[min(which(yeardata$date_date == ymd("2019-3-1")))]), ymin = graphlimit, ymax = Inf, fill = "cornflowerblue", alpha = 0.15)+
  annotate("rect", xmin =  (yeardata$date[min(which(yeardata$date_date == ymd("2019-3-1")))]), xmax =  (yeardata$date[finalcell]), ymin = graphlimit, ymax = Inf, fill = "springgreen4", alpha = 0.15)+
  geom_hline(yintercept = seq(0, graphlimit, by = 200), colour = "black", size = 0.75, alpha = 0.3)+ 
  geom_hline(yintercept = seq(0, graphlimit, by = 50), colour = "black", size = 0.5, alpha = 0.1)+ 
  annotate("segment",x =  (yeardata$date[1]), xend =  (yeardata$date[1]), y = 0, yend = graphlimit, colour = "black", size = 1, alpha = 0.5) +
#annotate("text",x =  (max(yeardata$date)), y = innerlimit, colour = "black", size = 7, alpha = 1, label = devicenumber)+
  scale_colour_gradientn(limits = c(0,1000), colours = c("grey","yellow","orangered1","red","red4","black"), values = c(0,0.1,0.2,0.5,0.8,1), breaks = c(0, 100, 200, 500, 800, 1000), oob = scales::squish, name = expression(atop("",atop(textstyle("Level"^2*"")))))+ #need oob = scales::squish to get values over 200 to be red.
    geom_jitter(alpha = 0.2, size = 1) +
 theme(text = element_text(family="Calibri"),  axis.title=element_text(size=16,face="bold"), axis.text.x = element_blank(), axis.text.y = element_text(size = 12))+
   labs(x = NULL, y = bquote('Level'))+
  scale_y_continuous(breaks = seq(0, graphlimit, 200),
                     limits = c(innerlimit,plotlimit))+
 annotate("segment", x =  (yeardata$date[min(which(yeardata$date_date == ymd(date_vals[1])))]), xend =  (yeardata$date[min(which(yeardata$date_date == ymd(date_vals[1])))]), y = graphlimit, yend = plotlimit, colour = "black", size = 2)+
  annotate("segment", x =  (yeardata$date[min(which(yeardata$date_date == ymd(date_vals[2])))]), xend =  (yeardata$date[min(which(yeardata$date_date == ymd(date_vals[2])))]), y = graphlimit, yend = plotlimit, colour = "black", size = 2)+
  annotate("segment", x =  (yeardata$date[min(which(yeardata$date_date == ymd(date_vals[3])))]), xend =  (yeardata$date[min(which(yeardata$date_date == ymd(date_vals[3])))]), y = graphlimit, yend = plotlimit, colour = "black", size = 2)+
  annotate("segment", x =  (yeardata$date[min(which(yeardata$date_date == ymd(date_vals[4])))]), xend =  (yeardata$date[min(which(yeardata$date_date == ymd(date_vals[4])))]), y = graphlimit, yend = plotlimit, colour = "black", size = 2)+
  annotate("segment", x =  (yeardata$date[min(which(yeardata$date_date == ymd(date_vals[5])))]), xend =  (yeardata$date[min(which(yeardata$date_date == ymd(date_vals[5])))]), y = graphlimit, yend = plotlimit, colour = "black", size = 2)+
  annotate("segment", x =  (yeardata$date[min(which(yeardata$date_date == ymd(date_vals[6])))]), xend =  (yeardata$date[min(which(yeardata$date_date == ymd(date_vals[6])))]), y = graphlimit, yend = plotlimit, colour = "black", size = 2)+
  annotate("segment", x =  (yeardata$date[min(which(yeardata$date_date == ymd(date_vals[7])))]), xend =  (yeardata$date[min(which(yeardata$date_date == ymd(date_vals[7])))]), y = graphlimit, yend = plotlimit, colour = "black", size = 2)+
  annotate("segment", x =  (yeardata$date[min(which(yeardata$date_date == ymd(date_vals[8])))]), xend =  (yeardata$date[min(which(yeardata$date_date == ymd(date_vals[8])))]), y = graphlimit, yend = plotlimit, colour = "black", size = 2)+
  annotate("segment", x =  (yeardata$date[min(which(yeardata$date_date == ymd(date_vals[9])))]), xend =  (yeardata$date[min(which(yeardata$date_date == ymd(date_vals[9])))]), y = graphlimit, yend = plotlimit, colour = "black", size = 2)+
  annotate("segment", x =  (yeardata$date[min(which(yeardata$date_date == ymd(date_vals[10])))]), xend =  (yeardata$date[min(which(yeardata$date_date == ymd(date_vals[10])))]), y = graphlimit, yend = plotlimit, colour = "black", size = 2)+
  annotate("segment", x =  (yeardata$date[min(which(yeardata$date_date == ymd(date_vals[11])))]), xend =  (yeardata$date[min(which(yeardata$date_date == ymd(date_vals[11])))]), y = graphlimit, yend = plotlimit, colour = "black", size = 2)+
  annotate("segment", x =  (yeardata$date[min(which(yeardata$date_date == ymd(date_vals[12])))]), xend =  (yeardata$date[min(which(yeardata$date_date == ymd(date_vals[12])))]), y = graphlimit, yend = plotlimit, colour = "black", size = 2)+
                  annotate("text", x =  (yeardata$date[min(which(yeardata$month == "01-16"))]), y = ((graphlimit+plotlimit)/2), colour = "black", size = 9, family="Calibri", label = "JAN", angle = -15)+
  annotate("text", x =  (yeardata$date[min(which(yeardata$month == "02-16"))]), y = ((graphlimit+plotlimit)/2), colour = "black", size = 9, family="Calibri", label = "FEB", angle = -45)+
  annotate("text", x =  (yeardata$date[min(which(yeardata$month == "03-16"))]), y = ((graphlimit+plotlimit)/2), colour = "black", size = 9, family="Calibri", label = "MAR", angle = -74)+
  annotate("text", x =  (yeardata$date[min(which(yeardata$month == "04-16"))]), y = ((graphlimit+plotlimit)/2), colour = "black", size = 9, family="Calibri", label = "APR", angle = -104)+
  annotate("text", x =  (yeardata$date[min(which(yeardata$month == "05-16"))]), y = ((graphlimit+plotlimit)/2), colour = "black", size = 9, family="Calibri", label = "MAY", angle = -133)+
  annotate("text", x =  (yeardata$date[min(which(yeardata$month == "06-16"))]), y = ((graphlimit+plotlimit)/2), colour = "black", size = 9, family="Calibri", label = "JUN", angle = -163)+
  annotate("text", x =  (yeardata$date[min(which(yeardata$month == "07-16"))]), y = ((graphlimit+plotlimit)/2), colour = "black", size = 9, family="Calibri", label = "JUL", angle = 165)+
  annotate("text", x =  (yeardata$date[min(which(yeardata$month == "08-16"))]), y = ((graphlimit+plotlimit)/2), colour = "black", size = 9, family="Calibri", label = "AUG", angle = 135)+
  annotate("text", x =  (yeardata$date[min(which(yeardata$month == "09-16"))]), y = ((graphlimit+plotlimit)/2), colour = "black", size = 9, family="Calibri", label = "SEP", angle = 105)+
  annotate("text", x =  (yeardata$date[min(which(yeardata$month == "10-16"))]), y = ((graphlimit+plotlimit)/2), colour = "black", size = 9, family="Calibri", label = "OCT", angle = 75)+
  annotate("text", x =  (yeardata$date[min(which(yeardata$month == "11-16"))]), y = ((graphlimit+plotlimit)/2), colour = "black", size = 9, family="Calibri", label = "NOV", angle = 45)+
  annotate("text", x =  (yeardata$date[min(which(yeardata$month == "12-16"))]), y = ((graphlimit+plotlimit)/2), colour = "black", size = 9, family="Calibri", label = "DEC", angle = 15)
plot
plot <- plot + coord_polar(start = ((2*NoOfhours/NoOfHoursall)*pi))+ #scale_x_continuous(breaks = as.POSIXct.Date(ymd_hms(yeardata$date[min(which(yeardata$date_date == ymd(date_vals[2])))]), origin))+ 
  theme(legend.title = element_text(color = "black", size = 14, face = "bold"), panel.background = element_rect(fill = "white"), panel.grid  = element_blank())
plot

Answer 1

我看不到scale_alpha_identity或scale_alpha_continuous(range = c(0, 0.2))，所以我怀疑ggplot会将您的各种alpha值映射到(0.1, 1)的默认范围，而不管基础值的范围如何。

这是一个简短的示例：

library(tidyverse); library(lubridate)
my_data <- tibble(
  date = seq.Date(ymd(20190101), ymd(20191231), by = "5 day"),
  month = month(date),
  color = case_when(month <= 2 ~ "cornflowerblue",
                    month <= 5 ~ "springgreen4",
                    month <= 8 ~ "goldenrod2",
                    month <= 11 ~ "orangered3",
                    TRUE ~ "cornflowerblue")) 


my_data %>%
  uncount(20, .id = "row") %>%
  mutate(alpha_val = row / max(row) * 0.2) %>%
  ggplot(aes(date, 5 + alpha_val * 5, fill = color, alpha = alpha_val)) +
  geom_tile(color = NA) +
  scale_fill_identity() +
  scale_alpha_identity() +
  expand_limits(y = 0) +
  coord_polar() +
  theme_void()