Funzione per creare un grafico a doppio asse y in ggplot2

Question

Sto testando una funzione per creare un grafico a doppio asse y in ggplot2. Funziona ma non riesco a ottenere alcuni elementi dalla grafica di input. Ho costruito questi due grafici con due telai di dati Base1 e Base2 (aggiungo la versione dput() nella parte finale):

library(ggplot2) 
library(scales) 
library(gtable) 
#Graph 1 
g1<-ggplot(Base1, aes(x = Month, y = value, fill = variable)) + 
    geom_bar(stat="identity",colour="black",size=1) + 
    scale_y_continuous(labels = comma,breaks=pretty_breaks(n=7), 
        limits=c(0,max(Base1$value,na.rm=T))) + 
    theme(axis.text.x=element_text(angle=90,colour="grey20",face="bold",size=12), 
     axis.text.y=element_text(colour="grey20",face="bold",hjust=1,vjust=0.8,size=15), 
     axis.title.x=element_text(colour="grey20",face="bold",size=16), 
     axis.title.y=element_text(colour="grey20",face="bold",size=16)) + 
    xlab('Month')+ylab('')+ ggtitle("My graph") + 
    theme(plot.title = element_text(lineheight=3, face="bold", color="black",size=24)) + 
    theme(legend.text=element_text(size=14), 
     legend.title=element_text(size=14)) + 
    scale_fill_manual(name = "variable", 
        label = "Power", 
        values = "#FF6C91") 

E il secondo:

#Graph2 
colors=c("red","darkgreen") 
g2<-ggplot(Base2, aes(x=Month, y=value, color=variable))+ 
    geom_line(aes(group=variable),size=1.3) + 
    geom_point(size=3.8, shape=21, fill="white") + 
    scale_color_manual(values=colors)+ ggtitle("My graph") 

Con questi due grafici ho usato la funzione successiva due fanno un doppio asse y gr APH:

double_axis_graph <- function(graf1,graf2){ 
    graf1 <- graf1 

    graf2 <- graf2 



    gtable1 <- ggplot_gtable(ggplot_build(graf1)) 

    gtable2 <- ggplot_gtable(ggplot_build(graf2)) 



    par <- c(subset(gtable1[['layout']], name=='panel', select=t:r)) 

    graf <- gtable_add_grob(gtable1, gtable2[['grobs']][[which(gtable2[['layout']][['name']]=='panel')]], 

          par['t'],par['l'],par['b'],par['r']) 



    ia <- which(gtable2[['layout']][['name']]=='axis-l') 

    ga <- gtable2[['grobs']][[ia]] 

    ax <- ga[['children']][[2]] 

    ax[['widths']] <- rev(ax[['widths']]) 

    ax[['grobs']] <- rev(ax[['grobs']]) 

    ax[['grobs']][[1]][['x']] <- ax[['grobs']][[1]][['x']] - unit(1,'npc') + unit(0.15,'cm') 

    graf <- gtable_add_cols(graf, gtable2[['widths']][gtable2[['layout']][ia, ][['l']]], length(graf[['widths']])-1) 

    graf <- gtable_add_grob(graf, ax, par['t'], length(graf[['widths']])-1, par['b']) 

    return(graf) 

} 

Così, quando ho usato questo per costruire i due grafici assi, il risultato mostra il doppio asse, ma non riesco a ottenere gli altri elementi di grafica di ingresso come una leggenda completo; inoltre, quando mi unisco ai grafici, viene mostrato solo uno di questi e l'altro è perso. Ho applicato la funzione con i seguenti risultati:

plot(double_axis_graph(g1,g2)) 

In questo caso, la barra grafica (g1) scompare e non riesco a completare la legenda con gli elementi di g2. Due assi funzionavano bene. In una seconda prova ho ottenuto questo risultato:

plot(double_axis_graph(g2,g1)) 

In questo caso ho perso la serie dal g2 e la leggenda non ha gli elementi da g1. Vorrei completare la funzione per mostrare sia la grafica che gli elementi nella legenda per tutte le serie nel grafico. La versione dput() dei miei dataframes è il prossimo:

Base1<-structure(list(Month = c("m11", "m12", "m13", "m14", "m15", "m16" 
), variable = structure(c(1L, 1L, 1L, 1L, 1L, 1L), .Label = "Power", class = "factor"), 
    value = c(28101696.45, 28606983.44, 30304944, 32583849.36, 
    34791542.82, 40051050.24)), .Names = c("Month", "variable", 
"value"), row.names = c(NA, -6L), class = "data.frame") 

Base2<-structure(list(Month = c("m11", "m12", "m13", "m14", "m15", "m16", 
"m11", "m12", "m13", "m14", "m15", "m16"), variable = structure(c(1L, 
1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c("Index1", 
"Index2"), class = "factor"), value = c(0.044370892419913, 0.0437161234641523, 
0.0516857394621815, 0.0495793011485982, 0.0506456741259283, 0.0314653057147897, 
0.0299405579124744, 0.0296145768664101, 0.0269727649059507, 0.0250663815369419, 
0.0233469715385275, 0.0201801611981898)), .Names = c("Month", 
"variable", "value"), row.names = c(NA, -12L), class = "data.frame") 

Molte grazie per il vostro aiuto!

Answer 1

Primi passi verso una soluzione:

g1.1 <- g1 + theme_bw() + theme(legend.position="top") 
g2.1 <- g2 + theme_bw() + theme(panel.grid=element_blank()) + 
    theme(panel.background = element_rect(fill = NA)) 
plot(double_axis_graph(g1.1,g2.1)) 

Ora abbiamo bisogno di risolvere:

• sfondo grigio Strano ovunque - edit: è stato risolto!
• La leggenda

e sopravvivere Hadley's wrath per fare quello che è fondamentalmente errata.

Answer 2

ho usato un po 'di codice di ragazzi a costruire il mio here

grid.newpage() 

# two plots 
p1 <- ggplot(fuel, aes(x=date, y=mpg)) + geom_line() + 
    theme_bw() + xlab("Date") + ylab("MPG (Black)") 
p2 <- ggplot(fuel, aes(x=date, y=avg.temp)) + 
    xlab("Date") + ylab("AVG Temp (Red)") + 
    geom_line(colour="red") + theme_bw() + 
    theme(axis.title.y=element_text(angle = -90)) %+replace% 
    theme(panel.background = element_rect(fill = NA)) 

# extract gtable 
g1 <- ggplot_gtable(ggplot_build(p1)) 
g2 <- ggplot_gtable(ggplot_build(p2)) 

# overlap the panel of 2nd plot on that of 1st plot 
pp <- c(subset(g1$layout, name == "panel", se = t:r)) 
g <- gtable_add_grob(g1, 
        g2$grobs[[which(g2$layout$name == "panel")]], 
        pp$t, pp$l, pp$b, pp$l) 

# axis tweaks 
alab <- g2$grobs[[which(g2$layout$name=="ylab")]] 
ia <- which(g2$layout$name == "axis-l") 
ga <- g2$grobs[[ia]] 
ax <- ga$children[[2]] 
ax$widths <- rev(ax$widths) 
ax$grobs <- rev(ax$grobs) 
ax$grobs[[1]]$x <- ax$grobs[[1]]$x - unit(1, "npc") + 
    unit(0.15, "cm") 
g <- gtable_add_cols(g, g2$widths[g2$layout[ia, ]$l], 
        length(g$widths) - 1) 
g <- gtable_add_cols(g, g2$widths[g2$layout[ia, ]$l], 
        length(g$widths) - 1) 
g <- gtable_add_grob(g, ax, pp$t, length(g$widths) - 2, pp$b) 
g <- gtable_add_grob(g, alab, pp$t, length(g$widths) - 1, pp$b) 

grid.draw(g) 

Answer 3

Un altro approccio più intelligente con sec_axis adattato da here.

Vantaggio:

1. nativo asse secondario, viene creato un solo oggetto ggplot.
2. Nessun hack che coinvolge oggetti asse in modo esplicito.

Svantaggio: i limiti dei due assi devono essere definiti in anticipo.

Vedere sec_axisdocumentation e blog post (in giapponese) per ulteriori informazioni.

# You must define limits first 

AXIS1_MIN = 0 
AXIS1_MAX = max(Base1$value) 
AXIS2_MIN = min(Base2$value) 
AXIS2_MAX = max(Base2$value) 

scale_to_value1 <- function(values) rescale(values, to = c(AXIS1_MIN, AXIS1_MAX)) 
scale_to_value2 <- function(values) rescale(values, to = c(AXIS2_MIN, AXIS2_MAX)) 

ggplot() + 
    geom_bar(aes(x = Month, y = value, fill = variable), data = Base1, stat="identity",colour="black",size=1) + 
    geom_line(aes(x = Month, y = scale_to_value1(value),color = variable, group = variable), data = Base2, size=1.3) + 
    scale_y_continuous(labels = comma,breaks=pretty_breaks(n=7), 
        limits=c(AXIS1_MIN, AXIS1_MAX), 
        sec.axis = sec_axis(~ scale_to_value2(.), name = "value2")) + 
    scale_color_manual(name = "variable", 
        label = c("Index1", "Index2"), 
        values = c("Index1" = "red", "Index2" = "green")) + 
    scale_fill_manual(name = "variable", 
        label = "Power", 
        values = "#FF6C91") + 
    theme(axis.text.x=element_text(angle=90,colour="grey20",face="bold",size=12), 
     axis.text.y=element_text(colour="grey20",face="bold",hjust=1,vjust=0.8,size=15), 
     axis.title.x=element_text(colour="grey20",face="bold",size=16), 
     axis.title.y=element_text(colour="grey20",face="bold",size=16)) + 
    xlab('Month')+ylab('')+ ggtitle("My graph") + 
    theme(plot.title = element_text(lineheight=3, face="bold", color="black",size=24)) + 
    theme(legend.text=element_text(size=14), 
     legend.title=element_text(size=14))