Nothing
###############################################################################
## Project: ETLUtils
## Content: Utilities like recoding, renaming
##
## Author: jan
## Creation date: Mar 25, 2012, 3:01:21 PM
## File: utils.R
###############################################################################
#' Recodes the values of a character vector
#'
#' Recodes the values of a character vector
#'
#' @param x character vector
#' @param from character vector with old values
#' @param to character vector with new values
#' @return
#' x where from values are recoded to the supplied to values
#' @export
#' @seealso \code{\link{match}}
#' @examples
#' recoder(x=append(LETTERS, NA, 5), from = c("A","B"), to = c("a.123","b.123"))
recoder <- function(x, from=c(), to=c()){
missing.levels <- unique(x)
missing.levels <- missing.levels[!missing.levels %in% from]
if(length(missing.levels) > 0){
from <- append(x=from, values=missing.levels)
to <- append(x=to, values=missing.levels)
}
to[match(x, from)]
}
#' Performs NA replacement by last observation carried forward but adds 1 to the last observation carried forward.
#'
#' Performs NA replacement by last observation carried forward but adds 1 to the last observation carried forward. \cr
#'
#' @param x a numeric vector
#' @return a vector where NA's are replaced with the LOCF + 1
#' @export
#' @seealso \code{\link[zoo]{na.locf}}
#' @examples
#' require(zoo)
#' x <- c(2,NA,NA,4,5,2,NA)
#' naLOCFPlusone(x)
naLOCFPlusone <- function(x){
ix <- cumsum(is.na(x))
zoo::na.locf(x) + ix - cummax(ix * !is.na(x))
}
#' Renames variables in a data frame.
#'
#' Renames variables in a data frame. \cr
#'
#' @param x data frame to be modified.
#' @param from character vector containing the current names of each variable to be renamed.
#' @param to character vector containing the new names of each variable to be renamed.
#' @return The updated data frame x where the variables listed in from are
#' renamed to the corresponding to column names.
#' @export
#' @seealso \code{\link{colnames}, \link{recoder}}
#' @examples
#' x <- data.frame(x = 1:4, y = LETTERS[1:4])
#' renameColumns(x, from = c("x","y"), to = c("digits","letters"))
renameColumns <- function(x, from = "", to = ""){
if(!"data.frame" %in% class(x)){
stop("x should be of class data.frame")
}
if(length(from) != length(to)) {
stop("from and to are not of equal length")
}
colnames(x) <- recoder(colnames(x), from = from, to = to)
x
}
#' Put character vectors, columns of a data.frame or list elements as factor
#'
#' Put character vectors, columns of a data.frame or list elements as factor if they are character strings
#' or optionally if they are logicals\cr
#'
#' @param x a character vector, a data.frame or a list
#' @param logicals logical indicating if logical vectors should also be converted to factors. Defaults to FALSE.
#' @param ... optional arguments passed on to the methods
#' @return The updated x vector/data.frame or list where the character vectors or optionally logical elements are
#' converted to factors
#' @export
#' @seealso \code{\link{as.factor}}, \code{\link{factor}}
#' @examples
#' x <- data.frame(x = 1:4, y = LETTERS[1:4], b = c(TRUE, FALSE, NA, TRUE), stringsAsFactors=FALSE)
#' str(factorise(x))
#' str(factorise(x, logicals = TRUE))
#' str(factorise(list(a = LETTERS, b = 1:10, c = pi, d = list(x = x))))
factorise <- function(x, logicals=FALSE, ...){
UseMethod(generic="factorise")
}
#' @rdname factorise
#' @export
factorise.default <- function(x, logicals=FALSE, ...){
x
}
#' @rdname factorise
#' @export
factorise.character <- function(x, logicals=FALSE, ...){
factor(x)
}
#' @rdname factorise
#' @export
factorise.data.frame <- function(x, logicals=FALSE, ...){
if(logicals){
tofactor <- sapply(x, FUN=function(x) inherits(x, "logical"))
tofactor <- names(tofactor)[tofactor == TRUE]
for(column in tofactor){
x[[column]] <- factor(x[[column]])
}
}
tofactor <- sapply(x, FUN=function(x) inherits(x, "character"))
tofactor <- tofactor[tofactor == TRUE]
if(length(tofactor) == 0){
return(x)
}
x <- unclass(x)
x <- as.data.frame(x, stringsAsFactors=TRUE)
x
}
#' @rdname factorise
#' @export
factorise.list <- function(x, logicals=FALSE, ...){
lapply(x, factorise, logicals = logicals)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.