What is the best way to make such a schedule?

Question

I used ggpairs to create this plot:

And this is the code for it:

#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 

However, my goal is to get a plot like this:

This graph is an example, and I produced it with the following three ggplot codes.

I used this for the geom_point graph:

 #------------------------ #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 

this gives the following graph:

I used this for 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 

This gives the following graph:

And I used this for correlation coefficients:

 #---------------------- #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 

This gives the following graph:

My question is: What is the best way to get the plot I want? I want to visualize similar elements from the questionnaire, and in my opinion, this is a very good way to do this. Is it possible to use ggpairs for this without creating a single storyline myself, as I did with the ggpairs storyline. Or is there another way to do this?

Answer 1

I don’t know how to be the best, this, of course, is not easier, but it generates three lists of plots: one for bars, dispersion charts and tiles. Using the gtable functions, it creates a gtable layout, adds graphics to the layout and a little tweaking follows.

EDIT: Add t and p.values ​​to the fragments.

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