R/maths.R

#'@title calculates the geometric mean
#'@description because base R doesn't. Which, WHAT.
#'
#'@param x a numeric vector
#'
#'@param na_rm whether to remove NA values or not. Set to TRUE by default.
#'
#'@export
geometric_mean <- function(x, na_rm = TRUE){
  exp(sum(log(x[x > 0]), na.rm = na_rm) / length(x))
}

#'@title sample from a data.frame
#'@description R programmers use data.frames for pretty much everything
#'and yet sample() doesn't have a data.frame method, thus ruining the
#'only base R function with sensible parameter names. Argh.
#'
#'@param x a data.frame
#'
#'@param size the size of the sample
#'
#'@param replace whether to sample with replacement; FALSE
#'by default.
#'
#'@export
sample_dataframe <- function(x, size, replace = FALSE){
  x[sample(1:nrow(x), size),]
}

#'@title calculate a percentage within a data.frame.
#'@description Takes a data.frame and a specified field,
#'calculates the percentage of that field each value represents,
#'and then appends that to the data.frame
#'
#'@param x a data.frame
#'
#'@param field the name of a field to generate the percentages of.
#'
#'@param for_writing whether the percentages are for writing out and consumption
#'by the public (1.03%) or for graphing and other internal use (0.0103%). Set
#'to TRUE by default.
#'
#'@export
percentage <- function(x, field, for_writing = TRUE){
  df$percentage <- x[,field]/sum(x[,field])
  if(for_writing){
    x$percentage <- x$percentage*100
  }
  return(x)
}

#'@title aggregates a vector and turns it into a data.frame
#'@description provided with a vector, \code{aggregate_vector}
#'produces a data.frame containing the unique values in that
#'vector and the number of times they appear.
#'
#'@param x a vector
#'
#'@param order whether or not to order it, decreasing, by value.
#'TRUE by default.
#'@export
aggregate_vector <- function(x, order = TRUE){
  results <- as.data.frame(table(x), stringsAsFactors = FALSE)
  if(order){
    results <- results[order(results$Freq, decreasing = TRUE),]
  }
  return(results)
}
Ironholds/olivr documentation built on May 7, 2019, 6:40 a.m.