Grafico di una matrice di correlazione in R come nell'esempio di Excel

Question

Ho cercato di ridurre al minimo il mio utilizzo di Excel in favore di R, ma sono ancora bloccato quando si tratta di visualizzare celle di dati semplici come spesso è necessario come ultimo passaggio di un'analisi Il seguente esempio è uno che vorrei spezzare, in quanto mi aiuterebbe a passare a R per questa parte critica del mio flusso di lavoro.

vorrei illustrare la seguente matrice di correlazione R in:

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") 

Le cellule devono essere colorati in base al loro grado (ad es> 95 percentile è completamente verde, < 5 percentile è completamente rosso). L'ultima riga dovrebbe essere illustrata da una barra orizzontale (che rappresenta la frazione del valore massimo).

ho fatto in Excel l'output che desidero avere:

Idealmente, desidero anche sottolineare gruppi di correlazione (manualmente o tramite script), come nella figura seguente:

Answer 1

Ecco un approccio utilizzando la grafica di 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

La matrice di correlazione ha diversi valori maggiori di 1, il che non è possibile. Ma tant'è ...

Provate questo

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 ha un buon inizio sulla risposta. Ho pensato di riempire qualche altro pezzo: ottenere il gradiente di colore nel rosso/verde specificato, sfogliando l'ordine dell'asse y e ripulendo alcuni altri punti (sfondo grigio e legenda).

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:

Ora il tentativo di ottenere le barre blu formato nella parte inferiore.

Ciò che rende le barre delle dimensioni più difficili è che si tratta di una rappresentazione completamente diversa di dati diversi rispetto alla matrice di correlazione. Quindi cercherò innanzitutto di rendere solo quella parte separata e poi lavorerò per metterli insieme.

Come con i dati del cor, prima i dati delle dimensioni vengono estratti dalla matrice e quindi trasformati in un data.frame con i valori utili, inclusa la frazione del totale.

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()) 

Il geom_rect chiamata utilizza alcuni trucchi come l'utilizzo della rappresentazione numerica della variabile categorica (discreto) per posizionare le cose con attenzione. Ogni "item" va da 0.5 sotto di esso a 0.5 sopra di esso. Quindi il bordo sinistro del rettangolo è 0,5 sotto il valore dell'articolo e il margine destro è frac a destra di quello. Usare Inf e -Inf per i limiti y significa andare all'estremo della trama. Questo dà

Ora per cercare di metterli insieme.La scala x è comune e le scale y possono essere rese comuni (sebbene disgiunte). È necessario giocare con livelli e ordini. Inoltre, ho capovolto xey nell'originale (che va bene poiché è simmetrico). Dal momento che i set di dati vengono estratti e formattati in modo leggermente diverso, li ho rinominati.

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()) 

Questa versione finale non si assume che sia una correlazione 10x10 con una riga aggiuntiva. Può essere qualsiasi numero. cor_matrix deve avere i nomi corretti (e "Dimensione" deve essere l'ultima riga) e item_names deve contenere l'elenco di elementi. Ma non deve essere 10.