tutorial - superponer graficas en r ggplot

Nivel de significancia agregado al mapa de calor de correlación de la matriz usando ggplot2

Question

Me pregunto cómo se puede agregar otra capa de complejidad importante y necesaria a un mapa de calor de correlación matricial como, por ejemplo, el valor p después de la manera de las estrellas de nivel de significancia además del valor R2 (-1 a 1)?
NO SE PRETENDIÓ en esta pregunta poner estrellas de nivel de significancia O los valores de p como texto en cada cuadrado de la matriz PERO más bien mostrar esto en una representación gráfica de nivel de significancia en cada cuadrado de la matriz. Creo que solo aquellos que disfrutan de la bendición del pensamiento INNOVADOR pueden ganar el aplauso para desentrañar este tipo de solución con el fin de tener la mejor manera de representar ese componente adicional de complejidad en nuestros "mapas de calor de correlación matricial a medias verdad". Busqué mucho en Google, pero nunca he visto una forma adecuada, o diría que respetuosa, de representar el nivel de significancia MÁS las sombras de colores estándar que reflejan el coeficiente R.
El conjunto de datos reproducibles se encuentra aquí:
http://learnr.wordpress.com/2010/01/26/ggplot2-quick-heatmap-plotting/
El código R se encuentra a continuación:

library(ggplot2)
library(plyr) # might be not needed here anyway it is a must-have package I think in R 
library(reshape2) # to "melt" your dataset
library (scales) # it has a "rescale" function which is needed in heatmaps 
library(RColorBrewer) # for convenience of heatmap colors, it reflects your mood sometimes
nba <- read.csv("http://datasets.flowingdata.com/ppg2008.csv")
nba <- as.data.frame(cor(nba[2:ncol(nba)])) # convert the matrix correlations to a dataframe 
nba.m <- data.frame(row=rownames(nba),nba) # create a column called "row"
rownames(nba) <- NULL #get rid of row names
nba <- melt(nba)
nba.m$value<-cut(nba.m$value,breaks=c(-1,-0.75,-0.5,-0.25,0,0.25,0.5,0.75,1),include.lowest=TRUE,label=c("(-0.75,-1)","(-0.5,-0.75)","(-0.25,-0.5)","(0,-0.25)","(0,0.25)","(0.25,0.5)","(0.5,0.75)","(0.75,1)")) # this can be customized to put the correlations in categories using the "cut" function with appropriate labels to show them in the legend, this column now would be discrete and not continuous
nba.m$row <- factor(nba.m$row, levels=rev(unique(as.character(nba.m$variable)))) # reorder the "row" column which would be used as the x axis in the plot after converting it to a factor and ordered now
#now plotting
ggplot(nba.m, aes(row, variable)) +
geom_tile(aes(fill=value),colour="black") +
scale_fill_brewer(palette = "RdYlGn",name="Correlation")  # here comes the RColorBrewer package, now if you ask me why did you choose this palette colour I would say look at your battery charge indicator of your mobile for example your shaver, won''t be red when gets low? and back to green when charged? This was the inspiration to choose this colour set.

El mapa de calor de correlación matricial debería verse así:

Sugerencias e ideas para mejorar la solución:
- Este código puede ser útil para tener una idea sobre las estrellas de nivel de significación tomadas de este sitio web:
http://ohiodata.blogspot.de/2012/06/correlation-tables-in-r-flagged-with.html
Código R:

mystars <- ifelse(p < .001, "***", ifelse(p < .01, "** ", ifelse(p < .05, "* ", " "))) # so 4 categories  

- El nivel de significancia se puede agregar como intensidad de color a cada cuadrado, como la estética alfa, pero no creo que esto sea fácil de interpretar y capturar
- Otra idea sería tener 4 tamaños diferentes de cuadrados correspondientes a las estrellas, por supuesto, dando el más pequeño al no significativo y aumenta a un cuadrado de tamaño completo si las estrellas más altas
- Otra idea para incluir un círculo dentro de esos cuadrados significativos y el grosor de la línea del círculo corresponde al nivel de significancia (las 3 categorías restantes) todos ellos de un color
- Igual que el anterior, pero se fija el grosor de la línea y se proporcionan 3 colores para los 3 niveles significativos restantes
- Puede ser que se te ocurran mejores ideas, ¿quién sabe?

Answer 1

Esto es solo un intento de mejorar hacia la solución final, tracé las estrellas aquí como indicador de la solución, pero como dije, el objetivo es encontrar una solución gráfica que pueda hablar mejor que las estrellas. Acabo de utilizar geom_point y alpha para indicar el nivel de significancia, pero el problema es que las NA (que también incluyen los valores no significativos) se mostrarán como el nivel de significancia de tres estrellas, ¿cómo solucionarlo? Creo que usar un solo color puede ser más fácil de usar cuando se usan muchos colores y evitar cargar la trama con muchos detalles para que los ojos se resuelvan. Gracias por adelantado.
Aquí está la trama de mi primer intento:

o podría ser mejor?

¡Creo que lo mejor hasta ahora es el siguiente, hasta que encuentres algo mejor!

Según lo solicitado, el código siguiente es para el último mapa de calor:

# Function to get the probability into a whole matrix not half, here is Spearman you can change it to Kendall or Pearson
cor.prob.all <- function (X, dfr = nrow(X) - 2) {
R <- cor(X, use="pairwise.complete.obs",method="spearman")
r2 <- R^2
Fstat <- r2 * dfr/(1 - r2)
R<- 1 - pf(Fstat, 1, dfr)
R[row(R) == col(R)] <- NA
R
}
# Change matrices to dataframes
nbar<- as.data.frame(cor(nba[2:ncol(nba)]),method="spearman") # to a dataframe for r^2
nbap<- as.data.frame(cor.prob.all(nba[2:ncol(nba)])) # to a dataframe for p values
# Reset rownames
nbar <- data.frame(row=rownames(nbar),nbar) # create a column called "row" 
rownames(nbar) <- NULL
nbap <- data.frame(row=rownames(nbap),nbap) # create a column called "row" 
rownames(nbap) <- NULL
# Melt
nbar.m <- melt(nbar)
nbap.m <- melt(nbap)
# Classify (you can classify differently for nbar and for nbap also)         
nbar.m$value2<-cut(nbar.m$value,breaks=c(-1,-0.75,-0.5,-0.25,0,0.25,0.5,0.75,1),include.lowest=TRUE, label=c("(-0.75,-1)","(-0.5,-0.75)","(-0.25,-0.5)","(0,-0.25)","(0,0.25)","(0.25,0.5)","(0.5,0.75)","(0.75,1)")) # the label for the legend
nbap.m$value2<-cut(nbap.m$value,breaks=c(-Inf, 0.001, 0.01, 0.05),label=c("***", "** ", "*  ")) 
nbar.m<-cbind.data.frame(nbar.m,nbap.m$value,nbap.m$value2) # adding the p value and its cut to the first dataset of R coefficients
names(nbar.m)[5]<-paste("valuep") # change the column names of the dataframe 
names(nbar.m)[6]<-paste("signif.")
nbar.m$row <- factor(nbar.m$row, levels=rev(unique(as.character(nbar.m$variable)))) # reorder the variable factor
# Plotting the matrix correlation heatmap
# Set options for a blank panel
po.nopanel <-list(opts(panel.background=theme_blank(),panel.grid.minor=theme_blank(),panel.grid.major=theme_blank()))
pa<-ggplot(nbar.m, aes(row, variable)) +
geom_tile(aes(fill=value2),colour="white") +
scale_fill_brewer(palette = "RdYlGn",name="Correlation")+ # RColorBrewer package
opts(axis.text.x=theme_text(angle=-90))+
po.nopanel
pa # check the first plot
# Adding the significance level stars using geom_text 
pp<- pa +
geom_text(aes(label=signif.),size=2,na.rm=TRUE) # you can play with the size
# Workaround for the alpha aesthetics if it is good to represent significance level, the same workaround can be applied for size aesthetics in ggplot2 as well. Applying the alpha aesthetics to show significance is a little bit problematic, because we want the alpha to be low while the p value is high, and vice verse which can''t be done without a workaround
nbar.m$signif.<-rescale(as.numeric(nbar.m$signif.),to=c(0.1,0.9)) # I tried to use to=c(0.1,0.9) argument as you might expect, but to avoid problems with the next step of reciprocal values when dividing over one, this is needed for the alpha aesthetics as a workaround
nbar.m$signif.<-as.factor(0.09/nbar.m$signif.) # the alpha now behaves as wanted  except for the NAs values stil show as if with three stars level, how to fix that?
# Adding the alpha aesthetics in geom_point in a shape of squares (you can improve here)
pp<- pa +
geom_point(data=nbar.m,aes(alpha=signif.),shape=22,size=5,colour="darkgreen",na.rm=TRUE,legend=FALSE) # you can remove this step, the result of this step is seen in one of the layers in the above green heatmap, the shape used is 22 which is again a square but the size you can play with it accordingly  

¡Espero que esto sea un paso adelante para llegar allí! Tenga en cuenta:
- Algunos sugirieron clasificar o cortar el R ^ 2 de manera diferente, ok podemos hacerlo, por supuesto, pero aún queremos mostrarle a la audiencia GRÁFICAMENTE el nivel de significación en lugar de preocupar al ojo con los niveles de estrellas. ¿Podemos LOGRAR eso en principio o no?
- Algunos sugirieron que se reduzcan los valores de p de manera diferente. De acuerdo, esta puede ser una opción si no se muestran los 3 niveles de significancia sin molestar al ojo. Entonces podría ser mejor mostrar significativo / no significativo sin niveles
- Puede que haya una mejor idea que se te ocurra para la solución anterior en ggplot2 para la estética de tamaño y alfa, ¡espero tener noticias tuyas pronto!
- ¡La pregunta aún no ha sido respondida, esperando una solución innovadora! - Curiosamente, el paquete "corrplot" lo hace! Este paquete me dio el siguiente gráfico, PD: los cuadrados cruzados no son significativos, nivel de signif = 0.05. ¿Pero cómo podemos traducir esto a ggplot2, podemos?

-¿O puedes hacer círculos y esconder esos no significativos? cómo hacer esto en ggplot2 ?!

Answer 2

Para indicar la importancia a lo largo de los coeficientes de correlación estimados, puede variar la cantidad de color, ya sea utilizando alpha o rellenando solo un subconjunto de cada mosaico:

# install.packages("fdrtool")
# install.packages("data.table")
library(ggplot2)
library(data.table)

#download dataset
nba <- as.matrix(read.csv("http://datasets.flowingdata.com/ppg2008.csv")[-1])
m <- ncol(nba)
# compute corellation and p.values for all combinations of columns
dt <- CJ(i=seq_len(m), j=seq_len(m))[i<j]
dt[, c("p.value"):=(cor.test(nba[,i],nba[,j])$p.value), by=.(i,j)]
dt[, c("corr"):=(cor(nba[,i],nba[,j])), by=.(i,j)]

# estimate local false discovery rate
dt[,lfdr:=fdrtool::fdrtool(p.value, statistic="pvalue")$lfdr]

dt <- rbind(dt, setnames(copy(dt),c("i","j"),c("j","i")), data.table(i=seq_len(m),j=seq_len(m), corr=1, p.value=0, lfdr=0))


#use alpha
ggplot(dt, aes(x=i,y=j, fill=corr, alpha=1-lfdr)) + 
  geom_tile()+
  scale_fill_distiller(palette = "RdYlGn", direction=1, limits=c(-1,1),name="Correlation") +
  scale_x_continuous("variable", breaks = seq_len(m), labels = colnames(nba)) +
  scale_y_continuous("variable", breaks = seq_len(m), labels = colnames(nba), trans="reverse") +
  coord_fixed() +
  theme(axis.text.x=element_text(angle=90, vjust=0.5),
        panel.background=element_blank(),
        panel.grid.minor=element_blank(),
        panel.grid.major=element_blank(),
  )

#use area
ggplot(dt, aes(x=i,y=j, fill=corr,  height=sqrt(1-lfdr),  width=sqrt(1-lfdr))) + 
  geom_tile()+
  scale_fill_distiller(palette = "RdYlGn", direction=1, limits=c(-1,1),name="Correlation") +
  scale_color_distiller(palette = "RdYlGn", direction=1, limits=c(-1,1),name="Correlation") +
  scale_x_continuous("variable", breaks = seq_len(m), labels = colnames(nba)) +
  scale_y_continuous("variable", breaks = seq_len(m), labels = colnames(nba), trans="reverse") +
  coord_fixed() +
  theme(axis.text.x=element_text(angle=90, vjust=0.5),
        panel.background=element_blank(),
        panel.grid.minor=element_blank(),
        panel.grid.major=element_blank(),
  )

La clave aquí es la escala de los p.values: para obtener valores fáciles de interpretar que muestran una gran variación solo en regiones relevantes, uso estimaciones del límite superior para el falso descubrimiento local (lfdr) provisto por fdrtools . Es decir, el valor alfa de un mosaico es probablemente menor o igual a la probabilidad de que esa correlación sea diferente de 0.