R/util-base.R

Defines functions Mode lag diff2 ma rm.col cmplt clearAllVars

Documented in rm.col

# 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()) }
ConvergenceDA/visdom documentation built on May 6, 2019, 12:51 p.m.