Розсіювач з граничними гістограмами в ggplot2

Чи існує спосіб створення розсипань з граничними гістограмами, як у зразку нижче ggplot2? У Matlab це scatterhist()функція, а також існують еквіваленти для R. Однак я не бачив цього для ggplot2.

Я розпочав спробу, створивши окремі графіки, але не знаю, як їх правильно розташувати.

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

і упорядкування їх за допомогою функції, розміщеної тут . Але коротко кажучи: чи існує спосіб створення цих графіків?

gridExtraПакет повинен працювати тут. Почніть із створення кожного з 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()

Потім скористайтеся функцією grid.arrange:

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

Це не зовсім чуйна відповідь, але це дуже просто. Він ілюструє альтернативний метод відображення граничної щільності, а також як використовувати альфа-рівні для графічного виводу, що підтримує прозорість:

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

Це може бути трохи пізно, але я вирішив зробити пакет ( ggExtra) для цього, оскільки він містив трохи коду і може бути стомлюючим для написання. Пакет також намагається вирішити деякі поширені проблеми, такі як забезпечення того, що навіть якщо є заголовок або текст збільшено, сюжети все одно будуть узгоджуватися один з одним.

Основна ідея схожа на відповіді, які тут давали, але це трохи перевищує це. Ось приклад того, як додати граничні гістограми до випадкового набору з 1000 балів. Сподіваємось, це полегшить додавання гістограм / графіків щільності в майбутньому.

Посилання на пакет 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")

Одне доповнення - просто заощадити час пошуку людей, які роблять це після нас.

Легенди, позначки на осі, тексти осі, галочки роблять сюжети відстороненими один від одного, тому ваш сюжет буде виглядати некрасиво та непослідовно.

Ви можете виправити це за допомогою деяких із цих параметрів теми,

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

і вирівняти ваги,

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

тому результати будуть виглядати нормально:

Лише незначна різниця у відповіді BondedDust у загальному дусі граничних показників розподілу.

Едвард Туфте назвав це використання графіків килимів «точковим графіком» і має в VDQI приклад використання ліній осі для позначення діапазону кожної змінної. У моєму прикладі мітки осі та лінії сітки також вказують на розподіл даних. Мітки розміщені за значеннями підсумків п'яти номерів Tukey (мінімум, нижній шарнір, медіана, верхній шарнір, максимум), що дає швидке враження про поширення кожної змінної.

Ці п'ять чисел, таким чином, є числовим представленням боксплоту. Це трохи хитро, тому що нерівномірно розташовані лінії сітки говорять про те, що осі мають нелінійний масштаб (у цьому прикладі вони лінійні). Можливо, було б краще пропустити лінії сітки або змусити їх знаходитись у звичайних місцях, а просто дозволити міткам відображати підсумки п’яти чисел.

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

Оскільки не було задовольняючого рішення для такого роду сюжетів при порівнянні різних груп, я написав функцію для цього.

Він працює як для згрупованих, так і для негрупованих даних і приймає додаткові графічні параметри:

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)

Я знайшов пакет (ggpubr ), який, здається, працює дуже добре для цієї проблеми, і він розглядає кілька можливостей для відображення даних.

Посилання на пакет знаходиться тут , і за цим посиланням ви знайдете приємний підручник з його використання. Для повноти додаю один із відтворених нами прикладів.

Я вперше встановив пакет (він вимагає devtools)

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

У конкретному прикладі відображення різних гістограм для різних груп, він згадується стосовно ggExtra: "Одне обмеження ggExtraполягає в тому, що він не може впоратися з декількома групами в діаграмі розсіяння та граничних ділянках. У R-коді, наведеному нижче, ми надаємо рішення за допомогою cowplotпакета. " У моєму випадку мені довелося встановити останній пакет:

install.packages("cowplot")

І я дотримувався цього коду:

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

Що добре працювало для мене:

Ірис встановив граничні гістограми розсіювача

Ви можете легко створити привабливі розсіювачі з крайовими гістограмами за допомогою ggstatsplot (він також підходить і описує модель):

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
)

Або трохи привабливіший (за замовчуванням) 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)
)

ОНОВЛЕННЯ:

Як запропонував @aickley, я використовував розроблювальну версію для створення сюжету.

Це старе питання, але я подумав, що було б корисно опублікувати оновлення тут, оскільки я нещодавно зіткнувся з цією ж проблемою (дякую Стефані Мюллер за допомогу!).

Відповідь, яка найбільше сприймається за допомогою gridExtra, працює, але вирівнювання осей складно / хитро, як було зазначено в коментарях. Тепер це можна вирішити за допомогою команди ggMarginal з пакету ggExtra як такої:

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

Я спробував ці варіанти, але не був задоволений результатами або брудним кодом, який потрібно було б використати, щоб потрапити туди. Пощастило мені, Томас Лін Педерсен щойно розробив пакет під назвою печворк , який виконує роботу в досить елегантній формі.

Якщо ви хочете створити розсіювач з граничними гістограмами, спершу вам доведеться створити ці три схеми окремо.

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

Єдине, що залишилося зробити - це додати ці сюжети з простим +і вказати макет з функцією plot_layout().

library(patchwork)

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

Функція plot_spacer()додає порожній сюжет у верхній правий кут. Усі інші аргументи повинні бути роз'яснювальними.

Оскільки гістограми сильно залежать від обраної ширини бін, можна стверджувати, що віддавати перевагу графікам щільності. З деякими невеликими модифікаціями можна отримати, наприклад, для даних відстеження очей гарний сюжет.

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

Хоча дані на даний момент не надаються, основні принципи повинні бути зрозумілими.

На основі відповіді за допомогою @ alf-pascu, встановлення кожного сюжету вручну та впорядкування їх з cowplotгрантами великої гнучкості як щодо основних, так і граничних сюжетів (порівняно з деякими іншими рішеннями). Розподіл по групах - один із прикладів. Зміна основного сюжету на графік 2D-щільності - ще одна.

Далі створюється розсіювач з (правильно вирівняними) граничними гістограмами.

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

Щоб замість цього побудувати графік 2D-щільності, просто змініть основний сюжет.

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

Інше рішення з використанням ggpubrі cowplot, але тут ми створюємо сюжети, використовуючи cowplot::axis_canvasта додаючи їх до початкового сюжету за допомогою 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)

На сьогодні існує щонайменше один пакет CRAN, який робить розсіювач за допомогою своїх граничних гістограм.

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

Ви можете користуватися інтерактивною формою ggExtra::ggMarginalGadget(yourplot) та вибирати між скриньками, сюжетними скрипками, графіками щільності та гістограмами, що легко.

щось схоже на те