Nuage de points avec histogrammes marginaux dans ggplot2

Existe-t-il un moyen de créer des nuages ​​de points avec des histogrammes marginaux, comme dans l'exemple ci-dessous ggplot2? Dans Matlab, c'est la scatterhist()fonction et il existe également des équivalents pour R. Cependant, je ne l'ai pas vu pour ggplot2.

J'ai commencé une tentative en créant les graphiques uniques mais je ne sais pas comment les organiser correctement.

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

et les organiser avec la fonction affichée ici . Mais pour faire court: existe-t-il un moyen de créer ces graphiques?

Le gridExtrapackage devrait fonctionner ici. Commencez par créer chacun des objets 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()

Ensuite, utilisez la fonction grid.arrange:

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

Ce n'est pas une réponse complètement réactive mais c'est très simple. Il illustre une autre méthode pour afficher les densités marginales et comment utiliser les niveaux alpha pour une sortie graphique prenant en charge la transparence:

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

C'est peut-être un peu tard, mais j'ai décidé de créer un package ( ggExtra) pour cela car il impliquait un peu de code et pouvait être fastidieux à écrire. Le paquet essaie également de résoudre certains problèmes courants, comme s'assurer que même s'il y a un titre ou que le texte est agrandi, les tracés seront toujours alignés les uns avec les autres.

L'idée de base est similaire à ce que les réponses ont donné ici, mais cela va un peu plus loin. Voici un exemple de la façon d'ajouter des histogrammes marginaux à un ensemble aléatoire de 1000 points. J'espère que cela facilitera l'ajout d'histogrammes / tracés de densité à l'avenir.

Lien vers le package 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 ajout, juste pour gagner du temps de recherche pour les personnes qui font cela après nous.

Les légendes, les étiquettes d'axes, les textes des axes, les graduations font que les tracés s'éloignent les uns des autres, de sorte que votre intrigue aura l'air moche et incohérente.

Vous pouvez corriger cela en utilisant certains de ces paramètres de thème,

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

et aligner les échelles,

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

donc les résultats sembleront OK:

Juste une très petite variation de la réponse de BondedDust , dans l'esprit général des indicateurs marginaux de distribution.

Edward Tufte a appelé cette utilisation des tracés de tapis un «tracé point-tiret», et a un exemple dans VDQI d'utilisation des lignes d'axe pour indiquer la plage de chaque variable. Dans mon exemple, les étiquettes des axes et les lignes de la grille indiquent également la distribution des données. Les étiquettes sont situées aux valeurs du résumé à cinq chiffres de Tukey (minimum, charnière inférieure, médiane, charnière supérieure, maximum), donnant une impression rapide de la répartition de chaque variable.

Ces cinq nombres sont donc une représentation numérique d'un boxplot. C'est un peu délicat car les lignes de grille espacées de manière inégale suggèrent que les axes ont une échelle non linéaire (dans cet exemple, ils sont linéaires). Il serait peut-être préférable d'omettre les lignes de la grille ou de les forcer à se trouver à des emplacements réguliers, et de laisser simplement les étiquettes afficher le résumé à cinq chiffres.

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

Comme il n'y avait pas de solution satisfaisante pour ce type d'intrigue lors de la comparaison de différents groupes, j'ai écrit une fonction pour le faire.

Il fonctionne pour les données groupées et non groupées et accepte des paramètres graphiques supplémentaires:

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)

J'ai trouvé le package ( ggpubr) qui semble très bien fonctionner pour ce problème et il considère plusieurs possibilités pour afficher les données.

Le lien vers le package est ici , et dans ce lien, vous trouverez un joli tutoriel pour l'utiliser. Par souci d'exhaustivité, je joins l'un des exemples que j'ai reproduits.

J'ai d'abord installé le package (il nécessite devtools)

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

Pour l'exemple particulier d'affichage de différents histogrammes pour différents groupes, il mentionne en relation avec ggExtra: "Une limitation de ggExtraest qu'il ne peut pas faire face à plusieurs groupes dans le nuage de points et les graphiques marginaux. Dans le code R ci-dessous, nous fournissons un solution en utilisant le cowplotpackage. " Dans mon cas, j'ai dû installer ce dernier package:

install.packages("cowplot")

Et j'ai suivi ce morceau de code:

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

Ce qui a bien fonctionné pour moi:

Iris set nuage de points histogrammes marginaux

Vous pouvez facilement créer des nuages ​​de points attrayants avec des histogrammes marginaux à l'aide de ggstatsplot (il ajustera et décrira également un modèle):

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
)

Ou un peu plus attrayant (par défaut) 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)
)

METTRE À JOUR:

Comme suggéré par @aickley, j'ai utilisé la version de développement pour créer l'intrigue.

C'est une vieille question, mais j'ai pensé qu'il serait utile de poster une mise à jour ici car j'ai rencontré ce même problème récemment (merci à Stefanie Mueller pour l'aide!).

La réponse la plus positive utilisant gridExtra fonctionne, mais l'alignement des axes est difficile / piraté, comme cela a été souligné dans les commentaires. Cela peut maintenant être résolu en utilisant la commande ggMarginal du package ggExtra, comme tel:

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

J'ai essayé ces options, mais je n'ai pas été satisfait des résultats ou du code désordonné qu'il faudrait utiliser pour y arriver. Heureusement pour moi, Thomas Lin Pedersen vient de développer un package appelé patchwork , qui fait le travail de manière assez élégante.

Si vous souhaitez créer un nuage de points avec des histogrammes marginaux, vous devez d'abord créer ces trois graphiques séparément.

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

La seule chose qui reste à faire est d'ajouter ces parcelles avec un simple +et de spécifier la mise en page avec la fonction plot_layout().

library(patchwork)

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

La fonction plot_spacer()ajoute un tracé vide dans le coin supérieur droit. Tous les autres arguments doivent être explicites.

Étant donné que les histogrammes dépendent fortement de la largeur de zone choisie, on pourrait dire qu'il faut préférer les graphiques de densité. Avec quelques petites modifications, on obtiendrait par exemple pour les données de suivi oculaire un beau tracé.

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

Bien que les données ne soient pas fournies à ce stade, les principes sous-jacents doivent être clairs.

Pour construire sur la réponse de @ alf-pascu, configurer chaque parcelle manuellement et les organiser avec cowplotoffre une grande flexibilité en ce qui concerne à la fois les parcelles principales et marginales (par rapport à certaines des autres solutions). Les distributions par groupes en sont un exemple. Changer le tracé principal en un tracé de densité 2D en est une autre.

Ce qui suit crée un nuage de points avec des histogrammes marginaux (correctement alignés).

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

Pour tracer un tracé de densité 2D à la place, changez simplement le tracé 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)
)

Une autre solution utilisant ggpubret cowplot, mais ici nous créons des tracés en utilisant cowplot::axis_canvaset les ajoutons au tracé d'origine avec 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)

De nos jours, il existe au moins un package CRAN qui crée le nuage de points avec ses histogrammes marginaux.

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

Vous pouvez utiliser la forme interactive de ggExtra::ggMarginalGadget(yourplot) et choisir entre des boîtes à moustaches, des graphiques de violon, des graphiques de densité et des histogrammes avec facilité.

comme ça