Создайте фасетный график с разными представлениями геометрии с одинаковой осью x в R - PullRequest
Новая
       38

Создайте фасетный график с разными представлениями геометрии с одинаковой осью x в R

2 голосов
/ 09 июля 2020

Я хотел бы создать фасетный график, который имеет одну и ту же ось x, но имеет другую ось y и разные геометрии, например, например:

enter image description here

Here is a reproducible examples in which I generate two separate facet plots as per the above

library(ggplot2)

## create example data similar structure to my own
data(iris)
a <- iris
a$Species <- paste0(a$Species, "_a")
b <- iris
b$Species <- paste0(b$Species, "_b")
c <- iris
c$Species <- paste0(c$Species, "_c")
plot_data <- rbind(a, b, c)
plot_data$rep <- c(rep("a", nrow(iris)), rep("b", nrow(iris)), rep("c", nrow(iris)))

## facet boxplot
g1 <- ggplot() + geom_boxplot(data = plot_data, aes(Species, Sepal.Width, group = rep)) +
   theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1)) +
   facet_wrap(rep~., scales = "free_x") + xlab("")

## facet heatmap
g2 <- ggplot() + geom_tile(data = plot_data, 
                           aes(factor(Species), rep, fill=Sepal.Width)) +
  scale_fill_continuous(low="white", high="#56B4E9", name="Sepal width") +
  facet_wrap(rep~., scales = "free_x") +
  theme(text=element_text(size=12),
        axis.text.x=element_text(angle=90, vjust=1, hjust=1),
        aspect.ratio=1)

## arrange
library(gridExtra)
grid.arrange(g1, g2, nrow = 2)

Это дает следующее:

enter image description here

I would like the plots aligned and the legend offset to the right hand side as shown in the first image (put together using a dodgy cut and paste job). Ultimately this plots will be passed to a shiny app.

I have seen этот пост , который может предложить решение, но я действительно хотел бы знать, возможно ли вышеперечисленное только с фасетами или если есть решение попроще.

Большое спасибо. 

> sessionInfo()
R version 4.0.0 (2020-04-24)
Platform: x86_64-apple-darwin17.0 (64-bit)
Running under: macOS High Sierra 10.13.6

Matrix products: default
BLAS:   /System/Library/Frameworks/Accelerate.framework/Versions/A/Frameworks/vecLib.framework/Versions/A/libBLAS.dylib
LAPACK: /Library/Frameworks/R.framework/Versions/4.0/Resources/lib/libRlapack.dylib

locale:
[1] en_GB.UTF-8/en_GB.UTF-8/en_GB.UTF-8/C/en_GB.UTF-8/en_GB.UTF-8

attached base packages:
[1] stats4    parallel  stats     graphics  grDevices utils     datasets 
[8] methods   base     

other attached packages:
 [1] gridExtra_2.3        plotly_4.9.2.1       pRolocdata_1.26.0   
 [4] tidyr_1.1.0          reshape2_1.4.4       pRoloc_1.29.0       
 [7] BiocParallel_1.22.0  MLInterfaces_1.68.0  cluster_2.1.0       
[10] annotate_1.66.0      XML_3.99-0.3         AnnotationDbi_1.50.0
[13] IRanges_2.22.2       MSnbase_2.14.2       ProtGenerics_1.20.0 
[16] S4Vectors_0.26.1     mzR_2.22.0           Rcpp_1.0.4.6        
[19] Biobase_2.48.0       BiocGenerics_0.34.0  ggplot2_3.3.1       
[22] shinyhelper_0.3.2    colorspace_1.4-1     colourpicker_1.0    
[25] shinythemes_1.1.2    DT_0.13              shiny_1.4.0.2       
[28] dplyr_1.0.0

1 Ответ

1 голос
/ 09 июля 2020

Самое быстрое решение - просто поместить легенду внизу. Но здесь решение с лоскутным одеялом.

Примечание. Я добавляю «глобальные» параметры темы, которые применяются ко всем графикам при вызове лоскутного шитья, для удобства и для сокращения кода. Это также значительно упрощает внесение изменений при необходимости. 

library(tidyverse)
library(patchwork)

ls_iris <- replicate(3, iris, simplify = FALSE)
names(ls_iris) <- letters[1:3]
plot_data <- 
  bind_rows(map2( ls_iris, letters[1:3], function(x, y) { 
  x[["Species"]] <- paste(x[["Species"]], y, sep ="_"); x}), .id = "rep")

## facet boxplot
g1 <- ggplot() + geom_boxplot(data = plot_data, aes(Species, Sepal.Width, group = rep)) +
  facet_wrap(rep~., scales = "free_x") +
  theme(axis.text.x = element_blank(), axis.title.x = element_blank()) # remove x labels and title

## facet heatmap
g2 <- ggplot() + geom_tile(data = plot_data, 
                           aes(factor(Species), rep, fill=Sepal.Width)) +
  scale_fill_continuous(low="white", high="#56B4E9", name="Sepal width") +
  facet_wrap(rep~., scales = "free_x") +
  theme(axis.text.x=element_text(angle=90, vjust=1, hjust=1), 
        strip.background = element_blank(),
        strip.text = element_blank()) # remove facet strips
g1/g2 & 
  theme(legend.position = "bottom") # theme elements that are for both plots are more conveniently passed to the patchwork call.

Created on 2020-07-09 by the пакет REPEX (v0.3.0)

...