R/parameter_manipulation.R

In duohongrui/simutils: Common functions used in data simulation and evaluation

#' Set Paramters
#'
#' Set new parameter values via prior infomation
#'
#' @param parameters The estimation result generated by \code{simpipe::estimate_parameters()}
#' @param other_prior A list with names of certain parameters. Some methods need
#' extra parameters to execute the estimation step, so you must input them. In
#' simulation step, the number of cells, genes, groups, batches, the percent of
#' DEGs and other variables are usually customed, so before simulating a dataset
#' you must point it out.
#' @param method Method name.
#'
#' @importFrom methods slotNames
#' @importFrom splatter setParams
#' @importFrom stats na.omit
#'
#' @export
#'
set_parameters <- function(parameters, other_prior, method){
  if(!requireNamespace("Hmisc", quietly = TRUE)){
    message("Install Hmisc...")
    install.packages('Hmisc')
  }
  class_name <- paste0(Hmisc::capitalize(method), "Params")
  # whether the parameters are generated by Splatter
  alternative_methods <- c("SCRIP",
                           "ESCO",
                           "scDD",
                           "BASiCS",
                           "SparseDC",
                           "MFA")
  if(class(parameters) == class_name | method %in% alternative_methods){
    # match names in other_prior and in parameters
    index <- methods::slotNames(parameters)[stats::na.omit(match(names(other_prior),
                                                                 methods::slotNames(parameters)))]
    # filter
    other_prior <- other_prior[index]
    # reset customed paramters
    parameters <- splatter::setParams(parameters, other_prior)
    # return
    return(parameters)
  }else{
    return(parameters)
  }
}


.get_param_name <- function(method, param_list){
  param_name <- purrr::map(method, .f = function(method){
    names(param_list[[method]][[base::paste0(method, "_parameters")]])
  }) %>% setNames(method)
  param_name
}


#' Get the Default Value
#'
#' @param x An object created by \code{simmethods::get_method()}
#'
#' @return A list
#' @export
#'
#' @examples
#' # x <- simmethods::get_method()
#' # params <- get_default_value(x)
get_default_value <- function(x){
  method_name <- names(x)
  param_list_name <- paste0(method_name, '_parameters')
  default_value <- list()
  for(i in seq_len(length(method_name))){
    sublist <- x[[method_name[i]]][[param_list_name[i]]]
    param_names <- names(sublist)
    default_value[[method_name[i]]] <- purrr::map(param_names, function(x){
      sublist[[x]][["default"]]
    }) %>% stats::setNames(param_names)
  }
  return(default_value)
}