Diagrama de dispersión con histogramas marginales en ggplot2

¿Hay alguna forma de crear diagramas de dispersión con histogramas marginales como en el ejemplo de abajo ggplot2? En Matlab es la scatterhist()función y existen equivalentes para R también. Sin embargo, no lo he visto para ggplot2.

Comencé un intento creando gráficos únicos, pero no sé cómo organizarlos correctamente.

 require(ggplot2)
 x<-rnorm(300)
 y<-rt(300,df=2)
 xy<-data.frame(x,y)
     xhist <- qplot(x, geom="histogram") + scale_x_continuous(limits=c(min(x),max(x))) + opts(axis.text.x = theme_blank(), axis.title.x=theme_blank(), axis.ticks = theme_blank(), aspect.ratio = 5/16, axis.text.y = theme_blank(), axis.title.y=theme_blank(), background.colour="white")
     yhist <- qplot(y, geom="histogram") + coord_flip() + opts(background.fill = "white", background.color ="black")

     yhist <- yhist + scale_x_continuous(limits=c(min(x),max(x))) + opts(axis.text.x = theme_blank(), axis.title.x=theme_blank(), axis.ticks = theme_blank(), aspect.ratio = 16/5, axis.text.y = theme_blank(), axis.title.y=theme_blank() )


     scatter <- qplot(x,y, data=xy)  + scale_x_continuous(limits=c(min(x),max(x))) + scale_y_continuous(limits=c(min(y),max(y)))
none <- qplot(x,y, data=xy) + geom_blank()

y organizarlos con la función publicada aquí . Pero para resumir: ¿hay alguna forma de crear estos gráficos?

El gridExtrapaquete debería funcionar aquí. Comience por hacer cada uno de los objetos ggplot:

hist_top <- ggplot()+geom_histogram(aes(rnorm(100)))
empty <- ggplot()+geom_point(aes(1,1), colour="white")+
         theme(axis.ticks=element_blank(), 
               panel.background=element_blank(), 
               axis.text.x=element_blank(), axis.text.y=element_blank(),           
               axis.title.x=element_blank(), axis.title.y=element_blank())

scatter <- ggplot()+geom_point(aes(rnorm(100), rnorm(100)))
hist_right <- ggplot()+geom_histogram(aes(rnorm(100)))+coord_flip()

Luego use la función grid.arrange:

grid.arrange(hist_top, empty, scatter, hist_right, ncol=2, nrow=2, widths=c(4, 1), heights=c(1, 4))

Esta no es una respuesta completamente receptiva, pero es muy simple. Ilustra un método alternativo para mostrar densidades marginales y también cómo usar los niveles alfa para la salida gráfica que admite la transparencia:

scatter <- qplot(x,y, data=xy)  + 
         scale_x_continuous(limits=c(min(x),max(x))) + 
         scale_y_continuous(limits=c(min(y),max(y))) + 
         geom_rug(col=rgb(.5,0,0,alpha=.2))
scatter

Esto puede ser un poco tarde, pero decidí hacer un paquete ( ggExtra) para esto, ya que implicaba un poco de código y puede ser tedioso escribirlo. El paquete también trata de abordar algunos problemas comunes, como garantizar que incluso si hay un título o el texto se amplía, las tramas seguirán alineadas entre sí.

La idea básica es similar a la que dieron las respuestas aquí, pero va un poco más allá de eso. Aquí hay un ejemplo de cómo agregar histogramas marginales a un conjunto aleatorio de 1000 puntos. Esperemos que esto facilite agregar histogramas / gráficos de densidad en el futuro.

Enlace al paquete ggExtra

library(ggplot2)
df <- data.frame(x = rnorm(1000, 50, 10), y = rnorm(1000, 50, 10))
p <- ggplot(df, aes(x, y)) + geom_point() + theme_classic()
ggExtra::ggMarginal(p, type = "histogram")

Una adición, solo para ahorrar tiempo de búsqueda para las personas que hacen esto después de nosotros.

Las leyendas, las etiquetas de los ejes, los textos de los ejes, los ticks hacen que las tramas se alejen unas de otras, por lo que su trama se verá fea e inconsistente.

Puede corregir esto utilizando algunas de estas configuraciones de tema,

+theme(legend.position = "none",          
       axis.title.x = element_blank(),
       axis.title.y = element_blank(),
       axis.text.x = element_blank(),
       axis.text.y = element_blank(), 
       plot.margin = unit(c(3,-5.5,4,3), "mm"))

y alinear escalas,

+scale_x_continuous(breaks = 0:6,
                    limits = c(0,6),
                    expand = c(.05,.05))

para que los resultados se vean bien:

Solo una variación muy pequeña en la respuesta de BondedDust , en el espíritu general de los indicadores marginales de distribución.

Edward Tufte ha llamado a este uso de parcelas de alfombra un 'diagrama de trazos de puntos', y tiene un ejemplo en VDQI de usar las líneas de eje para indicar el rango de cada variable. En mi ejemplo, las etiquetas del eje y las líneas de la cuadrícula también indican la distribución de los datos. Las etiquetas se encuentran en los valores del resumen de cinco números de Tukey (mínimo, bisagra inferior, mediana, bisagra superior, máximo), lo que da una impresión rápida de la extensión de cada variable.

Estos cinco números son, por lo tanto, una representación numérica de un diagrama de caja. Es un poco complicado porque las líneas de cuadrícula desigualmente espaciadas sugieren que los ejes tienen una escala no lineal (en este ejemplo son lineales). Quizás sería mejor omitir líneas de cuadrícula u obligarlas a estar en ubicaciones regulares, y simplemente dejar que las etiquetas muestren el resumen de cinco números.

x<-rnorm(300)
y<-rt(300,df=10)
xy<-data.frame(x,y)

require(ggplot2); require(grid)
# make the basic plot object
ggplot(xy, aes(x, y)) +        
  # set the locations of the x-axis labels as Tukey's five numbers   
  scale_x_continuous(limit=c(min(x), max(x)), 
                     breaks=round(fivenum(x),1)) +     
  # ditto for y-axis labels 
  scale_y_continuous(limit=c(min(y), max(y)),
                     breaks=round(fivenum(y),1)) +     
  # specify points
  geom_point() +
  # specify that we want the rug plot
  geom_rug(size=0.1) +   
  # improve the data/ink ratio
  theme_set(theme_minimal(base_size = 18))

Como no había una solución satisfactoria para este tipo de trama al comparar diferentes grupos, escribí una función para hacer esto.

Funciona para datos agrupados y no agrupados y acepta parámetros gráficos adicionales:

marginal_plot(x = iris$Sepal.Width, y = iris$Sepal.Length)

marginal_plot(x = Sepal.Width, y = Sepal.Length, group = Species, data = iris, bw = "nrd", lm_formula = NULL, xlab = "Sepal width", ylab = "Sepal length", pch = 15, cex = 0.5)

He encontrado el paquete ( ggpubr) que parece funcionar muy bien para este problema y considera varias posibilidades para mostrar los datos.

El enlace al paquete está aquí , y en este enlace encontrará un buen tutorial para usarlo. Para completar, adjunto uno de los ejemplos que reproduje.

Primero instalé el paquete (se requiere devtools)

if(!require(devtools)) install.packages("devtools")
devtools::install_github("kassambara/ggpubr")

Para el ejemplo particular de mostrar diferentes histogramas para diferentes grupos, menciona en relación con ggExtra: "Una limitación de ggExtraes que no puede hacer frente a múltiples grupos en el diagrama de dispersión y los diagramas marginales. En el código R a continuación, proporcionamos un solución usando el cowplotpaquete ". En mi caso, tuve que instalar el último paquete:

install.packages("cowplot")

Y seguí este fragmento de código:

# Scatter plot colored by groups ("Species")
sp <- ggscatter(iris, x = "Sepal.Length", y = "Sepal.Width",
            color = "Species", palette = "jco",
            size = 3, alpha = 0.6)+
border()                                         
# Marginal density plot of x (top panel) and y (right panel)
xplot <- ggdensity(iris, "Sepal.Length", fill = "Species",
               palette = "jco")
yplot <- ggdensity(iris, "Sepal.Width", fill = "Species", 
               palette = "jco")+
rotate()
# Cleaning the plots
sp <- sp + rremove("legend")
yplot <- yplot + clean_theme() + rremove("legend") 
xplot <- xplot + clean_theme() + rremove("legend")
# Arranging the plot using cowplot
library(cowplot)
plot_grid(xplot, NULL, sp, yplot, ncol = 2, align = "hv", 
      rel_widths = c(2, 1), rel_heights = c(1, 2))

Lo que funcionó bien para mí:

Iris establece un diagrama de dispersión de histogramas marginales

Puede crear fácilmente diagramas de dispersión atractivos con histogramas marginales utilizando ggstatsplot (también se ajustará y describirá un modelo):

data(iris)

library(ggstatsplot)

ggscatterstats(
  data = iris,                                          
  x = Sepal.Length,                                                  
  y = Sepal.Width,
  xlab = "Sepal Length",
  ylab = "Sepal Width",
  marginal = TRUE,
  marginal.type = "histogram",
  centrality.para = "mean",
  margins = "both",
  title = "Relationship between Sepal Length and Sepal Width",
  messages = FALSE
)

O un poco más atractivo (por defecto) ggpubr :

devtools::install_github("kassambara/ggpubr")
library(ggpubr)

ggscatterhist(
  iris, x = "Sepal.Length", y = "Sepal.Width",
  color = "Species", # comment out this and last line to remove the split by species
  margin.plot = "histogram", # I'd suggest removing this line to get density plots
  margin.params = list(fill = "Species", color = "black", size = 0.2)
)

ACTUALIZAR:

Según lo sugerido por @aickley, utilicé la versión de desarrollo para crear la trama.

Esta es una vieja pregunta, pero pensé que sería útil publicar una actualización aquí ya que me he encontrado con este mismo problema recientemente (¡gracias a Stefanie Mueller por la ayuda!).

La respuesta más votada usando gridExtra funciona, pero alinear ejes es difícil / hacky, como se ha señalado en los comentarios. Esto ahora se puede resolver usando el comando ggMarginal del paquete ggExtra, como tal:

#load packages
library(tidyverse) #for creating dummy dataset only
library(ggExtra)

#create dummy data
a = round(rnorm(1000,mean=10,sd=6),digits=0)
b = runif(1000,min=1.0,max=1.6)*a
b = b+runif(1000,min=9,max=15)

DummyData <- data.frame(var1 = b, var2 = a) %>% 
  filter(var1 > 0 & var2 > 0)

#plot
p = ggplot(DummyData, aes(var1, var2)) + geom_point(alpha=0.3)
ggMarginal(p, type = "histogram")

Probé esas opciones, pero no estaba satisfecho con los resultados o el código desordenado que uno necesitaría usar para llegar allí. Por suerte, Thomas Lin Pedersen acaba de desarrollar un paquete llamado patchwork , que hace el trabajo de una manera bastante elegante.

Si desea crear un diagrama de dispersión con histogramas marginales, primero deberá crear esos tres gráficos por separado.

library(ggplot2)

x <- rnorm(300)
y <- rt(300, df = 2)
xy <- data.frame(x, y)

plot1 <- ggplot(xy, aes(x = x, y = y)) + 
  geom_point() 

dens1 <- ggplot(xy, aes(x = x)) + 
  geom_histogram(color = "black", fill = "white") + 
  theme_void()

dens2 <- ggplot(xy, aes(x = y)) + 
  geom_histogram(color = "black", fill = "white") + 
  theme_void() + 
  coord_flip()

Lo único que queda por hacer es agregar esas parcelas con un simple +y especificar el diseño con la función plot_layout().

library(patchwork)

dens1 + plot_spacer() + plot1 + dens2 + 
  plot_layout(
    ncol = 2, 
    nrow = 2, 
    widths = c(4, 1),
    heights = c(1, 4)
  ) 

La función plot_spacer()agrega un diagrama vacío a la esquina superior derecha. Todos los otros argumentos deben explicarse por sí mismos.

Dado que los histogramas dependen en gran medida del ancho de bin elegido, uno podría argumentar que prefiere gráficos de densidad. Con algunas pequeñas modificaciones, se obtendría, por ejemplo, para los datos de seguimiento ocular, una hermosa trama.

library(ggpubr)

plot1 <- ggplot(df, aes(x = Density, y = Face_sum, color = Group)) + 
  geom_point(aes(color = Group), size = 3) + 
  geom_point(shape = 1, color = "black", size = 3) + 
  stat_smooth(method = "lm", fullrange = TRUE) +
  geom_rug() + 
  scale_y_continuous(name = "Number of fixated faces", 
                     limits = c(0, 205), expand = c(0, 0)) + 
  scale_x_continuous(name = "Population density (lg10)", 
                     limits = c(1, 4), expand = c(0, 0)) + 
  theme_pubr() +
  theme(legend.position = c(0.15, 0.9)) 

dens1 <- ggplot(df, aes(x = Density, fill = Group)) + 
  geom_density(alpha = 0.4) + 
  theme_void() + 
  theme(legend.position = "none")

dens2 <- ggplot(df, aes(x = Face_sum, fill = Group)) + 
  geom_density(alpha = 0.4) + 
  theme_void() + 
  theme(legend.position = "none") + 
  coord_flip()

dens1 + plot_spacer() + plot1 + dens2 + 
  plot_layout(ncol = 2, nrow = 2, widths = c(4, 1), heights = c(1, 4))

Aunque los datos no se proporcionan en este momento, los principios subyacentes deben ser claros.

Para construir sobre la respuesta de @ alf-pascu, configurar cada parcela manualmente y organizarlas con cowplotmucha flexibilidad le otorga mucha flexibilidad a las parcelas principales y marginales (en comparación con algunas de las otras soluciones). Las distribuciones por grupos son un ejemplo. Cambiar la trama principal a una trama de densidad 2D es otra.

Lo siguiente crea un diagrama de dispersión con histogramas marginales (correctamente alineados).

library("ggplot2")
library("cowplot")

# Set up scatterplot
scatterplot <- ggplot(iris, aes(x = Sepal.Length, y = Sepal.Width, color = Species)) +
  geom_point(size = 3, alpha = 0.6) +
  guides(color = FALSE) +
  theme(plot.margin = margin())


# Define marginal histogram
marginal_distribution <- function(x, var, group) {
  ggplot(x, aes_string(x = var, fill = group)) +
    geom_histogram(bins = 30, alpha = 0.4, position = "identity") +
    # geom_density(alpha = 0.4, size = 0.1) +
    guides(fill = FALSE) +
    theme_void() +
    theme(plot.margin = margin())
}

# Set up marginal histograms
x_hist <- marginal_distribution(iris, "Sepal.Length", "Species")
y_hist <- marginal_distribution(iris, "Sepal.Width", "Species") +
  coord_flip()

# Align histograms with scatterplot
aligned_x_hist <- align_plots(x_hist, scatterplot, align = "v")[[1]]
aligned_y_hist <- align_plots(y_hist, scatterplot, align = "h")[[1]]

# Arrange plots
plot_grid(
  aligned_x_hist
  , NULL
  , scatterplot
  , aligned_y_hist
  , ncol = 2
  , nrow = 2
  , rel_heights = c(0.2, 1)
  , rel_widths = c(1, 0.2)
)

Para trazar una trama de densidad 2D, simplemente cambie la trama principal.

# Set up 2D-density plot
contour_plot <- ggplot(iris, aes(x = Sepal.Length, y = Sepal.Width, color = Species)) +
  stat_density_2d(aes(alpha = ..piece..)) +
  guides(color = FALSE, alpha = FALSE) +
  theme(plot.margin = margin())

# Arrange plots
plot_grid(
  aligned_x_hist
  , NULL
  , contour_plot
  , aligned_y_hist
  , ncol = 2
  , nrow = 2
  , rel_heights = c(0.2, 1)
  , rel_widths = c(1, 0.2)
)

Otra solución usando ggpubry cowplot, pero aquí creamos trazados usando cowplot::axis_canvasy los agregamos al diagrama original con cowplot::insert_xaxis_grob:

library(cowplot) 
library(ggpubr)

# Create main plot
plot_main <- ggplot(faithful, aes(eruptions, waiting)) +
  geom_point()

# Create marginal plots
# Use geom_density/histogram for whatever you plotted on x/y axis 
plot_x <- axis_canvas(plot_main, axis = "x") +
  geom_density(aes(eruptions), faithful)
plot_y <- axis_canvas(plot_main, axis = "y", coord_flip = TRUE) +
  geom_density(aes(waiting), faithful) +
  coord_flip()

# Combine all plots into one
plot_final <- insert_xaxis_grob(plot_main, plot_x, position = "top")
plot_final <- insert_yaxis_grob(plot_final, plot_y, position = "right")
ggdraw(plot_final)

Hoy en día, hay al menos un paquete CRAN que hace el diagrama de dispersión con sus histogramas marginales.

library(psych)
scatterHist(rnorm(1000), runif(1000))

Puede utilizar la forma interactiva ggExtra::ggMarginalGadget(yourplot) y elegir entre diagramas de caja, diagramas de violín, diagramas de densidad e histogramas con facilidad.

como eso