R/notation.R

Defines functions switch_notation get_pref_suff flip_pref_suff paste_pref_suff split_pref_suff preposition_notation notation_vec

Documented in flip_pref_suff get_pref_suff notation_vec paste_pref_suff preposition_notation split_pref_suff switch_notation

#' Row and column notation
#'
#' @description
#' It is often convenient to represent row and column names
#' with notation that includes a prefix and a suffix,
#' with corresponding separators or start-end string sequences.
#' There are several functions that call `notation_vec()` to generate specialized versions
#' or otherwise manipulate row and column names on their own or as row or column names.
#'
#' * `notation_vec()` Builds a vector of notation symbols in a standard format
#'                    that is used by `matsbyname` in several places.
#'                    By default, it builds a list of notation symbols that provides an arrow
#'                    separator (" -> ") between prefix and suffix.
#' * `preposition_notation()` Builds a list of notation symbols that provides (by default) square brackets around the suffix with a preposition ("prefix \[preposition suffix\]").
#' * `paste_pref_suff()` `paste0`'s prefixes and suffixes, the inverse of `split_pref_suff()`.
#' * `flip_pref_suff()` Switches the location of prefix and suffix, such that the prefix becomes the suffix, and
#'                      the suffix becomes the prefix.
#'                      E.g., "a -> b" becomes "b -> a" or "a \[b\]" becomes "b \[a\]".
#' * `get_pref_suff()` Selects only prefix or suffix, discarding notational elements
#'                     and the rejected part.
#'                     Internally, calls `split_pref_suff()` and selects only the `suff` portions.
#' * `switch_notation()` Switches from one type of notation to another based on the `from` and `to` arguments.
#'                       Optionally, prefix and suffix can be `flip`ped.
#' * `split_pref_suff()` Splits prefixes from suffixes, returning each in a list with names `pref` and `suff`.
#'                       If no prefix or suffix delimiters are found, `x` is returned in the `pref` item, unmodified,
#'                       and the `suff` item is returned as `""` (an empty string).
#'                       If there is no prefix, and empty string is returned for the `pref` item.
#'                       If there is no suffix, and empty string is returned for the `suff` item.
#'
#' If `sep` only is specified (default is " -> "),
#' `pref_start`, `pref_end`, `suff_start`, and `suff_end` are
#' set appropriately.
#'
#' None of the strings in a notation vector are considered part of the prefix or suffix.
#' E.g., "a -> b" in arrow notation means that "a" is the prefix and "b" is the suffix.
#'
#' @param sep A string separator between prefix and suffix. Default is " -> ".
#' @param pref_start A string indicating the start of a prefix. Default is `NULL`.
#' @param pref_end A string indicating the end of a prefix. Default is the value of `sep`.
#' @param preposition A string that specifies a preposition for a notation.
#' @param suff_start A string indicating the start of a suffix. Default is the value of `sep`.
#' @param suff_end A string indicating the end of a suffix. Default is `NULL`.
#' @param x A string or vector of strings to be operated upon.
#' @param pref A string or list of strings that are prefixes. Default is `NULL`.
#' @param suff A string of list of strings that are suffixes. Default is `NULL`.
#' @param which Tells which to keep, the prefix ("pref") or the suffix ("suff").
#' @param ps A list of prefixes and suffixes in which each item of the list is itself a list with two items named `pref` and `suff`.
#' @param notation A notation vector generated by one of the `*_notation()` functions, such as
#'                 `notation_vec()`, `arrow_notation`, or `bracket_notation`.
#'                 Default is `arrow_notation`.
#' @param transpose A boolean that tells whether to `purr::transpose()` the result.
#'                  Set `transpose = TRUE` when using `split_pref_suff()` in a `dplyr::mutate()`
#'                  call in the context of a data frame.
#'                  Default is `FALSE`.
#' @param from The `notation` to switch _away from_.
#' @param to The `notation` to switch _to_.
#' @param flip A boolean that tells whether to also flip the notation. Default is `FALSE`.
#' @param preposition A string used to indicate position for energy flows, typically "from" or "to" in different notations.
#'
#' @return For `notation_vec()`, `arrow_notation`, and `bracket_notation`,
#'           a string vector with named items `pref_start`, `pref_end`, `suff_start`, and `suff_end`;
#'         For `split_pref_suff()`, a string list with named items `pref` and `suff`.
#'         For `paste_pref_suff()`, `split_pref_suff()`, and `switch_notation()`,
#'           a string list in notation format specified by various `notation` arguments, including
#'           `from`, and `to`.
#'         For `keep_pref_suff`, one of the prefix or suffix or a list of prefixes or suffixes.
#'
#' @examples
#' notation_vec()
#' arrow_notation
#' bracket_notation
#' split_pref_suff("a -> b", notation = arrow_notation)
#' split_pref_suff(c("a -> b", "c -> d", "e -> f"), notation = arrow_notation)
#' split_pref_suff(c("a -> b", "c -> d", "e -> f"), notation = arrow_notation,
#'                 transpose = TRUE)
#' flip_pref_suff("a [b]", notation = bracket_notation)
#' get_pref_suff("a -> b", which = "suff", notation = arrow_notation)
#' switch_notation("a -> b", from = arrow_notation, to = bracket_notation)
#' switch_notation("a -> b", from = arrow_notation, to = bracket_notation,
#'                 flip = TRUE)
#' # Also works for vectors
#' switch_notation(c("a -> b", "c -> d"), from = arrow_notation, to = bracket_notation)
#' @name row-col-notation
NULL


#' @export
#' @rdname row-col-notation
notation_vec <- function(sep = " -> ",
                         pref_start = "", pref_end = "",
                         suff_start = "", suff_end = "") {
  if (all(nchar(c(pref_start, pref_end, suff_start, suff_end)) == 0) & nchar(sep) != 0) {
    return(c(pref_start = "", pref_end = sep,
             suff_start = sep, suff_end = ""))
  }
  c(pref_start = pref_start,
    pref_end = pref_end,
    suff_start = suff_start,
    suff_end = suff_end)
}


#' @export
#' @rdname row-col-notation
preposition_notation <- function(preposition, suff_start = " [", suff_end = "]") {
  notation_vec(sep = "",
               pref_start = "",
               pref_end = paste0(suff_start, preposition, " "),
               suff_start = paste0(suff_start, preposition, " "),
               suff_end = suff_end)
}


#' @export
#' @rdname row-col-notation
split_pref_suff <- function(x, notation = RCLabels::arrow_notation, transpose = FALSE) {
  # Strip off first pref_start
  if (notation[["pref_start"]] == "") {
    no_pref_start <- x
  } else {
    no_pref_start <- gsub(pattern = paste0("^", Hmisc::escapeRegex(notation[["pref_start"]])), replacement = "", x = x)
  }
  # Strip off everything from first pref_end to end of string to obtain the prefix
  pref <- gsub(pattern = paste0(Hmisc::escapeRegex(notation[["pref_end"]]), ".*$"), replacement = "", x = no_pref_start)
  # Strip off pref and pref_end
  no_pref <- mapply(pref, no_pref_start, FUN = function(p, npstart) {
    gsub(pattern = paste0("^", Hmisc::escapeRegex(p)), replacement = "", x = npstart)
  }) %>%
    unname()
  # Strip off prefix end
  no_pref_end <- gsub(pattern = paste0("^", Hmisc::escapeRegex(notation[["pref_end"]])), replacement = "", x = no_pref)
  # Strip off suffix start
  no_suff_start <- gsub(pattern = paste0("^", Hmisc::escapeRegex(notation[["suff_start"]])), replacement = "", x = no_pref_end)
  # Strip off suffix end
  if (notation[["suff_end"]] == "") {
    suff <- no_suff_start
  } else {
    suff <- gsub(pattern = paste0(notation[["suff_end"]], "{1}$"), replacement = "", x = no_suff_start)
  }
  # Return a list with the prefixes and suffixes in two members of a list
  out <- list(pref = pref, suff = suff)
  # Unless the caller wants to transpose the result,
  # especially if the result will go in a data frame.
  if (transpose) {
    out <- out %>%
      purrr::transpose()
  }
  return(out)
}


#' @export
#' @rdname row-col-notation
paste_pref_suff <- function(ps = list(pref = pref, suff = suff), pref = NULL, suff = NULL, notation = RCLabels::arrow_notation) {
  join_func <- function(ps) {
    out <- paste0(notation[["pref_start"]], ps[["pref"]], notation[["pref_end"]])
    if (notation[["pref_end"]] != notation[["suff_start"]]) {
      out <- paste0(out, notation[["suff_start"]])
    }
    paste0(out, ps[["suff"]], notation[["suff_end"]])
  }
  if (!is.null(names(ps))){
    if (length(ps) == 2 & all(names(ps) == c("pref", "suff"))) {
      # We have a single list of the form list(pref = xxxx, suff = yyyy)
      return(join_func(ps))
    }
  }
  lapply(ps, FUN = join_func)
}


#' @export
#' @rdname row-col-notation
flip_pref_suff <- function(x, notation = RCLabels::arrow_notation) {
  # Split prefixes and suffixes
  pref_suff <- split_pref_suff(x, notation = notation)
  paste_pref_suff(pref = pref_suff[["suff"]],
                  suff = pref_suff[["pref"]],
                  notation = notation) %>%
    as.character()
}


#' @export
#' @rdname row-col-notation
get_pref_suff <- function(x, which = c("pref", "suff"), notation = RCLabels::arrow_notation) {
  if (is.null(x)) {
    return(NULL)
  }
  which <- match.arg(which)
  split_pref_suff(x, notation = notation) %>%
    magrittr::extract2(which) %>%
    as.character() %>%
    magrittr::set_names(rep(which, times = length(x)))
}


#' @export
#' @rdname row-col-notation
switch_notation <- function(x, from, to, flip = FALSE) {
  switch_func <- function(x) {
    ps <- split_pref_suff(x, notation = from)
    if (ps[["suff"]] == "") {
      # No split occurred, meaning the notation for prefix and suffix wasn't found.
      # In this case, return the string unmodified.
      return(x)
    }
    if (flip) {
      ps <- list(pref = ps[["suff"]], suff = ps[["pref"]])
    }
    paste_pref_suff(ps, notation = to)
  }

  if (length(x) > 1) {
    return(lapply(x, FUN = switch_func))
  }
  switch_func(x)
}

Try the RCLabels package in your browser

Any scripts or data that you put into this service are public.

RCLabels documentation built on March 18, 2022, 7:19 p.m.