R/qplot_spStat.R

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

#' @name qplot_spStat
#'
#' @title [+] Plot a summary statistic of spectroscopic data by group
#'
#' @description Plot a summary of spectroscopic data in hyperSpec object by group.
#' The summary statistic internally is generated by either function
#' \code{\link{spStat}} or \code{\link[hyperSpec]{aggregate}}.
#'
#' @template sp
#' @param by A grouping variable (either a vector or a variable name in \code{sp}).
#' @param FUN A function that calculates one or several summary statistics.
#' @param Title The main title of the plot.
#' @template subtitle
#' @param All Logical. If \code{TRUE}, plot additional curve for a statistic
#'                    of all spectra (\code{.ALL}), not divided to groups.
#' @param fixed.colors - Logical. If \code{TRUE}, color scheme where
#'                       \code{.ALL} is plotted as a black line is be used.
#' @param All.color A line color for \code{.ALL}.
#' @param gr.color Line colors (a vector) for each level in \code{by}.
#' @param All.linetype A line type for \code{.ALL}.
#' @param gr.linetype Line types (a vector) for each level in \code{by}.
#' @param All.size A line width for \code{.ALL}.
#' @param gr.size Line widths (a vector) for each level in \code{by}.
#' @param legend.title A title for legend. Default is no title.
#'
#'
#' @template ggplot
#' @export
#'
#' @examples
#'
#'
#' qplot_spStat(chondro,"clusters",mean)
#' qplot_spStat(chondro,"clusters",mean,All=FALSE)
#' qplot_spStat(chondro,"clusters",mean_sd,All=FALSE) + facet_grid(.~clusters)
#'
#' qplot_spStat(chondro,"clusters",median,All=FALSE, fixed.colors=FALSE)
#' qplot_spStat(chondro,"clusters",median, "My Title")
#'
#'
#' # Make facets with fewer ticks on the x axis:
#' qplot_spStat(chondro,"clusters",mean_pm_sd) +
#'      facet_grid(.~clusters) +
#'      nTick_x(2)
#'
#'
#' # Add as a layer:
#' qplot_spRange(chondro, "clusters") +
#'      layer_spStat(chondro,"clusters", mean, size = 1)
#'
#'
#' @seealso \code{\link{spStat}}
#' @family \pkg{spHelper} plots
#' @author Vilmantas Gegzna
#'

qplot_spStat <- function(sp,
                         by =  stop("Argument 'by' is missing."),
                         FUN = stop("Argument 'FUN' is missing."),
                         Title = fCap(as.character(match.call()$FUN)),
                         subTitle = NULL,
                         All = FALSE,
                         fixed.colors = All,
                         All.color = "black",
                         gr.color = c(hyGet_palette(sp),  RColorBrewer::brewer.pal(8,"Dark2")),
                         All.linetype = "dashed",
                         gr.linetype  = "solid",
                         All.size =  1.1,
                         gr.size =  0.8,
                         legend.title = element_blank(),
                         ...,
                         add = FALSE
)
{
    if (nrow(sp) == 0) {warning("Number of rows in `sp` is 0!"); return(NULL)}

    by <- getVarValues(by, sp) %>% as.factor

    if (!is.null(subTitle)) Title <- subt(Title, subTitle)

    # All - Lofical. Plot statistic of all spectra?
    if (All == TRUE) {
        sp2 <-    spStat(sp, by = by, FUN = FUN,
                         Name_of.by = as.character(match.call()$by))
    } else {
        sp2 <- aggregate(sp, by = by, FUN = FUN)
    }

    nl.gr  <- sum(levels(sp2$.aggregate) != ".All")

    fixedColors <- if (fixed.colors) {
        colors  <- c(gr.color[1:nl.gr], All.color)
        scale_color_manual(values = colors)
    } else NULL

    ldf <- function(x) as.long.df(sp2, rownames = TRUE, na.rm = FALSE)
    df <- ldf(x)
    df <- df[!is.na(df$spc), , drop = FALSE]

    mapping = aes_sp_(
        colour   = ".aggregate",
        size     = ".aggregate",
        linetype = ".aggregate")

    if (add == FALSE){
        p <- ggplot(df, mapping = mapping) + geom_line(...)

        # Make a plot
        p <- p +
            scale_size_manual(    values = c(rep(gr.size,     nl.gr), All.size))  +
            scale_linetype_manual(values = c(rep(gr.linetype, nl.gr), All.linetype)) + # ,guide=FALSE
            fixedColors +
            theme_bw() +
            theme(legend.title = legend.title)  +
            labs(title = Title,
                 x = labels(sp)$.wavelength,
                 y = labels(sp)$spc
            )

    } else {
        p <- geom_line(df,
                       mapping = aes_sp_(color = ".aggregate"),
                       inherit.aes = FALSE,
                       ...
        )
    }

    return(p)

}
# ==================================================================

#' @name qplot_spStat
#' @export

layer_spStat <- function(sp,
                         by  = stop("Argument 'by' is missing."),
                         FUN = stop("Argument 'FUN' is missing."),
                         Title = fCap(as.character(match.call()$FUN)),
                         subTitle = NULL,
                         All = FALSE,
                         ...,
                         add = TRUE
){
    qplot_spStat(sp,
                 by =  by,
                 FUN = FUN,
                 Title = Title,
                 subTitle = subTitle,
                 All = All,
                 ...,
                 add = add)
}



# =============================================================================
# varName <- as.character(match.call()$by)
# by <- if (varName %in% colnames(sp)) sp[[,varName]] else by

# by <- as.factor(by)


# Make a plot
# p <- qplotspc(sp2, spc.nmax = nrow(sp2),
#               mapping = aes(x = .wavelength,
#                             y = spc,
#                             group    = .rownames,
#                             colour   = .aggregate,
#                             size     = .aggregate,
#                             linetype = .aggregate),
#               map.lineonly = TRUE) +