R/plot_cut_point.R

In pdwaggoner/plotGMM: Tidy Tools for Visualizing Mixture Models

#' Tidy Visualization of a Cut Point from a Mixture Model
#'
#' Returns a plot of the data density (histogram) with an overlaid cut point generated by the fit mixture model
#' @usage plot_cut_point(m, plot = TRUE, color = c("grayscale", "amerika", "wesanderson"))
#' @param m An object of class \code{mixEM} corresponding with the fit mixture model
#' @param plot Logical for generating the plot. If FALSE, only the cut point value from the GMM is returned. If TRUE, histogram with the overlaid cut point is returned. Default is set to TRUE.
#' @param color A vector of color options including "amerika" (from \code{amerika} package), "wesanderson" (from \code{wesanderson} package), and "grayscale", which is the default option.
#'
#' @details Mixture models can be used to derive cut points separating clusters via soft assignment (See Benaglia et al. 2009 for more). \code{plot_cut_point()} plots data density with an overlaid cut point (the mean of the calculated \code{mu}) from \code{mixEM} objects via \code{mixtools}. Note, this function is in its infancy, and at present only works in the limited context of 2-component Gaussian mixture models with equal priors and equal variances. Development for more complex cases is in process.
#'
#' @examples
#' \donttest{
#' if(require(mixtools)){
#' mixmdl <- mixtools::normalmixEM(faithful$waiting, k = 2)
#' }
#' plot_cut_point(mixmdl, plot = TRUE, color = "amerika") # returns plot, amerika
#' plot_cut_point(mixmdl, plot = TRUE, color = "wesanderson") # returns plot, wesanderson
#' plot_cut_point(mixmdl, plot = FALSE) # returns only the cut point value from the GMM
#'}
#'
#' @references Benaglia, T., Chauveau, D., Hunter, D. and Young, D. 2009. mixtools: An R package for analyzing finite mixture models. Journal of Statistical Software, 32(6), pp.1-29.
#' @references Ram, K., and Wickham, H. 2015. wesanderson: a Wes Anderson palette generator. R package version 0.3.
#'
#' @export
plot_cut_point <- function(m, plot = TRUE, color = c("grayscale", "amerika", "wesanderson")) {
  if (!requireNamespace("dplyr", quietly = TRUE)) {
    stop("Package \"dplyr\" needed for this function to work. Please install it.",
         call. = FALSE)
  }
    if (!requireNamespace("ggplot2", quietly = TRUE)) {
    stop("Package \"ggplot2\" needed for this function to work. Please install it.",
         call. = FALSE)
  }
  if (!requireNamespace("mixtools", quietly = TRUE)) {
    stop("Package \"mixtools\" needed for this function to work. Please install it.",
         call. = FALSE)
  }
  if (!requireNamespace("methods", quietly = TRUE)) {
    stop("Package \"methods\" needed for this function to work. Please install it.",
         call. = FALSE)
  }
  if (!requireNamespace("amerika", quietly = TRUE)) {
    stop("Package \"amerika\" needed for this function to work. Please install it.",
         call. = FALSE)
  }
  if (!requireNamespace("wesanderson", quietly = TRUE)) {
    stop("Package \"wesanderson\" needed for this function to work. Please install it.",
         call. = FALSE)
  }
  m <- try(methods::as(m, "mixEM", strict=TRUE))
  if (!inherits(m, "mixEM")){
    stop("must be a mixEM object", call. = FALSE)
  }
  x <- m$x
  p <- ggplot2::ggplot(data.frame(m$x))
  if(plot == TRUE){
    if (color == "amerika"){
      a <- p + ggplot2::geom_histogram(ggplot2::aes(m$x),
                                       colour = "darkgray",
                                       fill = amerika::amerika_palette(n = 30, name = "Dem_Ind_Rep7", type = "continuous")) +
        ggplot2::geom_vline(xintercept = mean(m$mu)) +
        ggplot2::theme_bw() +
        ggplot2::labs(x = "x",
                      y = "Density",
                      title = "Cutpoint from Gaussian Mixture Model")
      a
    } else if (color == "wesanderson"){
      w <- p + ggplot2::geom_histogram(ggplot2::aes(m$x),
                                       colour = "darkgray",
                                       fill = wesanderson::wes_palette(n = 30, name = "Rushmore1", type = "continuous")) +
        ggplot2::geom_vline(xintercept = mean(m$mu)) +
        ggplot2::theme_bw() +
        ggplot2::labs(x = "x",
                      y = "Density",
                      title = "Cutpoint from Gaussian Mixture Model")
      w
    } else {
      g <- p + ggplot2::geom_histogram(ggplot2::aes(m$x),
                                       colour = "darkgray",
                                       fill = "lightgray") +
        ggplot2::geom_vline(xintercept = mean(m$mu)) +
        ggplot2::theme_bw() +
        ggplot2::labs(x = "x",
                      y = "Density",
                      title = "Cutpoint from Gaussian Mixture Model")
      g
    }
  } else mean(m$mu)
}