做这样的相关矩阵图的最佳方法是什么？

Question

我使用ggpairs生成这个图：

这是它的代码：

#load packages
library("ggplot2")
library("GGally")
library("plyr")
library("dplyr")
library("reshape2")
library("tidyr")


#generate example data
dat <- data.frame(replicate(6, sample(1:5, 100, replace=TRUE)))
dat[,1]<-as.numeric(dat[,1])
dat[,2]<-as.numeric(dat[,2])
dat[,3]<-as.numeric(dat[,3])
dat[,4]<-as.numeric(dat[,4])
dat[,5]<-as.numeric(dat[,5])
dat[,6]<-as.numeric(dat[,6])

#ggpairs-plot
main<-ggpairs(data=dat, 
              lower=list(continuous="smooth", params=c(colour="blue")),
              diag=list(continuous="bar", params=c(colour="blue")), 
              upper=list(continuous="cor",params=c(size = 6)), 
              axisLabels='show',
              title="correlation-matrix",
              columnLabels = c("Item 1", "Item 2", "Item 3","Item 4", "Item 5", "Item 6")) +  theme_bw() +
  theme(legend.position = "none", 
        panel.grid.major = element_blank(), 
        axis.ticks = element_blank(), 
        panel.border = element_rect(linetype = "dashed", colour = "black", fill = NA))
main

但是，我的目标是，获得这样的情节：

这个图是一个例子，我使用以下三个ggplot代码生成它。

我将它用于geom_point图：

#------------------------
#lower / geom_point with jitter
#------------------------

#dataframe 
df.point <- na.omit(data.frame(cbind(x=dat[,1], y=dat[,2])))

#plot
scatter <- ggplot(df.point,aes(x, y)) +
  geom_jitter(position = position_jitter(width = .25, height= .25)) +
  stat_smooth(method="lm", colour="black") +
  theme_bw() + 
  scale_x_continuous(labels=NULL, breaks = NULL) +
  scale_y_continuous(labels=NULL, breaks = NULL) +
  xlab("") +ylab("")
scatter

这给出了以下情节：

我用这个用于Barplot：

#-------------------------
#diag. / BARCHART
#------------------------

bar.df<-as.data.frame(table(dat[,1],useNA="no"))

#Barplot
bar<-ggplot(bar.df) + geom_bar(aes(x=Var1,y=Freq),stat="identity") +
  theme_bw() + 
  scale_x_discrete(labels=NULL, breaks = NULL) +
  scale_y_continuous(labels=NULL, breaks = NULL, limits=c(0,max(bar.df$Freq*1.05))) +
  xlab("") +ylab("")
bar

这给出了以下情节：

我将此用于相关系数：

#----------------------
#upper / geom_tile and geom_text
#------------------------

#correlations
df<-na.omit(dat)
df <- as.data.frame((cor(df[1:ncol(df)]))) 
df <- data.frame(row=rownames(df),df) 
rownames(df) <- NULL 

#Tile to plot (as example)
test<-as.data.frame(cbind(1,1,df[2,2])) #F09_a x F09_b
colnames(test)<-c("x","y","var")

#Plot
tile<-ggplot(test,aes(x=x,y=y)) +
  geom_tile(aes(fill=var)) +
  geom_text(data=test,aes(x=1,y=1,label=round(var,2)),colour="White",size=10,show_guide=FALSE) +
  theme_bw() + 
  scale_y_continuous(labels=NULL, breaks = NULL) +
  scale_x_continuous(labels=NULL, breaks = NULL) +
  xlab("") +ylab("") + theme(legend.position = "none")
tile

这给出了以下情节：

我的问题是： 什么是获得情节的最佳方式，我想要的？我想从问卷调查中看到Likert项目，在我看来，这是一个非常好的方法。 是否有可能使用ggpairs而不用自己创建每个情节，就像我对已经存放的ggpairs-plot所做的那样。还是有另一种方法可以做到这一点吗？

Answer 1

我不知道这是最好的方式，它肯定不容易，但这会生成三个图表列表：一个用于条形图，散点图和图块。使用gtable函数，它会创建一个gtable布局，将这些图添加到布局中，然后进行一些微调。

编辑：将t和p.values添加到磁贴中。

# Load packages
library(ggplot2)
library(plyr)
library(gtable)
library(grid)


# Generate example data
dat <- data.frame(replicate(10, sample(1:5, 200, replace = TRUE)))
dat = dat[, 1:6]
dat <- as.data.frame(llply(dat, as.numeric))


# Number of items, generate labels, and set size of text for correlations and item labels
n <- dim(dat)[2]
labels <- paste0("Item ", 1:n)
sizeItem = 16
sizeCor = 4


## List of scatterplots
scatter <- list()

for (i in 2:n) {
   for (j in 1:(i-1)) {

# Data frame 
df.point <- na.omit(data.frame(cbind(x = dat[ , j], y = dat[ , i])))

# Plot
p <- ggplot(df.point, aes(x, y)) +
   geom_jitter(size = .7, position = position_jitter(width = .2, height= .2)) +
   stat_smooth(method="lm", colour="black") +
   theme_bw() + theme(panel.grid = element_blank())

name <- paste0("Item", j, i)
scatter[[name]] <- p
} }


## List of bar plots
bar <- list()
for(i in 1:n) {

# Data frame
bar.df <- as.data.frame(table(dat[ , i], useNA = "no"))
names(bar.df) <- c("x", "y")

# Plot
p <- ggplot(bar.df) + 
   geom_bar(aes(x = x, y = y), stat = "identity", width = 0.6) +
   theme_bw() +  theme(panel.grid = element_blank()) +
   ylim(0, max(bar.df$y*1.05)) 

name <- paste0("Item", i)
bar[[name]] <- p
}


## List of tiles
tile <- list()

for (i in 1:(n-1)) {
   for (j in (i+1):n) {

# Data frame 
df.point <- na.omit(data.frame(cbind(x = dat[ , j], y = dat[ , i])))

x = df.point[, 1]
y = df.point[, 2]
correlation = cor.test(x, y)
cor <- data.frame(estimate = correlation$estimate,
                  statistic = correlation$statistic,
                  p.value = correlation$p.value)
cor$cor = paste0("r = ", sprintf("%.2f", cor$estimate), "\n", 
                 "t = ", sprintf("%.2f", cor$statistic), "\n",
                 "p = ", sprintf("%.3f", cor$p.value))


# Plot
p <- ggplot(cor, aes(x = 1, y = 1)) +
  geom_tile(fill = "steelblue") +
  geom_text(aes(x = 1, y = 1, label = cor),
     colour = "White", size = sizeCor, show_guide = FALSE) +
  theme_bw() + theme(panel.grid = element_blank()) 

name <- paste0("Item", j, i)
tile[[name]] <- p
} }


# Convert the ggplots to grobs, 
# and select only the plot panels
barGrob <- llply(bar, ggplotGrob)
barGrob <- llply(barGrob, gtable_filter, "panel")

scatterGrob <- llply(scatter, ggplotGrob)
scatterGrob <- llply(scatterGrob, gtable_filter, "panel")

tileGrob <- llply(tile, ggplotGrob)
tileGrob <- llply(tileGrob, gtable_filter, "panel")


## Set up the gtable layout
gt <- gtable(unit(rep(1, n), "null"), unit(rep(1, n), "null"))


## Add the plots to the layout
# Bar plots along the diagonal
for(i in 1:n) {
gt <- gtable_add_grob(gt, barGrob[[i]], t=i, l=i)
}

# Scatterplots in the lower half
k <- 1
for (i in 2:n) {
   for (j in 1:(i-1)) {
gt <- gtable_add_grob(gt, scatterGrob[[k]], t=i, l=j)
k <- k+1
} }

# Tiles in the upper half
k <- 1
for (i in 1:(n-1)) {
   for (j in (i+1):n) {
gt <- gtable_add_grob(gt, tileGrob[[k]], t=i, l=j)
k <- k+1
} }


# Add item labels
gt <- gtable_add_cols(gt, unit(1.5, "lines"), 0)
gt <- gtable_add_rows(gt, unit(1.5, "lines"), 2*n)

for(i in 1:n) {
textGrob <- textGrob(labels[i], gp = gpar(fontsize = sizeItem)) 
gt <- gtable_add_grob(gt, textGrob, t=n+1, l=i+1)
}

for(i in 1:n) {
textGrob <- textGrob(labels[i], rot = 90, gp = gpar(fontsize = sizeItem)) 
gt <- gtable_add_grob(gt, textGrob, t=i, l=1)
}


# Add small gap between the panels
for(i in n:1) gt <- gtable_add_cols(gt, unit(0.2, "lines"), i)
for(i in (n-1):1) gt <- gtable_add_rows(gt, unit(0.2, "lines"), i)


# Add chart title
gt <- gtable_add_rows(gt, unit(1.5, "lines"), 0)
textGrob <- textGrob("Korrelationsmatrix", gp = gpar(fontface = "bold", fontsize = 16)) 
gt <- gtable_add_grob(gt, textGrob, t=1, l=3, r=2*n+1)


# Add margins to the whole plot
for(i in c(2*n+1, 0)) {
gt <- gtable_add_cols(gt, unit(.75, "lines"), i)
gt <- gtable_add_rows(gt, unit(.75, "lines"), i)
}


# Draw it
grid.newpage()
grid.draw(gt)