R/qplot_infoDim.R

In GegznaV/spHelper: Extension of Package `hyperSpec` and Various Convenience Functions

#' [+] Scree plot with indicated information dimension (ggplot2)
#'
#' Plot a screeplot and with indicated information dimension.
#'
#' @param obj Either a matrix (rows = observations, columns = variables;
#'        to be passed to \code{infoDim}) or
#'       an obj (a list) generated by function \code{\link{infoDim}}.
#'
#' @param n.comp.SHOW A number of components to show on x axis, default is 20.
#' This number is corrected if (a) vector of eigenvalues is smaller than 20
#' or (b) information dimension is higher than 15.
#'
#' @param selected A number of components sellected, will be plotted as a
#'        separate vertical line (optional parameter).
#'
#' @param Title The main title of the plot.
#' @param y.log Logical. If \code{TRUE} (default) the scale of  y axis is
#'       logarythmic.
#'
#' @param show.legend Logical. If \code{TRUE} (default) the legend is displayed.
#' @param legend.position the position of the legend ("none", "left", "right",
#'        "bottom", "top", or two-element numeric vector).
#' @param ggtheme A function of ggplot2 theme to apply (e.g.:
#'        \link[ggplot2]{ggtheme}). Default is \code{theme_bw()}.
#'
#' @return A scree plot : plot which helps to
#'         determine the number of nenessary components (e.g. for PCA).\cr
#'         (A "ggplot" object.)
#'
#' @export
#'
#' @examples
#'  data(Spectra2, package ="spHelper")
#'  qplot_infoDim(Spectra2)
#'
#' # ------------------------------------------------------
#'  my_matrix <- matrix(rexp(200, rate=.1), ncol=20)
#'  my_result <- infoDim(my_matrix)
#'
#'  # Investigate the result
#'  str(my_result)
#'  my_result$exactDim
#'  my_result$dim
#'
#'  #Plot
#'  my_plot <- qplot_infoDim(my_result)
#'  my_plot
#'
#'
#' qplot_infoDim(my_matrix)
#'
#' @note http://www.originlab.com/doc%5Cen/Tutorial/images/Principal_Component_Analysis/Pca_scree_plot.png
#'
#' @family \pkg{spHelper} plots
#' @family component analysis / factorisation related functions in \pkg{spHelper}
#' @family information dimension functions

qplot_infoDim <- function(obj, n.comp.SHOW = 20,
                          selected = NA,
                          Title = "Scree Plot",
                          y.log = TRUE,
                          show.legend = TRUE,
                          legend.position = c(0.8, 0.8),
                          ggtheme = theme_bw()){

    if (!any(class(obj) == "infoDim"))    obj <- infoDim(obj)


    # Adjust n.comp.SHOW
    At_least         <- max(n.comp.SHOW,  obj$dim + 5)
    But_no_more_than <- length(obj$eigenval)
    n.comp.SHOW = min(At_least, But_no_more_than)
    ind <- 1:n.comp.SHOW

    # Prepare data ------------------------------------------------------------
    data2plot <- with(obj,
                 data.frame(x         = n.comp[ind],
                            explained = 100 * explained[ind])
    )

    # Prepare annotations -----------------------------------------------------
    getTicks <- function(n = 10){
        function(x) {
            xMin <- min(x, na.rm = TRUE) #signif(min(x, na.rm = TRUE),1)
            xMax <- max(x, na.rm = TRUE)
            axisTicks(log10(c(xMin,xMax)), log = TRUE, nint = n)
        }
    }

    yMin <- signif(.75*min(data2plot$explained), 1)

    annotations <- data.frame(
        Dim    = obj$exactDim,
        Legend = sprintf("Information dimension = %.1f",obj$exactDim),
        selected    = selected,
        selectedText = sprintf("# components selected = %d",selected)
    )

    # Create a plot ===========================================================

    p <- ggplot(data2plot, aes(x, explained))
    p <- p + ggtheme # Add theme
    p <- p +
        geom_line(color = "#0080ff") +
        geom_point(color = "#0080ff", size = 3) +

        labs(x = "Number of components",
             y = "Explained variance, %",
             title = Title)

    # Add annotation lines
    p <- p + geom_vline(data = annotations,
                        linetype = "dashed",
                        aes(xintercept = Dim,
                            color = Legend),
                        show.legend = show.legend)

    if (!is.na(selected)) {
        p <- p + geom_vline(data = annotations,
                            linetype = "dashed",
                            aes(xintercept = selected,
                                color = selectedText),
                            show.legend = show.legend)
    }

    p <- p +
        scale_colour_manual(values = c("red3", "green3")) +
        theme(legend.title  = element_blank(),
              legend.position   = legend.position # "top" # legend.position = c(0.8, 0.8)
        )
    # legend.background = element_rect(size = 0.5,
    #                                  linetype = "solid",
    #                                   colour  = "gray60")

    # Use log y scale --------------------------------------------------------

    if (y.log) {
        p <- p +
            scale_y_log10(breaks = getTicks(),
                          labels = prettyNum,
                          limits = c(yMin, NA)) +
            annotation_logticks(sides = 'rl', color = "grey50") +
            theme(panel.grid.minor = element_blank())
    }
    #  ------------------------------------------------------------------------
    return(p)
}