Gráfico de una matriz de correlación en R como ejemplo de Excel

Question

He intentado minimizar mi uso de Excel a favor de R, pero todavía estoy atascado cuando se trata de mostrar celdas de datos simples como a menudo se necesita como el último paso de un análisis. El siguiente ejemplo es uno que me gustaría descifrar, ya que me ayudaría a cambiar a R para esta parte crítica de mi flujo de trabajo.

me gustaría para ilustrar la matriz de correlación siguiente en R:

matrix_values <- c(
    NA,1.54,1.63,1.15,0.75,0.78,1.04,1.2,0.94,0.89, 
    17.95,1.54,NA,1.92,1.03,0.78,0.89,0.97,0.86,1.27, 
    0.95,25.26,1.63,1.92,NA,0.75,0.64,0.61,0.9,0.88, 
    1.18,0.74,15.01,1.15,1.03,0.75,NA,1.09,1.03,0.93, 
    0.93,0.92,0.86,23.84,0.75,0.78,0.64,1.09,NA,1.2, 
    1.01,0.85,0.9,0.88,30.4,0.78,0.89,0.61,1.03,1.2, 
    NA,1.17,0.86,0.95,1.02,17.64,1.04,0.97,0.9,0.93, 
    1.01,1.17,NA,0.94,1.09,0.93,17.22,1.2,0.86,0.88, 
    0.93,0.85,0.86,0.94,NA,0.95,0.96,24.01,0.94,1.27, 
    1.18,0.92,0.9,0.95,1.09,0.95,NA,1.25,21.19,0.89, 
    0.95,0.74,0.86,0.88,1.02,0.93,0.96,1.25,NA,18.14) 
cor_matrix <- matrix(matrix_values, ncol = 10, nrow = 11) 

item_names <- c('Item1','Item2','Item3','Item4','Item5', 
       'Item6','Item7','Item8','Item9','Item10') 
colnames(cor_matrix) <- item_names 
rownames(cor_matrix) <- c(item_names, "Size") 

Las células deben ser de color en función de su rango (por ejemplo> 95 percentil es completamente verde, < 5 percentil es completamente rojo). La última fila debe ilustrarse con una barra horizontal (que representa la fracción del valor máximo).

he hecho en Excel la salida que me gustaría tener:

Idealmente, me gustaría también resaltar los grupos de correlación (ya sea manualmente o por la escritura), como en la siguiente ilustración:

Answer 1

He aquí un método que utiliza gráficos de base:

par(mar=c(1,5,5,1)) 
plot.new() 
plot.window(xlim=c(0,10), ylim=c(0,11)) 

quant_vals <- findInterval(cor_matrix[-11,], 
    c(-Inf, quantile(cor_matrix[-11,], c(0.05, 0.25, 0.45, 0.55, 0.75, 0.95), na.rm=TRUE), 
      Inf)) 
quant_vals[ is.na(quant_vals) ] <- 4 
cols <- c('#ff0000','#ff6666','#ffaaaa','#ffffff','#aaffaa','#66ff66','#00ff00') 
colmat <- matrix(cols[quant_vals], ncol=10, nrow=10) 

rasterImage(colmat, 0, 1, 10, 11, interpolate=FALSE) 
for(i in seq_along(cor_matrix[11,])) { 
    rect(i-1, 0.1, i-1 + cor_matrix[11,i]/max(cor_matrix[11,]), 0.9, col='lightsteelblue3') 
} 

text(col(cor_matrix)-0.5, 11.5-row(cor_matrix), cor_matrix, font=2) 
rect(0,1,10,11) 
rect(0,0,10,1) 
axis(2, at=(11:1)-0.5, labels=rownames(cor_matrix), tick=FALSE, las=2) 
axis(3, at=(1:10)-0.5, labels=colnames(cor_matrix), tick=FALSE, las=2) 

rect(0,8,3,11, lwd=2) 
rect(4,4,7,7, lwd=2) 
rect(8,1,10,3, lwd=2) 

Answer 2

Su matriz de correlación tiene varios valores mayores que 1, lo cual no es posible. Pero de todos modos ...

Prueba este

library(reshape2) 
dat <- melt(cor_matrix[-11, ]) 

library(ggplot2) 
p <- ggplot(data = dat, aes(x = Var1, y = Var2)) + 
    geom_tile(aes(fill = value), colour = "white") + 
    geom_text(aes(label = sprintf("%1.2f",value)), vjust = 1) + 
    scale_fill_gradient(low = "white", high = "steelblue") 

print(p)

Answer 3

Myaseen208 tiene un buen comienzo en la respuesta. Pensé en completar algunas piezas más: obteniendo un degradado de color en el rojo/verde que especificó, cambiando el orden del eje y, y limpiando algunos otros puntos (fondo gris y leyenda).

library("reshape2") 
library("ggplot2") 

cor_dat <- melt(cor_matrix[-11,]) 
cor_dat$Var1 <- factor(cor_dat$Var1, levels=item_names) 
cor_dat$Var2 <- factor(cor_dat$Var2, levels=rev(item_names)) 
cor_dat$pctile <- rank(cor_dat$value, na.last="keep")/sum(!is.na(cor_dat$value)) 

ggplot(data = cor_dat, aes(x = Var1, y = Var2)) + 
    geom_tile(aes(fill = pctile), colour = "white") + 
    geom_text(aes(label = sprintf("%1.1f",value)), vjust = 1) + 
    scale_fill_gradientn(colours=c("red","red","white","green","green"), 
         values=c(0,0.05,0.5,0.95,1), 
         guide = "none", na.value = "white") + 
    coord_equal() + 
    opts(axis.title.x = theme_blank(), 
     axis.title.y = theme_blank(), 
     panel.background = theme_blank()) 

EDIT:

Ahora tratando de obtener las barras de tamaño de color azul en la parte inferior.

Lo que hace que las barras de tamaño sean más difíciles es que son una representación completamente diferente de datos diferentes a la matriz de correlación. Así que primero trataré de separar solo esa parte y luego trabajaré en unirlas.

Al igual que con los datos cor, primero los datos de tamaño se extraen de la matriz y luego se convierten en un data.frame que tiene los valores útiles, incluida la fracción del total.

size_dat <- melt(cor_matrix[11,,drop=FALSE]) 
size_dat$Var2 <- factor(size_dat$Var2, levels=item_names) 
size_dat$frac <- size_dat$value/max(size_dat$value) 

ggplot(data=size_dat, aes(x=Var2, y=Var1)) + 
    geom_blank() + 
    geom_rect(aes(xmin = as.numeric(Var2) - 0.5, 
       xmax = as.numeric(Var2) - 0.5 + frac), 
      ymin = -Inf, ymax = Inf, fill="blue", color="white") + 
    coord_equal() + 
    opts(axis.title.x = theme_blank(), 
     axis.title.y = theme_blank(), 
     panel.background = theme_blank()) 

La llamada geom_rect utiliza algunos trucos como el uso de la representación numérica de la variable categórica (discreta) para posicionar las cosas con cuidado. Cada "elemento" va desde 0.5 debajo de él hasta 0.5 arriba. Entonces, el borde izquierdo del rectángulo está 0.5 debajo del valor del artículo, y el borde derecho es frac a la derecha de eso. Usar Inf y -Inf para los límites y significa ir al extremo de la trama. Esto da

ahora para tratar de ponerlos juntos.La escala x es común, y las escalas y se pueden hacer comunes (aunque disjuntas). Jugar con niveles y pedidos es necesario. Además, invertí xey en el original (lo cual está bien ya que es simétrico). Como los conjuntos de datos se extrajeron y formatearon de forma un poco diferente, los he cambiado de nombre.

cor_dat2 <- melt(cor_matrix[-(nrow(cor_matrix),]) 
cor_dat2$Var1 <- factor(cor_dat$Var1, levels=rev(c(item_names, "Size"))) 
cor_dat2$Var2 <- factor(cor_dat$Var2, levels=item_names) 
cor_dat2$pctile <- rank(cor_dat$value, na.last="keep")/sum(!is.na(cor_dat$value)) 

size_dat2 <- melt(cor_matrix["Size",,drop=FALSE]) 
size_dat2$Var1 <- factor(size_dat$Var1, levels=rev(c(item_names, "Size"))) 
size_dat2$Var2 <- factor(size_dat$Var2, levels=item_names) 
size_dat2$frac <- size_dat$value/max(size_dat$value) 

ggplot(data = cor_dat2, aes(x = Var2, y = Var1)) + 
    geom_tile(aes(fill = pctile), colour = "white") + 
    geom_text(aes(label = sprintf("%1.1f",value))) + 
    geom_rect(data=size_dat2, 
      aes(xmin = as.numeric(Var2) - 0.5, 
       xmax = as.numeric(Var2) - 0.5 + frac, 
       ymin = as.numeric(Var1) - 0.5, 
       ymax = as.numeric(Var1) + 0.5), 
      fill="lightblue", color="white") + 
    geom_text(data=size_dat2, 
      aes(x=Var2, y=Var1, label=sprintf("%.0f", value))) + 
    scale_fill_gradientn(colours=c("red","red","white","green","green"), 
         values=c(0,0.05,0.5,0.95,1), 
         guide = "none", na.value = "white") + 
    scale_y_discrete(drop = FALSE) + 
    coord_equal() + 
    opts(axis.title.x = theme_blank(), 
     axis.title.y = theme_blank(), 
     panel.background = theme_blank()) 

Esta versión final no asume que se trata de una correlación de 10x10 con una fila adicional. Puede ser cualquier número. cor_matrix debe tener los nombres correctos (y "Tamaño" tiene que ser la última fila) y item_names debe contener la lista de elementos. Pero esto no tiene por qué ser 10.