diff options
Diffstat (limited to 'R/corplot.R')
| -rw-r--r-- | R/corplot.R | 142 |
1 files changed, 0 insertions, 142 deletions
diff --git a/R/corplot.R b/R/corplot.R deleted file mode 100644 index e849a92..0000000 --- a/R/corplot.R +++ /dev/null @@ -1,142 +0,0 @@ -#' Correlation Plot (Upper Triangle) -#' -#' Minimal ggplot2 correlation 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) -#' corplot(R, title = 'Example Correlation Plot') -#' -#' @importFrom reshape2 melt -#' @import ggplot2 -#' @export -corplot <- 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) -} |
