R/get_protocol_type.R

In inbo/protocolshelper: Helper Functions to Manage Protocols

#' Get protocol type from protocol code
#'
#' The protocol type corresponds to the first 3 letters of the protocol code
#'
#' @param protocol_code Character vector giving the protocol code(s)
#' @param auto_identifier Logical.
#' If `TRUE` returns labels following [`Pandoc's`
#' auto-identifier](https://pandoc.org/MANUAL.html#extension-auto_identifiers)
#' rules.
#' @param labels Logical. If `TRUE` return full labels, else return just the
#' three letter abbreviation.
#'
#' @return A factor with 5 levels corresponding to `sfp`, `sip`, `sap`, `sop`
#' and `spp`. The labels depend on `auto_identifier` setting.
#' @export
#' @family utility
#'
get_protocol_type <- function(protocol_code,
                              labels = TRUE,
                              auto_identifier = FALSE) {
  type <- regmatches(
    protocol_code,
    regexpr("^s.p", protocol_code)
  )
  if (!labels) {
    return(factor(
      type,
      levels = c("sfp", "sip", "sap", "sop", "spp"),
      labels = c("sfp", "sip", "sap", "sop", "spp")
    ))
  }
  if (!auto_identifier) {
    type <- factor(
      type,
      levels = c("sfp", "sip", "sap", "sop", "spp"),
      labels = c(
        "Standard field protocols (sfp)",
        "Standard instrument protocols (sip)",
        "Standard analytical protocols (sap)",
        "Standard operating procedures (sop)",
        "Project-specific protocols (spp)"
      )
    )
  } else {
    type <- factor(
      type,
      levels = c("sfp", "sip", "sap", "sop", "spp"),
      labels = c(
        "standard-field-protocols-sfp",
        "standard-instrument-protocols-sip",
        "standard-analytical-protocols-sap",
        "standard-operating-procedures-sop",
        "project-specific-protocols-spp"
      )
    )
  }
  return(type)
}