R/qcorrplot.R

In Hy4m/linkET: Everything is Linkable

#' @title Init Correlation Plot
#' This functions can be used to visualize simply and directly a correlation matrix.
#' @param data one of 'correlate', 'rcorr' or 'corr.test' object.
#' @param mapping default list of aesthetic mappings to use for plot.
#' @param drop logical, if TRUE will drop unused axis labels.
#' @param parse logical or function generated by \code{parse_func()}.
#' @param grid_col colour of panel grid.
#' @param grid_size size of panel grid.
#' @param fixed if TRUE (default), will add \code{coord_fixed()} to plot.
#' @param use_md deprecated.
#' @param facets NULL or a parameters list of \code{facet_wrap}.
#' @param facets_order character vector to set the order of facet panels.
#' @param ... other parameters.
#' @return a gg object.
#' @rdname qcorrplot
#' @author Hou Yun
#' @export
#' @examples
#' ### type = "full"
#' qcorrplot(correlate(mtcars)) +
#'   geom_square()
#' ### type = "lower"
#' qcorrplot(correlate(mtcars), type = "lower") +
#'   geom_square()
#' ### type = "upper"
#' qcorrplot(correlate(mtcars), type = "upper") +
#'   geom_square()
qcorrplot <- function(data, ...) {
  UseMethod("qcorrplot")
}

#' @rdname qcorrplot
#' @method qcorrplot cor_md_tbl
qcorrplot.cor_md_tbl <- function(data,
                                 mapping = NULL,
                                 drop = FALSE,
                                 parse = FALSE,
                                 grid_col = "grey50",
                                 grid_size = 0.25,
                                 fixed = TRUE,
                                 facets = list(),
                                 facets_order = NULL,
                                 use_md,
                                 ...) {
  if("p" %in% names(data)) {
    base_mapping <- aes_(fill = ~r, r = ~r, r0 = ~r, pvalue = ~p)
  } else {
    base_mapping <- aes_(fill = ~r, r = ~r, r0 = ~r)
  }

  p <- hyplot(md = data,
              mapping = aes_modify(base_mapping, mapping),
              drop = drop,
              parse = parse,
              facets = facets,
              facets_order = facets_order)

  ## add panel grid
  p <- p + geom_panel_grid(colour = grid_col, size = grid_size)

  ## coord fixed?
  if(isTRUE(fixed)) {
    p <- p + ggplot2::coord_fixed()
  }

  ## remove the panel background
  p <- p + theme(panel.background = element_blank(),
                 axis.ticks = element_blank())

  ## check if or not use corrplot-style
  if (inherits(getOption("linkET.corrplot.style"), "Scale")) {
    p <- p + getOption("linkET.corrplot.style")
  }

  p
}

#' @rdname qcorrplot
#' @method qcorrplot default
qcorrplot.default <- function(data,
                              mapping = NULL,
                              drop = FALSE,
                              parse = FALSE,
                              grid_col = "grey50",
                              grid_size = 0.25,
                              fixed = TRUE,
                              facets = list(),
                              facets_order = NULL,
                              use_md,
                              ...) {
  if (is.matrix(data) || is.data.frame(data)) {
    data <- tryCatch(as_correlate(data),
                     error = function(e) {as_md_tbl(data, ...)})
  }

  data <- as_md_tbl(data, ...)
  qcorrplot(data = data,
            mapping = mapping,
            drop = drop,
            parse = parse,
            grid_col = grid_col,
            grid_size = grid_size,
            fixed = fixed,
            facets = facets,
            facets_order = facets_order)
}