## ============================================================================
##
## Internal functions to the jakemisc package. These functions are not exported
## , therefore if you are trying to use one you need to use the ::: operator.
## Functions from within the package can access these internal functions via
## the package's namespace.
##
## ============================================================================
# Save typing by importing functions from other packages::
##
#' @importFrom magrittr "%>%"
#' @importFrom magrittr "%<>%"
#' @importFrom magrittr "%T>%"
#' @importFrom magrittr "%$%"
#' @importFrom assertthat assert_that
#' @importFrom assertthat is.flag
#' @importFrom assertthat not_empty
# compatibility for data.table functions
# (see: https://github.com/hadley/dplyr/issues/548)
.datatable.aware <- TRUE
# Return TRUE if all ... have the same length
equal_length <- function(...) {
objects <- list(...)
objects_range <- range(vapply(objects, length, numeric(1)))
objects_range[1] == objects_range[[2]]
}
named_list <- function(...) {
# Returns a list of objects in ... but uses NSE to name each element of
# the list as the name of that object
list_names <- sapply(substitute(...()), deparse)
named_list <- list(...)
names(named_list) <- list_names
named_list
}
# Fast version of the %in% operator
`%fin%` <- function(x, table) fastmatch::fmatch(x, table, nomatch = 0L) > 0L
# Function for getting a numerical vector of the positions of a pattern
# within a string (using regex, from the grepexpr function)
patternPositions <- function(string, pattern, ignore.case = FALSE) {
charPositions <- gregexpr(pattern, string, ignore.case)
charPositions <- charPositions[[1]][1:length(charPositions[[1]])]
return(charPositions)
}
# Get vector of names of all installed packages
installedPackages <- function() {
all_packages <- installed.packages()
return(all_packages[1:(length(all_packages)/16)])
}
# Is a package installed?
isPackageInstalled <- function(packageName) {
return(packageName %in% installedPackages())
}
# Turn one or more NSE names (...) into a character vector, removing " marks
NSEtoVector <- function(..., USE.NAMES = FALSE) {
# Concatenate the package names together via non-standard evaluation
# (NSE) so quotes do not need to be placed around package names
package_names <- sapply(substitute(...()), deparse)
# Remove escaped quotation marks if the the user inputted any package
# names in quotation marks:
package_names <- sapply(package_names, function(f) {
if (grepl("\"", f)) f <- gsub("\"", "", f)
return(f)
}, USE.NAMES = USE.NAMES)
return(package_names)
}
# Given a string a symbol, return the position of the symbol w/i the string
getSymbolPosition <- function(string, symbol) {
return(gregexpr(symbol, string)[[1]][1])
}
# Seperate a character vector of length 1 based on an inputted symbol
seperateSymbol <- function(string, symbol) {
symbolPosition <- getSymbolPosition(string, symbol)
before_symbol <- substr(string, 1, (symbolPosition - 1))
after_symbol <- substr(string, (symbolPosition + 1),
nchar(string))
return(c(before_symbol, after_symbol))
}
# Return the column order of a subset of columns from a data.frame
subsetColOrder <- function(data, subset_cols) {
subset_order <- sapply(subset_cols, grep, colnames(data),
USE.NAMES = FALSE)
return(order(subset_order))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.