Gráfico de dispersão com histogramas marginais em ggplot2

Existe uma maneira de criar gráficos de dispersão com histogramas marginais, como na amostra abaixo em ggplot2? No Matlab, é a scatterhist()função e existem equivalentes para R também. No entanto, eu não vi isso para o ggplot2.

Comecei uma tentativa criando os gráficos únicos, mas não sei como organizá-los corretamente.

 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 organizando-os com a função postada aqui . Mas, para resumir a história: existe uma maneira de criar esses gráficos?

O gridExtrapacote deve funcionar aqui. Comece criando cada um dos 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()

Em seguida, use a função grid.arrange:

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

Esta não é uma resposta completamente responsiva, mas é muito simples. Ele ilustra um método alternativo para exibir densidades marginais e também como usar níveis alfa para resultados gráficos que suportam transparência:

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

Isso pode ser um pouco tarde, mas decidi criar um pacote ( ggExtra), pois envolvia um pouco de código e pode ser entediante de escrever. O pacote também tenta solucionar um problema comum, como garantir que, mesmo que haja um título ou o texto seja ampliado, os gráficos ainda estejam alinhados.

A idéia básica é semelhante ao que as respostas aqui deram, mas vai um pouco além disso. Aqui está um exemplo de como adicionar histogramas marginais a um conjunto aleatório de 1000 pontos. Esperamos que isso facilite a adição de histogramas / gráficos de densidade no futuro.

Link para o pacote 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")

Uma adição, apenas para economizar tempo de pesquisa para as pessoas que fazem isso depois de nós.

As legendas, os rótulos dos eixos, os textos dos eixos, os tiques fazem com que os gráficos se afastem um do outro, para que o gráfico fique feio e inconsistente.

Você pode corrigir isso usando algumas dessas configurações 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"))

e alinhar escalas,

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

para que os resultados fiquem bem:

Apenas uma variação muito pequena na resposta da BondedDust , no espírito geral dos indicadores marginais de distribuição.

Edward Tufte chamou esse uso de plotagens de tapete de 'traço pontilhado' e tem um exemplo no VDQI de uso das linhas de eixo para indicar o intervalo de cada variável. No meu exemplo, os rótulos dos eixos e as linhas de grade também indicam a distribuição dos dados. Os rótulos estão localizados nos valores do resumo de cinco números de Tukey (mínimo, dobradiça inferior, mediana, dobradiça superior, máximo), fornecendo uma rápida impressão da distribuição de cada variável.

Esses cinco números são, portanto, uma representação numérica de um boxplot. É um pouco complicado, porque as linhas de grade com espaçamento desigual sugerem que os eixos têm uma escala não linear (neste exemplo, eles são lineares). Talvez seja melhor omitir linhas de grade ou forçá-las a estar em locais regulares, e apenas deixar os rótulos mostrarem o resumo dos 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 não havia solução satisfatória para esse tipo de gráfico ao comparar grupos diferentes, escrevi uma função para fazer isso.

Ele funciona para dados agrupados e não agrupados e aceita parâmetros gráficos adicionais:

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)

Eu encontrei o pacote ( ggpubr) que parece funcionar muito bem para esse problema e considera várias possibilidades para exibir os dados.

O link para o pacote está aqui e neste link você encontrará um bom tutorial para usá-lo. Para completar, anexo um dos exemplos que reproduzi.

Eu instalei o pacote pela primeira vez (requer devtools)

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

Para o exemplo particular de exibição de histogramas diferentes para diferentes grupos, ele menciona em relação a ggExtra: "Uma limitação ggExtraé que ele não pode lidar com vários grupos no gráfico de dispersão e nos gráficos marginais. No código R abaixo, fornecemos um solução usando o cowplotpacote ". No meu caso, eu tive que instalar o último pacote:

install.packages("cowplot")

E eu segui este pedaço 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))

O que funcionou bem para mim:

Conjunto de íris de histogramas marginais

Você pode criar facilmente gráficos de dispersão atraentes com histogramas marginais usando ggstatsplot (ele também se encaixa e descreve um 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
)

Ou um pouco mais atraente (por padrão) 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)
)

ATUALIZAR:

Conforme sugerido por @aickley, usei a versão de desenvolvimento para criar o enredo.

Esta é uma pergunta antiga, mas achei que seria útil postar uma atualização aqui, já que me deparei com esse mesmo problema recentemente (obrigado a Stefanie Mueller pela ajuda!).

A resposta mais votada usando o gridExtra funciona, mas o alinhamento dos eixos é difícil / hacky, como foi apontado nos comentários. Agora isso pode ser resolvido usando o comando ggMarginal do pacote ggExtra, da seguinte forma:

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

Eu tentei essas opções, mas não estava satisfeito com os resultados ou o código confuso que seria necessário usar para chegar lá. Para minha sorte, Thomas Lin Pedersen acabou de desenvolver um pacote chamado patchwork , que faz o trabalho de uma maneira bastante elegante.

Se você quiser criar um gráfico de dispersão com histogramas marginais, primeiro precisará criar esses três gráficos separadamente.

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

A única coisa que resta a fazer é adicionar esses lotes com um simples +e especificar o layout com a função plot_layout().

library(patchwork)

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

A função plot_spacer()adiciona um gráfico vazio ao canto superior direito. Todos os outros argumentos devem ser auto-explicativos.

Como os histogramas dependem muito da largura de caixa escolhida, pode-se argumentar que prefere gráficos de densidade. Com algumas pequenas modificações, obteríamos, por exemplo, para os dados de rastreamento ocular, um belo gráfico.

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

Embora os dados não sejam fornecidos neste momento, os princípios subjacentes devem ser claros.

Para desenvolver a resposta de @ alf-pascu, configurar cada plotagem manualmente e organizá-las com cowplotmuita flexibilidade em relação às plotagens principal e marginal (em comparação com algumas das outras soluções). Distribuições por grupos é um exemplo. Alterar o gráfico principal para um gráfico de densidade 2D é outro.

A seguir, cria-se um gráfico de dispersão com histogramas marginais (alinhados adequadamente).

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 plotar um gráfico de densidade 2D, basta alterar o gráfico 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)
)

Outra solução usando ggpubre cowplot, mas aqui criamos gráficos usando cowplot::axis_canvase os adicionamos ao gráfico original com 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)

Atualmente, há pelo menos um pacote CRAN que faz o gráfico de dispersão com seus histogramas marginais.

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

Você pode usar a forma interativa ggExtra::ggMarginalGadget(yourplot) e escolher entre gráficos de caixas, gráficos de violino, gráficos de densidade e histogramas com facilidade.

Curtiu isso