Scatterplot z marginalnymi histogramami w ggplot2

Czy istnieje sposób tworzenia wykresów rozrzutu z histogramami marginalnymi, tak jak w przykładzie poniżej w ggplot2? W Matlabie jest to scatterhist()funkcja i istnieją również odpowiedniki dla R. Jednak nie widziałem tego dla ggplot2.

Zacząłem od stworzenia pojedynczych wykresów, ale nie wiem, jak je odpowiednio ułożyć.

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

i aranżując je za pomocą funkcji zamieszczonej tutaj . Krótko mówiąc: czy istnieje sposób na tworzenie tych wykresów?

gridExtraPakiet powinien tu pracować. Zacznij od utworzenia każdego z obiektów 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()

Następnie użyj funkcji grid.arrange:

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

Nie jest to pełna odpowiedź, ale jest bardzo prosta. Przedstawia alternatywną metodę wyświetlania gęstości krańcowych, a także sposób korzystania z poziomów alfa dla graficznego wyjścia obsługującego przezroczystość:

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

To może być trochę za późno, ale zdecydowałem się stworzyć pakiet ( ggExtra) w tym celu, ponieważ wymagał on trochę kodu i może być żmudny w pisaniu. Pakiet próbuje również rozwiązać niektóre powszechne problemy, takie jak zapewnienie, że nawet jeśli tytuł lub tekst jest powiększony, wątki nadal będą ze sobą wbudowane.

Podstawowa idea jest podobna do tych, które dały odpowiedzi, ale wykracza poza to. Oto przykład, jak dodać histogramy krańcowe do losowego zestawu 1000 punktów. Miejmy nadzieję, że ułatwi to w przyszłości dodawanie histogramów / wykresów gęstości.

Link do pakietu 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")

Jeden dodatek, aby zaoszczędzić trochę czasu na szukanie ludzi, którzy robią to po nas.

Legendy, etykiety osi, teksty osi, znaczniki sprawiają, że wykresy oddalają się od siebie, więc Twój wykres będzie wyglądał brzydko i niespójnie.

Możesz to poprawić, używając niektórych z tych ustawień motywu,

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

i wyrównaj skale,

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

więc wyniki będą wyglądać dobrze:

Tylko bardzo niewielka zmiana w odpowiedzi BondedDust , w ogólnym duchu marginalnych wskaźników dystrybucji.

Edward Tufte nazwał to użycie wykresów dywanowych „wykresem kropkowym” i ma przykład w VDQI użycia linii osi do wskazania zakresu każdej zmiennej. W moim przykładzie etykiety osi i linie siatki również wskazują rozkład danych. Etykiety znajdują się przy wartościach podsumowania pięciu liczb Tukeya (minimum, dolny zawias, mediana, górny zawias, maksimum), dając szybkie wrażenie rozrzutu każdej zmiennej.

Te pięć liczb stanowi zatem numeryczną reprezentację wykresu pudełkowego. Jest to trochę skomplikowane, ponieważ nierównomiernie rozmieszczone linie siatki sugerują, że osie mają nieliniową skalę (w tym przykładzie są one liniowe). Być może najlepiej byłoby pominąć linie siatki lub zmusić je do umieszczenia w zwykłych lokalizacjach i po prostu pozwolić etykietom pokazać podsumowanie pięciu liczb.

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

Ponieważ nie było satysfakcjonującego rozwiązania dla tego rodzaju wykresu przy porównywaniu różnych grup, napisałem funkcję która to robi.

Działa zarówno dla danych zgrupowanych, jak i niezgrupowanych i akceptuje dodatkowe parametry graficzne:

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)

Znalazłem pakiet ( ggpubr), który wydaje się działać bardzo dobrze w przypadku tego problemu i rozważa kilka możliwości wyświetlenia danych.

Link do pakietu jest tutaj i w formacie tym linku znajdziesz fajny tutorial jak go używać. Dla kompletności załączam jeden z przykładów, które odtworzyłem.

Najpierw zainstalowałem pakiet (wymaga devtools)

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

Dla konkretnego przykładu wyświetlania różnych histogramów dla różnych grup, wspomina w powiązaniu z ggExtra: „Jednym z ograniczeń ggExtrajest to, że nie radzi sobie z wieloma grupami na wykresie rozrzutu i na wykresach krańcowych. W kodzie R poniżej podajemy rozwiązanie za pomocą cowplotpakietu ”. W moim przypadku musiałem zainstalować ten drugi pakiet:

install.packages("cowplot")

Postępowałem zgodnie z tym fragmentem kodu:

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

Co dla mnie działało dobrze:

Iris ustawia wykres rozrzutu histogramów marginalnych

Możesz łatwo tworzyć atrakcyjne wykresy rozrzutu z marginalnymi histogramami za pomocą ggstatsplot (będzie również pasował i opisywał model):

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
)

Lub nieco bardziej atrakcyjny (domyślnie) 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)
)

AKTUALIZACJA:

Zgodnie z sugestią @aickley do stworzenia fabuły wykorzystałem wersję rozwojową.

To stare pytanie, ale pomyślałem, że przydałoby się opublikowanie tutaj aktualizacji, ponieważ ostatnio napotkałem ten sam problem (dzięki Stefanie Mueller za pomoc!).

Najbardziej pozytywna odpowiedź przy użyciu gridExtra działa, ale wyrównywanie osi jest trudne / hacky, jak wskazano w komentarzach. Można to teraz rozwiązać za pomocą polecenia ggMarginal z pakietu ggExtra, na przykład:

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

Wypróbowałem te opcje, ale nie byłem zadowolony z wyników lub niechlujnego kodu, którego trzeba użyć, aby się tam dostać. Na szczęście dla mnie, Thomas Lin Pedersen właśnie opracował pakiet o nazwie patchwork , który wykonuje swoją pracę w całkiem elegancki sposób.

Jeśli chcesz utworzyć wykres rozrzutu z marginalnymi histogramami, najpierw musisz osobno utworzyć te trzy wykresy.

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

Jedyne, co pozostało, to dodać te wykresy za pomocą prostego +i określić układ za pomocą funkcji plot_layout().

library(patchwork)

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

Funkcja plot_spacer()dodaje pusty wykres w prawym górnym rogu. Wszystkie inne argumenty powinny być oczywiste.

Ponieważ histogramy w dużym stopniu zależą od wybranej szerokości pasma, można argumentować, że preferowane są wykresy gęstości. Przy niewielkich modyfikacjach można by uzyskać np. Piękny wykres do śledzenia wzroku.

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

Chociaż na tym etapie dane nie są dostarczane, podstawowe zasady powinny być jasne.

Aby zbudować na odpowiedzi @ alf-pascu, konfigurując każdy wykres ręcznie i ustawiając je za pomocą cowplot zapewnia dużą elastyczność zarówno w odniesieniu do działek głównych, jak i marginalnych (w porównaniu z niektórymi innymi rozwiązaniami). Jednym z przykładów jest dystrybucja według grup. Zmiana głównego wątku na wykres o gęstości 2D to inna sprawa.

Poniższy rysunek tworzy wykres rozrzutu z (odpowiednio wyrównanymi) histogramami marginalnymi.

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

Aby zamiast tego wykreślić wykres gęstości 2D, po prostu zmień główny wykres.

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

Inne rozwiązanie wykorzystujące ggpubr i cowplot, ale tutaj tworzymy działki używając cowplot::axis_canvasi dodajemy je do oryginalnej działki za pomocą 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)

Obecnie istnieje co najmniej jeden pakiet CRAN, który tworzy wykres rozrzutu z jego marginalnymi histogramami.

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

Możesz skorzystać z interaktywnej formy ggExtra::ggMarginalGadget(yourplot) i wybierać między wykresami pudełkowymi, wykresami skrzypcowymi, wykresami gęstości i histogramami, które są łatwe.

tak