Potential helper function: `set_table_columns`

@seth127 and I discussed the possibility of a helper function for amending columns in a $TABLE record. It was suggested that this functionality may be useful for bbr and/or bbr.bayes in an upcoming patch (discussed briefly here and here).

We discussed the idea of adding a replace argument, though this becomes tricky to implement when also allowing for column removals without needing more arguments. Given that we want to limit the arguments and simplify the function as much as possible, I opted to not include this for the prototype function, pasted below:

Function

#' Get table columns from table record
#'
#' @param record An [nmrec_record] object.
#' @param column a column to add or remove
#' @param include Logical (T/F). If `TRUE`, add this column. If `FALSE`, remove the column.
#' @param idx Index of new column. If specified, and `include = TRUE`, append the new column at this location
#'
#' @export
set_table_columns <- function(record, column, include = TRUE, idx = NULL) {

  stopifnot(is.logical(include))
  
  if (record[["name"]] != "table") {
    abort(
      sprintf("set_table_columns is only meant for %s records", record[["name"]]),
      nmrec_error()
    )
  }
  
  table_cols <- get_record_option(record, "list1")
  
  if(!is.null(table_cols)){
    old_cols <- strsplit(table_cols$value, " ")[[1]]
    if (any(old_cols == column) && isTRUE(include)) {
      abort(
        sprintf("Column %s is already present in %s record", column, record[["name"]]),
        nmrec_error()
      )
    }
    
    if (isTRUE(include)) {
      if(is.null(idx)){
        idx <- length(old_cols)
      }else{
        stopifnot(idx %in% seq_along(old_cols))
        idx <- idx - 1 # `append()` appends *after* specified id; shift by 1
      }
      new_cols <- paste(append(old_cols, column, after = idx), collapse = " ")
    } else if (isFALSE(include) && any(old_cols == column)) {
      new_cols <- paste(old_cols[-which(old_cols == column)], collapse = " ")
    }else{
      abort(
        sprintf("Attempted to remove non-existant column: %s", column),
        nmrec_error()
      )
    }
    
    set_record_option(record, "list1", value = new_cols)
  }

}

Use cases

Setup

ctl <- parse_ctl(get("bayes1", envir = nmrec_examples))
recs <- select_records(ctl, "table")
record <- recs[[1]]
> record
$TABLE ID TIME PRED RES WRES CPRED CWRES EPRED ERES EWRES NOAPPEND
       ONEHEADER FILE=example1.TAB NOPRINT

Examples

> # Add new column
> set_table_columns(record, "PRED3", include = TRUE)
> record
$TABLE ID TIME PRED RES WRES CPRED CWRES EPRED ERES EWRES PRED3 NOAPPEND
       ONEHEADER FILE=example1.TAB NOPRINT

> # Remove new column
> set_table_columns(record, "PRED3", include = FALSE)
> record
$TABLE ID TIME PRED RES WRES CPRED CWRES EPRED ERES EWRES NOAPPEND
       ONEHEADER FILE=example1.TAB NOPRINT

> # Add new column to index=3
> set_table_columns(record, "PRED3", include = TRUE, idx = 3)
> record
$TABLE ID TIME PRED3 PRED RES WRES CPRED CWRES EPRED ERES EWRES NOAPPEND
       ONEHEADER FILE=example1.TAB NOPRINT

Start with the proposed set_table_columns prototype and the linked discussion in pull request 5, then inspect the existing get_record_option, set_record_option, select_records, and parse_ctl entry points. Done means settling the column add, remove, duplicate, and index behavior for TABLE records and validating it against the examples shown in this issue.