R/staticimports.R

In rstudio-education/grader: Automated Feedback for Student Exercises in 'learnr' Tutorials

# Generated by staticimports; do not edit by hand.
# ======================================================================
# Imported from pkg:learnr
# ======================================================================

is_AsIs <- function(x) {
  inherits(x, "AsIs")
}

is_html_any <- function(x) {
  is_html_tag(x) || is_html_chr(x)
}

is_html_chr <- function(x) {
  is.character(x) && inherits(x, "html")
}

is_html_tag <- function(x) {
  inherits(x, c("shiny.tag", "shiny.tag.list"))
}

knitr_engine_caption <- function(engine = NULL) {
  if (is.null(engine)) {
    engine <- "r"
  }

  switch(
    tolower(engine),
    "bash" = "Bash",
    "c" = "C",
    "coffee" = "CoffeeScript",
    "cc" = "C++",
    "css" = "CSS",
    "go" = "Go",
    "groovy" = "Groovy",
    "haskell" = "Haskell",
    "js" = "JavaScript",
    "mysql" = "MySQL",
    "node" = "Node.js",
    "octave" = "Octave",
    "psql" = "PostgreSQL",
    "python" = "Python",
    "r" = "R",
    "rcpp" = "Rcpp",
    "cpp11" = "cpp11",
    "rscript" = "Rscript",
    "ruby" = "Ruby",
    "perl" = "Perl",
    "sass" = "Sass",
    "scala" = "Scala",
    "scss" = "SCSS",
    "sql" = "SQL",
    # else, return as the user provided
    engine
  )
}

str_trim <- function(x, side = "both", character = "\\s") {
  if (side %in% c("both", "left", "start")) {
    rgx <- sprintf("^%s+", character)
    x <- sub(rgx, "", x)
  }
  if (side %in% c("both", "right", "end")) {
    rgx <- sprintf("%s+$", character)
    x <- sub(rgx, "", x)
  }
  x
}
# Generated by staticimports; do not edit by hand.
# ======================================================================
# Imported from pkg:stringstatic
# ======================================================================

#' Compare literal bytes in the string
#'
#' @source Adapted from the [stringr](https://stringr.tidyverse.org/) package.
#'
#' Dependency-free drop-in alternative for `stringr::fixed()`.
#' This is very fast,
#' but not usually what you want for non-ASCII character sets.
#'
#' @param pattern Pattern to modify behavior.
#' @param ignore_case Should case differences be ignored in the match?
#'
#' @return An integer vector.
#' @noRd
fixed <- function(pattern, ignore_case = FALSE) {
  if (!isTRUE(ignore_case)) {
    return(structure(
      pattern, class = c("stringr_fixed", "stringr_pattern", "character")
    ))
  }

  if (!is.null(names(pattern))) {
    names(pattern) <- paste0("(?i)", names(pattern))
  } else {
    pattern <- paste0("(?i)", pattern)
  }

  structure(pattern, class = c("stringr_regex", "stringr_pattern", "character"))
}

#' Count the number of matches in a string
#'
#' Dependency-free drop-in alternative for `stringr::str_count()`.
#'
#' @source Adapted from the [stringr](https://stringr.tidyverse.org/) package.
#'
#' @param string Input vector.
#'   Either a character vector, or something coercible to one.
#'
#' @param pattern Pattern to look for.
#'
#'   The default interpretation is a regular expression,
#'   as described in [base::regex].
#'   Control options with [regex()].
#'
#'   Match a fixed string (i.e. by comparing only bytes), using [fixed()].
#'   This is fast, but approximate.
#'
#' @return An integer vector.
#' @noRd
str_count <- function(string, pattern = "") {
  if (length(string) == 0 || length(pattern) == 0) return(integer(0))
  is_fixed <- inherits(pattern, "stringr_fixed")
  mapply(
    function(string, pattern) {
      match <- unlist(
        gregexpr(pattern, text = string, perl = !is_fixed, fixed = is_fixed)
      )
      length(match[match > 0])
    },
    string, pattern, SIMPLIFY = "vector", USE.NAMES = FALSE
  )
}

#' Extract matching patterns from a string
#'
#' Dependency-free drop-in alternative for `stringr::str_extract()`.
#'
#' @source Adapted from the [stringr](https://stringr.tidyverse.org/) package.
#'
#' @param string Input vector.
#'   Either a character vector, or something coercible to one.
#'
#' @param pattern Pattern to look for.
#'
#'   The default interpretation is a regular expression,
#'   as described in [base::regex].
#'   Control options with [regex()].
#'
#'   Match a fixed string (i.e. by comparing only bytes), using [fixed()].
#'   This is fast, but approximate.
#'
#' @return A character matrix.
#'   The first column is the complete match,
#'   followed by one column for each capture group.
#' @noRd
str_extract <- function(string, pattern) {
  if (length(string) == 0 || length(pattern) == 0) return(character(0))

  is_fixed <- inherits(pattern, "stringr_fixed")

  result <- Map(
    function(string, pattern) {
      if (is.na(string) || is.na(pattern)) return(NA_character_)

      regmatches(
        x = string,
        m = regexpr(
          pattern = pattern, text = string, perl = !is_fixed, fixed = is_fixed
        )
      )
    },
    string, pattern, USE.NAMES = FALSE
  )

  result[lengths(result) == 0] <- NA_character_
  unlist(result)
}

#' Keep strings matching a pattern
#'
#' Dependency-free drop-in alternative for `stringr::str_subset()`.
#'
#' @source Adapted from the [stringr](https://stringr.tidyverse.org/) package.
#'
#' @param string Input vector.
#'   Either a character vector, or something coercible to one.
#'
#' @param pattern Pattern to look for.
#'
#'   The default interpretation is a regular expression,
#'   as described in [base::regex].
#'   Control options with [regex()].
#'
#'   Match a fixed string (i.e. by comparing only bytes), using [fixed()].
#'   This is fast, but approximate.
#'
#' @param negate If `TRUE`, return non-matching elements.
#'
#' @return A character vector.
#' @noRd
str_subset <- function(string, pattern, negate = FALSE) {
  if (length(string) == 0 || length(pattern) == 0) return(character(0))

  ignore.case <- isTRUE(attr(pattern, "options")$case_insensitive)
  is_fixed <- !ignore.case && inherits(pattern, "stringr_fixed")

  result <- Map(
    function(string, pattern) {
      grep(
        pattern,
        x = string,
        ignore.case = ignore.case,
        perl = !is_fixed,
        fixed = is_fixed,
        invert = negate
      )
    },
    string, pattern, USE.NAMES = FALSE
  )

  string[which(lengths(result) > 0)]
}