# WARNING - Generated by {fusen} from dev/flat_kwb_simulate_inflow.Rmd: do not edit by hand # nolint: line_length_linter.

#' Select Columns from a Data Frame
#' 
#' Select columns from a data frame. Stop with message if columns do not exist
#' 
#' This function does the same thing as kwb.utils::selectColumns(),
#' but it is bundled with *ambre* to avoid a hard dependency on the
#' unmaintained package.
#' 
#' @param x data frame
#' @param columns vector of column names. If \code{columns} is of length 0 or
#'   \code{NULL} (default) or \code{NA} \code{x} is returned unchanged.
#' @param pattern regular expression matching the names of the columns to be
#'   selected. Will only be evaluated if no explicit column names are given in 
#'   \code{columns}.
#' @param drop if \code{TRUE} and if only one column is to be selected the
#'   result is a vector (one dimensional) containing the values of the selected
#'   column and not a data frame. One dimension has been \emph{dropped} then.
#'   See the \code{help("[.data.frame")}. The default is \code{TRUE} if 
#'   \code{length(columns) == 1}, else \code{FALSE}.
#' @param do.stop this flag controls whether the function stops (\code{do.stop =
#'   TRUE}) or not (\code{do.stop = FALSE}) if there are non-existing columns to
#'   be selected. If \code{do.stop = FALSE} only those columns are selected that
#'   actually exist
#' @return data frame containing the columns of \code{x} that are specified in 
#'   \code{columns} or \code{x} itself if \code{columns} is \code{NULL} or a
#'   vector containing the values of column \code{value} if \code{columns} is of
#'   length 1 and \code{drop = TRUE} (which is the default in this case).
#' @references
#'   Sonnenberg H (2024). kwb.utils: General Utility Functions Developed at KWB. R package version 0.15.0
#'   URL: \url{https://github.com/kwb-r/kwb.utils}
#'   (MIT Licence)
#' @noRd
#' 
#' @examples
#'
#' # Example usage of selectColumns
#' df <- data.frame(a = 1:3, b = letters[1:3], c = c(TRUE, FALSE, TRUE))
#'
#' # Select specific columns
#' selected <- selectColumns(df, columns = c("a", "b"))
#' print(selected)
#'
#' # Select columns using pattern
#' pattern_selected <- selectColumns(df, pattern = "a|b")
#' print(pattern_selected)
#'
#' # Select single column with drop = TRUE (returns vector)
#' single_column <- selectColumns(df, columns = "a", drop = TRUE)
#' print(single_column)
#'
#' # Try to select non-existing column (with warning)
#' tryCatch({
#'   selectColumns(df, columns = c("a", "x"), do.stop = FALSE)
#' }, warning = function(w) {
#'   print("Caught expected warning:")
#'   print(w$message)
#' })
#'
#' # Try to select non-existing column (with error)
#' tryCatch({
#'   selectColumns(df, columns = c("a", "x"), do.stop = TRUE)
#' }, error = function(e) {
#'   print("Caught expected error:")
#'   print(e$message)
#' })
#'
selectColumns <- function(
  x, columns = NULL, pattern = NULL, drop = (length(columns) == 1), 
  do.stop = TRUE
)
{
  if (! is.data.frame(x)) {
    stop(call. = FALSE, sprintf(
      "%s given to selectColumns() must be a data frame but is of class: %s", 
      deparse(substitute(x)),
      stringList(class(x))
    ))
  }
  
  if (is.null(columns) || length(columns) == 0 || all(is.na(columns))) {
    
    if (is.null(pattern)) {
      
      return(x)
      
    } else {
      
      columns <- grep(pattern, names(x), value = TRUE)
    }
  }
  
  ok <- checkForMissingColumns(
    x, columns, dataFrameName = deparse(substitute(x)), do.stop = do.stop
  )
  
  if (! ok) {
    warning("Only the existing columns are selected.")
    columns <- intersect(columns, names(x))
  }
  
  x[, columns, drop = drop]
}
