Commit 6ba1d2d7 authored by Reinhold Kainhofer's avatar Reinhold Kainhofer

mortalityTable: Add data slot, store raw data of whittaker graduatino; Fix wrong NULL check

parent 3a1c3eea
...@@ -19,6 +19,9 @@ ...@@ -19,6 +19,9 @@
#' to give the user a way to modify the final probabilities #' to give the user a way to modify the final probabilities
#' @slot loading Additional security loading on the resulting table (single numeric #' @slot loading Additional security loading on the resulting table (single numeric
#' value, e.g. 0.05 adds 5\% security margin to the probabilities) #' value, e.g. 0.05 adds 5\% security margin to the probabilities)
#' @slot data Placeholder list to make it possible to store any kind of data
#' associated with the object inside the object (e.g. the underlying
#' data used to derive the death probabilities, parameters for adjustment, etc.)
#' #'
#' @export mortalityTable #' @export mortalityTable
#' @exportClass mortalityTable #' @exportClass mortalityTable
...@@ -28,13 +31,15 @@ mortalityTable = setClass( ...@@ -28,13 +31,15 @@ mortalityTable = setClass(
name = "character", name = "character",
baseYear = "numeric", baseYear = "numeric",
loading = "numeric", loading = "numeric",
modification = "function" modification = "function",
data = "list"
), ),
prototype = list( prototype = list(
name = "Actuarial Mortality Table", name = "Actuarial Mortality Table",
baseYear = 0, baseYear = 0,
loading = 0, loading = 0,
modification = identity modification = identity,
data = list()
), ),
contains = "VIRTUAL" contains = "VIRTUAL"
) )
...@@ -80,7 +80,7 @@ whittaker.mortalityTable = function(table, lambda = 10, d = 2, name.postfix = ", ...@@ -80,7 +80,7 @@ whittaker.mortalityTable = function(table, lambda = 10, d = 2, name.postfix = ",
ages = table@ages ages = table@ages
if (missing(weights) || is.null(weights)) { if (missing(weights) || is.null(weights)) {
if (is.na(table@exposures) || is.null(table@exposures)) { if (is.null(table@exposures) || is.na(table@exposures)) {
weights = rep(1, length(ages)) weights = rep(1, length(ages))
} else { } else {
weights = table@exposures weights = table@exposures
...@@ -114,6 +114,8 @@ whittaker.mortalityTable = function(table, lambda = 10, d = 2, name.postfix = ", ...@@ -114,6 +114,8 @@ whittaker.mortalityTable = function(table, lambda = 10, d = 2, name.postfix = ",
# above the last raw probability to NA # above the last raw probability to NA
probsToClear = (cumsum(!is.na(orig.probs)) == 0) | (rev(cumsum(rev(!is.na(orig.probs)))) == 0) probsToClear = (cumsum(!is.na(orig.probs)) == 0) | (rev(cumsum(rev(!is.na(orig.probs)))) == 0)
probs.smooth[probsToClear] = NA_real_ probs.smooth[probsToClear] = NA_real_
table@data$rawProbs = orig.probs
table@data$whittaker = list(weights = weights)
table@deathProbs = probs.smooth table@deathProbs = probs.smooth
table table
......
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