Sebar dengan histogram marginal di ggplot2

Apakah ada cara untuk membuat diagram sebar dengan histogram marginal seperti pada contoh di bawah ini ggplot2? Di Matlab itu adalahscatterhist() fungsi dan ada padanan untuk R juga. Namun, saya belum melihatnya untuk ggplot2.

Saya memulai upaya dengan membuat grafik tunggal tetapi tidak tahu bagaimana mengaturnya dengan benar.

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

dan mengaturnya dengan fungsi yang diposting di sini . Tetapi untuk membuat cerita panjang menjadi pendek: Apakah ada cara untuk membuat grafik ini?

The gridExtrapaket harus bekerja di sini. Mulailah dengan membuat setiap objek 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()

Kemudian gunakan fungsi grid.arrange:

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

Ini bukan jawaban yang sepenuhnya responsif tetapi sangat sederhana. Ini menggambarkan metode alternatif untuk menampilkan kepadatan marginal dan juga cara menggunakan level alfa untuk keluaran grafis yang mendukung transparansi:

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

Ini mungkin agak terlambat, tetapi saya memutuskan untuk membuat paket ( ggExtra) untuk ini karena melibatkan sedikit kode dan bisa membosankan untuk ditulis. Paket ini juga mencoba mengatasi beberapa masalah umum seperti memastikan bahwa meskipun ada judul atau teks yang diperbesar, plot akan tetap sejajar satu sama lain.

Ide dasarnya mirip dengan jawaban yang diberikan di sini, tetapi lebih dari itu. Berikut adalah contoh cara menambahkan histogram marginal ke kumpulan acak 1000 poin. Semoga kedepannya lebih mudah untuk menambahkan histogram / plot kepadatan.

Tautkan ke paket 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")

Satu tambahan, hanya untuk menghemat waktu mencari orang yang melakukan ini setelah kita.

Legenda, label sumbu, teks sumbu, tanda centang membuat plot menjauh dari satu sama lain, sehingga plot Anda akan terlihat jelek dan tidak konsisten.

Anda dapat memperbaikinya dengan menggunakan beberapa pengaturan tema berikut,

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

dan sejajarkan skala,

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

jadi hasilnya akan terlihat oke:

Hanya variasi yang sangat kecil pada jawaban BondedDust , dalam semangat umum indikator distribusi marjinal.

Edward Tufte menyebut penggunaan petak permadani ini sebagai 'petak titik-titik', dan memiliki contoh dalam VDQI tentang penggunaan garis sumbu untuk menunjukkan kisaran setiap variabel. Dalam contoh saya, label sumbu dan garis kisi juga menunjukkan distribusi data. Label terletak pada nilai ringkasan lima angka Tukey (minimum, engsel bawah, median, engsel atas, maksimum), memberikan kesan cepat penyebaran setiap variabel.

Lima angka ini dengan demikian merupakan representasi numerik dari plot kotak. Agak rumit karena garis kisi yang berjarak tidak rata menunjukkan bahwa sumbu memiliki skala non-linier (dalam contoh ini adalah linier). Mungkin yang terbaik adalah menghilangkan garis kisi atau memaksanya berada di lokasi biasa, dan biarkan label memperlihatkan ringkasan lima angka.

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

Karena tidak ada solusi yang memuaskan untuk jenis plot ini saat membandingkan kelompok yang berbeda, saya menulis fungsi untuk melakukan ini.

Ini berfungsi untuk data yang dikelompokkan dan tidak dikelompokkan dan menerima parameter grafis tambahan:

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)

Saya telah menemukan package ( ggpubr) yang tampaknya bekerja sangat baik untuk masalah ini dan mempertimbangkan beberapa kemungkinan untuk menampilkan data.

Tautan ke paket ada di sini , dan di tautan ini Anda akan menemukan tutorial bagus untuk menggunakannya. Untuk kelengkapan, saya lampirkan salah satu contoh yang saya buat ulang.

Saya pertama kali menginstal paket (itu membutuhkan devtools)

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

Untuk contoh khusus dalam menampilkan histogram yang berbeda untuk kelompok yang berbeda, ia menyebutkan sehubungan dengan ggExtra: "Salah satu batasannya ggExtraadalah bahwa ia tidak dapat menangani banyak kelompok di plot pencar dan plot marjinal. Dalam kode R di bawah ini, kami menyediakan solusi menggunakan cowplotpaket. " Dalam kasus saya, saya harus menginstal paket yang terakhir:

install.packages("cowplot")

Dan saya mengikuti potongan kode ini:

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

Yang bekerja dengan baik untuk saya:

Iris mengatur sebar histogram marginal

Saya mencoba opsi itu, tetapi tidak puas dengan hasil atau kode berantakan yang perlu digunakan untuk sampai ke sana. Saya beruntung, Thomas Lin Pedersen baru saja mengembangkan paket yang disebut tambal sulam , yang menyelesaikan pekerjaan dengan cara yang cukup elegan.

Jika Anda ingin membuat sebar dengan histogram marginal, pertama-tama Anda harus membuat ketiga plot tersebut secara terpisah.

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

Satu-satunya hal yang harus dilakukan, adalah menambahkan plot tersebut dengan sederhana +dan menentukan tata letak dengan fungsi plot_layout().

library(patchwork)

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

Fungsi plot_spacer()menambahkan plot kosong ke pojok kanan atas. Semua argumen lainnya harus cukup jelas.

Karena histogram sangat bergantung pada binwidth yang dipilih, orang mungkin berpendapat lebih suka plot kepadatan. Dengan beberapa modifikasi kecil seseorang akan mendapatkan misalnya untuk data pelacakan mata sebuah plot yang indah.

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

Meskipun data tidak tersedia pada saat ini, prinsip dasarnya harus jelas.

Ini adalah pertanyaan lama, tetapi saya pikir akan berguna untuk memposting pembaruan di sini karena saya telah menemukan masalah yang sama baru-baru ini (terima kasih kepada Stefanie Mueller atas bantuannya!).

Jawaban yang paling banyak dipilih menggunakan gridExtra berfungsi, tetapi sumbu penyelarasan sulit / hacky, seperti yang telah ditunjukkan di komentar. Ini sekarang dapat diselesaikan dengan menggunakan perintah ggMarginal dari paket ggExtra, seperti:

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

Anda dapat dengan mudah membuat diagram sebar yang menarik dengan histogram marginal menggunakan ggstatsplot (ini juga akan sesuai dan mendeskripsikan 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
)

Atau sedikit lebih menarik (secara default) 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)
)

MEMPERBARUI:

Seperti yang disarankan oleh @aickley, saya menggunakan versi pengembangan untuk membuat plot.

Untuk membangun jawaban oleh @ alf-pascu, menyiapkan setiap plot secara manual dan mengaturnya dengan cowplotmemberikan banyak fleksibilitas sehubungan dengan plot utama dan marjinal (dibandingkan dengan beberapa solusi lain). Distribusi menurut kelompok adalah salah satu contohnya. Mengubah plot utama menjadi plot kepadatan 2D adalah hal lain.

Berikut ini membuat diagram sebar dengan histogram marginal (sejajar dengan benar).

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

Untuk memplot plot kepadatan 2D, ubah saja plot utamanya.

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

Solusi lain menggunakan ggpubrdan cowplot, tetapi di sini kami membuat plot menggunakan cowplot::axis_canvasdan menambahkannya ke plot asli dengan 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)

Saat ini, setidaknya ada satu paket CRAN yang membuat scatterplot dengan histogram marginalnya.

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

Anda dapat menggunakan bentuk interaktif ggExtra::ggMarginalGadget(yourplot) dan memilih antara plot kotak, plot biola, plot kepadatan dan histogram dengan mudah.

seperti itu