Dodaj wspólną legendę dla połączonych ggplots

138

Mam dwa wykresy gg, z którymi dopasowuję się w poziomie grid.arrange . Przejrzałem wiele postów na forum, ale wszystko, czego próbuję, wydaje się być komendami, które są teraz zaktualizowane i mają inną nazwę.

Moje dane wyglądają tak;

# Data plot 1                                   
        axis1     axis2   
group1 -0.212201  0.358867
group2 -0.279756 -0.126194
group3  0.186860 -0.203273
group4  0.417117 -0.002592
group1 -0.212201  0.358867
group2 -0.279756 -0.126194
group3  0.186860 -0.203273
group4  0.186860 -0.203273

# Data plot 2   
        axis1     axis2
group1  0.211826 -0.306214
group2 -0.072626  0.104988
group3 -0.072626  0.104988
group4 -0.072626  0.104988
group1  0.211826 -0.306214
group2 -0.072626  0.104988
group3 -0.072626  0.104988
group4 -0.072626  0.104988

#And I run this:
library(ggplot2)
library(gridExtra)


groups=c('group1','group2','group3','group4','group1','group2','group3','group4')

x1=data1[,1]
y1=data1[,2]

x2=data2[,1]
y2=data2[,2]

p1=ggplot(data1, aes(x=x1, y=y1,colour=groups)) + geom_point(position=position_jitter(w=0.04,h=0.02),size=1.8)

p2=ggplot(data2, aes(x=x2, y=y2,colour=groups)) + geom_point(position=position_jitter(w=0.04,h=0.02),size=1.8)

#Combine plots
p3=grid.arrange(
p1 + theme(legend.position="none"), p2+ theme(legend.position="none"), nrow=1, widths = unit(c(10.,10), "cm"), heights = unit(rep(8, 1), "cm")))

Jak wyodrębnić legendę z któregokolwiek z tych wątków i dodać ją na dole / środku połączonej fabuły?

jO.
źródło
2
Czasami mam ten problem. Jeśli nie chcesz przedstawiać fabuły, najłatwiejszym rozwiązaniem, jakie znam, jest po prostu zapisanie jednej z legendą, a następnie użycie programu Photoshop / Ilustrator, aby wkleić ją na puste wykresy legendy. Wiem, nieeleganckie - ale praktyczne szybko i łatwo.
Stephen Henderson
@StephenHenderson To jest odpowiedź. Facet lub post-process z edytorem gfx.
Brandon Bertelsen

Odpowiedzi:

107

Aktualizacja 2015-luty

Zobacz odpowiedź Stevena poniżej


df1 <- read.table(text="group   x     y   
group1 -0.212201  0.358867
group2 -0.279756 -0.126194
group3  0.186860 -0.203273
group4  0.417117 -0.002592
group1 -0.212201  0.358867
group2 -0.279756 -0.126194
group3  0.186860 -0.203273
group4  0.186860 -0.203273",header=TRUE)

df2 <- read.table(text="group   x     y   
group1  0.211826 -0.306214
group2 -0.072626  0.104988
group3 -0.072626  0.104988
group4 -0.072626  0.104988
group1  0.211826 -0.306214
group2 -0.072626  0.104988
group3 -0.072626  0.104988
group4 -0.072626  0.104988",header=TRUE)


library(ggplot2)
library(gridExtra)

p1 <- ggplot(df1, aes(x=x, y=y,colour=group)) + geom_point(position=position_jitter(w=0.04,h=0.02),size=1.8) + theme(legend.position="bottom")

p2 <- ggplot(df2, aes(x=x, y=y,colour=group)) + geom_point(position=position_jitter(w=0.04,h=0.02),size=1.8)

#extract legend
#https://github.com/hadley/ggplot2/wiki/Share-a-legend-between-two-ggplot2-graphs
g_legend<-function(a.gplot){
  tmp <- ggplot_gtable(ggplot_build(a.gplot))
  leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
  legend <- tmp$grobs[[leg]]
  return(legend)}

mylegend<-g_legend(p1)

p3 <- grid.arrange(arrangeGrob(p1 + theme(legend.position="none"),
                         p2 + theme(legend.position="none"),
                         nrow=1),
             mylegend, nrow=2,heights=c(10, 1))

Oto wynikowa fabuła: 2 działki ze wspólną legendą

Roland
źródło
2
obie odpowiedzi wskazują na tę samą stronę wiki, która może być aktualizowana, gdy nowe wersje ggplot2 łamią kod.
baptiste
Ponad sześć lat później ta odpowiedź rozwiązała mój problem. Dzięki!
SPK.z
Może to być proste dla niektórych / większości ludzi, ale nie zrozumiałem tego od razu, więc pomyślałem, że skomentuję. Jeśli chcesz, aby wspólna legenda znajdowała się na górze fabuły (a nie poniżej), wszystko, co musisz zrobić, to zmienić argumenty. W powyższym przykładzie mylegend poprzedza arrangeGrob(). Musisz także odwrócić wysokości (tj.heights=c(1,10)
ljh2001
113

Możesz także użyć ggarrange z pakietu ggpubr i ustawić "common.legend = TRUE":

library(ggpubr)

dsamp <- diamonds[sample(nrow(diamonds), 1000), ]
p1 <- qplot(carat, price, data = dsamp, colour = clarity)
p2 <- qplot(cut, price, data = dsamp, colour = clarity)
p3 <- qplot(color, price, data = dsamp, colour = clarity)
p4 <- qplot(depth, price, data = dsamp, colour = clarity) 

ggarrange(p1, p2, p3, p4, ncol=2, nrow=2, common.legend = TRUE, legend="bottom")

wprowadź opis obrazu tutaj

Huiyan Wan
źródło
1
Czy to możliwe, że to nie działa wewnątrz błyszczącej aplikacji (lub flexdashboard) z renderPlot ()? Działa doskonale w normalnym skrypcie R z normalnymi wykresami. Ale kiedy robię dokładnie to samo z wykresami utworzonymi za pomocą renderPlot () w moim flexdashboard, nic się nie pojawia.
Tingolfin
1
Dziękuję za to - myślę, że to było zdecydowanie najłatwiejsze rozwiązanie tego, czego szukałem
Komal Rathi
To jest niesamowite! Dziękuję Ci!
yanes
@Tingolfin Czasami musiałem zawijać print(ggarrangeobject)jeden z moich ggarrangeobiektów, gdy potrzebowałem, aby był wykreślony przez inną funkcję, która może być podobna do rozwiązania dla twojego renderPlot()?
Brandon
common.legend = TRUEto wszystko, czego potrzebuję!
Aryo
62

Odpowiedź Rolanda wymaga aktualizacji. Widzieć: https://github.com/hadley/ggplot2/wiki/Share-a-legend-between-two-ggplot2-graphs

Ta metoda została zaktualizowana dla ggplot2 v1.0.0.

library(ggplot2)
library(gridExtra)
library(grid)


grid_arrange_shared_legend <- function(...) {
    plots <- list(...)
    g <- ggplotGrob(plots[[1]] + theme(legend.position="bottom"))$grobs
    legend <- g[[which(sapply(g, function(x) x$name) == "guide-box")]]
    lheight <- sum(legend$height)
    grid.arrange(
        do.call(arrangeGrob, lapply(plots, function(x)
            x + theme(legend.position="none"))),
        legend,
        ncol = 1,
        heights = unit.c(unit(1, "npc") - lheight, lheight))
}

dsamp <- diamonds[sample(nrow(diamonds), 1000), ]
p1 <- qplot(carat, price, data=dsamp, colour=clarity)
p2 <- qplot(cut, price, data=dsamp, colour=clarity)
p3 <- qplot(color, price, data=dsamp, colour=clarity)
p4 <- qplot(depth, price, data=dsamp, colour=clarity)
grid_arrange_shared_legend(p1, p2, p3, p4)

Zwróć uwagę na brak ggplot_gtablei ggplot_build. ggplotGrobjest używany zamiast tego. Ten przykład jest nieco bardziej zawiły niż powyższe rozwiązanie, ale nadal go rozwiązał.

Steven Lockton
źródło
10
Witam mam 6 działek i chciałbym ułożyć 6 działek jako 2 rzędy × 3 kol i narysować legendę na górze czyli jak zmienić funkcję grid_arrange_shared_legend ? Dziękuję Ci!
just_rookie
4
@just_rookie, czy znalazłeś rozwiązanie, jak zmienić funkcję, aby można było używać różnych ustawień ncol i nrow zamiast tylko ncol = 1?
Giuseppe
Witam, wypróbowałem to rozwiązanie, działa dobrze, jednak podczas drukowania otrzymałem 2 strony pdf zamiast tylko 1, pierwsza jest pusta, a druga zawiera moją fabułę, dlaczego mam takie zachowanie? dzięki,
HanniBaL90
dla każdego, jak uzyskać ten sam problem co ja, oto obejście: stackoverflow.com/questions/12481267/ ...
HanniBaL90
1
Świetna rzecz. Masz pomysł, jak dodać jeden tytuł dla wszystkich wątków?
Pertinax
27

Zastosować nowe, atrakcyjne rozwiązanie patchwork. Składnia jest bardzo prosta:

library(ggplot2)
library(patchwork)

p1 <- ggplot(df1, aes(x = x, y = y, colour = group)) + 
  geom_point(position = position_jitter(w = 0.04, h = 0.02), size = 1.8)
p2 <- ggplot(df2, aes(x = x, y = y, colour = group)) + 
  geom_point(position = position_jitter(w = 0.04, h = 0.02), size = 1.8)

combined <- p1 + p2 & theme(legend.position = "bottom")
combined + plot_layout(guides = "collect")

Utworzony 13.12.2019 przez pakiet reprex (v0.2.1)

MSR
źródło
2
Jeśli nieznacznie zmienisz kolejność poleceń, możesz to zrobić w jednej linii: combined <- p1 + p2 + plot_layout(guides = "collect") & theme(legend.position = "bottom")
mlcyo
17

Sugeruję użycie cowplot. Z ich winiety R :

# load cowplot
library(cowplot)

# down-sampled diamonds data set
dsamp <- diamonds[sample(nrow(diamonds), 1000), ]

# Make three plots.
# We set left and right margins to 0 to remove unnecessary spacing in the
# final plot arrangement.
p1 <- qplot(carat, price, data=dsamp, colour=clarity) +
   theme(plot.margin = unit(c(6,0,6,0), "pt"))
p2 <- qplot(depth, price, data=dsamp, colour=clarity) +
   theme(plot.margin = unit(c(6,0,6,0), "pt")) + ylab("")
p3 <- qplot(color, price, data=dsamp, colour=clarity) +
   theme(plot.margin = unit(c(6,0,6,0), "pt")) + ylab("")

# arrange the three plots in a single row
prow <- plot_grid( p1 + theme(legend.position="none"),
           p2 + theme(legend.position="none"),
           p3 + theme(legend.position="none"),
           align = 'vh',
           labels = c("A", "B", "C"),
           hjust = -1,
           nrow = 1
           )

# extract the legend from one of the plots
# (clearly the whole thing only makes sense if all plots
# have the same legend, so we can arbitrarily pick one.)
legend_b <- get_legend(p1 + theme(legend.position="bottom"))

# add the legend underneath the row we made earlier. Give it 10% of the height
# of one plot (via rel_heights).
p <- plot_grid( prow, legend_b, ncol = 1, rel_heights = c(1, .2))
p

połączone działki z legendą na dole

Gregor Sturm
źródło
Tylko w ten sposób możliwe było umieszczenie ręcznej legendy w moim wątku za annotate_figure(ggarrange())pomocą funkcji legend_b (). Dziękuję bardzo, niech Bóg cię błogosławi!
Jean Karlos
12

@Giuseppe, możesz rozważyć to w celu elastycznej specyfikacji układu działek (zmodyfikowanej tutaj ):

library(ggplot2)
library(gridExtra)
library(grid)

grid_arrange_shared_legend <- function(..., nrow = 1, ncol = length(list(...)), position = c("bottom", "right")) {

  plots <- list(...)
  position <- match.arg(position)
  g <- ggplotGrob(plots[[1]] + theme(legend.position = position))$grobs
  legend <- g[[which(sapply(g, function(x) x$name) == "guide-box")]]
  lheight <- sum(legend$height)
  lwidth <- sum(legend$width)
  gl <- lapply(plots, function(x) x + theme(legend.position = "none"))
  gl <- c(gl, nrow = nrow, ncol = ncol)

  combined <- switch(position,
                     "bottom" = arrangeGrob(do.call(arrangeGrob, gl),
                                            legend,
                                            ncol = 1,
                                            heights = unit.c(unit(1, "npc") - lheight, lheight)),
                     "right" = arrangeGrob(do.call(arrangeGrob, gl),
                                           legend,
                                           ncol = 2,
                                           widths = unit.c(unit(1, "npc") - lwidth, lwidth)))
  grid.newpage()
  grid.draw(combined)

}

Dodatkowe argumenty nrowi ncolkontroluj układ ułożonych działek:

dsamp <- diamonds[sample(nrow(diamonds), 1000), ]
p1 <- qplot(carat, price, data = dsamp, colour = clarity)
p2 <- qplot(cut, price, data = dsamp, colour = clarity)
p3 <- qplot(color, price, data = dsamp, colour = clarity)
p4 <- qplot(depth, price, data = dsamp, colour = clarity)
grid_arrange_shared_legend(p1, p2, p3, p4, nrow = 1, ncol = 4)
grid_arrange_shared_legend(p1, p2, p3, p4, nrow = 2, ncol = 2)

wprowadź opis obrazu tutaj wprowadź opis obrazu tutaj

epsilone
źródło
Tak samo jak w przypadku drugiego rozwiązania, wypróbowałem, działa dobrze, jednak podczas drukowania otrzymałem 2 strony pdf zamiast tylko 1, pierwsza jest pusta, a druga zawiera moją fabułę, dlaczego mam takie zachowanie? dzięki,
HanniBaL90
dla każdego, jak uzyskać ten sam problem co ja, oto obejście: stackoverflow.com/questions/12481267/…
HanniBaL90
Czy ktoś może mi wyjaśnić rozwiązanie? Jak można między innymi umieścić legendę na górze zamiast na dole? Dzięki
HanniBaL90
8

Jeśli drukujesz te same zmienne na obu wykresach, najprostszym sposobem byłoby połączenie ramek danych w jedną, a następnie użycie funkcji facet_wrap.

Na przykład:

big_df <- rbind(df1,df2)

big_df <- data.frame(big_df,Df = rep(c("df1","df2"),
times=c(nrow(df1),nrow(df2))))

ggplot(big_df,aes(x=x, y=y,colour=group)) 
+ geom_point(position=position_jitter(w=0.04,h=0.02),size=1.8) 
+ facet_wrap(~Df)

Działka 1

Kolejny przykład wykorzystujący zestaw danych diamentów. To pokazuje, że możesz nawet sprawić, by działało, jeśli masz tylko jedną wspólną zmienną między wykresami.

diamonds_reshaped <- data.frame(price = diamonds$price,
independent.variable = c(diamonds$carat,diamonds$cut,diamonds$color,diamonds$depth),
Clarity = rep(diamonds$clarity,times=4),
Variable.name = rep(c("Carat","Cut","Color","Depth"),each=nrow(diamonds)))

ggplot(diamonds_reshaped,aes(independent.variable,price,colour=Clarity)) + 
geom_point(size=2) + facet_wrap(~Variable.name,scales="free_x") + 
xlab("")

Działka 2

Jedyną trudną rzeczą w drugim przykładzie jest to, że zmienne czynnikowe są przekształcane na liczbowe, gdy łączysz wszystko w jedną ramkę danych. Idealnie byłoby więc zrobić to głównie wtedy, gdy wszystkie interesujące cię zmienne są tego samego typu.

hmgeiger
źródło
1

@Guiseppe:

Nie mam pojęcia o Grobsach itp., Ale zhakowałem rozwiązanie dla dwóch wątków, powinno być możliwe rozszerzenie do dowolnej liczby, ale nie jest to seksowna funkcja:

plots <- list(p1, p2)
g <- ggplotGrob(plots[[1]] + theme(legend.position="bottom"))$grobs
legend <- g[[which(sapply(g, function(x) x$name) == "guide-box")]]
lheight <- sum(legend$height)
tmp <- arrangeGrob(p1 + theme(legend.position = "none"), p2 + theme(legend.position = "none"), layout_matrix = matrix(c(1, 2), nrow = 1))
grid.arrange(tmp, legend, ncol = 1, heights = unit.c(unit(1, "npc") - lheight, lheight))
Jacek
źródło
1

Jeśli legenda jest taka sama dla obu wykresów, istnieje proste rozwiązanie polegające na użyciu grid.arrange(zakładając, że chcesz, aby legenda była wyrównana z obydwoma wykresami w pionie lub w poziomie). Po prostu zachowaj legendę dla dolnej lub skrajnej prawej działki, pomijając legendę dla drugiej. Dodanie legendy tylko do jednego wykresu zmienia jednak rozmiar jednego wykresu względem drugiego. Aby tego uniknąć, użyj heightspolecenia, aby ręcznie dostosować i zachować ten sam rozmiar. Możesz nawet użyć grid.arrangedo tworzenia wspólnych tytułów osi. Zauważ, że będzie to wymagało library(grid)oprócz library(gridExtra). W przypadku działek pionowych:

y_title <- expression(paste(italic("E. coli"), " (CFU/100mL)"))

grid.arrange(arrangeGrob(p1, theme(legend.position="none"), ncol=1), arrangeGrob(p2, theme(legend.position="bottom"), ncol=1), heights=c(1,1.2), left=textGrob(y_title, rot=90, gp=gpar(fontsize=20)))

Oto wynik dla podobnego wykresu dla projektu, nad którym pracowałem: wprowadź opis obrazu tutaj

Wesley Lozano
źródło