Gradient fill of geom_polygon

Question

mã này tạo biểu đồ với 3 đa giác ...

Tôi đang tạo biểu đồ hiển thị 3 đa giác, tôi không quan tâm nhiều lắm nếu có cách tốt hơn để vẽ đa giác (tại các đa giác này đại diện cho các sự kiện và có một khoảng thời gian cho các sự kiện này).

Điều tôi quan tâm, ngay từ đầu, là khả năng điền vào mỗi đa giác bằng cách sử dụng một 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 

tạo biểu đồ này

một cái gì đó như thế này

Những gì tôi đang cố gắng để đạt được là, bạn có hav bất kỳ ý tưởng

Như luôn luôn bất kỳ gợi ý được đánh giá cao

Tom

Answer 1

Hmm, tôi thực sự tôi không chắc chắn nếu nó làm cho tinh thần để trả lời câu hỏi của riêng tôi ...

Nhưng do thực tế rằng tôi không nhận được câu trả lời, Mayby ban đầu của tôi câu hỏi là một chút ngu ngốc.

Tuy nhiên, trong ngày cuối cùng tôi dành chút thời gian để giải quyết vấn đề của mình. Về cơ bản giải pháp của tôi là thêm các phân đoạn bổ sung theo thời gian của sự kiện. Tôi dành cho bạn các tính toán của tôi trong suốt thời gian. Điều này là do sở thích ban đầu của tôi là làm thế nào để cung cấp một gradient đến một đa giác.

Có lẽ một số bạn tìm thấy giải pháp của tôi có ích

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 

Sử dụng mã này tôi đã có thể tạo ra một biểu đồ mà trông như thế này: