#' Change case
#'
#' @export
#' @param x Input species list, a character vector
#' @param what (character) one of onlyfirst, trim, lower, upper
#' @return Same as put in, either list, character vector or data.frame
#' @examples
#' x <- c("Salmo eperlanus Linnaeus, 1758", 'Oncorhynchus clarkii', 'Salmo',
#' 'Oncorhynchus clarkii', 'Salvelinus fontinalis', 'Salvelinus confluentus')
#'
#' # capitalize first letter only
#' case_names(x)
#'
#' # all lower case
#' case_names(x, 'lower')
#'
#' # all upper case
#' case_names(x, 'upper')
#'
#' # trim white space
#' x <- c("Salmo eperlanus Linnaeus, 1758 ", 'Oncorhynchus clarkii', 'Salmo ',
#' 'Oncorhynchus clarkii ', ' Salvelinus fontinalis ', 'Salvelinus confluentus ')
#' case_names(x, 'trim')
#'
case_names <- function(x, what = "onlyfirst") {
UseMethod("case_names")
}
#' @export
#' @rdname case_names
case_names.character <- function(x, what = "onlyfirst") {
switch(what,
onlyfirst = lets_capwords(x, onlyfirst = TRUE),
trim = strtrimm(x),
lower = tolower(x),
upper = toupper(x)
)
}
#' @export
#' @rdname case_names
case_names.splist <- function(x, what = "onlyfirst") {
switch(what,
onlyfirst = lets_capwords(x, onlyfirst = TRUE)
)
}
lets_capwords <- function(s, strict = FALSE, onlyfirst = FALSE) {
cap <- function(s) {
paste(toupper(substring(s,1,1)), {
s <- substring(s,2); if (strict) tolower(s) else s
}, sep = "", collapse = " " )
}
if (!onlyfirst) {
sapply(strsplit(s, split = " "), cap, USE.NAMES = !is.null(names(s)))
} else {
sapply(s, function(x) {
xx <- strsplit(substring(x,2), "\\s")[[1]]
rest <- paste0(na.omit(xx[1:2]), collapse = " ")
auth <- if (length(xx) > 2) paste0(xx[3:length(xx)], collapse = " ") else ""
strtrimm(paste(toupper(substring(x,1,1)),
tolower(rest),
" ",
auth,
sep = "", collapse = " "))
}, USE.NAMES = FALSE)
}
}
strtrimm <- function(str) gsub("^\\s+|\\s+$", "", str)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.