R ggplot2: Bagaimana saya bisa memberi nama sumbu y tergantung pada nilai variabel dengan facet_wrap?

Saya akan memberi Anda gambaran tentang data itu dan saya pikir itu akan lebih mudah untuk memahami apa yang saya coba capai.

Repex:

ID <- c(1, 1, 2, 3, 3, 3)
cat <- c("Others", "Others", "Population", "Percentage", "Percentage", "Percentage")
logT <- c(2.7, 2.9, 1.5, 4.3, 3.7, 3.3)
m <- c(1.7, 1.9, 1.1, 4.8, 3.2, 3.5)
aggr <- c("median", "median", "geometric mean", "mean", "mean", "mean")
over.under <- c("overestimation", "overestimation", "underestimation", "underestimation", "underestimation", "underestimation")
data <- cbind(ID, cat, logT, m, aggr, over.under)
data <- data.frame(data)
data$ID <- as.numeric(data$ID)
data$logT<- as.numeric(data$logT)
data$m<- as.numeric(data$m)

Kode:

Fig <- data %>% ggplot(aes(x = logT, y = m, color = over.under)) + 
  facet_wrap(~ ID) +
  geom_point() +
  scale_x_continuous(name = "log (True value)", limits=c(1, 7)) +
  scale_y_continuous(name = NULL, limits=c(1, 7)) +
  geom_abline(intercept = 0, slope = 1, linetype = "dashed") +
  theme_bw() +
  theme(legend.position='none')
Fig

Saya ingin memberi label sumbu y dari setiap grafik dengan nilai aggr. Jadi untuk ID 1 itu harus mengatakan median, untuk mean geometris ID 2 dan mean ID 3.

Saya mencoba beberapa hal:

mtext(data1$aggr, side = 2, cex=1) #or
ylab(data1$aggr) #or
strip.position = "left"

Tapi itu tidak berhasil.

Saya juga mencoba menambahkan catdi sudut kiri atas grafik. Jadi untuk ID 1 "Lainnya", ID 2 "Populasi" dan ID 3 "Persentase". Saya mencoba untuk bekerja dengan legend()tetapi saya belum bisa menyelesaikan masalah.

mtext dimaksudkan untuk plot(). ggplot adalah sistem merencanakan yang lain sehingga tidak akan berfungsi. Sayangnya tidak banyak pilihan, salah satu caranya adalah menghapus xlab, dan menggunakan strip sebagai sumbu y:

LAB =tapply(as.character(data$aggr),data$ID,unique)

Fig <- data %>% ggplot(aes(x = logT, y = m, color = over.under)) + 
  geom_point() +
  scale_x_continuous(name = "log (True value)", limits=c(1, 7)) +
  scale_y_continuous(name = NULL, limits=c(1, 7)) +
  geom_abline(intercept = 0, slope = 1, linetype = "dashed") +
  theme_bw() +
  theme(legend.position='none') +
  facet_wrap(~ID, scales = "free_y",strip.position = "left", 
  labeller = as_labeller(LAB ))  +
  ylab(NULL) +
  theme(strip.background = element_blank(),strip.placement = "outside")

Cara lain adalah dengan menggabungkan plot:

library(gridExtra) 

plts = by(data,data$ID,function(i){
ggplot(i,aes(x=logT,y=m,color=over.under)) + 
geom_point() + 
scale_x_continuous(name = "log (True value)", limits=c(1, 7)) +
scale_y_continuous(name = unique(i$agg), limits=c(1, 7)) +
geom_abline(intercept = 0, slope = 1, linetype = "dashed") +
theme_bw() + 
scale_color_manual(values=c("overestimation"="turquoise","underestimation"="orange"))+
theme(legend.position='none') 
})

grid.arrange(grobs=plts,ncol=3)

Jika kita peduli dengan IDlabel facet, ini menjadi jauh lebih rumit dan terinspirasi oleh jawaban ini .

Pertama, kita perlu membuat dua salinan plot, satu dengan strip yang diganti namanya dan satu dengan yang asli.

Kemudian kita menambahkan strip facet secara manual ke yang lain.

library(gtable)
library(grid)
plot1 <- data %>% ggplot(aes(x = logT, y = m, color = over.under)) + 
  facet_wrap(~ ID, scales = "free_y",strip.position = "left",  labeller = as_labeller(c(`1`="median",`2`="geometric mean",`3`="mean"))) +
  geom_point() +
  scale_x_continuous(name = "log (True value)", limits=c(1, 7)) +
  scale_y_continuous(name = NULL, limits=c(1, 7)) +
  geom_abline(intercept = 0, slope = 1, linetype = "dashed") +
  theme_bw() +  
  theme(legend.position='none',strip.background = element_blank(),strip.placement = "outside")

plot2 <- data %>% ggplot(aes(x = logT, y = m, color = over.under)) + 
  facet_grid(~ ID) +
  geom_point() +
  scale_x_continuous(name = "log (True value)", limits=c(1, 7)) +
  scale_y_continuous(name = NULL, limits=c(1, 7)) +
  geom_abline(intercept = 0, slope = 1, linetype = "dashed") +
  theme_bw() +  
  theme(legend.position='none')

gt1 = ggplot_gtable(ggplot_build(plot1))
gt2 = ggplot_gtable(ggplot_build(plot2))
strip1 <- gtable_filter(gt2, 'strip-t-1')
strip2 <- gtable_filter(gt2, 'strip-t-2')
strip3 <- gtable_filter(gt2, 'strip-t-3')
gt1 = gtable_add_rows(gt1, heights=strip1$heights[1], pos = 0)
panel_id <- gt1$layout[grep('panel-.+1$', gt1$layout$name),]
gt1 = gtable_add_grob(gt1, strip1, t = 1, l = panel_id$l[1])
gt1 = gtable_add_grob(gt1, strip2, t = 1, l = panel_id$l[2])
gt1 = gtable_add_grob(gt1, strip3, t = 1, l = panel_id$l[3])
gt1 = gtable_add_grob(gt1, zeroGrob(), t = 1, l = 1)
gt1 = gtable_add_rows(gt1, heights=gt2$heights[1], pos = 0)
grid.newpage()
grid.draw(gt1)