
#' \code{notame} package.
#'
#' Provides tabular data preprocessing and data wrangling functionality for 
#' untargeted LC-MS metabolomics research.
#' 
#' @name notame-package
#' @references
#' Klåvus et al. (2020). "notame": Workflow for Non-Targeted LC-MS Metabolic 
#' Profiling. Metabolites, 10: 135.
"_PACKAGE"
NULL

#' @rawNamespace import(ggplot2, except = Position)
#' @importFrom utils citation
#' @import BiocGenerics
#' @import methods
#' @import SummarizedExperiment
NULL

utils::globalVariables(c('i', '.'))

#' Set default color scales on load
#'
#' @param libname,pkgname default parameters
#' @noRd
.onLoad <- function(libname, pkgname) {
  op <- options()
  op_notame <- list(
    notame.citations = list(
      "Preprocessing and analyses were performed using notame package:" =
      utils::citation("notame"),
      "The primary data structure in notame is SummarizedExperiment:" = 
      utils::citation("SummarizedExperiment"),
      "visualizations in notame are built with ggplot2:" =
      utils::citation("ggplot2")),
    notame.color_scale_con = scale_color_viridis_c(),
    notame.color_scale_dis = scale_color_brewer(palette = "Set1"),
    notame.fill_scale_con = scale_fill_viridis_c(),
    notame.fill_scale_dis = scale_fill_brewer(palette = "Set1"),
    notame.fill_scale_div_con = scale_fill_distiller(palette = "RdBu"),
    notame.fill_scale_div_dis = scale_fill_brewer(palette = "RdBu"),
    notame.shape_scale = scale_shape_manual(values = c(16, 17, 15, 3,
                                                       7, 8, 11, 13)))
  toset <- !(names(op_notame) %in% names(op))
  if (any(toset)) {
    options(op_notame[toset])
  }
  invisible()
}

.add_citation <- function(name, ref) {
  cites <- getOption("notame.citations")
  if (!name %in% names(cites)) {
    cites[[name]] <- ref
    options(notame.citations = cites)
  }
}

#' Show citations
#'
#' This function lists citations behind the notame functions that have been 
#' called during the session. All notame functions 
#' update the list automatically. The citations are taken from the call to 
#' '\code{citation("package")}, and complemented with a brief description of 
#' what the package was used for.
#' NOTE: the citations might not point to the correct paper if the package 
#' authors have not supplied correct citation information for their package.
#' The output is written to the current log file, if specified.
#'
#' @return None, the function is invoked for its side effect.
#'
#' @examples
#' citations()
#' data(toy_notame_set)
#' ex_set <- flag_quality(toy_notame_set)
#' # Broadhurst et al.(2018) added to citations
#' citations()
#'
#' @export
citations <- function() {
  cites <- getOption("notame.citations")
  for (i in seq_along(cites)) {
    log_text(names(cites)[i])
    log_text(utils::capture.output(show(cites[[i]])))
  }
}


#' Summary statistics of finite elements
#'
#' These functions first remove non-finite and missing values, then 
#' compute the summary statistic in question. They are helper 
#' functions used for computing quality measurements.
#' 
#' @param x a numeric vector.
#' @param ... other parameters passed to underlying function
#' @return A named, numeric vector with the summary statistic in question.
#'
#' @name finite_helpers
#' @noRd
NULL

finite_sd <- function(x) {
  sd(x[is.finite(x)], na.rm = TRUE)
}

finite_mean <- function(x) {
  if (all(is.na(x))) {
    return(NA_real_)
  }
  mean(x[is.finite(x)], na.rm = TRUE)
}

finite_median <- function(x) {
  stats::median(x[is.finite(x)], na.rm = TRUE)
}

finite_min <- function(x) {
  if (all(is.na(x))) {
    return(NA_real_)
  }
  min(x[is.finite(x)], na.rm = TRUE)
}

finite_max <- function(x) {
  if (all(is.na(x))) {
    return(NA_real_)
  }
  max(x[is.finite(x)], na.rm = TRUE)
}

finite_mad <- function(x) {
  mad(x[is.finite(x)], 
      center = stats::median(x[is.finite(x)], na.rm = TRUE), 
      na.rm = TRUE)
}

finite_quantile <- function(x, ...) {
  unname(stats::quantile(x[is.finite(x)], na.rm = TRUE, ...))
}

# Defaults for NULL values
`%||%` <- function(a, b) {
  if (is.null(a)) {
    b
  } else if (is.na(a)) {
    b
  } else {
    a
  }
}

#' Proportion of NA values in a vector
#'
#' @param x a numeric vector
#'
#' @return A numeric, the proportion of non-missing values in a vector.
#'
#' @examples
#' data(toy_notame_set)
#' ex_set <- mark_nas(toy_notame_set, value = 0)
#' prop_na(assay(ex_set))
#' 
#' @noRd
prop_na <- function(x) {
  sum(is.na(x)) / length(x)
}

#' Proportion of non-missing values in a vector
#'
#' @param x a numeric vector
#' 
#' @return A numeric, the proportion of non-missing values in vector.
#'
#' @examples
#' data(toy_notame_set)
#' ex_set <- mark_nas(toy_notame_set, value = 0)
#' prop_found(assay(toy_notame_set))
#'
#' @noRd
prop_found <- function(x) {
  sum(!is.na(x)) / length(x)
}

.best_class <- function(x) {
  x <- as.character(x)
  x <- gsub("false", "FALSE", x, ignore.case = TRUE)
  x <- gsub("true", "TRUE", x, ignore.case = TRUE)
  x <- utils::type.convert(x, as.is = TRUE, na.strings = c("NA", "", "null"))
  if ((is.character(x) || is.integer(x)) && length(unique(x)) < 9) {
    x <- as.factor(x)
  }
  x
}

.best_classes <- function(x) {
  as.data.frame(lapply(x, .best_class), stringsAsFactors = FALSE)
}

.all_unique <- function(x) {
  !any(duplicated(x))
}

.get_from_to_names <- function(object, assay.type, name) {
  # Input behavior (from)
  # If assay.type is not supplied and there is only one assay in the objcet, 
  # choose the first assay
  if (is.null(assay.type) && length(assays(object)) == 1) {
    from <- 1
  } else if (is.null(assay.type)) {
    stop("When using multiple assays, specify assay.type", call. = FALSE)
  } else if (!assay.type %in% names(assays(object)) & assay.type != 1) {
    stop(assay.type, " was specified but not found in assays", call. = FALSE)
  } else {
    from <- assay.type
  }
  # Output behavior (to)
  if (is.null(name) && length(assays(object)) == 1) {
    to <- 1
  } else if (is.null(name)) {
    stop("When using multiple assays, specify name of new assay", call. = FALSE)
  } else {
    to <- name
  }
  list(from, to)
}

.get_from_name <- function(object, assay.type) {
  # Input behavior (from)
  if (is.null(assay.type) && length(assays(object)) == 1) {
    from <- 1
  } else if (is.null(assay.type)) {
    stop("When using multiple assays, specify assay.type", call. = FALSE)
  } else if (!assay.type %in% names(assays(object)) & assay.type != 1) {
    stop(assay.type, " was specified but not found in assays", call. = FALSE)
  } else {
    from <- assay.type
  }
}
