Verlauf aus geom_polygon

Question

dieser Code erzeugt eine Tabelle mit 3 Polygone ...

Ich erstelle ein Diagramm, das 3 Polygone zeigt, ich bin nicht so sehr interessiert, wenn es bessere Möglichkeiten, um die Polygone zu zeichnen (diese Polygone repräsentieren normalerweise Ereignisse und es gibt eine Dauer für diese Ereignisse.

Was mich interessiert, an erster Stelle ist die Möglichkeit, jedes Polygon mit einem Farbverlauf zu füllen.

# 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 

erzeugt dieses Diagramm

Was ich versuche ist wie diese

etwas zu erreichen, tun Sie

Wie alle Ideen hav immer einen Hinweis geschätzt wird

Tom

Answer 1

Hmm, ich bin ich eigentlich nicht sicher, ob es Sinn macht, meine eigene Frage zu beantworten ...

Aber aufgrund der Tatsache, dass ich keine Antwort erhielt, mayby ​​meine erste Frage war ein bisschen dumm.

Nichtsdestotrotz verbrachte ich am letzten Tag einige Zeit, um mein Problem zu lösen. Grundsätzlich besteht meine Lösung darin, je nach Dauer des Events weitere Segmente hinzuzufügen. Ich erspare Ihnen meine Berechnungen für die Dauer. Dies liegt daran, dass ich anfänglich daran interessiert war, einem Polygon einen Gradienten zu verleihen.

Vielleicht finden einige von Ihnen, meine Lösung nützlich

Prost 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 

diesen Code verwenden konnte ich ein Diagramm erstellen, die wie folgt aussehen: