diff --git a/R/HelperFunctions.R b/R/HelperFunctions.R index fc69ee54208177da0011dc3a109abfd7aa4217ac..c0c80f5e9e983e5414ebdb44e7e3626118163929 100644 --- a/R/HelperFunctions.R +++ b/R/HelperFunctions.R @@ -12,7 +12,7 @@ calculatePVSurvival = function(px=1-qx, qx=1-px, advance, arrears=c(0), ..., m=1 # TODO: Replace loop by better way (using Reduce?) res = rep(0, l+1); for (i in l:1) { - # coefficients for the payemtns(including corrections for payments during the year (using the alpha(m) and beta(m)): + # coefficients for the payments (including corrections for payments during the year (using the alpha(m) and beta(m)): advcoeff = mCorrection$alpha - mCorrection$beta*(1-p[i]*v); arrcoeff = mCorrection$alpha - (mCorrection$beta + 1/m)*(1-p[i]*v); # The actual recursion: @@ -22,6 +22,26 @@ calculatePVSurvival = function(px=1-qx, qx=1-px, advance, arrears=c(0), ..., m=1 } +calculatePVGuaranteed = function(advance, arrears=c(0), ..., m=1, mCorrection = list(alpha=1, beta=0), v=1) { + # assuming advance and arrears have the same dimensions... + init = advance[1]*0; + l = max(length(advance), length(arrears)); + advance = pad0(advance, l, value=init); + arrears = pad0(arrears, l, value=init); + + # TODO: Make this work for matrices (i.e. currently advance and arrears are assumed to be one-dimensional vectors) + # TODO: Replace loop by better way (using Reduce?) + res = rep(0, l+1); + for (i in l:1) { + # coefficients for the payments (including corrections for payments during the year (using the alpha(m) and beta(m)): + advcoeff = mCorrection$alpha - mCorrection$beta*(1-v); + arrcoeff = mCorrection$alpha - (mCorrection$beta + 1/m)*(1-v); + # The actual recursion: + res[i] = advance[i]*advcoeff + arrears[i]*arrcoeff + v*res[i+1]; + } + res[1:l] +} + # TODO: So far, we are assuming, the costs array has sufficient time steps and does not need to be padded! calculatePVCosts = function(px=1-qx, qx=1-px, costs, ..., v=1) { diff --git a/R/InsuranceTarif.R b/R/InsuranceTarif.R index 92dfc665d05c31b3ccec50340bd11ca60272e632..08da0cd2a902a1b07ca27992bb10a33b14623495 100644 --- a/R/InsuranceTarif.R +++ b/R/InsuranceTarif.R @@ -75,7 +75,7 @@ InsuranceTarif = R6Class( ), - initialize = function(name = NULL, mortalityTable = NULL, i = NULL, type = "wholelife", ..., invalidityTable=NULL, features = list(), premiumPeriod = NULL, premiumFrequencyOrder = 0, benefitFrequencyOrder = 0, costs, surrenderValueCalculation) { + initialize = function(name = NULL, mortalityTable = NULL, i = NULL, type = "wholelife", ..., loadings=list(), invalidityTable=NULL, features = list(), premiumPeriod = NULL, premiumFrequencyOrder = 0, benefitFrequencyOrder = 0, costs, surrenderValueCalculation) { if (!missing(name)) self$name = name; if (!missing(mortalityTable)) self$mortalityTable = mortalityTable; if (!missing(i)) self$i = i; @@ -88,6 +88,7 @@ InsuranceTarif = R6Class( if (!missing(features)) self$features = c(features, self$features); if (!missing(surrenderValueCalculation)) self$surrenderValueCalculation = surrenderValueCalculation; if (!missing(invalidityTable)) self$invalidityTable = invalidityTable; + if (!missing(loadings)) self$loadings = self$getLoadings(loadings=loadings); self$v = 1/(1+self$i); @@ -95,7 +96,7 @@ InsuranceTarif = R6Class( }, # Merge a possibly passed loadings override with this tariff's default loadings: - getLoadings = function(..., loadings=list()) { + getLoadings = function(loadings=list(), ...) { c(loadings, self$loadings) }, @@ -106,6 +107,7 @@ InsuranceTarif = R6Class( } ages }, + getTransitionProbabilities = function(age, ..., YOB = 2000) { ages = self$getAges(age, YOB = YOB); q = deathProbabilities(self$mortalityTable, YOB = YOB);