r - Excelの例のようにRの相関行列のプロット

Question

私はRを優先してExcelの使用を最小限に抑えようとしていますが、分析の最後のステップとして頻繁に必要となる単純なデータセルの表示に関してはまだ行き詰まっています。次の例は、ワークフローのこの重要な部分をRに切り替えるのに役立つため、クラックしたい例です。

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

セルは、ランクに基づいて色付けする必要があります（たとえば、> 95パーセンタイルは完全に緑、<5パーセンタイルは完全に赤です）。最後の行は、水平バー（最大値の端数を表す）で示されている必要があります。

私はExcelで私が欲しい出力を作りました：

理想的には、次の図のように、相関グループを（手動またはスクリプトで）強調表示したいと思います。

Answer 1

相関行列に1より大きい値がいくつかありますが、これは不可能です。しかしとにかく...

これを試してみてください

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 2

Myaseen208は答えの良いスタートを切っています。さらにいくつかの部分を埋めると思いました。指定した赤/緑のカラーグラデーションを取得し、y軸の順序を反転し、他のいくつかのポイント（灰色の背景と凡例）をクリーンアップします。

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

編集：

次に、下部にある青いサイズのバーを取得しようとしています。

サイズバーを難しくしているのは、それらが相関行列とは異なるデータの完全に異なる表現であるということです。それで、私は最初にその部分だけを分離してから、それらをまとめることに取り組みます。

corデータと同様に、最初にサイズデータがマトリックスから抽出され、次に合計の一部を含む有用な値を持つdata.frameに変換されます。

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

このgeom_rect呼び出しでは、カテゴリ（離散）変数の数値表現を使用して物事を慎重に配置するなど、いくつかのトリックを使用します。各「アイテム」は、その下の0.5から上の0.5になります。したがって、長方形の左端はアイテム値の下0.5であり、右端fracはその右側にあります。Infy限界にとを使用-Infすることは、プロットの極限に行くことを意味します。これは与える

次に、それらをまとめてみます。xスケールは一般的であり、yスケールは一般的にすることができます（互いに素ですが）。レベルと注文で遊ぶ必要があります。また、オリジナルのxとyを反転しました（対称であるため問題ありません）。データセットの抽出とフォーマットが少し異なるため、名前を変更しました。

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

この最終バージョンは、追加の行との10x10の相関関係であるとは想定していません。任意の数にすることができます。cor_matrix正しい名前が必要であり（「サイズ」は最後の行である必要があります）item_names、アイテムのリストが含まれている必要があります。ただし、10である必要はありません。

Answer 3

ベースグラフィックを使用したアプローチは次のとおりです。

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)

データ

cor_matrix <- structure(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), .Dim = 11:10)