Commit 0ff21de2 authored by Reinhold Kainhofer's avatar Reinhold Kainhofer

Add function mT.round to round all base probabilities and trends to a given number of digits

parent 1f14254e
......@@ -63,6 +63,7 @@ exportMethods(getCohortTable)
exportMethods(getOmega)
exportMethods(getPeriodTable)
exportMethods(lifeTable)
exportMethods(mT.round)
exportMethods(mortalityImprovement)
exportMethods(periodDeathProbabilities)
exportMethods(periodTransitionProbabilities)
......
......@@ -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)
% 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
}}
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment