#' Convert life table function into mortality rates.
#'
#' Given the column of a life table (eg "qx"), calculate the implied mortality
#' rates ("mx").
#'
#' \code{convertToMx} is needed when calculating a life table from values
#' other than 'mx', since function \code{\link{LifeTable}} constructs the
#' life table from 'mx' values.
#'
#' \code{object} must have a dimension with \code{\link[dembase]{dimtype}}
#' \code{"age"}. \code{from} must be one of \code{"qx"}, \code{"px"},
#' \code{"dx"}, \code{"lx"}, \code{"Lx"}, \code{"Tx"}, or \code{"ex"}.
#' See \code{\link{LifeTable}} for definitions of these functions.
#'
#' Demographers typically obtain the 'lx' column of a life table by
#' multiplying the probability of surviving to age 'x' by a 'radix',
#' which is usually 100000. The 'dx', 'Lx', and 'Tx' columns
#' are also scaled by the radix.
#'
#' See the documentation for \code{\link{LifeTable}} for a discussion of
#' how to specify separation factor \code{ax}.
#'
#' Life table functions \code{qx}, \code{px}, \code{dx}, \code{lx},
#' effectively contain no information about mortality conditions in the final
#' age group if, as is normally the case, the final age group is open (that
#' is, has no upper limit.) With \code{qx}, the final value is always
#' 1. With \code{px} the final value is always 0. With \code{dx} the
#' final value is always the radix minus deaths in earlier age groups. With
#' \code{lx}, the final value describes mortality up to age \code{x}, but
#' says nothing about mortality beyond age \code{x}. (In contrast to the
#' other life table functions, the first value of \code{lx} contains
#' no information, since it always equals \code{radix}.)
#' Because life table functions \code{qx}, \code{px}, \code{dx}, and \code{lx},
#' contain no information on the final age group, when \code{from} is one of
#' these functions, the return value from \code{convertToMx} drops the final
#' age group. See below for an example.
#'
#' @param object An object of class
#' \code{\link[dembase:DemographicArray-class]{DemographicArray}}.
#' @param from The name of a life table function.
#' @param ax An object of class
#' \code{\link[dembase:DemographicArray-class]{DemographicArray}}
#' specifying 'separation factors'.
#' @param radix A positive number, defaulting to 100000.
#'
#' @return An object of class
#' \code{\link[dembase:DemographicArray-class]{Values}}.
#'
#' @seealso \code{convertToMx} may be needed to prepare the \code{mx}
#' argument for function \code{\link{LifeTable}}.
#'
#' @references Preston S, Heuveline P, Guillot M. 2000. \emph{Demography:
#' Measuring and Modeling Population Processes}. Blackwell.
#' @examples
#' Lx <- dembase::Counts(array(c(1800000, 1650000, 1500000, 900000, 100000,
#' 1700000, 1500000, 1400000, 800000, 50000),
#' dim = c(5, 2),
#' dimnames = list(age = c("0-19", "20-39", "40-59",
#' "60-79", "80+"),
#' sex = c("Female", "Male"))))
#' ax <- dembase::Values(array(c(8.3, 5),
#' dim = c(1, 2),
#' dimnames = list(age = "0-19",
#' sex = c("Female", "Male"))))
#' convertToMx(Lx, from = "Lx", ax = ax)
#'
#'
#' ax <- dembase::ValuesOne(3, labels = "0-19", name = "age")
#'
#' lx <- dembase::CountsOne(c(100000, 90000, 70000, 30000, 5000),
#' labels = c(0, 20, 40, 60, 80),
#' name = "age")
#' ax <- dembase::ValuesOne(5, labels = "0-19", name = "age")
#' convertToMx(lx, from = "lx", ax = ax)
#'
#' qx <- dembase::ValuesOne(c(0.1, 0.05, 0.15, 0.25, 1),
#' labels = c("0-19", "20-39", "40-59", "60-79", "80+"),
#' name = "age")
#' ax <- dembase::ValuesOne(5, labels = "0-19", name = "age")
#' convertToMx(qx, from = "qx", ax = ax)
#' @export
convertToMx <- function(object, from = c("qx", "px", "dx", "lx", "Lx", "Tx", "ex"),
ax, radix = 100000) {
kUsesRadix <- c("dx", "lx", "Lx", "Tx")
kLastAgeIntervalUninformative <- c("qx", "px", "dx") # 'lx' is not interval
if (!methods::is(object, "DemographicArray"))
stop(gettextf("'%s' has class \"%s\"",
"object", class(object)))
if (!methods::is(ax, "Values"))
stop(gettextf("'%s' has class \"%s\"",
"ax", class(ax)))
if (any(dembase::dimtypes(object) == "origin"))
stop("cannot handle orig-dest yet")
from <- match.arg(from)
.Data.obj <- object@.Data
metadata.obj <- object@metadata
dim.obj <- dim(.Data.obj)
dimtypes.obj <- dembase::dimtypes(object, use.names = FALSE)
n.dim.obj <- length(dim.obj)
i.age <- match("age", dimtypes.obj, nomatch = 0L)
has.age <- i.age > 0L
if (!has.age)
stop(gettextf("'%s' does not have a dimension with %s \"%s\"",
"object", "dimtype", "age"))
expected.dimscale <- getLifeTableDimScale(from)
dembase::checkAge(object = object,
minAges = 2L,
regular = FALSE,
openLeftOK = FALSE,
openRightOK = TRUE,
expectedDimscale = expected.dimscale)
checkLifeTableMetaData(object)
radix <- checkAndTidyRadix(radix)
checkLifeTableInputValues(object = object,
from = from,
radix = radix)
metadata.ans <- makeLifeTableMetaData(metadata = metadata.obj,
from = from,
to = "mx")
dim.ans <- dim(metadata.ans)
dimnames.ans <- dimnames(metadata.ans)
.Data.template <- array(0,
dim = dim.ans,
dimnames = dimnames.ans)
template.ans <- methods::new("Values",
.Data = .Data.template,
metadata = metadata.ans)
ax <- dembase::expandAx(ax = ax,
object = template.ans)
.Data.ax <- ax@.Data
if (n.dim.obj > 1L) {
s <- seq_len(n.dim.obj)
perm <- c(i.age, s[-i.age])
.Data.obj <- aperm(.Data.obj, perm = perm)
.Data.ax <- aperm(.Data.ax, perm = perm)
}
n.age.obj <- dim.obj[i.age]
n.age.ans <- dim.ans[i.age]
.Data.obj <- matrix(.Data.obj, nrow = n.age.obj)
.Data.ax <- matrix(.Data.ax, nrow = n.age.ans)
DimScales.ans <- dembase::DimScales(metadata.ans,
use.names = FALSE)
DimScale.age.ans <- DimScales.ans[[i.age]]
dv.age.ans <- DimScale.age.ans@dimvalues
nx <- diff(dv.age.ans)
open <- is.infinite(nx[n.age.ans])
nx <- matrix(nx,
nrow = n.age.ans,
ncol = ncol(.Data.obj))
if (from %in% kUsesRadix)
.Data.obj <- .Data.obj / radix
if (from %in% kLastAgeIntervalUninformative)
.Data.obj <- .Data.obj[-n.age.obj, ]
.Data.ans <- convertLifeTableFun(.Data = .Data.obj,
from = from,
to = "mx",
nx = nx,
ax = .Data.ax,
open = open,
mA = NULL)
if (n.dim.obj > 1L) {
.Data.ans <- array(.Data.ans,
dim = c(n.age.ans, dim.obj[-i.age]))
.Data.ans <- aperm(.Data.ans,
perm = match(s, perm))
}
.Data.ans <- array(.Data.ans,
dim = dim.ans,
dimnames = dimnames.ans)
methods::new("Values",
.Data = .Data.ans,
metadata = metadata.ans)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.