R/mean-.R

In atusy/qntmap: Enhance quantitative analysis of EPMA map

# © 2018 JAMSTEC

#' @name mean
#' @title Arithmetric mean for objects generated by `qntmap` package
#' @description
#'   S3 methods for the arithmetric mean.
#'   See [base::mean()]  for general use of `mean()`.
#'
#' @param x
#'   A `qntmap` class object returned by [quantify()] or [qntmap()].
#' @param index
#'   A vector of length `1`` or length equal to number of pixels in map.
#'   An index can be created using mask image through [segment()].
#' @param density
#'   A named numeric vector specifying density of all the phases in `x`.
#'   (e.g., `c(Qtz = 2.6, Ab = 2.6)`).
#' @param cluster
#'   A result of `cluster_xmap()` (i.e., `qm_cluster` class object).
#'   `cluster` is required when specifying `density`.
#' @param ...
#'   Ignored
#'
#' @section mean.qntmap:
#'   A returning value is a [`data.frame`] whose first column lists elements,
#'   and second to last columns lists `mean` values of each elements by index.
#'
#' @seealso [base::mean()], [segment()], [quantify()], [qntmap()]
NULL

#' @rdname mean
#' @export
mean.qntmap <- function(x, index = "Whole area", cluster = NULL, density = NULL, ...) {
  # Provide densities
  density <- if (is.null(cluster)) {
      1 
    } else if (!all(cluster$cluster %in% names(density))) {
      stop("`density` must be a named vector to specify density of all the phases")
    } else {
      density[cluster$cluster]
    }

  x %>>%
    select(
      -ends_with(".se"), # for qm_qntmap
      -matches("cluster"), -matches("membership"), # for qm_cluster
      -"x", -"y"
    ) %>>%
    mutate(.index = !!index, .density = !!density) %>>%
    gather("Element", "val", -".index", -".density", factor_key = TRUE) %>>%
    mutate(val = .data$val * .data$.density) %>>%
    group_by(.data$Element, .data$.index) %>>%
    summarize(val = sum(.data$val), .density = sum(.data$.density)) %>>%
    ungroup() %>>%
    mutate(val = .data$val / .data$.density, .density = NULL) %>>%
    spread(".index", "val") %>>%
    as.data.frame()
}

#' @rdname mean
#' @export
mean.qm_xmap <- mean.qntmap

#' @rdname mean
#' @export
mean.qm_cluster <- mean.qntmap