Попарное графическое сравнение нескольких распределений

Это отредактированная версия предыдущего вопроса.

Нам дана таблица m на n из n наблюдений (выборок) над m переменными (генами и т. д.). , и мы хотим изучить поведение переменных между каждой парой наблюдений — например, два наблюдения, имеющие самую высокую положительную или отрицательную корреляцию. Для этой цели я видел отличную диаграмму у Stadler et.al. Бумага природы (2011):

введите здесь описание изображения

Здесь это может быть образец набора данных для использования.

m <- 1000
samples <- data.frame(unif1 = runif(m), unif2 = runif(m, 1, 2), norm1 = rnorm(m), 
                      norm2 = rnorm(m, 1), norm3 = rnorm(m, 0, 5))

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

введите здесь описание изображения

Затем я использовал ggpairs(samples, lower=list(continuous="density")) из пакета GGally (спасибо @LucianoSelzer за комментарий ниже). Теперь у нас есть корреляции в верхнем углу и плотности в нижнем углу, но нам не хватает диагональных гистограмм, а графики плотности не имеют форму тепловой карты.

введите здесь описание изображения

Есть идеи, как сделать картинку ближе к желаемой (первой)?


person Ali    schedule 19.03.2013    source источник


Ответы (2)


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

cors<-round(cor(samples),2) #correlations

# make layout for plot layout
laymat<-diag(1:5) #histograms
laymat[upper.tri(laymat)]<-6:15 #correlations
laymat[lower.tri(laymat)]<-16:25 #heatmaps

layout(laymat) #define layout using laymat

par(mar=c(2,2,2,2)) #define marginals etc.

# Draw histograms, tweak arguments of hist to make nicer figures
for(i in 1:5) 
  hist(samples[,i],main=names(samples)[i])

# Write correlations to upper diagonal part of the graph
# Again, tweak accordingly
for(i in 1:4)
  for(j in (i+1):5){
    plot(-1:1,-1:1, type = "n",xlab="",ylab="",xaxt="n",yaxt="n")
    text(x=0,y=0,labels=paste(cors[i,j]),cex=2)
    }

# Plot heatmaps, here I use kde2d function for density estimation
# image function for generating heatmaps
library(MASS)
for(i in 2:5)
  for(j in 1:(i-1)){
     k <- kde2d(samples[,i],samples[,j])
     image(k,col=heat.colors(1000))
    } 

редактировать: исправлена ​​индексация в последнем цикле. парный график

person Jouni Helske    schedule 19.03.2013
comment
Ух ты! Это здорово, спасибо. Мне любопытно посмотреть, есть ли какой-нибудь отличный и короткий ответ ggplot2. - person Ali; 20.03.2013
comment
Бьюсь об заклад, есть, я только начал знакомиться с ggplot2, поэтому решил пойти по-старому. ggplot2 использует сеточную графику, поэтому идея макета здесь не работает. Но это может быть полезно: cookbook-r.com/Graphs/Multiple_graphs_on_one_page_%28ggplot2 %29 - person Jouni Helske; 20.03.2013

Вы можете сделать что-то подобное, используя три разных пакета и две разные функции, как показано ниже:

cor_fun для корреляционного расчета верхнего треугольника. my_fn для построения нижнего треугольника

Вам также нужно ggpairs.

library(GGally)
library(ggplot2)
library(RColorBrewer)

m <- 1000
samples <- data.frame(unif1 = runif(m), unif2 = runif(m, 1, 2), norm1 = rnorm(m), 
                      norm2 = rnorm(m, 1), norm3 = rnorm(m, 0, 5))

cor_fun <- function(data, mapping, method="pearson", ndp=2, sz=5, stars=TRUE){ #ndp is to adjust the number of decimals
  
  x <- eval_data_col(data, mapping$x)
  y <- eval_data_col(data, mapping$y)
  
  corr <- cor.test(x, y, method=method)
  est <- corr$estimate
  lb.size <- sz 
  
  if(stars){
    stars <- c("***", "**", "*", "")[findInterval(corr$p.value, c(0, 0.001, 0.01, 0.05, 1))]
    lbl <- paste0(round(est, ndp), stars)
  }else{
    lbl <- round(est, ndp)
  }
  
  ggplot(data=data, mapping=mapping) +
    annotate("text", x=mean(x, na.rm=TRUE), y=mean(y, na.rm=TRUE), label=lbl, size=lb.size)+
    theme(panel.grid = element_blank(), panel.background=element_rect(fill="snow1")) 
  
}

colfunc<-colorRampPalette(c("darkblue","cyan","yellow","red"))

my_fn <- function(data, mapping){
  p <- ggplot(data = data, mapping = mapping) + 
    stat_density2d(aes(fill=..density..), geom="tile", contour = FALSE) +
    scale_fill_gradientn(colours = colfunc(100)) + theme_classic()
}


ggpairs(samples, columns = c(1,2,3,4,5),
        lower=list(continuous=my_fn),
        diag=list(continuous=wrap("densityDiag", fill="gray92")), #densityDiag is a function
        upper=list(continuous=cor_fun)) + theme(panel.background=element_rect(fill="white")) +
  theme(axis.text.x = element_text(angle = 0, vjust = 1, color = "black")) + 
  theme(axis.text.y = element_text(angle = 0, vjust = 1 , color = "black"))

введите здесь описание изображения

person Apex    schedule 06.11.2020