Scatterplot con istogrammi marginali in ggplot2

C'è un modo per creare grafici a dispersione con istogrammi marginali proprio come nell'esempio qui sotto in ggplot2? In Matlab è la scatterhist()funzione e esistono equivalenti anche per R. Tuttavia, non l'ho visto per ggplot2.

Ho iniziato un tentativo creando i singoli grafici ma non so come organizzarli correttamente.

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

e disponendoli con la funzione pubblicata qui . Per farla breve: esiste un modo per creare questi grafici?

Il gridExtrapacchetto dovrebbe funzionare qui. Inizia creando ciascuno degli oggetti 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()

Quindi utilizzare la funzione grid.arrange:

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

Questa non è una risposta completamente reattiva ma è molto semplice. Illustra un metodo alternativo per visualizzare le densità marginali e anche come utilizzare i livelli alfa per l'output grafico che supporta la trasparenza:

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

Questo potrebbe essere un po 'in ritardo, ma ho deciso di creare un pacchetto ( ggExtra) per questo dato che comportava un po' di codice e può essere noioso da scrivere. Il pacchetto cerca anche di risolvere alcuni problemi comuni come garantire che, anche se c'è un titolo o il testo viene ingrandito, i grafici rimarranno in linea tra loro.

L'idea di base è simile a ciò che hanno dato le risposte qui, ma va un po 'oltre. Ecco un esempio di come aggiungere istogrammi marginali a un set casuale di 1000 punti. Speriamo che questo renda più facile aggiungere istogrammi / grafici di densità in futuro.

Link al pacchetto 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")

Un'aggiunta, solo per risparmiare un po 'di tempo di ricerca per le persone che fanno questo dopo di noi.

Leggende, etichette degli assi, testi degli assi, segni di spunta rendono le trame allontanate l'una dall'altra, quindi la trama apparirà brutta e incoerente.

Puoi correggerlo utilizzando alcune di queste impostazioni del 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"))

e allineare le scale,

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

quindi i risultati sembreranno OK:

Solo una variazione molto piccola sulla risposta di BondedDust , nello spirito generale degli indicatori marginali di distribuzione.

Edward Tufte ha definito questo uso dei grafici a tappeto un "diagramma a punti" e ha un esempio in VDQI dell'uso delle linee degli assi per indicare l'intervallo di ciascuna variabile. Nel mio esempio le etichette degli assi e le linee della griglia indicano anche la distribuzione dei dati. Le etichette si trovano ai valori del riepilogo dei cinque numeri di Tukey (minimo, cerniera inferiore, mediana, cerniera superiore, massimo), dando una rapida impressione della diffusione di ciascuna variabile.

Questi cinque numeri sono quindi una rappresentazione numerica di un diagramma a scatole. È un po 'complicato perché le linee della griglia spaziate in modo non uniforme suggeriscono che gli assi hanno una scala non lineare (in questo esempio sono lineari). Forse sarebbe meglio omettere le linee della griglia o forzarle ad essere in posizioni regolari, e lasciare che le etichette mostrassero il riepilogo dei cinque numeri.

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

Poiché non c'era una soluzione soddisfacente per questo tipo di trama quando si confrontano gruppi diversi, ho scritto una funzione per farlo.

Funziona con dati sia raggruppati che non raggruppati e accetta parametri grafici aggiuntivi:

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)

Ho trovato il pacchetto ( ggpubr) che sembra funzionare molto bene per questo problema e considera diverse possibilità per visualizzare i dati.

Il link al pacchetto è qui e in questo link troverai un simpatico tutorial per usarlo. Per completezza, allego uno degli esempi che ho riprodotto.

Ho installato il pacchetto per la prima volta (richiede devtools)

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

Per il particolare esempio di visualizzazione di diversi istogrammi per diversi gruppi, menziona in relazione a ggExtra: "Una limitazione ggExtraè che non può far fronte a più gruppi nel grafico a dispersione e nei grafici marginali. Nel codice R di seguito, forniamo un soluzione usando il cowplotpacchetto ". Nel mio caso, ho dovuto installare quest'ultimo pacchetto:

install.packages("cowplot")

E ho seguito questo pezzo di codice:

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

Che ha funzionato bene per me:

L'iride imposta un diagramma a dispersione degli istogrammi marginali

Puoi facilmente creare interessanti grafici a dispersione con istogrammi marginali usando ggstatsplot (si adatterà e descriverà anche un modello):

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 leggermente più attraente (per impostazione predefinita) 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)
)

AGGIORNARE:

Come suggerito da @aickley, ho usato la versione di sviluppo per creare la trama.

Questa è una vecchia domanda, ma ho pensato che sarebbe stato utile pubblicare un aggiornamento qui poiché ho riscontrato di recente lo stesso problema (grazie a Stefanie Mueller per l'aiuto!).

La risposta più votata con gridExtra funziona, ma allineare gli assi è difficile / hacky, come è stato sottolineato nei commenti. Ora questo può essere risolto usando il comando ggMarginal dal pacchetto ggExtra, come tale:

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

Ho provato quelle opzioni, ma non ero soddisfatto dei risultati o del codice disordinato che uno avrebbe dovuto usare per arrivarci. Fortunatamente me, Thomas Lin Pedersen ha appena sviluppato un pacchetto chiamato patchwork , che porta a termine il lavoro in modo abbastanza elegante.

Se vuoi creare un diagramma a dispersione con istogrammi marginali, devi prima creare questi tre grafici separatamente.

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

L'unica cosa che resta da fare è aggiungere quei grafici con un semplice +e specificare il layout con la funzione plot_layout().

library(patchwork)

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

La funzione plot_spacer()aggiunge un grafico vuoto nell'angolo in alto a destra. Tutti gli altri argomenti dovrebbero essere autoesplicativi.

Poiché gli istogrammi dipendono fortemente dalla larghezza di bin prescelta, si potrebbe sostenere di preferire i diagrammi di densità. Con alcune piccole modifiche si otterrebbe, ad esempio, per i dati di tracciamento degli occhi una trama meravigliosa.

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

Sebbene i dati non siano forniti a questo punto, i principi sottostanti dovrebbero essere chiari.

Per basarsi sulla risposta di @ alf-pascu, impostare manualmente ogni trama e disporli con cowplot concede molta flessibilità rispetto alle trame principali e marginali (rispetto ad alcune delle altre soluzioni). Le distribuzioni per gruppi ne sono un esempio. Cambiare la trama principale in una trama a densità 2D è un'altra.

Di seguito viene creato un diagramma a dispersione con istogrammi marginali (correttamente allineati).

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

Per tracciare invece un grafico a densità 2D, basta modificare il grafico principale.

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

Un'altra soluzione utilizza ggpubre cowplot, ma qui creiamo i grafici usando cowplot::axis_canvase li aggiungiamo alla trama originale 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)

Oggi esiste almeno un pacchetto CRAN che crea il diagramma a dispersione con i suoi istogrammi marginali.

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

È possibile utilizzare la forma interattiva di ggExtra::ggMarginalGadget(yourplot) e scegliere tra box box, grafici violino, grafici densità e istogrammi con facilità.

come quello