https://github.com/cran/simPopulation
Tip revision: 4ec60704d4db0215b4d1b6b2f98b697dbef9595a authored by Andreas Alfons on 08 August 2011, 00:00:00 UTC
version 0.3
version 0.3
Tip revision: 4ec6070
tableWt.R
# ----------------------------------------
# Authors: Andreas Alfons and Stefan Kraft
# Vienna University of Technology
# ----------------------------------------
tableWt <- function(x, weights = NULL, useNA = c("no", "ifany", "always")) {
# initializations
if(!is.data.frame(x)) x <- as.data.frame(x)
if(is.null(weights)) return(table(x, useNA=useNA))
else if(!is.numeric(weights)) stop("'weights' must be a numeric vector")
else if(length(weights) != nrow(x)) {
stop("length of 'weights' must equal the number of rows in 'x'")
} else if(!all(is.finite(weights))) stop("missing or infinite weights")
useNA <- match.arg(useNA)
if(nrow(x) > 0 && ncol(x) > 0 && useNA != "no") {
always <- useNA == "always"
if(ncol(x) == 1) x[, 1] <- factorNA(x[, 1], always)
else x <- as.data.frame(lapply(x, factorNA, always))
}
# compute and return weighted table
tab <- round(tapply(weights, x, sum))
tab[is.na(tab)] <- 0
class(tab) <- "table"
return(tab)
}