R/own_functions.R

In vhmedina/vhmo: Personal package with mix of functions I use.

#
# You can learn more about package authoring with RStudio at:
#
#   http://r-pkgs.had.co.nz/
#
# Some useful keyboard shortcuts for package authoring:
#
#   Build and Reload Package:  'Ctrl + Shift + B'
#   Check Package:             'Ctrl + Shift + E'
#   Test Package:              'Ctrl + Shift + T'



#' todate function
#'
#' This function allows you to change a date that comes in the YYYYMM to a R date object.
#' It is useful for plotting...
#' @param x either numeric or string object with a date format YYYYMM
#' @keywords todate, fecha, date
#' @export
#' @examples
#' todate("201502")
#' todate(201502)
todate<-function(x){
    a<-as.integer(as.numeric(x)/100)
    m<-as.numeric(x)-as.integer(as.numeric(x)/100)*100
    return(as.Date(paste(as.character(a),"/",as.character(m),"/01", sep = "")))
}

#' number_ticks function
#'
#' This function allows you to create an equidistant grid for ploting
#' @param n an integer number of ticks in the axis you want in your plot
#' @keywords plot, ticks
#' @export
#' @examples
#' number_ticks(10)
number_ticks <- function(n) {function(limits) pretty(limits, n)}


#' numNaCol function
#'
#' This function gives you the number of NA and the total rows per columns in your dataframe
#' @param data a dataframe class
#' @keywords na, NA
#' @export
#' @examples
#' numNaCol(cars)
numNaCol<-function(data){
  nulls<-as.data.frame(cbind(names(data),colSums(is.na(data)),rep(nrow(data),length(data))))
  colnames(nulls)<-c("Feature_Col","NAs","Total")
  rownames(nulls)=NULL
  return(nulls)
}

#' trim function
#'
#' This function gets rid of the spaces at the begining and end of a string
#' @param x a string or a vector string
#' @keywords trim, gsub, str_trim
#' @export
#' @examples
#' trim(" lala ")
trim <- function (x) gsub("^\\s+|\\s+$", "", x)

#' diff_meses function
#'
#' This function outputs the number of months between two dates in the format AAAAYY
#' (in which case will assume the day 1 for the corresponding month), or in the formats AAAA-MM-DD,AAAA/MM/DD.
#' @param end_date either numeric or string object with a date format YYYYMM, representing the final date.
#' @param start_date either numeric or string object with a date format YYYYMM, representing the initial date.
#' @keywords difference, dates
#' @export
#' @examples
#' diff_meses(201502,198507)
diff_meses<-function(end_date,start_date){
  if(!is.na(end_date) & !is.na(start_date)){
    if(nchar(end_date)==6 & nchar(start_date)==6){
      end_date=as.numeric(end_date)
      start_date=as.numeric(start_date)
      (round(end_date/100)-round(start_date/100))*12+
        (end_date-round(end_date/100)*100)-(start_date-round(start_date/100)*100)
    }
    else if(nchar(end_date)==10 & nchar(start_date)==10){
      ed <- as.POSIXlt(end_date)
      sd <- as.POSIXlt(start_date)
      12 * (ed$year - sd$year) + (ed$mon - sd$mon)
      }
    else NA
  }
  else NA
}


#' getmode function
#'
#' This function gives you back the mode of an array, ignoring the NAs. This function calculate
#' the mode for categorical variables, not continuous.
#' @param v array of strings or numbers
#' @keywords mode
#' @export
#' @examples
#' getmode(c("hola","chao","hola"))
getmode <- function(v) {
    v=v[!is.na(v)]
    uniqv <- unique(v)
    uniqv[which.max(tabulate(match(v, uniqv)))]
}

#' coalesce function
#'
#' This function emulates the COALESCE function in SQL, which Evaluates the arguments in order
#' and returns the current value of the first expression that initially does not evaluate to NA.
#' @param ... an expression of any type
#' @keywords NA, coalesce
#' @export
#' @examples
#' coalesce(NA,"hola","chao")
coalesce <- function(...) {
  Reduce(function(x, y) {
    i <- which(is.na(x))
    x[i] <- y[i]
    x},
    list(...))
}


#' cp_interval function
#'
#' This function estimates the Clopper-Pearson confidence interval for n observations, x number of
#' successes with an error quantile alpha.
#' @param n the total number of observations.
#' @param x the number of successes in the n observations.
#' @param alpha the error quantile. Default value is 5%.
#' @keywords confidence, interval, binomial
#' @export
#' @examples
#' cp_interval(100,5,0.05)
cp_interval<-function(n,x,alpha=0.05){
  list(a=qbeta(alpha/2,x,n-x+1),b=qbeta(1-alpha/2,x+1,n-x))
}