diff --git a/NAMESPACE b/NAMESPACE index baf7650f05ee93b64308a15c25aa4e464adc91eb..812937d45b7e67624b6ee3bae96ea1a27757dc35 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -63,6 +63,7 @@ exportMethods(getCohortTable) exportMethods(getOmega) exportMethods(getPeriodTable) exportMethods(lifeTable) +exportMethods(mT.round) exportMethods(mortalityImprovement) exportMethods(periodDeathProbabilities) exportMethods(periodTransitionProbabilities) diff --git a/R/utilityFunctions.R b/R/utilityFunctions.R index 1c9f7671193b7bc7759b635116abbc99381d4317..59e603afe39f891a2517eb2a44d41218c3a780d3 100644 --- a/R/utilityFunctions.R +++ b/R/utilityFunctions.R @@ -190,9 +190,9 @@ mT.extrapolateTrendExp = function(table, idx, up = TRUE) { if (!is(table, "mortalityTable")) stop("First argument must be a mortalityTable or a list of mortalityTable objects.") - if (.hasSlot(table, "trend") && !is.null(table@trend)) + if (.hasSlot(table, "trend") && !is.null(table@trend) && length(table@trend) > 1) table@trend = fitExpExtrapolation(table@trend, idx = idx,up = up) - if (.hasSlot(table, "trend2") && !is.null(table@trend2)) + if (.hasSlot(table, "trend2") && !is.null(table@trend2) && length(table@trend2) > 1) table@trend2 = fitExpExtrapolation(table@trend2, idx = idx,up = up) table } @@ -327,3 +327,70 @@ pT.getSubTable = function(table, subtable = "qx") { NULL } + + +#' @exportMethod mT.round +setGeneric("mT.round", function(object, digits = 8) standardGeneric("mT.round")); + +#' @describeIn setModification Return the life table with the given modification set +setMethod("mT.round", "mortalityTable", + function(object, digits = 8) { + object + }) +setMethod("mT.round", "mortalityTable.period", + function(object, digits = 8) { + o = callNextMethod() + o@deathProbs = round(o@deathProbs, digits = digits) + o@loading = round(o@loading, digits = digits) + o + }) +setMethod("mT.round", "mortalityTable.trendProjection", + function(object, digits = 8) { + o = callNextMethod() + if (!is.null(o@trend) && !is.na(o@trend)) { + o@trend = round(o@trend, digits = digits) + } + if (!is.null(o@trend2) && !is.na(o@trend2)) { + o@trend2 = round(o@trend2, digits = digits) + } + o + }) +setMethod("mT.round", "mortalityTable.improvementFactors", + function(object, digits = 8) { + o = callNextMethod() + o@improvement = round(o@improvement, digits = digits) + if (!is.null(o@loading) && !is.na(o@loading)) { + o@loading = round(o@loading, digits = digits) + } + o + }) +setMethod("mT.round", "array", + function(object, digits = 8) { + array( + lapply(object, mT.round, digits = digits), + dim = dim(object), dimnames = dimnames(object)) + }) +setMethod("mT.round", "list", + function(object, digits = 8) { + lapply(object, mT.round, digits = digits) + }) + +setMethod("mT.round", "pensionTable", + function(object, digits = 8) { + object@qx = mT.round(object@qx, digits = digits) + object@ix = mT.round(object@ix, digits = digits) + object@qix = mT.round(object@qix, digits = digits) + object@rx = mT.round(object@rx, digits = digits) + object@apx = mT.round(object@apx, digits = digits) + object@qpx = mT.round(object@qpx, digits = digits) + object@hx = mT.round(object@hx, digits = digits) + object@qwy = mT.round(object@qwy, digits = digits) + object@qgx = mT.round(object@qgx, digits = digits) + object + }) + + +# pensionTables.list() +# pensionTables.load("*") +# library(tidyverse) +# AVOe2008P.male %>% mT.round(digits = 2) diff --git a/man/setModification.Rd b/man/setModification.Rd index 13aa3044d01cd172f380db08d87b7e07885f29fc..008a845f0d0b55529bbfeb20a0caa406836e5d3a 100644 --- a/man/setModification.Rd +++ b/man/setModification.Rd @@ -1,14 +1,17 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/setModification.R +% Please edit documentation in R/setModification.R, R/utilityFunctions.R \docType{methods} \name{setModification} \alias{setModification} \alias{setModification,mortalityTable-method} +\alias{mT.round,mortalityTable-method} \title{Return a copy of the table with the given modification function added} \usage{ setModification(object, modification = 0) \S4method{setModification}{mortalityTable}(object, modification = 0) + +\S4method{mT.round}{mortalityTable}(object, digits = 8) } \arguments{ \item{object}{A life table object (instance of a \code{mortalityTable} class)} @@ -20,6 +23,8 @@ Return a copy of the table with the given modification function added } \section{Methods (by class)}{ \itemize{ +\item \code{mortalityTable}: Return the life table with the given modification set + \item \code{mortalityTable}: Return the life table with the given modification set }}