geom_polygon的渐变填充 [英] Gradient fill of geom_polygon
本文介绍了geom_polygon的渐变填充的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
此代码生成一个包含3个多边形的图表......
我创建一个显示3个多边形的图表，如果有多边形更好的方法来绘制多边形（事实上这些多边形代表事件，并且这些事件有一个持续时间）。
我首先感兴趣的是可以使用渐变填充每个多边形。
＃library（ggplot2）
＃library（data。表格）
##一些向量
event.day< - c（A，A，B，B）
event.time< ; c（1,2,1,2）
event.duration <-c（1,2,3,1）
sys <-c（100,50,50,100）
## data data.frame
df.event< - data.frame（event.day，event.time，event.duration，sys）
＃ordered the data.frame
df.event< - df.event [with（df.event，order（event.day，event.time）），]
＃下一个事件的sys值
df.event $ sys.end< - c（df.event $ sys [-1]，NA）
df.event $ sys.min< - min（df.event $ sys）
df.event $ sys.minday< - ave（df.event $ sys，list（event.day），FUN = function（x）{min（x）}）
df.event $ sys .max< - max（df.event $ sys）
df.event $ sys.maxday< -ave（df.event $ sys，list（event.day），FUN = function（x）{max （x）}）
＃统计所有事件
df.event $ cntTotalNoOfEvents< - seq_along（df.event $ sys）
＃统计一天内的事件数量
df.event $ cntTotalNoOfEventsByDay< - ave（1：nrow（df.event），df.event $ event.day，FUN = function（x）seq_along（x））
＃在一天内
df.event $ TotalNoOfEventsByDay< - do.call（c，lapply（df.event $ event.day，function（foo）{
sum（df.event $ event.day = = foo）
）））
＃后继事件
df.event $ event.successor< - c（df.event $ cntTotalNoOfEvents [-1]，NA）
df.event $ event.day< - factor（df.event $ event.day，levels = unique（df.event $ event.day））
event.day.level< - levels （df.event $ event.day）
df.event $ event.day.level.ordinal< - as.numeric（match（df.event $ event.day，event.day.level））
##位置data.frame
df.position< - data.frame（event.polygon = rep（c（1： nrow（df.event）），each = 4），polygon.x = 1，polygon.y = 1）
df.position $ event.polygon.point< - ave（1：nrow（df.position ），df.position $ event.polygon，FUN = function（x）seq_along（x））
##合并数据和位置数据。 - data.table（merge（df.event，df.position，by.x =cntTotalNoOfEvents，by.y =event.polygon））
##计算多边形的点
dt.polygon [dt.polygon $ event.polygon.point == 1，polygon.x：= event.day.level.ordinal - .5 * sys / sys.max]
dt.polygon [dt.polygon $ event.polygon.point == 1，polygon.y：= cntTotalNoOfEventsByDay]
dt.polygon [dt.polygon $ event.polygon.point == 2，polygon.x：= event.day .level.ordinal - .5 * sys.end / sys.max]
dt.polygon [dt.polygon $ event.polygon.point == 2，polygon.y：= cntTotalNoOfEventsByDay + event.duration]
dt.polygon [dt.polygo n $ event.polygon.point == 3，polygon.x：= event.day.level.ordinal + .5 * sys.end / sys.max]
dt.polygon [dt.polygon $ event.polygon .point == 3，polygon.y：= cntTotalNoOfEventsByDay + event.duration]
dt.polygon [dt.polygon $ event.polygon.point == 4，polygon.x：= event.day.level.ordinal + .5 * sys / sys.max]
dt.polygon [dt.polygon $ event.polygon.point == 4，polygon.y：= cntTotalNoOfEventsByDay]
p < - ggplot （）
p< - p + geom_polygon（data = dt.polygon
，aes（
x = polygon.x
，y = polygon.y
，fill = sys
，group = cntTotalNoOfEvents
）
）
p < - p + theme（
panel.background = element_rect（fill = white）
）
p < - p + scale_fill_gradient（guide =colourbar，low =lightgrey，high =red）
p < - p + coord_flip（）
p
生成此图表
p>
我试图实现的是这样的
，你有什么想法吗？
一如既往地表示赞赏
Tom
嗯，我其实不确定是否有意义回答我自己的问题...但由于我没有收到任何答复，mayby我的第一个问题有点愚蠢。
然而，在最后那天我花了一些时间来解决我的问题。基本上我的解决方案是根据事件的持续时间添加更多的分区。我把你的计算留给你。这是因为我最初的兴趣在于如何为多边形提供渐变。
也许你们中的一些人认为我的解决方案很有用
Cheers Tom
library（ggplot2）
library（reshape）
event.day <-c（A，A，A，A，B，B）
事件<-c（1,2,3,4,5,6 ）
sys< -c（120,160,100,180,100,180）
持续时间< -c（50,100,50,150,350,0）
df < - data.frame（event.day，event，sys，duration）
df $ end< - c（df $ sys [-1]，NA）
##替换na值
df.value.na< - is.na（df $ end）
df [df.value.na，] $ end< - df [df.value.na，] $ sys
##计算斜率
df $ slope < - df $ end / df $ sys
##根据持续时间为每个事件创建行
event.id< - vector（）
segment.id< - vector（）
for（i in 1：nrow（df））{
event.id< -c（event.id，rep（df [i，] $ event，each = df [i]] $ duration））
segment.id< -C（segment.id，c （1：DF [I，] $ DUR ation））
}
##将原始数据帧与附加段合并
df.segments< - data.frame（event.id，segment.id）
df< - merge（df，df.segments，by.x = c（event），by.y = c（event.id））
##计算新创建的segements的开始和结束值
df $ segment.start< -df $ sys +（df $ segment.id - 1）*（df $ end - df $ sys）/ df $ duration
df $ segment.end< - df $ sys +（df $ segment.id）*（df $ end - df $ sys）/ df $持续时间
##只是一个简单的计算
value.max < - max（df $ sys）
df $ high < - 1 + 0.45 * df $ segment.end / value.max
df $ low< ; - 1 - 0.45 * df $ segment.end / value.max
df $ percent < - df $ segment.end / value.max
df $ id < - seq_along（df $ sys）
df $ idByDay< - ave（1：nrow（df），df $ event.day，FUN = function（x）seq_along（x））
##总共需要多少个事件，必要的
newevents< - nrow（df）
##将原始数据进行子集化。 t.day，id，idByDay，segment.id，segment.start，duration，segment.end，high，low，percent，
$ b ##熔化data.frame
df.melted< - melt（df，id.vars = c（event.day，id，idByDay，segment。 id，segment.start，duration，segment.end，percent））
df.melted< - df.melted [order（df.melted $ id，df.melted $ segment.id），]
##这是一个棘手的问题，基本上这是一个自联接，两个表
＃每个事件可用两次，这是由于前一个section
＃产生一个数据帧，其中每个事件包含4次，除了第一行和最后2行，
＃第一行标记第一个多边形的开始处
＃最后一行标记最后一个多边形的结尾
df.melted< - rbind（df.melted [1：（nrow（df.melted）-2），]，df.melted [3：nrow（df.melted）， ]）
df.melted< - df.melted [order（df.melted $ id，df.melted $ segment.id），]
## grouping，绘制多边形
＃是第一个多边形所必需的从第一个事件开始，第二个事件从第二个事件开始
＃第二个多边形跨越第二个事件的最后2个行，第二个行从第三个事件开始
＃...
＃最后一个多边形跨越最后一个事件的最后两行和最后一个事件的两行
df.melted $ grouping< - rep（1：（newevents-1），each = 4 ）
df.melted< - df.melted [order（df.melted $ id，df.melted $ grouping，df.melted $ variable），]
＃ ＃为每个组添加4点
df.melted $ point < - rep（c（1,2,4,3），（newevents-1））
df.melted< - df .melted [order（df.melted $ grouping，df.melted $ point），]
##绘制多边形
p < - ggplot（）
p < - p + geom_polygon（data = df.melted
，aes（
x = value
，y = idByDay
，group = grouping
，fill = percent
）
）
p < - p + labs（x =something，y =so ）
p< - p + theme（
panel.background = element_blank（）
＃，panel.grid.minor = element_blank（）
＃ axis.title.x = element_blank（）
＃，axis.text.x = element_text（size = 12，face = 2，color =darkgrey）
＃，axis.title.y = element_blank （）
＃，axis.ticks.y = element_blank（）
＃，axis.text.y = element_blank（）
）
p < - p + scale_fill_gradient（
low =lightgrey
，high =red
，guide =
guide_legend（
title =Sys
，order = 1
，reverse = FALSE
，ncol = 2
，override.aes = list（alpha = NA）
）
）
p < - p + facet_wrap（〜event.day，ncol = 2）
p
使用这个代码我能够创建一个如下所示的图表：
this code produces a chart with 3 polygons ...
I'm creating a chart that shows 3 polygons, I'm not that much interested if there are better ways to draw the polygons (atually these polygons represent events and there is a duration for these events).
What I'm interested in, in the first place, is the possibility to fill each polygon using a gradient.
# library("ggplot2")
# library(data.table)
## some vectors
event.day <- c("A", "A", "B", "B")
event.time <- c(1, 2, 1, 2)
event.duration <- c(1,2,3,1)
sys <- c(100, 50, 50, 100)
## the data data.frame
df.event <- data.frame(event.day, event.time,event.duration,sys)
# ordering the data.frame
df.event <- df.event[with(df.event, order(event.day, event.time)), ]
# sys values of the next event
df.event$sys.end <- c(df.event$sys[-1], NA)
df.event$sys.min <- min(df.event$sys)
df.event$sys.minday <- ave(df.event$sys, list(event.day), FUN=function(x) {min(x)})
df.event$sys.max <- max(df.event$sys)
df.event$sys.maxday <- ave(df.event$sys, list(event.day), FUN=function(x) {max(x)})
# count all events
df.event$cntTotalNoOfEvents <- seq_along(df.event$sys)
# count the events within one day
df.event$cntTotalNoOfEventsByDay <- ave( 1:nrow(df.event), df.event$event.day,FUN=function(x) seq_along(x))
# aggregate the number or events within one day
df.event$TotalNoOfEventsByDay <- do.call(c, lapply(df.event$event.day, function(foo){
sum(df.event$event.day==foo)
}))
# the successor event
df.event$event.successor <- c(df.event$cntTotalNoOfEvents[-1], NA)
df.event$event.day <- factor(df.event$event.day, levels = unique(df.event$event.day))
event.day.level <- levels(df.event$event.day)
df.event$event.day.level.ordinal <- as.numeric(match(df.event$event.day, event.day.level))
## the position data.frame
df.position <- data.frame(event.polygon = rep(c(1:nrow(df.event)), each = 4), polygon.x = 1, polygon.y = 1)
df.position$event.polygon.point <- ave( 1:nrow(df.position), df.position$event.polygon,FUN=function(x) seq_along(x))
## merge of the data and the positition data.frame
dt.polygon <- data.table(merge(df.event, df.position, by.x = "cntTotalNoOfEvents", by.y = "event.polygon"))
## calculating the points of the polygon
dt.polygon[dt.polygon$event.polygon.point == 1, polygon.x := event.day.level.ordinal - .5 * sys / sys.max ]
dt.polygon[dt.polygon$event.polygon.point == 1, polygon.y := cntTotalNoOfEventsByDay]
dt.polygon[dt.polygon$event.polygon.point == 2, polygon.x := event.day.level.ordinal - .5 * sys.end / sys.max]
dt.polygon[dt.polygon$event.polygon.point == 2, polygon.y := cntTotalNoOfEventsByDay + event.duration]
dt.polygon[dt.polygon$event.polygon.point == 3, polygon.x := event.day.level.ordinal + .5 * sys.end / sys.max]
dt.polygon[dt.polygon$event.polygon.point == 3, polygon.y := cntTotalNoOfEventsByDay + event.duration]
dt.polygon[dt.polygon$event.polygon.point == 4, polygon.x := event.day.level.ordinal + .5 * sys / sys.max]
dt.polygon[dt.polygon$event.polygon.point == 4, polygon.y := cntTotalNoOfEventsByDay]
p <- ggplot()
p <- p + geom_polygon(data = dt.polygon
,aes(
x = polygon.x
,y = polygon.y
,fill = sys
,group = cntTotalNoOfEvents
)
)
p <- p + theme(
panel.background = element_rect(fill="white")
)
p <- p + scale_fill_gradient(guide = "colourbar", low = "lightgrey", high = "red")
p <- p + coord_flip()
p
produces this chart
What I'm trying to achieve is something like this
, do you hav any ideas
As always any hint is appreciated
Tom
解决方案
Hmm, I actually I'm not sure if it makes sense to answer my own question ...
But due to the fact that I received no answer, mayby my initial question was a little bit stupid.
Nevertheless, in the last day I spent some time to solve my issue. Basically my solution is to add additional segements according to the duration of the event. I spare you my calculations for the duration. This is because my initial interest was in how to provide a gradient to a polygon.
Maybe some of you find my solution useful
Cheers Tom
library(ggplot2)
library(reshape)
event.day <- c("A", "A", "A", "A", "B", "B")
event <- c(1, 2, 3, 4, 5, 6)
sys <- c(120, 160, 100, 180, 100, 180)
duration <- c(50, 100, 50, 150, 350, 0)
df <- data.frame(event.day, event, sys, duration)
df$end <- c(df$sys[-1], NA)
## replacing na values
df.value.na <- is.na(df$end)
df[df.value.na,]$end <- df[df.value.na,]$sys
## calculating the slope
df$slope <- df$end / df$sys
## creating rows for each event depending on the duration
event.id <- vector()
segment.id <- vector()
for(i in 1:nrow(df)) {
event.id <- c(event.id, rep(df[i,]$event, each = df[i,]$duration))
segment.id <- c(segment.id,c(1:df[i,]$duration))
}
## merging the original dataframe with the additional segments
df.segments <- data.frame(event.id, segment.id)
df <- merge(df, df.segments, by.x = c("event"), by.y = c("event.id"))
## calculate the start and end values for the newly created segements
df$segment.start <- df$sys + (df$segment.id - 1) * (df$end - df$sys) / df$duration
df$segment.end <- df$sys + (df$segment.id) * (df$end - df$sys) / df$duration
## just a simple calculation
value.max <- max(df$sys)
df$high <- 1 + 0.45 * df$segment.end / value.max
df$low <- 1 - 0.45 * df$segment.end / value.max
df$percent <- df$segment.end / value.max
df$id <- seq_along(df$sys)
df$idByDay <- ave( 1:nrow(df), df$event.day,FUN=function(x) seq_along(x))
## how many events in total, necessary
newevents <- nrow(df)
## subsetting the original data.frame
df <- df[,c("event.day", "id", "idByDay", "segment.id", "segment.start", "duration", "segment.end", "high", "low", "percent")]
## melting the data.frame
df.melted <- melt(df, id.vars = c("event.day", "id", "idByDay", "segment.id", "segment.start", "duration", "segment.end","percent"))
df.melted <- df.melted[order(df.melted$id,df.melted$segment.id),]
## this is a tricky one, basically this a self join, of two tables
# every event is available twice, this is due to melt in the previous section
# a dataframe is produced where every event is contained 4 times, except the first and last 2 rows,
# the first row marks the start of the first polygon
# the last row marks the end of the last polygon
df.melted <- rbind(df.melted[1:(nrow(df.melted)-2),],df.melted[3:nrow(df.melted),])
df.melted <- df.melted[order(df.melted$id,df.melted$segment.id),]
## grouping, necessary for drawing the polygons
# the 1st polygon spans from the 1st event, and the first 2 rows from 2nd event
# the 2nd polygon spans from last 2 rows of the 2nd event and the first 2 rows from 3rd event
# ...
# the last polygon spans from the last 2 rows of the next to last event and the 2 rows of the last event
df.melted$grouping <- rep (1:(newevents-1), each=4)
df.melted <- df.melted[order(df.melted$id, df.melted$grouping, df.melted$variable), ]
## adding a 4 point for each group
df.melted$point <- rep(c(1,2,4,3),(newevents-1))
df.melted <- df.melted[order(df.melted$grouping,df.melted$point), ]
## drawing the polygons
p <- ggplot()
p <- p + geom_polygon(data = df.melted
,aes(
x = value
,y =idByDay
,group = grouping
,fill = percent
)
)
p <- p + labs(x = "something", y="something else")
p <- p + theme(
panel.background = element_blank()
#,panel.grid.minor = element_blank()
#axis.title.x=element_blank()
#,axis.text.x=element_text(size=12, face=2, color="darkgrey")
#,axis.title.y=element_blank()
#,axis.ticks.y = element_blank()
#,axis.text.y = element_blank()
)
p <- p + scale_fill_gradient(
low = "lightgrey"
,high = "red"
,guide =
guide_legend(
title = "Sys"
,order = 1
,reverse = FALSE
,ncol = 2
,override.aes = list(alpha = NA)
)
)
p <- p + facet_wrap(~event.day, ncol=2)
p
Using this code I was able to create a chart that look like this:
这篇关于geom_polygon的渐变填充的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
