如何获得离散 geom_rect 的 ggplot2 函数以遵守 alpha(透明度)值
How to get a ggplot2 function of discrete geom_rect to obey the alpha (transparency) values
我刚刚提出并回答了一个我需要更多帮助的问题。这是 link:
我的问题是,对于我生成的代码,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_rect 出于某种原因被删除有关,但我不确定如何继续。
如有任何帮助,我们将不胜感激。
#Generate a similar dataset to the one I am working with.
library(lubridate);library(ggplot2);library(extrafont);library(openair)
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)
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
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)
yeardata <- selectByDate(data1, start = startdate, end = enddate, year = 2018:2019) #select for a defined set of years
graphlimit <- 400
graphlength <- graphlimit/(1350/1750)
innerlimit <- -(graphlength*(200/1750))
plotlimit <- graphlength+innerlimit
starttimedate <- ymd_hms(paste(startdate, "01:00:00"))
endtimedate <- ymd_hms(paste(enddate1, "01:00:00"))
#This section helps determine the rotation of the geom jitter to align January 1 at 00:00:00 at the top
NoOfhours <- as.numeric(ymd_hms(starttimedate) - ymd_hms("2018-01-01 00:00:00"))*24
NoOfHours <- (8760/12)*(month(startdate)-1)
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)
#Dataframes to encompass the seasons.
spring <- data.frame(matrix(ncol = 0, nrow = 1))
spring$seasonstartdate <- ((yeardata$date[1]))
spring$seasonenddates <- (yeardata$date[min(which(yeardata$date_date == ymd("2018-6-1")))])
spring$colour <- "springgreen4"
summer <- data.frame(matrix(ncol = 0, nrow = 1))
summer$seasonstartdate <- (yeardata$date[min(which(yeardata$date_date == ymd("2018-6-1")))])
summer$seasonenddates <- (yeardata$date[min(which(yeardata$date_date == ymd("2018-9-1")))])
summer$colour <- "goldenrod2"
fall <- data.frame(matrix(ncol = 0, nrow = 1))
fall$seasonstartdate <- (yeardata$date[min(which(yeardata$date_date == ymd("2018-9-1")))])
fall$seasonenddates <- (yeardata$date[min(which(yeardata$date_date == ymd("2018-12-1")))])
fall$colour <- "orangered3"
winter <- data.frame(matrix(ncol = 0, nrow = 1))
winter$seasonstartdate <- (yeardata$date[min(which(yeardata$date_date == ymd("2018-12-1")))])
winter$seasonenddates <- (yeardata$date[min(which(yeardata$date_date == ymd("2019-3-1")))])
winter$colour <- "orangered3"
spring1 <- data.frame(matrix(ncol = 0, nrow = 1))
spring1$seasonstartdate <- (yeardata$date[min(which(yeardata$date_date == ymd("2019-3-1")))])
spring1$seasonenddates <- (yeardata$date[finalcell])
spring1$colour <- "springgreen4"
#This function enables geom rectangles to be gradient filled, independently of a gradient fill within a plot.
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=(seasonstartdate), xmax=(seasonenddates),
ymin=ymin, ymax=ymax,
alpha=alpha), fill="springgreen4") +
geom_rect(data=rect_total2,
aes(xmin=(seasonstartdate), xmax=(seasonenddates),
ymin=ymin, ymax=ymax,
alpha=alpha), fill="goldenrod2") +
geom_rect(data=rect_total3,
aes(xmin=(seasonstartdate), xmax=(seasonenddates),
ymin=ymin, ymax=ymax,
alpha=alpha), fill="orangered3") +
geom_rect(data=rect_total4,
aes(xmin=(seasonstartdate), xmax=(seasonenddates),
ymin=ymin, ymax=ymax,
alpha=alpha), fill="cornflowerblue") +
geom_rect(data=rect_total5,
aes(xmin=(seasonstartdate), xmax=(seasonenddates),
ymin=ymin, ymax=ymax,
alpha=alpha), fill="springgreen4") +
guides(alpha = FALSE)
}
plot <- ggplot_grad_rects(100, graphlimit, graphlength) +
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*"")))))+
geom_jitter(aes(x=date, y=level, color = level), 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))+
scale_alpha_identity() +
coord_polar(start = ((2*NoOfhours/NoOfHoursall)*pi))+
theme(legend.title = element_text(color = "black", size = 14, face = "bold"), panel.background = element_rect(fill = "white"), panel.grid = element_blank())
plot
现在合并了此修复程序:
我没有看到 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()
我刚刚提出并回答了一个我需要更多帮助的问题。这是 link:
我的问题是,对于我生成的代码,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_rect 出于某种原因被删除有关,但我不确定如何继续。
如有任何帮助,我们将不胜感激。
#Generate a similar dataset to the one I am working with.
library(lubridate);library(ggplot2);library(extrafont);library(openair)
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)
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
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)
yeardata <- selectByDate(data1, start = startdate, end = enddate, year = 2018:2019) #select for a defined set of years
graphlimit <- 400
graphlength <- graphlimit/(1350/1750)
innerlimit <- -(graphlength*(200/1750))
plotlimit <- graphlength+innerlimit
starttimedate <- ymd_hms(paste(startdate, "01:00:00"))
endtimedate <- ymd_hms(paste(enddate1, "01:00:00"))
#This section helps determine the rotation of the geom jitter to align January 1 at 00:00:00 at the top
NoOfhours <- as.numeric(ymd_hms(starttimedate) - ymd_hms("2018-01-01 00:00:00"))*24
NoOfHours <- (8760/12)*(month(startdate)-1)
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)
#Dataframes to encompass the seasons.
spring <- data.frame(matrix(ncol = 0, nrow = 1))
spring$seasonstartdate <- ((yeardata$date[1]))
spring$seasonenddates <- (yeardata$date[min(which(yeardata$date_date == ymd("2018-6-1")))])
spring$colour <- "springgreen4"
summer <- data.frame(matrix(ncol = 0, nrow = 1))
summer$seasonstartdate <- (yeardata$date[min(which(yeardata$date_date == ymd("2018-6-1")))])
summer$seasonenddates <- (yeardata$date[min(which(yeardata$date_date == ymd("2018-9-1")))])
summer$colour <- "goldenrod2"
fall <- data.frame(matrix(ncol = 0, nrow = 1))
fall$seasonstartdate <- (yeardata$date[min(which(yeardata$date_date == ymd("2018-9-1")))])
fall$seasonenddates <- (yeardata$date[min(which(yeardata$date_date == ymd("2018-12-1")))])
fall$colour <- "orangered3"
winter <- data.frame(matrix(ncol = 0, nrow = 1))
winter$seasonstartdate <- (yeardata$date[min(which(yeardata$date_date == ymd("2018-12-1")))])
winter$seasonenddates <- (yeardata$date[min(which(yeardata$date_date == ymd("2019-3-1")))])
winter$colour <- "orangered3"
spring1 <- data.frame(matrix(ncol = 0, nrow = 1))
spring1$seasonstartdate <- (yeardata$date[min(which(yeardata$date_date == ymd("2019-3-1")))])
spring1$seasonenddates <- (yeardata$date[finalcell])
spring1$colour <- "springgreen4"
#This function enables geom rectangles to be gradient filled, independently of a gradient fill within a plot.
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=(seasonstartdate), xmax=(seasonenddates),
ymin=ymin, ymax=ymax,
alpha=alpha), fill="springgreen4") +
geom_rect(data=rect_total2,
aes(xmin=(seasonstartdate), xmax=(seasonenddates),
ymin=ymin, ymax=ymax,
alpha=alpha), fill="goldenrod2") +
geom_rect(data=rect_total3,
aes(xmin=(seasonstartdate), xmax=(seasonenddates),
ymin=ymin, ymax=ymax,
alpha=alpha), fill="orangered3") +
geom_rect(data=rect_total4,
aes(xmin=(seasonstartdate), xmax=(seasonenddates),
ymin=ymin, ymax=ymax,
alpha=alpha), fill="cornflowerblue") +
geom_rect(data=rect_total5,
aes(xmin=(seasonstartdate), xmax=(seasonenddates),
ymin=ymin, ymax=ymax,
alpha=alpha), fill="springgreen4") +
guides(alpha = FALSE)
}
plot <- ggplot_grad_rects(100, graphlimit, graphlength) +
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*"")))))+
geom_jitter(aes(x=date, y=level, color = level), 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))+
scale_alpha_identity() +
coord_polar(start = ((2*NoOfhours/NoOfHoursall)*pi))+
theme(legend.title = element_text(color = "black", size = 14, face = "bold"), panel.background = element_rect(fill = "white"), panel.grid = element_blank())
plot
现在合并了此修复程序:
我没有看到 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()