ojiva - superponer graficas en r

Genera gráficos en R para ciertas correlaciones en una matriz

Question

Quiero generar gráficos entre variables (columnas) que tienen una correlación por encima y por debajo de un cierto punto, además de tener un pvalue <0.01. Los gráficos serían gráficos ggplot2 (línea o barra) que grafican las dos columnas (variables) que se correlacionan.

Aquí está la esencia de mi enfoque hasta el momento, con algunos datos ficticios, me encantaría un puntero a dónde ir a continuación.

# 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 

A continuación se muestra el ejemplo codificado si var1 y var2 tienen un valor de VERDADERO. Supongo que aquí es donde necesito algún tipo de bucle para generar múltiples gráficas donde varA y varB están correlacionados.

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

Answer 1

Como se dice en el comentario de @DrewSteen, p-avlue debe tener la misma forma que cor.

Aquí proporciono una función que calcula la matriz de p-value (debe existir una función de compilación, en el paquete de estadísticas)

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
}

Luego usas la versión vectorial de | y así

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

la trama es clásica con 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()

Editar después de la aclaración OP

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

Solo quería agregar una adición a la respuesta de @agstudy si lo hace usted mismo.

Si juegas con los resultados de la función que genera una tabla de índices matriciales a la que puedes aplicar el significado. Es decir, esta línea:

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

También recuerde que los 4 codificados en la línea de arriba son la longitud de su cuadrícula (cuadrada). De todos modos, puedes ignorar la generación de cualquier gráfico duplicado haciendo un código como ese:

# 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,]

¡Disfrutar!