R/tosort.R

In gogonzo/oddsandsods: Miscellanous functions

#' Adding fractions of higher aggregation
#'
#' @param data data.frame
#' @param agregations variable
#' @export
applyDnum <- function(data, group){
  grp <- lapply(group, as.symbol)
  vars <- chooseColumn(data)

  data_sum <-
    data %>%
    group_by_(.dots=grp) %>%
    summarise_each_(funs(sum),vars=vars)

  colnames(data_sum)[!colnames(data_sum) %in% group] <-
    paste("a_",colnames(data_sum)[!colnames(data_sum) %in% group])

  data %<>%
    left_join(data_sum)
}


#' Adjust sum( integer(x) ) = sum(y)
#'
#' Adjust sum( integer(x) ) = sum(y)
#'
#' @param x vector to be adjusted
#' @param y vector which sum is beign compared to
#' @return x adjusted values
#' @return diff difference between sum(adjusted x) and sum(y)
#' @examples
#' adjustSum(runif(10, 1,10), 500)
adjustSum <- function(x,y,par=NULL){

  if(is.null(par))
    par <- sum(x,na.rm=T)/sum(y,na.rm=T)

  minDev <- function(x, y, par)
    abs(
      sum(ceiling(x/par),na.rm=T) - sum(y,na.rm=T)
    )

  ratio <- optim(par=par, fn = minDev, x = x, y= y, method = 'BFGS')$par

  list(
    x =  ceiling(x/ratio),
    diff = sum(ceiling(x/ratio), na.rm=T) - sum(y, na.rm=T)
  )
}