#' Heatmap Plot (Upper Triangle) #' #' Minimal ggplot2 relationship structure plot showing the upper triangle #' in the top-right corner with no axis labels. #' @param R A square numeric correlation matrix #' @param title Optional plot title #' #' @return A ggplot object #' #' @examples #' X <- matrix(data = rnorm(100), nrow = 10) #' R <- cor(X) #' heatmap(R, title = 'Example Correlation Plot') #' #' @importFrom reshape2 melt #' @import ggplot2 #' @export heatmap <- function(R, title = NULL){ R_list <- tryCatch({ if(is.matrix(R)){ cnames <- colnames(R) rnames <- rownames(R) if(nrow(R) == ncol(R)){ list( R = R[upper.tri(R)], cnames = cnames, rnames = rnames, p = ncol(R) ) } }else if(is.vector(R)){ m <- length(R) n <- (1 + sqrt(1 + 8 * m)) / 2 if(n == floor(n)){ list( R = R, cnames = NULL, rnames = NULL, p = n ) }else{ stop('Input length not compatible with upper triangle') } }else{ Rm <- as.matrix(R) cnames <- colnames(Rm) rnames <- rownames(Rm) if(nrow(Rm) == ncol(Rm)){ list( R = Rm[upper.tri(Rm)], cnames = cnames, rnames = rnames, p = ncol(Rm) ) } } }, error = function(e){ stop(paste('Invalid input for corplot:', e$message)) }) if(is.null(R_list$cnames)){ R_list$cnames <- as.character(seq_len(R_list$p)) } if(is.null(R_list$rnames)){ R_list$rnames <- as.character(seq_len(R_list$p)) } # Now get a df from the upper triangle m <- length(R_list$R) n <- as.integer((1 + sqrt(1 + 8 * m)) / 2) M <- matrix(NA, n, n) M[upper.tri(M)] <- R_list$R colnames(M) <- R_list$cnames rownames(M) <- R_list$rnames df <- reshape2::melt(M, na.rm = TRUE) colnames(df) <- c('i', 'j', 'value') col_label_df <- data.frame( j = seq_len(n)[-1], i = 0, label = R_list$cnames[-1] ) row_label_df <- data.frame( j = seq_len(n)[-n], i = seq_len(n)[-n], label = R_list$cnames[-n] ) max_nchar <- max(nchar(R_list$cnames)) top_margin <- 5 + max_nchar * 2 # And plot it p <- ggplot2::ggplot( data = df, ggplot2::aes(x = .data$j, y = .data$i, fill = .data$value) ) + ggplot2::geom_tile() + ggplot2::geom_text( data = col_label_df, ggplot2::aes(x = .data$j, y = .data$i, label = .data$label), inherit.aes = FALSE, angle = 90, hjust = 0, vjust = 0.5 ) + ggplot2::geom_text( data = row_label_df, ggplot2::aes(x = .data$j, y = .data$i, label = .data$label), inherit.aes = FALSE, hjust = 1, vjust = 0.5 ) + ggplot2::scale_fill_gradient2( low = 'red', mid = 'white', high = 'blue', midpoint = 0, limits = c(-1, 1), name = NULL, guide = 'none' ) + ggplot2::scale_y_reverse() + ggplot2::coord_fixed(clip = 'off') + ggplot2::theme_void() + ggplot2::theme( plot.margin = ggplot2::margin( t = top_margin, r = 5, b = 5, l = 5 ) ) if(!is.null(title)){ p <- p + ggplot2::ggtitle(title) + ggplot2::theme( plot.title = ggplot2::element_text(hjust = 0.5) ) } return(p) }