2015-08-02 17 views
8

Sto tentando di aggiungere più titoli a un grafico utilizzando facet_wrap e ggplot2. Dillo che ad es. avere dati trimestrali su due anni e desidera un confronto grafico dei dati trimestrali con due titoli principali principali; 2014 e 2015, oltre a titoli per il rispettivo trimestre.Più titoli in facet_wrap (ggplot2)

Sono venuto fino a questo punto:

data <- rnorm(10) 

A1 <- data.frame("Y"=data, "X"=1:10, "Q"=1, "year"=2014) 
A2 <- data.frame("Y"=data, "X"=1:10, "Q"=2, "year"=2014) 
A3 <- data.frame("Y"=data, "X"=1:10, "Q"=3, "year"=2014) 
A4 <- data.frame("Y"=data, "X"=1:10, "Q"=4, "year"=2014) 

N1 <- data.frame("Y"=data, "X"=1:10, "Q"=1, "year"=2015) 
N2 <- data.frame("Y"=data, "X"=1:10, "Q"=2, "year"=2015) 
N3 <- data.frame("Y"=data, "X"=1:10, "Q"=3, "year"=2015) 
N4 <- data.frame("Y"=data, "X"=1:10, "Q"=4, "year"=2015) 

A <- rbind(A1, A2, A3, A4) 
N <- rbind(N1, N2, N3, N4) 
tmp <- data.frame(rbind(A, N)) 

ggplot(data=tmp, aes(x=X, y=Y)) + geom_line() + facet_wrap(~year + Q, scales="free", ncol=4) 

che mi dà questo grafico: enter image description here

Invece vorrei "2014" e "2015" di essere in due riquadri grigi separati sopra ciascun comparto grafico. È possibile?

Grazie!

+0

Forse vedere [qui] (http://stackoverflow.com/questions/11724311/how-to-add-a-ggplot2-subtitle-with-different-size-and-colour) – MichaelChirico

+0

[questo] (http: //stackoverflow.com/questions/22818061/annotating-facet-title-as-strip-over-facet/22825447#22825447) potrebbe aiutare, o [this] (http://stackoverflow.com/questions/29311772/ggplot2- più-complesso-sfaccettatura/29323739 # 29323739). –

risposta

2

Tu mi hai battuto sul tempo RHA, ho scritto quasi un codice identico al tuo prima di vedere il tuo post. Comunque, grazie!

Volevo anche rimuovere "2014" e "2015" dalle caselle grigie (che non ho specificato nel mio primo post), quindi ho dovuto apportare ulteriori modifiche.

Con qualche ispirazione da here, here e here, mi si avvicinò con il seguente codice (davvero brutto):

data14 <- rnorm(10) 
data15 <- rnorm(10, mean = 500) 

A1 <- data.frame("Y"=data14, "X"=1:10, "Q"=1, "year"=2014) 
A2 <- data.frame("Y"=data14, "X"=1:10, "Q"=2, "year"=2014) 
A3 <- data.frame("Y"=data14, "X"=1:10, "Q"=3, "year"=2014) 
A4 <- data.frame("Y"=data14, "X"=1:10, "Q"=4, "year"=2014) 

N1 <- data.frame("Y"=data15, "X"=1:10, "Q"=1, "year"=2015) 
N2 <- data.frame("Y"=data15, "X"=1:10, "Q"=2, "year"=2015) 
N3 <- data.frame("Y"=data15, "X"=1:10, "Q"=3, "year"=2015) 
N4 <- data.frame("Y"=data15, "X"=1:10, "Q"=4, "year"=2015) 

A <- rbind(A1, A2, A3, A4) 
N <- rbind(N1, N2, N3, N4) 
tmp <- data.frame(rbind(A, N)) 

poi ho fatto una semplice funzione di denominazione delle variabili correttamente

labFunc <- function(data, var1, var2, names) { 
    data$id <- NA 
    loop <- length(levels(factor(data[[var2]]))) 

    for (i in 1:loop) { 
    data[data[[var1]] == 2014 & data[[var2]] == levels(factor(data[[var2]]))[i], "id"] <- names[i] 
    data[data[[var1]] == 2015 & data[[var2]] == levels(factor(data[[var2]]))[i], "id"] <- paste(names[i], "") 
    } 

    first <- levels(factor(data$id))[seq(from=1, to = length(levels(factor(data$id))), by = 2)] 
    second <- levels(factor(data$id))[seq(from=2, to = length(levels(factor(data$id))), by = 2)] 

    data$id <- factor(data$id, levels=paste(c(first, second))) 
    return(data) 
} 

names <- c("Q1", "Q2", "Q3", "Q4") 
data <- labFunc(tmp, "year", "Q", names) 

Fai un grafico:

p <-ggplot(data, aes(y = Y, x = X)) + 
    geom_line() + 
    facet_wrap(~ id , ncol = 4, scales = "free") 

E poi finalmente aggiungere le major

z <- ggplotGrob(p) 

# New strip at the top 
z <- gtable_add_rows(z, unit(1, "lines"), pos = 0) # New row added to top 
z <- gtable_add_rows(z, unit(1, "lines"), pos = 6) # New row added to top 

#z <- gtable_add_rows(z, unit(9, "lines"), pos = 0) # New row added to top 


# Check the layout 
gtable_show_layout(z) # New strip goes into row 2 
# New strip spans columns 4 to 8 

z <- gtable_add_grob(z, 
        list(rectGrob(gp = gpar(col = NA, fill = grey(0.8), size = .5)), 
          textGrob("2014", vjust = .27, 
            gp = gpar(cex = .75, fontface = 'bold', col = "black"))), 2, 4, 2, 14, name = c("a", "b")) 

z <- gtable_add_grob(z, 
        list(rectGrob(gp = gpar(col = NA, fill = grey(0.8), size = .5)), 
          textGrob("2015", vjust = .27, 
            gp = gpar(cex = .75, fontface = 'bold', col = "black"))), 7, 4, 7, 14, name = c("a", "b")) 



# Add small gap between strips - below row 2 
z <- gtable_add_rows(z, unit(2/10, "lines"), 2) 
z <- gtable_add_rows(z, unit(5/10, "lines"), 7) 

# Draw it 
grid.newpage() 
grid.draw(z) 

enter image description here

Questa è stata un po 'più complicato di quanto pensassi, ma grazie a tutti per l'aiuto!

4

Utilizzando il codice here, come suggerito da Sandy Muspratt, posso venire con:

library(ggplot2) 
library(gtable) 

data <- rnorm(10) 

A1 <- data.frame("Y"=data, "X"=1:10, "Q"=1, "year"=2014) 
A2 <- data.frame("Y"=data, "X"=1:10, "Q"=2, "year"=2014) 
A3 <- data.frame("Y"=data, "X"=1:10, "Q"=3, "year"=2014) 
A4 <- data.frame("Y"=data, "X"=1:10, "Q"=4, "year"=2014) 

N1 <- data.frame("Y"=data, "X"=1:10, "Q"=1, "year"=2015) 
N2 <- data.frame("Y"=data, "X"=1:10, "Q"=2, "year"=2015) 
N3 <- data.frame("Y"=data, "X"=1:10, "Q"=3, "year"=2015) 
N4 <- data.frame("Y"=data, "X"=1:10, "Q"=4, "year"=2015) 

A <- rbind(A1, A2, A3, A4) 
N <- rbind(N1, N2, N3, N4) 
tmp <- data.frame(rbind(A, N)) 

p <- ggplot(data=tmp, aes(x=X, y=Y)) + geom_line() + facet_wrap(~year + Q, scales="free", ncol=4) 


z <- ggplotGrob(p) 

# New title strip at the top 
z <- gtable_add_rows(z, unit(1, "lines"), pos = 0) # New row added to top 

# Display the layout to select the place for the new strip 
gtable_show_layout(z) # New strip goes into row 2 
# New strip spans columns 4 to 13 

z <- gtable_add_grob(z, 
        list(rectGrob(gp = gpar(col = NA, fill = grey(0.8), size = .5)), 
          textGrob("2014", vjust = .27, 
            gp = gpar(cex = .75, fontface = 'bold', col = "black"))), 2, 4, 2, 13, name = c("a", "b")) 

# Add small gap between strips - below row 2 
z <- gtable_add_rows(z, unit(2/10, "line"), 2) 


# New title strip in the middle 
z <- gtable_add_rows(z, unit(1, "lines"), pos = 8) # New row added to top 
# Display the layout to select the place for the new strip 
gtable_show_layout(z) 
# New strip goes into row 9 
# New strip spans columns 4 to 13 

z <- gtable_add_grob(z, 
        list(rectGrob(gp = gpar(col = NA, fill = grey(0.8), size = .5)), 
          textGrob("2015", vjust = .27, 
            gp = gpar(cex = .75, fontface = 'bold', col = "black"))), 9, 4, 9, 13, name = c("a", "b")) 

# Add small gap between strips - below row 2 
z <- gtable_add_rows(z, unit(2/10, "line"), 9) 


# Draw it 
grid.newpage() 
grid.draw(z) 

che vi darà questo grafico: enter image description here

Problemi correlati