如何在ggplot2中渐变填充注释形状 [英] How to gradient fill an annotation shape in ggplot2
本文介绍了如何在ggplot2中渐变填充注释形状的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
我有一个极坐标图，可以绘制一年中每小时的数据.我设法放入四个注释矩形来表示季节.我希望这些矩形具有从透明到当前颜色的渐变填充.这是我当前的图形:
我尝试专门为矩形设置渐变填充，但这与标记比例填充渐变冲突.理想情况下，图形如下所示:
到目前为止，这是我的代码:
#如何生成具有一年半以上小时读数的数据集.库(润滑)NoOfHours<-as.numeric(ymd_hms("2019-6-1 00:00:00")-ymd_hms("2018-3-1 00:00:00"))* 24data1<-as.data.frame(ymd_hms("2018-3-01 8:00:00")+小时(0:NoOfHours))colnames(data1)<-'日期'set.seed(10)data1 $ level<-runif(nrow(data1)，最小值= 0，最大值= 400)库(readxl);库(lubridate);#加载'readxl'软件包.#1.小时<-格式(as.POSIXct(strptime(data1 $ date，％Y-％m-％d％H:％M:％S"，tz ="))，format =％H:％M:％S)data1 $ hours<-小时日期<-format(as.POSIXct(strptime(data1 $ date，％Y-％m-％d％H:％M:％S"，tz ="))，format =％Y-％m-％d)data1 $ date_date<-日期#输出month<-format(as.POSIXct(strptime(data1 $ date，％Y-％m-％d％H:％M:％S"，tz ="))，format =％m-％d")data1 $ month<-月#在此处输入日期以选择数据集的开始，使用格式:"yyyy-mm-dd".然后通过获取整整一年的数据来选择结束日期.IE.开始="2018-3-1"，结束="2019-2-28"开始<-ceiling_date(ymd(data1 $ date_date [1])，"day"，change_on_boundary = FALSE)开始日期<-日期(开始)％m +％天(1)enddate1 <-as.Date(startdate)％m +％years(1)enddate<-as.Date(enddate1)％m-％天(1)设备编号<-"1"房屋名称<-"level.tiff"houseinfo<-c(设备编号，房屋名称)graphlimit<-0#需要定义图的限制i< -200#的初始最低限制始终为200#this循环现在将检查Radon的最高含量，然后绘制一个图形极限值，该极限值将包含该最大值.这个新确定的限制将使不同数据集可以轻松自动绘制，其范围对于数据来说不会太大或太小.如果(max(data1 $ level)<(i + 50)){图限制<-i} 别的 {而(max(data1 $ level)>(i + 50)){i< -i + 200}if(max(data1 $ level)<(i + 50)){graphlimit<-i}}图书馆(露天)yeardata<-selectByDate(data1，start =开始日期，end =结束日期，year = 2018:2019)#select为一组定义的年份库(ggplot2);库(超字体)graphlength<-graphlimit/(1350/1750)内部极限<--(图形长度*(200/1750))plotlimit<-graphlength + innerlimit#设置外部曲线滴答的结束极限.该比率是根据最大的数据集确定的.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"))* 24NoOfHours<-(8760/12)*(month(startdate)-1)#as.numeric(ymd_hms(starttimedate)-ymd_hms(endtimedate2))* 24#需要此操作来确定轮换.这将确定从数据集开始到1月1-1日在0:0:0之间有多少小时.NoOfHoursall<-as.numeric(ymd_hms(endtimedate)-ymd_hms(starttimedate))* 24date_vals<-seq(from = ceiling_date(ymd(startdate)，"month"，change_on_boundary = FALSE)，length.out = 12，by ="months")finalcell<-长度(yeardata $ date)绘图<-ggplot(yeardata，aes(x = date，y = level，color = level))+annotate("rect"，xmin =((yeardata $ date [1]))，xmax =(yeardata $ date [min(which(yeardata $ date_date == ymd("2018-6-1")))))，ymin = graphlimit，ymax = Inf，填充="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，填充="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，填充="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，填充="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，填充="springgreen4"，alpha = 0.15)+geom_hline(yintercept = seq(0，graphlimit，by = 200)，color ="black"，size = 0.75，alpha = 0.3)+geom_hline(yintercept = seq(0，graphlimit，by = 50)，color ="black"，size = 0.5，alpha = 0.1)+annotate("segment"，x =(yeardata $ date [1])，xend =(yeardata $ date [1])，y = 0，yend = graphlimit，color ="black"，size = 1，alpha = 0.5)+#annotate("text"，x =(max(yeardata $ date))，y =内部限制，color ="black"，大小= 7，alpha = 1，标签=设备编号)+scale_colour_gradientn(极限= c(0,1000)，颜色= c(灰色"，黄色"，危险1"，红色"，"red4"，黑色")，值= 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以获取超过200的值为红色.geom_jitter(alpha = 0.2，size = 1)+主题(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))+实验室(x = NULL，y = bquote('Level'))+scale_y_continuous(breaks = seq(0，graphlimit，200)，限制= 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，￥ d = plotlimit，颜色="black"，大小= 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，￥ d = plotlimit，颜色="black"，大小= 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，￥ d = plotlimit，颜色="black"，大小= 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，￥ d = plotlimit，颜色="black"，大小= 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，￥ d = plotlimit，颜色="black"，大小= 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，￥ d = plotlimit，颜色="black"，大小= 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，￥ d = plotlimit，颜色="black"，大小= 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，￥ d = plotlimit，颜色="black"，大小= 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，￥ d = plotlimit，颜色="black"，大小= 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，￥ d = plotlimit，颜色="black"，大小= 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，￥ d = plotlimit，颜色="black"，大小= 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，￥ d = plotlimit，颜色="black"，大小= 2)+annotate("text"，x =(yeardata $ date [min(which(yeardata $ month =="01-16"))]))，y =((graphlimit + plotlimit)/2)，color ="black"，大小= 9，家庭="Calibri"，标签="JAN"，角度= -15)+annotate("text"，x =(yeardata $ date [min(which(yeardata $ month =="02-16"))]))，y =((graphlimit + plotlimit)/2)，color ="black"，大小= 9，家庭="Calibri"，标签="FEB"，角度= -45)+annotate("text"，x =(yeardata $ date [min(which(yeardata $ month =="03-16"))]))，y =((graphlimit + plotlimit)/2)，color ="black"，大小= 9，家庭="Calibri"，标签="MAR"，角度= -74)+annotate("text"，x =(yeardata $ date [min(which(yeardata $ month =="04-16"))]))，y =((graphlimit + plotlimit)/2)，color ="black"，大小= 9，家庭="Calibri"，标签="APR"，角度= -104)+annotate("text"，x =(yeardata $ date [min(which(yeardata $ month =="05-16"))]))，y =((graphlimit + plotlimit)/2)，color ="black"，大小= 9，家庭="Calibri"，标签="MAY"，角度= -133)+annotate("text"，x =(yeardata $ date [min(which(yeardata $ month =="06-16"))]))，y =((graphlimit + plotlimit)/2)，color ="black"，大小= 9，家庭="Calibri"，标签="JUN"，角度= -163)+annotate("text"，x =(yeardata $ date [min(which(yeardata $ month =="07-16"))]))，y =((graphlimit + plotlimit)/2)，color ="black"，大小= 9，家庭="Calibri"，标签="JUL"，角度= 165)+annotate("text"，x =(yeardata $ date [min(which(yeardata $ month =="08-16"))]))，y =((graphlimit + plotlimit)/2)，color ="black"，大小= 9，家庭="Calibri"，标签="AUG"，角度= 135)+annotate("text"，x =(yeardata $ date [min(which(yeardata $ month =="09-16"))]))，y =((graphlimit + plotlimit)/2)，color ="black"，大小= 9，家庭="Calibri"，标签="SEP"，角度= 105)+annotate("text"，x =(yeardata $ date [min(which(yeardata $ month =="10-16"))]))，y =((graphlimit + plotlimit)/2)，color ="black"，大小= 9，家庭="Calibri"，标签="OCT"，角度= 75)+annotate("text"，x =(yeardata $ date [min(which(yeardata $ month =="11-16"))]))，y =((graphlimit + plotlimit)/2)，color ="black"，大小= 9，家庭="Calibri"，标签="NOV"，角度= 45)+annotate("text"，x =(yeardata $ date [min(which(yeardata $ month =="12-16"))]))，y =((graphlimit + plotlimit)/2)，color ="black"，大小= 9，家庭="Calibri"，标签="DEC"，角度= 15)阴谋图<-图+ coord_polar(开始=(((2 * NoOfhours/NoOfHoursall)* pi))+ #scale_x_continuous(breaks = as.POSIXct.Date(ymd_hms(yeardata $ date [min(which(yeardata $ date_date == ymd(date_vals [2]))))))，原点))+#需要具有弧度数才能获得我的起始位置.如果3月1日是开始日期，则自1月1日起已经过去60天.主题(legend.title = element_text(颜色=黑色"，大小= 14，面部=粗体")，panel.background = element_rect(填充=白色")，panel.grid = element_blank())阴谋 任何帮助将不胜感激.
谢谢
解决方案
好了，经过一番寻找，我已经解决了一个问题.我发现了这篇文章:
现在这里是完整代码，因此大家都可以看到该过程.
库(润滑)NoOfHours<-as.numeric(ymd_hms("2019-6-1 00:00:00")-ymd_hms("2018-3-1 00:00:00"))* 24data1<-as.data.frame(ymd_hms("2018-3-01 8:00:00")+小时(0:NoOfHours))colnames(data1)<-'日期'set.seed(10)data1 $ level<-runif(nrow(data1)，最小值= 0，最大值= 400)库(readxl);库(lubridate);#加载'readxl'软件包.#1.小时<-格式(as.POSIXct(strptime(data1 $ date，％Y-％m-％d％H:％M:％S"，tz ="))，format =％H:％M:％S)data1 $ hours<-小时日期<-format(as.POSIXct(strptime(data1 $ date，％Y-％m-％d％H:％M:％S"，tz ="))，format =％Y-％m-％d)data1 $ date_date<-日期#输出month<-format(as.POSIXct(strptime(data1 $ date，％Y-％m-％d％H:％M:％S"，tz ="))，format =％m-％d")data1 $ month<-月#在此处输入日期以选择数据集的开始，使用格式:"yyyy-mm-dd".然后通过获取整整一年的数据来选择结束日期.IE.开始="2018-3-1"，结束="2019-2-28"开始<-ceiling_date(ymd(data1 $ date_date [1])，"day"，change_on_boundary = FALSE)开始日期<-日期(开始)％m +％天(1)enddate1 <-as.Date(startdate)％m +％years(1)enddate<-日期(enddate1)％m-％天(1)设备编号<-"1"房屋名称<-"level.tiff"houseinfo<-c(设备编号，房屋名称)graphlimit<-0#需要定义图的限制i< -200#的初始最低限制始终为200#this循环现在将检查Radon的最高含量，然后绘制一个图形极限值，该极限值将包含该最大值.这个新确定的限制将使不同数据集可以轻松自动绘制，其范围对于数据来说不会太大或太小.如果(max(data1 $ level)<(i + 50)){图限制<-i} 别的 {而(max(data1 $ level)>(i + 50)){i< -i + 200}if(max(data1 $ level)<(i + 50)){graphlimit<-i}}图书馆(露天)yeardata<-selectByDate(data1，start =开始日期，end =结束日期，year = 2018:2019)#select为一组定义的年份库(ggplot2);库(超字体)graphlength<-graphlimit/(1350/1750)内部极限<--(图形长度*(200/1750))plotlimit<-graphlength + innerlimit#设置外部曲线滴答的结束极限.该比率是根据最大的数据集确定的.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"))* 24NoOfHours<-(8760/12)*(month(startdate)-1)#as.numeric(ymd_hms(starttimedate)-ymd_hms(endtimedate2))* 24#需要此操作来确定轮换.这将确定从数据集开始到1月1-1日在0:0:0之间有多少小时.NoOfHoursall<-as.numeric(ymd_hms(endtimedate)-ymd_hms(starttimedate))* 24date_vals<-seq(from = ceiling_date(ymd(startdate)，"month"，change_on_boundary = FALSE)，length.out = 12，by ="months")finalcell<-长度(yeardata $ date)#HERE是解决方案#我创建了一些数据框来表示季节的开始和结束时间.从那里，我修改了以前的解决方案，以创建一个渐变geom_rect函数.弹簧<-data.frame(矩阵(ncol = 0，nrow = 1))spring $ seasonstartdate<-ymd_hms((yeardata $ date [1]))春季$ seasonenddates<-ymd_hms(yeardata $ date [min(which(yeardata $ date_date == ymd("2018-6-1")))))spring $ colour<-"springgreen4"夏季<-data.frame(矩阵(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"下降<-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"冬季<-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(矩阵(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<-函数(n，ymin，ymax){y_steps<-seq(从= ymin，到= ymax，length.out = n +1)alpha_steps<-seq(从= 0到= 0.2，length.out = n)rect_grad<-data.frame(ymin = y_steps [-(n + 1)]，ymax = y_steps [-1]，alpha = alpha_steps)rect_total<-合并(spring，rect_grad)rect_total2<-merge(夏天，rect_grad)rect_total3<-merge(fall，rect_grad)rect_total4<-merge(冬天，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")+指南(alpha = FALSE)}绘图<-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，填充="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，填充="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，填充="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，填充="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，填充="springgreen4"，alpha = 0.15)+geom_hline(yintercept = seq(0，graphlimit，by = 200)，color ="black"，size = 0.75，alpha = 0.3)+geom_hline(yintercept = seq(0，graphlimit，by = 50)，color ="black"，size = 0.5，alpha = 0.1)+annotate("segment"，x =(yeardata $ date [1])，xend =(yeardata $ date [1])，y = 0，yend = graphlimit，color ="black"，size = 1，alpha = 0.5)+#annotate("text"，x =(max(yeardata $ date))，y =内部限制，color ="black"，大小= 7，alpha = 1，标签=设备编号)+scale_colour_gradientn(极限= c(0,1000)，颜色= c(灰色"，黄色"，危险1"，红色"，"red4"，黑色")，值= 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以使超过200的值变为红色.geom_jitter(alpha = 0.2，size = 1)+主题(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))+实验室(x = NULL，y = bquote('Level'))+scale_y_continuous(breaks = seq(0，graphlimit，200)，限制= 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，￥ d = plotlimit，颜色="black"，大小= 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，￥ d = plotlimit，颜色="black"，大小= 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，￥ d = plotlimit，颜色="black"，大小= 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，￥ d = plotlimit，颜色="black"，大小= 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，￥ d = plotlimit，颜色="black"，大小= 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，￥ d = plotlimit，颜色="black"，大小= 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，￥ d = plotlimit，颜色="black"，大小= 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，￥ d = plotlimit，颜色="black"，大小= 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，￥ d = plotlimit，颜色="black"，大小= 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，￥ d = plotlimit，颜色="black"，大小= 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，￥ d = plotlimit，颜色="black"，大小= 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，￥ d = plotlimit，颜色="black"，大小= 2)+annotate("text"，x =(yeardata $ date [min(which(yeardata $ month =="01-16"))]))，y =((graphlimit + plotlimit)/2)，color ="black"，大小= 9，家庭="Calibri"，标签="JAN"，角度= -15)+annotate("text"，x =(yeardata $ date [min(which(yeardata $ month =="02-16"))]))，y =((graphlimit + plotlimit)/2)，color ="black"，大小= 9，家庭="Calibri"，标签="FEB"，角度= -45)+annotate("text"，x =(yeardata $ date [min(which(yeardata $ month =="03-16"))]))，y =((graphlimit + plotlimit)/2)，color ="black"，大小= 9，家庭="Calibri"，标签="MAR"，角度= -74)+annotate("text"，x =(yeardata $ date [min(which(yeardata $ month =="04-16"))]))，y =((graphlimit + plotlimit)/2)，color ="black"，大小= 9，家庭="Calibri"，标签="APR"，角度= -104)+annotate("text"，x =(yeardata $ date [min(which(yeardata $ month =="05-16"))]))，y =((graphlimit + plotlimit)/2)，color ="black"，大小= 9，家庭="Calibri"，标签="MAY"，角度= -133)+annotate("text"，x =(yeardata $ date [min(which(yeardata $ month =="06-16"))]))，y =((graphlimit + plotlimit)/2)，color ="black"，大小= 9，家庭="Calibri"，标签="JUN"，角度= -163)+annotate("text"，x =(yeardata $ date [min(which(yeardata $ month =="07-16"))]))，y =((graphlimit + plotlimit)/2)，color ="black"，大小= 9，家庭="Calibri"，标签="JUL"，角度= 165)+annotate("text"，x =(yeardata $ date [min(which(yeardata $ month =="08-16"))]))，y =((graphlimit + plotlimit)/2)，color ="black"，大小= 9，家庭="Calibri"，标签="AUG"，角度= 135)+annotate("text"，x =(yeardata $ date [min(which(yeardata $ month =="09-16"))]))，y =((graphlimit + plotlimit)/2)，color ="black"，大小= 9，家庭="Calibri"，标签="SEP"，角度= 105)+annotate("text"，x =(yeardata $ date [min(which(yeardata $ month =="10-16"))]))，y =((graphlimit + plotlimit)/2)，color ="black"，大小= 9，家庭="Calibri"，标签="OCT"，角度= 75)+annotate("text"，x =(yeardata $ date [min(which(yeardata $ month =="11-16"))]))，y =((graphlimit + plotlimit)/2)，color ="black"，大小= 9，家庭="Calibri"，标签="NOV"，角度= 45)+annotate("text"，x =(yeardata $ date [min(which(yeardata $ month =="12-16"))]))，y =((graphlimit + plotlimit)/2)，color ="black"，大小= 9，家庭="Calibri"，标签="DEC"，角度= 15)阴谋图<-图+ coord_polar(开始=(((2 * NoOfhours/NoOfHoursall)* pi))+ #scale_x_continuous(breaks = as.POSIXct.Date(ymd_hms(yeardata $ date [min(which(yeardata $ date_date == ymd(date_vals [2])))))，原点))+主题(legend.title = element_text(颜色=黑色"，大小= 14，面部=粗体")，panel.background = element_rect(填充=白色")，panel.grid = element_blank())阴谋 感谢并享受
I have a polar plot that graphs hourly data over a year. I have managed to put in four annotation rectangles to denote season. I would like these rectangles to have a gradient fill from clear to the current colour. Here is my current graph:
I have tried to put in a gradient fill for the rectangles specifically, but this conflicts with the marker scale fill gradient. Ideally the graph would look like this:
Here is my code so far:
#how to generate a dataset with hourly readings over a year and a half.
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)
plot <- ggplot(yeardata, aes(x=date, y=level, color = level)) +
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))+ #need to have the number of radians to get my start position. If march 1st is the start date, then 60 days have past since Jan 1.
theme(legend.title = element_text(color = "black", size = 14, face = "bold"), panel.background = element_rect(fill = "white"), panel.grid = element_blank())
plot
Any help would be much appreciated.
Thanks
解决方案
Well, after much looking, I have managed a solution. I found this post: How can I apply a gradient fill to a geom_rect object in ggplot2?
From that, I modified the answer given to include what is seen in my code below. Taking a quote from @baptiste: "you have two options: i) discretise the rectangles along y and map the fill or alpha to that variable; ii) post-process the plot e.g. via gridSVG, which supports natively gradient fills."
So essentially, I created a function that mapped transparency values to n number of rectangles. To get this to work with the different colours I wanted, I had to create a separate dataframe for each season, then within the function map each season to its own set of discretized rectangles with their specific colour. Here is the dataframe and function code specifically.
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)
}
It turned out will in the end. Here is a plot that was created.
Now here is the full code so you all can see the process.
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
Thanks and enjoy
这篇关于如何在ggplot2中渐变填充注释形状的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
