Диаграмма рассеяния с маргинальными гистограммами в 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

Это может быть немного поздно, но я решил сделать package ( 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 есть пример использования осевых линий для указания диапазона каждой переменной. В моем примере метки осей и линии сетки также указывают распределение данных. Метки располагаются в значениях пятизначной сводки Тьюки (минимум, нижний шарнир, медиана, верхний шарнир, максимум), что дает быстрое представление о разбросе каждой переменной.

Эти пять чисел, таким образом, являются числовым представлением коробчатого графика. Это немного сложно, потому что неравномерно расположенные линии сетки предполагают, что оси имеют нелинейный масштаб (в этом примере они линейные). Возможно, было бы лучше, чтобы пропустить линии сетки или заставить их быть в регулярных местах, и просто позволить ярлыкам показывать сводку из пяти чисел.

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) и выбирать между бокс-плотами, скрипками, плотностью и гистограммами.

как это