# Copyright 2016 The Board of Trustees of the Leland Stanford Junior University.
# Direct inquiries to Sam Borgeson (sborgeson@stanford.edu)
# or professor Ram Rajagopal (ramr@stanford.edu)
#' @importFrom dplyr %>%
#' @export
dplyr::`%>%`
#' @export
Mode <- function(x,rndTieBreak=F) {
ux <- unique(x)
tab = tabulate(match(x, ux))
maxCount = max(tab)
modes = ux[tab == maxCount] # there could be more than one
if(rndTieBreak) {
out = sample(rep(modes,2),1) # random choice breaks ties; single mode is deterministic
} else {
out = rep(modes,2)[1]
}
if(length(out) == 0) out = NA
return(out)
}
# lag (shift) an array of values by n places, filling in the gap at the beginning with n NAs
#' @export
lag = function(v,n=1) {
if(n==0) return(v)
return(c(rep(NA,n),head(v,-n)))
} # prepend NAs and truncate to preserve length
# finite difference between observations
#' @export
diff2 = function(v,n=1) { return(c(rep(NA,n),diff(v, n))) } # prepend NAs to preserve length of standard diff
# calculate moving averages note adds n-1 NAs to beginning
# as.numeric is called because filter returns 'ts' objects which apparently don't play well with cbind and data.frames
#' @export
ma = function(v,n=5,weights=NULL) {
if(length(weights) == 0) { weights = rep(1/n,n) } # standard moving window average
as.numeric(stats::filter(v, weights, sides=1))
}
#' @title remove named, index, or logical columns, if present, from a data.frame
#' @export
rm.col = function(df, cols) {
cls = class(cols)
subdf = NULL
if( cls == 'character') {
keepers = setdiff(names(df),cols) #! names(df) %in% cols
} else if (cls %in% c('numeric','integer') ) {
keepers = setdiff(1:ncol(df),cols) #! 1:ncol(df) %in% cols
} else if (cls == 'logical' ) {
keepers = ! cols
} else {
stop( paste( 'Unrecognized class for columns', cls ) )
}
return( df[,keepers] )
}
# return only the complete cases of a data.frame
#' @export
cmplt = function(df) {
return( df[complete.cases(df),])
}
# utility fn to clear all active variables -
#leaves .varName vars behind to eliminate these, use ls(all.names=TRUE)
#' @export
clearAllVars = function() { rm(list=ls(),envir=baseenv()) }
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.