Генерация графиков в R для определенных корреляций в матрице

Question

Я хочу генерировать графики между переменными (столбцами), которые имеют корреляцию выше и ниже определенной точки, а также имеют значение < 0,01. Графиками будут графики ggplot2 (линейные или столбчатые), на которых изображены два столбца (переменных), которые коррелируют.

Здесь суть моего подхода на данный момент, с некоторыми фиктивными данными, я бы хотел указатель, куда идти дальше.

# Create some dummy data
df <- data.frame(sample(1:50), sample(1:50), sample(1:50), sample(1:50))
colnames(df) <- c("var1", "var2", "var3", "var4")

# Find correlations in the dummy data
df.cor <- cor(df)

# Make up some random pvalues for this example
x <- 0:1000
df.cor.pvals <- data.frame(sample(x/1000, 4), sample(x/1000, 4), sample(x/1000, 4), sample(x/1000,4))
colnames(df.cor.pvals) <- c("var1", "var2", "var3", "var4")

# Find the significant correlations
df.cor.extreme <- ((df.cor < -0.01 | df.cor > 0.01) & df.cor.pvals < 0.5)

# Ready data to for plotting
df$rownames <- rownames(df)
df.melt <- melt(df, id="rownames")

# I want to plot the combinations of variables that have a TRUE value
# in the df.cor.extreme matrix 

Ниже приведен жестко закодированный пример, если var1 и var2 имели значение TRUE. Я предполагаю, что именно здесь мне нужен какой-то цикл для генерации нескольких графиков, где varA и varB коррелированы.

ggplot(df.melt[(df.melt$variable=="var1" | df.melt$variable=="var2"),], aes(x=rownames, y=value, group=variable, colour=variable)) +
  geom_line()

Answer 1

Как сказано в комментарии @DrewSteen, p-avlue должен иметь ту же форму, что и cor.

Здесь я предоставляю функцию, которая вычисляет матрицу p-значений (она должна существовать в виде встроенной функции в пакете статистики)

pvalue.matrix <- function(x,...){
  ncx <- ncol(x)
  r <- matrix(0, nrow = ncx, ncol = ncx)
  for (i in seq_len(ncx)) {
    for (j in seq_len(i)) {
      x2 <- x[, i]
      y2 <- x[, j]
      r[i, j] <-  cor.test(x2,y2,...)$p.value
    }
  }
  r <- r + t(r) - diag(diag(r))
  rownames(r) <- colnames(x)
  colnames(r) <- colnames(x)
  r
}

Затем вы используете векторизованную версию | а вот так

df.cor.sig <- (df.cor > 0.01 | df.cor < -0.01) & pvalue.matrix(df) < 0.5

сюжет классический с geom_tile

library(reshape2) ## melt
library(plyr)     ## round_any
 library(ggplot2) 
dat <- expand.grid(var1=1:4, var2=1:4)
dat$value <- melt(df.cor.sig)$value
dat$labels <- paste(round_any(df.cor,0.01) ,'(', round_any(pvalue.matrix(df),0.01),')',sep='')
ggplot(dat, aes(x=var1,y=var2,label=labels))+ 
  geom_tile(aes(fill = value),colour='white')+
 geom_text()

Редактировать после уточнения ОП

plots <- apply(dat,1,function(x){
    plot.grob <- nullGrob()
    if(length(grep(pattern='TRUE',x[3])) >0 ){
      gg <- paste('var',c(x[1],x[2]),sep='')
      p <- ggplot(subset(df.melt,variable %in% gg ), 
            aes(x=rownames, y=value, group=variable, colour=variable)) +
            geom_line()
      plot.grob <- ggplotGrob(p)
    }
    plot.grob

})


library(gridExtra)
do.call(grid.arrange,  plots)

Answer 2

Просто хотел добавить дополнение к ответу @agstudy, если вы делаете это самостоятельно.

Если вы играете с результатами функции, которая генерирует таблицу матричных индексов, к которой вы можете применить значение. Т.е. эта строка:

dat <- expand.grid(var1=1:4, var2=1:4)

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

# Find redunant pairs
dat <- data.frame(t(apply(dat, 1, function(x){
  if(x[1]-x[2] <= 0) {    # If > zero than pair has come before.
    -x                    # If = zero than pair is same 
  } else x
})))

# Remove redundant pairs
dat <- dat[dat$var1>0,]

Наслаждайтесь!