R ggplot2: Wie kann ich die y-Achse abhängig vom Wert einer Variablen mit facet_wrap benennen?

Ich werde Ihnen eine Vorstellung von den Daten geben und ich denke, dann sollte es einfacher sein zu verstehen, was ich erreichen möchte.

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)

Code:

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

Ich möchte die y-Achse jedes Diagramms mit dem Wert von beschriften aggr. Für ID 1 sollte also Median angegeben werden, für ID 2 geometrisches Mittel und ID 3 Mittelwert.

Ich habe mehrere Dinge ausprobiert:

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

Aber es funktioniert nicht.

Ich versuche auch, das catin der oberen linken Ecke des Diagramms hinzuzufügen . Also für ID 1 "Andere", ID 2 "Bevölkerung" und ID 3 "Prozentsatz". Ich habe versucht, damit zu arbeiten, legend()aber ich konnte das Problem auch noch nicht lösen.

mtext ist gedacht für plot(). ggplot ist ein anderes Plotsystem, daher funktioniert es nicht. Leider gibt es nicht viele Möglichkeiten. Eine Möglichkeit besteht darin, das xlab zu entfernen und den Streifen als y-Achse zu verwenden:

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")

Die andere Möglichkeit besteht darin, Diagramme zu kombinieren:

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)

Wenn wir uns für die IDFacettenetiketten interessieren , wird dies viel komplizierter und ist von dieser Antwort inspiriert .

Zuerst müssen wir zwei Kopien der Handlung erstellen, eine mit den umbenannten Streifen und eine mit dem Original.

Dann fügen wir die Facettenstreifen manuell zum anderen hinzu.

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)