Plot einer Korrelationsmatrix in R wie in Excel Beispiel

Question

Ich habe versucht, meine Verwendung von Excel zugunsten von R zu minimieren, bin aber immer noch fest, wenn es darum geht, einfache Datenzellen anzuzeigen, wie oft als letzter Schritt benötigt wird eine Analyse. Das folgende Beispiel ist eines, das ich gerne knacken würde, da es mir helfen würde, für diesen kritischen Teil meines Workflows zu R zu wechseln.

I möchte folgende Korrelationsmatrix in R zu veranschaulichen:

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

Die Zellen sollten basierend auf ihrem Rang (z.B.> 95 Perzentil vollständig grün, < 5 Perzentil ist vollständig rot) gefärbt werden. Die letzte Zeile sollte durch einen horizontalen Balken dargestellt werden (der den Bruchteil des Maximalwerts darstellt).

I in Excel gemacht habe, die Ausgabe, die Ich mag würde haben:

Im Idealfall würde Ich mag auch Korrelationsgruppen (entweder manuell oder durch Skript) markieren, wie in der folgenden Abbildung:

Answer 1

Hier ist ein Ansatz mit Basis Grafiken sein:

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

Ihre Korrelationsmatrix hat mehrere Werte größer als 1, was nicht möglich ist. Aber trotzdem ...

Versuchen Sie dieses

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 einen guten Start auf die Antwort hat. Ich dachte, ich würde ein paar mehr Teile ausfüllen: Ich bekomme einen Farbverlauf in dem von Ihnen angegebenen Rot/Grün, kippe die Reihenfolge der Y-Achse und bereinige ein paar andere Punkte (grauer Hintergrund und Legende).

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:

nun versuchen, die blaue Größe Balken unten zu bekommen.

Was die Größenbalken erschwert ist, dass sie eine völlig andere Darstellung von Daten als die Korrelationsmatrix darstellen. Also werde ich zuerst versuchen, nur diesen Teil zu trennen und dann daran arbeiten, sie zusammenzufügen.

Wie bei den COR-Daten werden zuerst die Daten der Größe aus der Matrix extrahiert und dann in einen Datenrahmen umgewandelt, der die nützlichen Werte enthält, einschließlich des Anteils der Gesamtsumme.

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

Der geom_rect Aufruf verwendet einige Tricks wie die numerische Darstellung der kategorischen (diskreten) Variable Dinge sorgfältig zu positionieren. Jedes "Item" geht von 0,5 bis 0,5 darüber. Der linke Rand des Rechtecks ​​ist also 0,5 unter dem Wert des Elements und der rechte Rand ist rechts davon frac. Mit Inf und -Inf für die y-Grenzwerte gehen Sie zum äußersten der Handlung. Dies gibt

Jetzt und sie zu versuchen, zusammen.Die x-Skala ist üblich, und die y-Skala kann gemeinsam gemacht werden (obwohl disjunkt). Das Spielen mit Leveln und Befehlen ist notwendig. Außerdem habe ich x und y im Original umgedreht (was gut ist, da es symmetrisch ist). Da die Datensätze ein wenig anders extrahiert und formatiert sind, habe ich sie umbenannt.

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

Diese endgültige Version geht nicht davon aus, dass es sich um eine 10x10 Korrelation mit einer zusätzlichen Reihe ist. Es kann eine beliebige Nummer sein. cor_matrix muss die richtigen Namen haben (und "Größe" muss die letzte Zeile sein) und item_names muss die Liste der Elemente enthalten. Aber es muss nicht 10.