Scatterplot с маргинальными гистограммами в 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()

и упорядочивая их с размещенной функцией здесь. Но коротко сделать короткую историю: есть ли способ создания этих графиков?

Ответ 1

Пакет 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))

Ответ 2

Это не совсем отзывчивый ответ, но он очень прост. Он иллюстрирует альтернативный метод отображения предельных плотностей, а также как использовать альфа-уровни для графического вывода, поддерживающего прозрачность:

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

Ответ 3

Это может быть немного поздно, но я решил сделать для него пакет (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")

Ответ 4

Одно дополнение, просто чтобы сохранить время поиска для людей, делающих это после нас.

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

Вы можете исправить это, используя некоторые из этих настроек темы,

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

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

Ответ 5

Просто очень незначительная вариация на BondedDust answer, в общем духе маргинальных показателей распределения.

Эдвард Туфте назвал это использование графиков ковриков "графиком пунктирной точки" и имеет пример в 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 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))

Ответ 6

Поскольку для сравнения этих групп не было удовлетворительного решения, я написал функцию для этого.

Он работает как для сгруппированных, так и для негруппированных данных и принимает дополнительные графические параметры:

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)

Ответ 7

Я нашел пакет (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))

Что у меня хорошо сработало:

Радужная оболочка рассеивает гистограммы

Ответ 8

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

Ответ 9

Чтобы построить ответ @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)
)

Ответ 10

Другое решение, использующее 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)

Ответ 11

Это старый вопрос, но я подумал, что было бы полезно опубликовать здесь обновление, поскольку я недавно столкнулся с этой проблемой (спасибо Стефани Мюллер за помощь!).

Ответ с наибольшим количеством голосов с использованием 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")

Ответ 12

В настоящее время существует по крайней мере один пакет CRAN, который составляет диаграмму рассеяния с ее маргинальными гистограммами.

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

Ответ 13

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

как это