R/write_YAMLConfigFile.R

In BayLum: Chronological Bayesian Models Integrating Optically Stimulated Luminescence and Radiocarbon Age Dating

#'@title Write Auto Generated YAML BayLum Configuration File to the Disc
#'
#'@description This little function helps to auto-generate a the BayLum YAML configuration file
#'or a [list] that can be passed to [create_DataFile]. The YAML file itself can be modified in any
#'text editor. The allowed parameters are extracted from the reference YAML file
#'
#'@param output_file [character] (*with default*): valid file path of the output file
#'
#'@param ... parameters to be preset in the YAML file (run `write_YAMLConfigFile()` to see allowed parameters)
#'The parameter `sample` is special, because it can be provided as a [character] vector of any length. The number
#'of elements in the vector (sample names) are then used to multiply the records in the configuration file.
#'
#'@section Function version: 0.1.0
#'
#'@author Sebastian Kreutzer, Institute of Geography, Ruprecht-Karl University of Heidelberg (Germany)
#'
#'@returns The function has two output modes:
#'
#'* (1) `output_file = <file_path>`: Writes a YAML into the specified path and returns this path.
#'* (2) `output_file = NULL`: Returns a list of allowed function parameters that can be passed
#'to the function **and** it returns a list that can be used a passed on to [create_DataFile].
#'
#'@seealso [create_DataFile], [yaml::read_yaml], [Luminescence::read_BIN2R], [Luminescence::read_XSYG2R]
#'
#'@examples
#'
#'## generate list
#'write_YAMLConfigFile(
#' sample = c("samp1", "samp2"),
#' settings.rules.endTest = 10)
#'
#'## generate file (here written in tempdir)
#'write_YAMLConfigFile(
#'  output_file = tempfile("configuration.yml"),
#'  sample = c("samp1", "samp2"),
#'  settings.rules.endTest = 10)
#'
#'@md
#'@export
write_YAMLConfigFile <- function (
  output_file = NULL,
  ...
) {
# Helper functions --------------------------------------------------------
  ## function to replace NULL elements in lists with NA
  ## https://stackoverflow.com/questions/38950005/how-to-manipulate-null-elements-in-a-nested-list
  .replace_NULL <- function(l, fn) {
    if (inherits(l, "list"))
      lapply(l, .replace_NULL, fn)
    else
      fn(l)
  }

# Process -----------------------------------------------------------------
  ## read reference file
  yaml_ref_raw <- system.file("extdata/yaml_config_reference.yml", package = "BayLum") |>
    yaml::read_yaml(readLines.warn = FALSE)


  ## replace all NULL values in the reference list
  ## and then extract names
  param_allowed <- .replace_NULL(yaml_ref_raw, function(x) if (is.null(x)) NA else x) |>
    unlist() |> names()

  # Mode 1 ... show parameters ----------------------------------------------
  if (is.null(output_file)) {
    ## list allowed parameters
    cli::cli_rule("Allowed function parameters (start)")
    writeLines(param_allowed)
    cli::cli_rule("Allowed function parameters (end)")

   }

  # Mode 2 add parameters to list  ----------------------------------------------
  ## get all parameters provided
  param_list <- list(...)

  ## remove all parameters that are not in the original parameter list
  if (!all(names(param_list) %in% param_allowed)) {
    rm <- !names(param_list) %in% param_allowed
    warning(
      paste0("[write_YAMLConfigFile()] The following parameter(s) are not supported and were removed: ",
             paste(names(param_list)[rm], collapse = ", ")), call. = FALSE)
    param_list <- param_list[!rm]

  }

  ## modify parameters were matching ... for this we simply go through the list and construct calls
  for (i in seq_along(param_list)) {
    ## get name
    tmp_parm <- strsplit(names(param_list), split = ".", fixed = TRUE)[[i]]

    ## modify element
    yaml_ref_raw[[1]][[tmp_parm]] <- param_list[[i]][1]

  }
  ## finally inflate list according to the length of sample
  if (!is.null(param_list$sample))
    yaml_ref_raw <- lapply(seq_along(param_list$sample), function(x){
      yaml_ref_raw[[1]]$sample <- param_list$sample[[x]]
      yaml_ref_raw[[1]]

    })

# Mode 3 ... write YAML ---------------------------------------------------
  if (!is.null(output_file)) {
    ## make sure that the ending is always yml
    if (rev(strsplit(x = output_file, split = ".", fixed = TRUE)[[1]])[1] != "yml")
      output_file <- paste0(output_file, ".yml")

    ## normalise output path
    output_file <- suppressWarnings(normalizePath(output_file))

    ## write output file
    yaml::write_yaml(
      x = yaml_ref_raw,
      file = output_file)

    ## add some additional information to the file
    tmp <- c(
      paste0(
      "# +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++\n",
      "# BayLum v", utils::packageVersion("BayLum"), "\n",
      "# Autogenerated BayLum Configuration file ... please check and modify\n",
      "# +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++"),
      readLines(con = output_file))

    writeLines(tmp, con = output_file)

    ## return of the file path
    return(output_file)

  }

  ## return of the list
  invisible(yaml_ref_raw)
}