#' Calculates a quantile.
#'
#' @param value A brobability in percent
#' @param pop a matrix of population by age and year
#' @param ages vector of ages to consider
#'
#' @return A (vector of) quantile(s)
#'
#' @examples
#' women <- getPop(sex = "females")
#' perc(50, women)
perc <- function(value, pop, ages = 0:100){
## Assuming that 'pop' is a matrix of population by age and year,
## with age in rows and years (or other groups) in columns,
## this function calculates the 'value' quantile. 'value' must lie
## between 0 and 100. Note that the last age class is open, so very high
## percentiles will be inaccurate.
## Warning: 'ages' must be in one-year intervals!!
if (length(value) > 1)
stop("This is not a vectorizing function in 'value'")
if ((value <= 0) || (value >= 100)) stop("'value' must be in (0, 100)")
##if (!is.numeric(pop)) stop("'pop' must be numeric")
if (!is.matrix(pop)){
if (is.vector(pop)) {
pop <- matrix(pop, ncol = 1)
}else{
if (is.data.frame(pop)){
pop <- as.matrix(pop)
}else stop("'pop' is a not allowed object")
}
}
if (length(ages) != NROW(pop)) stop("'pop' and 'ages' do not match")
per <- numeric(NCOL(pop))
for (j in 1:NCOL(pop)){
year <- pop[, j]
n <- sum(year)
orr <- value * n / 100
##cat("orr = ", orr, "\n")
su <- 0
i <- 0
while ((su < orr) && (i < length(year))){
i <- i + 1
su <- su + year[i]
##cat("i = ", i, "su = ", su, "\n")
}
##cat("su - orr = ", su - orr, "\n")
su <- su - year[i]
per[j] <- ages[i] + (orr - su) / year[i]
}
per
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.