#' 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)
)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.