Skip to content
Snippets Groups Projects

Compare revisions

Changes are shown as if the source revision was being merged into the target revision. Learn more about comparing revisions.

Source

Select target project
No results found
Select Git revision

Target

Select target project
  • R/LifeInsureR
1 result
Select Git revision
Show changes
Commits on Source (2)
  • Reinhold Kainhofer's avatar
    Implement rounding intermediate values using the new RoundingHelper class. · d25482c2
    Reinhold Kainhofer authored
    * Add the $Hooks$Rounding parameter to hold the RoundingHelper
      object (in the constructor, a named list of rounding specs
      can be given, which will be coverted to a RoundingHelper by
      the InsuranceTariff constructor).
    * Use the helper in most places where rounding intermediate values
      makes sense
    * Each use of the rounding helper is indicated by a separate ID, so
      each rounding occurrence can (and must) be configured separately
    * By default, no rounding occurs, unless a rounding accuracy (nr of
      digits) was explicitly configured for the ID
    * Add documentation
    d25482c2
  • Reinhold Kainhofer's avatar
    Fix Docs syntax error · a7ec5457
    Reinhold Kainhofer authored
    a7ec5457
......@@ -43,6 +43,7 @@ Collate:
'ProfitParticipation.R'
'InsuranceTarif.R'
'InsuranceContract.R'
'RoundingHelper.R'
'contractGrid.R'
'create_LIR_project.R'
'exportInsuranceContract_xlsx.R'
......
......@@ -55,6 +55,7 @@ export(PVfactory)
export(PaymentTimeEnum)
export(ProfitComponentsEnum)
export(ProfitParticipation)
export(RoundingHelper)
export(SexEnum)
export(TariffTypeEnum)
export(age.exactRounded)
......
......@@ -2,8 +2,9 @@
# Version 1.0.1: XXXXXXXXXXX XX, 2023
* New parameters:
- survivalBenefit: Generalize survival benefit vectors (previously: unit CF 1 at end of contract)
- gammaInZillmer: As a feature, include gamma costs (but not beta) in the Zillmer premium
* Improve test case generation: Als generate code to export sample contract to Excel
- gammaInZillmer: As a company-specific feature, include gamma costs (but not beta) in the Zillmer premium
* Improve test case generation: Also generate code to export sample contract to Excel
* Add feature to round intermediate value using a RoundingHelper class (stored in Parameters$Hooks$Rounding)
# Version 1.0.0: October 27, 2023
......
......@@ -70,7 +70,7 @@ setCost = function(costs, type, basis = "SumInsured", frequency = "PolicyPeriod"
#' even if the insured has already dies (for term-fix insurances)
#' @param unitcosts Unit costs (absolute monetary amount, during premium period)
#' @param unitcosts.PolicyPeriod Unit costs (absolute monetary amount, during full contract period)
#'
#'
#' @returns an insurance cost structure (multi-dimensional matrix)
#'
#' @examples
......@@ -350,16 +350,16 @@ InsuranceContract.Values = list(
#' \item{\code{$deathBenefit}}{The yearly relative death benefit (relative
#' to the initial sum insured); Can be set to a \code{function(len,
#' params, values)}, e.g. \code{deathBenefit = deathBenefit.linearDecreasing}}
#' \item{\code{$survivalBenefit}}{The survival benefit (relative to the initial
#' \item{\code{$survivalBenefit}}{The survival benefit (relative to the initial
#' sum insured). By default, for (pure) endowments a survival benefit
#' of 1 is assumed at the end of the contract period. Other values
#' (e.g. double survival benefit in endowments) or multiple survival
#' payments during the contract period can be set with this parameter.
#' A single numeric value indicates a single survival benefit at
#' the end of the contract, a vector of numeric values indicates
#' yearly survival benefits (not neccessarily with a survival
#' of 1 is assumed at the end of the contract period. Other values
#' (e.g. double survival benefit in endowments) or multiple survival
#' payments during the contract period can be set with this parameter.
#' A single numeric value indicates a single survival benefit at
#' the end of the contract, a vector of numeric values indicates
#' yearly survival benefits (not neccessarily with a survival
#' payment at the end of the contract). Can be set to a \code{function(len,
#' params, values)} returning the benefit as a numeric value or vector.
#' params, values)} returning the benefit as a numeric value or vector.}
#' \item{\code{$benefitParameter}}{(optional) Tariff-specific parameter to
#' indicate special benefit conditions (e.g. for non-constant benefits
#' the initial starting value, or a minimum benefit, etc.). This
......@@ -452,6 +452,8 @@ InsuranceContract.Values = list(
#' that can be waived at all. }
#' }
#'
#'
#'
#' ## Elements of sublist \code{InsuranceContract.ParameterDefault$Loadings}
#'
#' \describe{
......@@ -568,6 +570,7 @@ InsuranceContract.Values = list(
#' \item{\code{$adjustPremiums}}{Adjust the resulting premiums. \code{function(premiums = list(premiums, coefficients, sumInsured), params, values)}}
#' \item{\code{$adjustPVForReserves}}{Adjust the absolute present value vectors used to derive reserves (e.g. when a sum rebate is subtracted from the gamma-cost reserves without influencing the premium calculation). \code{function(absPV, params, values)}}
#' \item{\code{$premiumRebateCalculation}}{Calculate the actual premium rebate from the rebate rate (e.g. when the premium rate is given as a yearly cost reduction applied to a single-premium contract). \code{function(premiumRebateRate, params = params, values = values)}}
#' \item{\code{$Rounding}}{A [RoundingHelper] object to specify rounding of intermediate values. Alternatively, a named list of rounding specifications can be given, which is used to construct a new [RoundingHelper] object.}
#' }
#'
#'
......@@ -630,7 +633,7 @@ InsuranceContract.ParameterDefaults = list(
benefitFrequencyOrder = function(params, ...) { if (is.null(params$Loadings$benefitFrequencyLoading)) 0 else -1}
),
Costs = initializeCosts(),
minCosts = NULL, # Base costs, which cannot be waived
minCosts = NULL, # Base costs, which cannot be waived
Loadings = list( # Loadings can also be function(sumInsured, premiums)
ongoingAlphaGrossPremium = 0, # Acquisition cost that increase the gross premium
tax = 0.04, # insurance tax, factor on each premium paid
......@@ -694,7 +697,8 @@ InsuranceContract.ParameterDefaults = list(
adjustPremiumCoefficients = NULL, # function(coeff, type = type, premiums = premiums, params = params, values = values, premiumCalculationTime = premiumCalculationTime)
adjustPremiums = NULL, # function(premiums = list(premiums, coefficients, sumInsured), params, values)
adjustPVForReserves = NULL, # function(absPresentValues, params, values)
premiumRebateCalculation = NULL # function(premiumRebateRate, params = params, values = values)
premiumRebateCalculation = NULL, # function(premiumRebateRate, params = params, values = values)
Rounding = NULL # Rounding helper to specify particular rounding of values
)
);
......
......@@ -236,6 +236,12 @@ InsuranceTarif = R6Class(
# Fill all remaining uninitialized values with their defaults, except for profit participation params
self$Parameters = InsuranceContract.ParametersFallback(self$Parameters, InsuranceContract.ParameterDefaults, ppParameters = FALSE);
# Properly set up the rounding helper
if (is.null(self$Parameters$Hooks$Rounding)) self$Parameters$Hooks$Rounding = list()
if (is.list(self$Parameters$Hooks$Rounding)){
self$Parameters$Hooks$Rounding = do.call(RoundingHelper$new, self$Parameters$Hooks$Rounding)
}
},
#' @description create a copy of a tariff with certain parameters changed
......@@ -271,6 +277,11 @@ InsuranceTarif = R6Class(
if (!missing(tariffType)) cloned$tariffType = tariffType;
cloned$Parameters = InsuranceContract.ParametersFill(cloned$Parameters, ...);
# Properly set up the rounding helper
if (is.null(cloned$Parameters$Hooks$Rounding)) cloned$Parameters$Hooks$Rounding = list()
if (is.list(cloned$Parameters$Hooks$Rounding)){
cloned$Parameters$Hooks$Rounding = do.call(RoundingHelper$new, cloned$Parameters$Hooks$Rounding)
}
cloned
},
......@@ -364,7 +375,8 @@ InsuranceTarif = R6Class(
} else {
px = 1 - qx
}
df = data.frame(age = ages, qx = qx, ix = ix, px = px, row.names = ages - age)
rd = params$Hooks$Rounding
df = data.frame(age = ages, qx = rd$round("qx", qx), ix = rd$round("ix", ix), px = rd$round("px", px), row.names = ages - age)
df
}
},
......@@ -489,6 +501,7 @@ InsuranceTarif = R6Class(
#' - a single numeric value indicates a single survival payment at the end of the contract
#' - a vector of numeric values indicates potentially multiple survival payments for the whole contract period (paddded with 0 to the full contract length if shorter)
#' @details Not to be called directly, but implicitly by the [InsuranceContract] object.
#' @param len The desired length of the returned data frame (the number of contract periods desired)
getSurvivalCF = function(len, params, values) {
if (getOption('LIC.debug.getSurvivalCF', FALSE)) {
browser();
......@@ -497,11 +510,11 @@ InsuranceTarif = R6Class(
if (is.null(benefit)) {
benefit = 1
}
if (is.vector(benefit) && length(benefit) == 1) {
c(rep(0, len - 1), benefit)
} else {
# If survivalBenefit is (or returns) a vector, treat it as yearly
# If survivalBenefit is (or returns) a vector, treat it as yearly
# survival payments, pad it to the desired length
pad0(benefit, len)
}
......@@ -727,6 +740,7 @@ InsuranceTarif = R6Class(
if (getOption('LIC.debug.presentValueCashFlows', FALSE)) {
browser();
}
rd = params$Hooks$Rounding
qq = self$getTransitionProbabilities(params, values);
......@@ -746,17 +760,17 @@ InsuranceTarif = R6Class(
(values$cashFlows[,"death_GrossPremium"] - values$cashFlows[,"premiums_advance"]);
pv = cbind(
premiums = pvf$survival(values$cashFlows$premiums_advance, values$cashFlows$premiums_arrears,
m = params$ContractData$premiumFrequency, mCorrection = premiumFreqCorr),
additional_capital = pvf$survival(advance = values$cashFlows$additional_capital),
guaranteed = pvf$guaranteed(values$cashFlows$guaranteed_advance, values$cashFlows$guaranteed_arrears),
survival = pvf$survival(values$cashFlows$survival_advance, values$cashFlows$survival_arrears),
death_SumInsured = pvf$death(values$cashFlows$death_SumInsured),
disease_SumInsured = pvf$disease(values$cashFlows$disease_SumInsured),
death_GrossPremium = pvRefund,
death_Refund_past = pvRefundPast,
death_Refund_future = pvRefund - pvRefundPast,
death_PremiumFree = pvf$death(values$cashFlows$death_PremiumFree)
premiums = rd$round("PV Premiums", pvf$survival(values$cashFlows$premiums_advance, values$cashFlows$premiums_arrears,
m = params$ContractData$premiumFrequency, mCorrection = premiumFreqCorr)),
additional_capital = rd$round("PV AdditionalCapital", pvf$survival(advance = values$cashFlows$additional_capital)),
guaranteed = rd$round("PV Guarantee", pvf$guaranteed(values$cashFlows$guaranteed_advance, values$cashFlows$guaranteed_arrears)),
survival = rd$round("PV Survival", pvf$survival(values$cashFlows$survival_advance, values$cashFlows$survival_arrears)),
death_SumInsured = rd$round("PV Death", pvf$death(values$cashFlows$death_SumInsured)),
disease_SumInsured = rd$round("PV Disease", pvf$disease(values$cashFlows$disease_SumInsured)),
death_GrossPremium = rd$round("PV Death PremiumRefund", pvRefund),
death_Refund_past = rd$round("PV Death PremiumRefund Past", pvRefundPast),
death_Refund_future = rd$round("PV Death PremiumRefund Future", pvRefund - pvRefundPast),
death_PremiumFree = rd$round("PV Death PremiumFree", pvf$death(values$cashFlows$death_PremiumFree))
);
rownames(pv) <- pad0(rownames(qq), values$int$l);
......@@ -817,6 +831,8 @@ InsuranceTarif = R6Class(
pvfben$disease(cf$disease_SumInsured * cfCosts);
}
rd = params$Hooks$Rounding;
pvc = rd$round("PV Costs", pvc)
applyHook(hook = params$Hooks$adjustPresentValuesCosts, val = pvc, params = params, values = values, presentValues = presentValues)
},
......@@ -831,6 +847,7 @@ InsuranceTarif = R6Class(
if (getOption('LIC.debug.getAbsCashFlows', FALSE)) {
browser();
}
rd = params$Hooks$Rounding;
# TODO: Set up a nice list with coefficients for each type of cashflow,
# rather than multiplying each item manually (this also mitigates the risk
......@@ -854,6 +871,8 @@ InsuranceTarif = R6Class(
values$cashFlows[,"death_SumInsured"] = values$cashFlows[,"death_SumInsured"] + values$cashFlows[,"death_GrossPremium"]
colnames(values$cashFlows)[colnames(values$cashFlows) == "death_SumInsured"] = "death";
# cashFlows[,"death_GrossPremium"] = NULL;
values$cashFlows = rd$round("CF absolute", values$cashFlows);
# costs relative to sumInsured are already set up as the correct multiple
# of the original SI, including the dynamic changes over time!
......@@ -863,6 +882,7 @@ InsuranceTarif = R6Class(
values$cashFlowsCosts[,,"NetPremium",] * values$premiums[["net"]] +
# values$cashFlowsCosts[,,"Benefits",] * TODO!!!
values$cashFlowsCosts[,,"Constant",];
values$cashFlowsCosts = rd$round("CF costs absolute", values$cashFlowsCosts);
# Handle survival CF differently, because we don't want ".survival" in the column names!
cbind(values$cashFlows, values$cashFlowsCosts[,,"survival"], values$cashFlowsCosts[,,-1])
......@@ -897,6 +917,8 @@ InsuranceTarif = R6Class(
pv[,"death_SumInsured"] = pv[,"death_SumInsured"] + pv[,"death_GrossPremium"]
colnames(pv)[colnames(pv) == "death_SumInsured"] = "death";
pv = params$Hooks$Rounding$round("PV absolute", pv);
cbind("premiums.unit" = values$presentValues[,"premiums"], pv)
},
......@@ -929,6 +951,10 @@ InsuranceTarif = R6Class(
values$presentValuesCosts[,,"Constant",] / params$ContractData$sumInsured,
dims = 2)
rd = params$Hooks$Rounding;
benefits = rd$round("PV abs benefits", benefits)
allBenefits = rd$round("PV abs allBenefits", allBenefits)
benefitsCosts = rd$round("PV abs benefitsCosts", benefitsCosts)
cbind(
benefits = benefits,
......@@ -1146,7 +1172,7 @@ InsuranceTarif = R6Class(
temp = temp /
(enumerator / denominator * (1 + noMedicalExam.relative + extraChargeGrossPremium) + noMedicalExam - sumRebate - extraRebate);
}
sumInsured = temp
sumInsured = params$Hooks$Rounding$round("sumInsured", temp);
sumInsured
},
......@@ -1160,6 +1186,8 @@ InsuranceTarif = R6Class(
if (getOption('LIC.debug.premiumCalculation', FALSE)) {
browser();
}
rd = params$Hooks$Rounding;
loadings = params$Loadings;
sumInsured = params$ContractData$sumInsured
values$premiums = c(
......@@ -1191,8 +1219,8 @@ InsuranceTarif = R6Class(
coeff = self$getPremiumCoefficients("gross", pv * 0, pvCost * 0, premiums = values$premiums, params = params, values = values, premiumCalculationTime = premiumCalculationTime)
enumerator = sum(coeff[["SumInsured"]][["benefits"]] * pv) + sum(coeff[["SumInsured"]][["costs"]] * pvCost);
denominator = sum(coeff[["Premium" ]][["benefits"]] * pv) + sum(coeff[["Premium" ]][["costs"]] * pvCost);
values$premiums[["unit.gross"]] = enumerator/ifelse(denominator == 0, 1, denominator) * (1 + loadings$ongoingAlphaGrossPremium);
values$premiums[["gross"]] = values$premiums[["unit.gross"]] * sumInsured;
values$premiums[["unit.gross"]] = rd$round("Premium gross unit", enumerator/ifelse(denominator == 0, 1, denominator) * (1 + loadings$ongoingAlphaGrossPremium));
values$premiums[["gross"]] = rd$round("Premium gross", values$premiums[["unit.gross"]] * sumInsured);
coefficients[["gross"]] = coeff;
# ======================================================================= =
......@@ -1201,8 +1229,8 @@ InsuranceTarif = R6Class(
coeff = self$getPremiumCoefficients("net", pv*0, pvCost*0, premiums = values$premiums, params = params, values = values, premiumCalculationTime = premiumCalculationTime)
enumerator = sum(coeff[["SumInsured"]][["benefits"]] * pv) + sum(coeff[["SumInsured"]][["costs"]] * pvCost);
denominator = sum(coeff[["Premium" ]][["benefits"]] * pv) + sum(coeff[["Premium" ]][["costs"]] * pvCost);
values$premiums[["unit.net"]] = enumerator/ifelse(denominator == 0, 1, denominator);
values$premiums[["net"]] = values$premiums[["unit.net"]] * sumInsured;
values$premiums[["unit.net"]] = rd$round("Premium net unit", enumerator/ifelse(denominator == 0, 1, denominator));
values$premiums[["net"]] = rd$round("Premium net", values$premiums[["unit.net"]] * sumInsured);
coefficients[["net"]] = coeff;
# ======================================================================= =
......@@ -1211,8 +1239,8 @@ InsuranceTarif = R6Class(
coeff = self$getPremiumCoefficients("Zillmer", pv * 0, pvCost * 0, premiums = values$premiums, params = params, values = values, premiumCalculationTime = premiumCalculationTime);
enumerator = sum(coeff[["SumInsured"]][["benefits"]] * pv) + sum(coeff[["SumInsured"]][["costs"]] * pvCost);
denominator = sum(coeff[["Premium" ]][["benefits"]] * pv) + sum(coeff[["Premium" ]][["costs"]] * pvCost);
values$premiums[["unit.Zillmer"]] = enumerator/ifelse(denominator == 0, 1, denominator);
values$premiums[["Zillmer"]] = values$premiums[["unit.Zillmer"]] * sumInsured;
values$premiums[["unit.Zillmer"]] = rd$round("Premium Zillmer unit", enumerator/ifelse(denominator == 0, 1, denominator));
values$premiums[["Zillmer"]] = rd$round("Premium Zillmer", values$premiums[["unit.Zillmer"]] * sumInsured);
coefficients[["Zillmer"]] = coeff;
......@@ -1220,6 +1248,7 @@ InsuranceTarif = R6Class(
# Additional premium components (after gross premium)
# ----------------------------------------------------------------------- -
# The written premium is the gross premium with additional loadings, rebates, unit costs and taxes
# TODO: Think through, how each of the components should / could be rounded
tax = valueOrFunction(loadings$tax, params = params, values = values);
unitCosts = valueOrFunction(loadings$unitcosts, params = params, values = values);
noMedicalExam = valueOrFunction(loadings$noMedicalExam,params = params, values = values);
......@@ -1260,10 +1289,10 @@ InsuranceTarif = R6Class(
premiumBeforeTax = premiumBeforeTax * (1 - premiumRebate - advanceProfitParticipationUnitCosts - partnerRebate);
premiumBeforeTax.y = premiumBeforeTax * (1 + frequencyLoading);
premiumBeforeTax = premiumBeforeTax.y / params$ContractData$premiumFrequency;
values$premiums[["written_yearly"]] = premiumBeforeTax.y * (1 + tax)
values$premiums[["written_beforetax"]] = premiumBeforeTax;
values$premiums[["tax"]] = premiumBeforeTax * tax;
values$premiums[["written"]] = premiumBeforeTax * (1 + tax);
values$premiums[["written_yearly"]] = rd$round("Premium written yearly", premiumBeforeTax.y * (1 + tax))
values$premiums[["written_beforetax"]] = rd$round("Premium written beforeTax", premiumBeforeTax);
values$premiums[["tax"]] = rd$round("Premium tax", premiumBeforeTax * tax);
values$premiums[["written"]] = rd$round("Premium written", values$premiums[["written_beforetax"]] + values$premiums[["tax"]]);
applyHook(
params$Hooks$adjustPremiums,
......@@ -1281,6 +1310,7 @@ InsuranceTarif = R6Class(
if (getOption('LIC.debug.reserveCalculation', FALSE)) {
browser();
}
rd = params$Hooks$Rounding;
t = "0"
securityFactor = (1 + valueOrFunction(params$Loadings$security, params = params, values = values));
ppScheme = params$ProfitParticipation$profitParticipationScheme;
......@@ -1288,10 +1318,10 @@ InsuranceTarif = R6Class(
absPV = applyHook(params$Hooks$adjustPVForReserves, values$absPresentValues, params = params, values = values);
# Net, Zillmer and Gross reserves
resNet = absPV[,"benefitsAndRefund"] * securityFactor - values$premiums[["net"]] * absPV[,"premiums.unit"];
resNet = rd$round("Res net", absPV[,"benefitsAndRefund"] * securityFactor - values$premiums[["net"]] * absPV[,"premiums.unit"]);
BWZcorr = ifelse(absPV[t, "premiums"] == 0, 0,
absPV[t, "Zillmer"] / absPV[t, "premiums"]) * absPV[,"premiums"];
resZ = resNet - BWZcorr;
resZ = rd$round("Res Zillmer", resNet - BWZcorr);
resAdeq = absPV[,"benefitsAndRefund"] * securityFactor +
absPV[,"alpha"] + absPV[,"beta"] + absPV[,"gamma"] -
......@@ -1299,10 +1329,11 @@ InsuranceTarif = R6Class(
if (params$Features$unitcostsInGross) {
resAdeq = resAdeq + absPV[, "unitcosts"]
}
resAdeq = rd$round("Res adequate", resAdeq)
resGamma = absPV[,"gamma"] -
resGamma = rd$round("Res gamma", absPV[,"gamma"] -
ifelse(absPV[t, "premiums"] == 0, 0,
absPV[t, "gamma"] / absPV[t, "premiums"]) * absPV[,"premiums"]
absPV[t, "gamma"] / absPV[t, "premiums"]) * absPV[,"premiums"]);
advanceProfitParticipation = 0;
......@@ -1339,7 +1370,10 @@ InsuranceTarif = R6Class(
resContractual = resAdeq + resGamma
resReduction = resAdeq + alphaRefund;
}
resConversion = resContractual * (1 - advanceProfitParticipation);
resContractual = rd$round("Res contractual", resContractual)
resReduction = rd$round("Res reduction", resReduction)
resConversion = rd$round("Res conversion", resContractual * (1 - advanceProfitParticipation));
if (params$Features$surrenderIncludesCostsReserves) {
resReduction = resReduction + resGamma;
}
......@@ -1379,6 +1413,7 @@ InsuranceTarif = R6Class(
partnerRebate = valueOrFunction(params$Loadings$partnerRebate, params = params, values = values);
surrenderValue = resReduction * (1 - advanceProfitParticipationUnitCosts - partnerRebate);
}
surrenderValue = rd$round("Surrender Value", surrenderValue)
# Calculate new sum insured after premium waiver
......@@ -1392,6 +1427,7 @@ InsuranceTarif = R6Class(
newSI = ifelse(premiumfreePV == 0, 0,
(premiumfreeValue - absPV[,"death_Refund_past"] * securityFactor - c(Storno)) /
premiumfreePV * params$ContractData$sumInsured);
newSI = rd$round("Premiumfree SI", newSI)
cbind(res,
"PremiumsPaid" = Reduce("+", values$absCashFlows$premiums_advance, accumulate = TRUE),
......@@ -1443,6 +1479,7 @@ InsuranceTarif = R6Class(
if (getOption('LIC.debug.reserveCalculationBalanceSheet', FALSE)) {
browser();
}
rd = params$Hooks$Rounding
reserves = values$reserves;
years = length(reserves[,"Zillmer"]);
# Balance sheet reserves:
......@@ -1496,7 +1533,7 @@ InsuranceTarif = R6Class(
"unearned Premiums" = unearnedPremiums
);
rownames(res) <- rownames(reserves);
res
rd$round("Balance Sheet", res)
},
#' @description Calculate the profit participation given the contract
......@@ -1549,6 +1586,7 @@ InsuranceTarif = R6Class(
#' @details Not to be called directly, but implicitly by the [InsuranceContract] object.
#' All premiums, reserves and present values have already been calculated.
premiumDecomposition = function(params, values) {
# TODO: No rounding applied yet!
if (getOption('LIC.debug.premiumDecomposition', FALSE)) {
browser();
}
......
#' @import R6
NULL
############# Class RoundingHelper ###########################################
#' Helper object to define rounding rules for the InsuranceContract,
#' InsuranceTarif and ProfitParticipation classes.
#'
#' @description The class \code{RoundingHelper} provides the code and settings
#' to define numeric rounding rules for premiums, reserves, benefits etc. of
#' a life insurance contract. By default, no rounding it applied.
#'
#' @param values Contract values calculated so far (in the \code{contract$Values}
#' list) then this method is called by the contract object
#'
#' @param premiumCalculationTime The time when the premiums should be
#' (re-)calculated according to the equivalence principle. A time 0
#' means the initial premium calculation at contract closing, later
#' premium calculation times can be used to re-calculate the new
#' premium after a contract change (possibly including an existing reserve)
#'
#' @examples
#' # TODO
#' @export
RoundingHelper = R6Class(
"RoundingHelper",
######################### PUBLIC METHODS ##################################
public = list(
#' @field rounding The (named) list containing all declared rounding definitions
rounding = list(),
#' @description Initialize the rounding settings
#' @details Sets up the rounding helper by giving a list of named entries, specifying rounding accuracy for each particular value
#'
#' @param ... named entries specifying rounding accuracy
#' @examples
#' rounding = RoundingHelper$new(raw = 0, hundred = -2, accurate = 4)
#' rounding$round("raw", c(1234.567891, 0.00012345, 1234))
#' rounding$round("hundred", c(1234.567891, 0.00012345, 1234))
#' rounding$round("accurate", c(1234.567891, 0.00012345, 1234))
#' rounding$round("non-existing", c(1234.567891, 0.00012345, 1234))
initialize = function(...) {
self$rounding = list(...)
},
#' @description Round the given values using the pre-defined accuracy
#' @details Rounds the given values using the accuracies defined in the
#' internal rounding list (set either via the 'initialize' function
#' or via a call to 'setRounding'. The accuracies are defined using
#' a 'spec' identifier, which allows to define different accuracies
#' for different uses
#'
#' @param spec the ID used for looking up the desired accuracy
#' @param value the values to be rounded according to 'spec'
#' @param ... currently unused
#' @examples
#' rounding = RoundingHelper$new(raw = 0, hundred = -2, accurate = 4)
#' rounding$round("raw", c(1234.567891, 0.00012345, 1234))
#' rounding$round("hundred", c(1234.567891, 0.00012345, 1234))
#' rounding$round("accurate", c(1234.567891, 0.00012345, 1234))
#' # If the given spec does not exist, no rounding it applied
#' rounding$round("non-existing", c(1234.567891, 0.00012345, 1234))
round = function(spec, value, ...) {
if (is.character(spec)) {
spec = self$getRounding(spec, ...)
}
if (is.function(spec)) {
spec(value)
} else if (is.numeric(spec)) {
round(value, digits = spec)
} else {
value
}
},
#' @description Define rounding accuracy for a certain identifier
#' @details Configures the rounding helper for a given named entry,
#' specifying rounding accuracy for each particular value
#'
#' @param key the ID used for looking up the desired accuracy
#' @param spec the rounding accuracy (number of digits)
#' @param ... currently unused
#' @examples
#' rounding = RoundingHelper$new(raw = 0, hundred = -2, accurate = 4)
#' rounding$round("raw", c(1234.567891, 0.00012345, 1234))
#' rounding$round("hundred", c(1234.567891, 0.00012345, 1234))
#' rounding$round("accurate", c(1234.567891, 0.00012345, 1234))
#' # If the given spec does not exist, no rounding it applied
#' rounding$round("non-existing", c(1234.567891, 0.00012345, 1234))
#' # Add a new spec with different settings:
#' rounding$setRounding("non-existing", 1)
#' rounding$round("non-existing", c(1234.567891, 0.00012345, 1234))
setRounding = function(key, spec, ...) {
self$rounding[[key]] = spec
},
#' @description Extract rounding accuracy for a certain identifier
#' @details Read out the rounding for a given named entry.
#'
#' @param key the ID used for looking up the desired accuracy
#' @param ... currently unused
#' @examples
#' rounding = RoundingHelper$new(raw = 0, hundred = -2, accurate = 4)
#' rounding$getRounding("hundred")
getRounding = function(key, ...) {
self$rounding[[key]]
}
)
)
......@@ -108,6 +108,16 @@ describes the annuity unit payments for all years}
\item{\code{$deathBenefit}}{The yearly relative death benefit (relative
to the initial sum insured); Can be set to a \code{function(len,
params, values)}, e.g. \code{deathBenefit = deathBenefit.linearDecreasing}}
\item{\code{$survivalBenefit}}{The survival benefit (relative to the initial
sum insured). By default, for (pure) endowments a survival benefit
of 1 is assumed at the end of the contract period. Other values
(e.g. double survival benefit in endowments) or multiple survival
payments during the contract period can be set with this parameter.
A single numeric value indicates a single survival benefit at
the end of the contract, a vector of numeric values indicates
yearly survival benefits (not neccessarily with a survival
payment at the end of the contract). Can be set to a \code{function(len,
params, values)} returning the benefit as a numeric value or vector.}
\item{\code{$benefitParameter}}{(optional) Tariff-specific parameter to
indicate special benefit conditions (e.g. for non-constant benefits
the initial starting value, or a minimum benefit, etc.). This
......@@ -321,6 +331,7 @@ participation rates are defined at the level of profit classes.}
\item{\code{$adjustPremiums}}{Adjust the resulting premiums. \code{function(premiums = list(premiums, coefficients, sumInsured), params, values)}}
\item{\code{$adjustPVForReserves}}{Adjust the absolute present value vectors used to derive reserves (e.g. when a sum rebate is subtracted from the gamma-cost reserves without influencing the premium calculation). \code{function(absPV, params, values)}}
\item{\code{$premiumRebateCalculation}}{Calculate the actual premium rebate from the rebate rate (e.g. when the premium rate is given as a yearly cost reduction applied to a single-premium contract). \code{function(premiumRebateRate, params = params, values = values)}}
\item{\code{$Rounding}}{A \link{RoundingHelper} object to specify rounding of intermediate values. Alternatively, a named list of rounding specifications can be given, which is used to construct a new \link{RoundingHelper} object.}
}
}
}
......
......@@ -146,6 +146,7 @@ all fields.}
\item \href{#method-InsuranceTarif-getPremiumCF}{\code{InsuranceTarif$getPremiumCF()}}
\item \href{#method-InsuranceTarif-getAnnuityCF}{\code{InsuranceTarif$getAnnuityCF()}}
\item \href{#method-InsuranceTarif-getDeathCF}{\code{InsuranceTarif$getDeathCF()}}
\item \href{#method-InsuranceTarif-getSurvivalCF}{\code{InsuranceTarif$getSurvivalCF()}}
\item \href{#method-InsuranceTarif-getBasicCashFlows}{\code{InsuranceTarif$getBasicCashFlows()}}
\item \href{#method-InsuranceTarif-getCashFlows}{\code{InsuranceTarif$getCashFlows()}}
\item \href{#method-InsuranceTarif-getCashFlowsCosts}{\code{InsuranceTarif$getCashFlowsCosts()}}
......@@ -514,7 +515,40 @@ period (after potential deferral period!)
\subsection{Arguments}{
\if{html}{\out{<div class="arguments">}}
\describe{
\item{\code{len}}{The desired length of the returned data frame (the number of contract periods desire)}
\item{\code{len}}{The desired length of the returned data frame (the number of contract periods desired)}
\item{\code{params}}{Contract-specific, full set of parameters of the contract
(merged parameters of the defaults, the tariff, the profit participation
scheme and the contract)}
\item{\code{values}}{Contract values calculated so far (in the \code{contract$Values}
list) then this method is called by the contract object}
}
\if{html}{\out{</div>}}
}
\subsection{Details}{
Not to be called directly, but implicitly by the \link{InsuranceContract} object.
}
}
\if{html}{\out{<hr>}}
\if{html}{\out{<a id="method-InsuranceTarif-getSurvivalCF"></a>}}
\if{latex}{\out{\hypertarget{method-InsuranceTarif-getSurvivalCF}{}}}
\subsection{Method \code{getSurvivalCF()}}{
Returns the unit survival cash flow profile for the whole contract
period (after potential deferral period!)
\itemize{
\item a single numeric value indicates a single survival payment at the end of the contract
\item a vector of numeric values indicates potentially multiple survival payments for the whole contract period (paddded with 0 to the full contract length if shorter)
}
\subsection{Usage}{
\if{html}{\out{<div class="r">}}\preformatted{InsuranceTarif$getSurvivalCF(len, params, values)}\if{html}{\out{</div>}}
}
\subsection{Arguments}{
\if{html}{\out{<div class="arguments">}}
\describe{
\item{\code{len}}{The desired length of the returned data frame (the number of contract periods desired)}
\item{\code{params}}{Contract-specific, full set of parameters of the contract
(merged parameters of the defaults, the tariff, the profit participation
......
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/RoundingHelper.R
\name{RoundingHelper}
\alias{RoundingHelper}
\title{Helper object to define rounding rules for the InsuranceContract,
InsuranceTarif and ProfitParticipation classes.}
\description{
The class \code{RoundingHelper} provides the code and settings
to define numeric rounding rules for premiums, reserves, benefits etc. of
a life insurance contract. By default, no rounding it applied.
}
\examples{
# TODO
## ------------------------------------------------
## Method `RoundingHelper$new`
## ------------------------------------------------
rounding = RoundingHelper$new(raw = 0, hundred = -2, accurate = 4)
rounding$round("raw", c(1234.567891, 0.00012345, 1234))
rounding$round("hundred", c(1234.567891, 0.00012345, 1234))
rounding$round("accurate", c(1234.567891, 0.00012345, 1234))
rounding$round("non-existing", c(1234.567891, 0.00012345, 1234))
## ------------------------------------------------
## Method `RoundingHelper$round`
## ------------------------------------------------
rounding = RoundingHelper$new(raw = 0, hundred = -2, accurate = 4)
rounding$round("raw", c(1234.567891, 0.00012345, 1234))
rounding$round("hundred", c(1234.567891, 0.00012345, 1234))
rounding$round("accurate", c(1234.567891, 0.00012345, 1234))
# If the given spec does not exist, no rounding it applied
rounding$round("non-existing", c(1234.567891, 0.00012345, 1234))
## ------------------------------------------------
## Method `RoundingHelper$setRounding`
## ------------------------------------------------
rounding = RoundingHelper$new(raw = 0, hundred = -2, accurate = 4)
rounding$round("raw", c(1234.567891, 0.00012345, 1234))
rounding$round("hundred", c(1234.567891, 0.00012345, 1234))
rounding$round("accurate", c(1234.567891, 0.00012345, 1234))
# If the given spec does not exist, no rounding it applied
rounding$round("non-existing", c(1234.567891, 0.00012345, 1234))
# Add a new spec with different settings:
rounding$setRounding("non-existing", 1)
rounding$round("non-existing", c(1234.567891, 0.00012345, 1234))
## ------------------------------------------------
## Method `RoundingHelper$getRounding`
## ------------------------------------------------
rounding = RoundingHelper$new(raw = 0, hundred = -2, accurate = 4)
rounding$getRounding("hundred")
}
\section{Public fields}{
\if{html}{\out{<div class="r6-fields">}}
\describe{
\item{\code{rounding}}{The (named) list containing all declared rounding definitions}
}
\if{html}{\out{</div>}}
}
\section{Methods}{
\subsection{Public methods}{
\itemize{
\item \href{#method-RoundingHelper-new}{\code{RoundingHelper$new()}}
\item \href{#method-RoundingHelper-round}{\code{RoundingHelper$round()}}
\item \href{#method-RoundingHelper-setRounding}{\code{RoundingHelper$setRounding()}}
\item \href{#method-RoundingHelper-getRounding}{\code{RoundingHelper$getRounding()}}
\item \href{#method-RoundingHelper-clone}{\code{RoundingHelper$clone()}}
}
}
\if{html}{\out{<hr>}}
\if{html}{\out{<a id="method-RoundingHelper-new"></a>}}
\if{latex}{\out{\hypertarget{method-RoundingHelper-new}{}}}
\subsection{Method \code{new()}}{
Initialize the rounding settings
\subsection{Usage}{
\if{html}{\out{<div class="r">}}\preformatted{RoundingHelper$new(...)}\if{html}{\out{</div>}}
}
\subsection{Arguments}{
\if{html}{\out{<div class="arguments">}}
\describe{
\item{\code{...}}{named entries specifying rounding accuracy}
}
\if{html}{\out{</div>}}
}
\subsection{Details}{
Sets up the rounding helper by giving a list of named entries, specifying rounding accuracy for each particular value
}
\subsection{Examples}{
\if{html}{\out{<div class="r example copy">}}
\preformatted{rounding = RoundingHelper$new(raw = 0, hundred = -2, accurate = 4)
rounding$round("raw", c(1234.567891, 0.00012345, 1234))
rounding$round("hundred", c(1234.567891, 0.00012345, 1234))
rounding$round("accurate", c(1234.567891, 0.00012345, 1234))
rounding$round("non-existing", c(1234.567891, 0.00012345, 1234))
}
\if{html}{\out{</div>}}
}
}
\if{html}{\out{<hr>}}
\if{html}{\out{<a id="method-RoundingHelper-round"></a>}}
\if{latex}{\out{\hypertarget{method-RoundingHelper-round}{}}}
\subsection{Method \code{round()}}{
Round the given values using the pre-defined accuracy
\subsection{Usage}{
\if{html}{\out{<div class="r">}}\preformatted{RoundingHelper$round(spec, value, ...)}\if{html}{\out{</div>}}
}
\subsection{Arguments}{
\if{html}{\out{<div class="arguments">}}
\describe{
\item{\code{spec}}{the ID used for looking up the desired accuracy}
\item{\code{value}}{the values to be rounded according to 'spec'}
\item{\code{...}}{currently unused}
}
\if{html}{\out{</div>}}
}
\subsection{Details}{
Rounds the given values using the accuracies defined in the
internal rounding list (set either via the 'initialize' function
or via a call to 'setRounding'. The accuracies are defined using
a 'spec' identifier, which allows to define different accuracies
for different uses
}
\subsection{Examples}{
\if{html}{\out{<div class="r example copy">}}
\preformatted{rounding = RoundingHelper$new(raw = 0, hundred = -2, accurate = 4)
rounding$round("raw", c(1234.567891, 0.00012345, 1234))
rounding$round("hundred", c(1234.567891, 0.00012345, 1234))
rounding$round("accurate", c(1234.567891, 0.00012345, 1234))
# If the given spec does not exist, no rounding it applied
rounding$round("non-existing", c(1234.567891, 0.00012345, 1234))
}
\if{html}{\out{</div>}}
}
}
\if{html}{\out{<hr>}}
\if{html}{\out{<a id="method-RoundingHelper-setRounding"></a>}}
\if{latex}{\out{\hypertarget{method-RoundingHelper-setRounding}{}}}
\subsection{Method \code{setRounding()}}{
Define rounding accuracy for a certain identifier
\subsection{Usage}{
\if{html}{\out{<div class="r">}}\preformatted{RoundingHelper$setRounding(key, spec, ...)}\if{html}{\out{</div>}}
}
\subsection{Arguments}{
\if{html}{\out{<div class="arguments">}}
\describe{
\item{\code{key}}{the ID used for looking up the desired accuracy}
\item{\code{spec}}{the rounding accuracy (number of digits)}
\item{\code{...}}{currently unused}
}
\if{html}{\out{</div>}}
}
\subsection{Details}{
Configures the rounding helper for a given named entry,
specifying rounding accuracy for each particular value
}
\subsection{Examples}{
\if{html}{\out{<div class="r example copy">}}
\preformatted{rounding = RoundingHelper$new(raw = 0, hundred = -2, accurate = 4)
rounding$round("raw", c(1234.567891, 0.00012345, 1234))
rounding$round("hundred", c(1234.567891, 0.00012345, 1234))
rounding$round("accurate", c(1234.567891, 0.00012345, 1234))
# If the given spec does not exist, no rounding it applied
rounding$round("non-existing", c(1234.567891, 0.00012345, 1234))
# Add a new spec with different settings:
rounding$setRounding("non-existing", 1)
rounding$round("non-existing", c(1234.567891, 0.00012345, 1234))
}
\if{html}{\out{</div>}}
}
}
\if{html}{\out{<hr>}}
\if{html}{\out{<a id="method-RoundingHelper-getRounding"></a>}}
\if{latex}{\out{\hypertarget{method-RoundingHelper-getRounding}{}}}
\subsection{Method \code{getRounding()}}{
Extract rounding accuracy for a certain identifier
\subsection{Usage}{
\if{html}{\out{<div class="r">}}\preformatted{RoundingHelper$getRounding(key, ...)}\if{html}{\out{</div>}}
}
\subsection{Arguments}{
\if{html}{\out{<div class="arguments">}}
\describe{
\item{\code{key}}{the ID used for looking up the desired accuracy}
\item{\code{...}}{currently unused}
}
\if{html}{\out{</div>}}
}
\subsection{Details}{
Read out the rounding for a given named entry.
}
\subsection{Examples}{
\if{html}{\out{<div class="r example copy">}}
\preformatted{rounding = RoundingHelper$new(raw = 0, hundred = -2, accurate = 4)
rounding$getRounding("hundred")
}
\if{html}{\out{</div>}}
}
}
\if{html}{\out{<hr>}}
\if{html}{\out{<a id="method-RoundingHelper-clone"></a>}}
\if{latex}{\out{\hypertarget{method-RoundingHelper-clone}{}}}
\subsection{Method \code{clone()}}{
The objects of this class are cloneable with this method.
\subsection{Usage}{
\if{html}{\out{<div class="r">}}\preformatted{RoundingHelper$clone(deep = FALSE)}\if{html}{\out{</div>}}
}
\subsection{Arguments}{
\if{html}{\out{<div class="arguments">}}
\describe{
\item{\code{deep}}{Whether to make a deep clone.}
}
\if{html}{\out{</div>}}
}
}
}
test_that("Rounding Helper", {
rounding = RoundingHelper$new(test = 2, gross.premium = 0, "Sum Insured" = -2)
rounding$rounding
expect_equal(
rounding$round("test", c(2*10^(-8:5), 987654321.987654321)),
c(0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.02, 0.20, 2.00, 20.00, 200.00, 2000.00, 20000.00, 200000.00, 987654321.99)
)
expect_equal(
rounding$round("gross.premium", c(2*10^(-8:5), 987654321.987654321)),
c(0, 0, 0, 0, 0, 0, 0, 0, 2, 20, 200, 2000, 20000, 200000, 987654322)
)
expect_equal(
rounding$round("Sum Insured", c(2*10^(-8:5), 987654321.987654321)),
c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 200, 2000, 20000, 200000, 987654300)
)
expect_equal(
rounding$round("NotExisting", c(2*10^(-8:5), 987654321.987654321)),
c(2*10^(-8:5), 987654321.987654321)
)
})
test_that("Calculation of sumInsured from premium", {
library(MortalityTables)
mortalityTables.load("Austria_Census")
Tarif.EndowmentSI = InsuranceTarif$new(
name = "Example Tariff - Endowment",
type = "endowment",
tarif = "E1-RP",
desc = "An endowment with regular premiums (standard tariff)",
age = 40, policyPeriod = 20,
mortalityTable = mort.AT.census.2011.unisex,
cost = initializeCosts(alpha = 0.04, gamma.contract = 0.0005, unitcosts = 10),
i = 0.03,
sumInsured = 10000,
contractClosing = as.Date("2020-09-01")
)
Tarif.EndowmentSI.rounded = Tarif.EndowmentSI$createModification(
Rounding = list("Premium gross" = 0, "Premium net" = 2)
)
Contract.sumInsured = InsuranceContract$new(
tarif = Tarif.EndowmentSI
)
Contract.sumInsured.rounded = InsuranceContract$new(
tarif = Tarif.EndowmentSI.rounded
)
expect_equal(Contract.sumInsured.rounded$Values$premiums[["gross"]], round(Contract.sumInsured$Values$premiums[["gross"]], 0))
expect_equal(Contract.sumInsured.rounded$Values$premiums[["net"]], round(Contract.sumInsured$Values$premiums[["net"]], 2))
})
......@@ -1133,6 +1133,94 @@ contractGridPremium(
) %>% kableTable(digits = 2)
```
# Rounding values
In an ideal world, all calculations would be done with perfect accuracy. However,
in reality insurance tariffs are often implemented in systems that support only
a limited number of digits. Or it is company policy to round premiums to whole
Euro or Dollar amounts.
For this reason, the package also provides a `RoundingHelper` class that provides
an easy interfact for rounding intermediate values in the calculation. The
instance of this class is stored in the tariff (and the contract) as
`$Parameters$Hooks$Rounding` and the methods of the `InsuranceTarif` make use
of it in all places where rounding can typicall happen.
Each place where a number/vector/matrix is rounded in the package uses a separate
ID, which can and must be used to adjust the rounding behavior at that position.
If no rounding setting is set, no rounding occurs and no accuracy is lost.
An easy example of how rounding works is:
```{r RoundingHelper}
# Define three different rounding IDs / instances: "raw" with rounding to
# the nearest integer, "hundred" with rounding to the nearest multiple of
# 100 and "accurate" rounded to the nearest multiple of 0.0001:
rounding = RoundingHelper$new(raw = 0, hundred = -2, accurate = 4)
# The rounding IDs are used as first argument in the rounding$round function:
rounding$round("raw", c(1234.567891, 0.00012345, 1234))
rounding$round("hundred", c(1234.567891, 0.00012345, 1234))
rounding$round("accurate", c(1234.567891, 0.00012345, 1234))
# If the given spec does not exist, no rounding it applied
rounding$round("non-existing", c(1234.567891, 0.00012345, 1234))
# Add a new spec with different settings:
rounding$setRounding("non-existing", 1)
rounding$round("non-existing", c(1234.567891, 0.00012345, 1234))
```
The `InsuranceTarif` class makes heavy use of these rounding settings. For
example, to round the gross premium to Euros and the net premium to cent,
one can use the setting `Rounding = list("Premium gross" = 0, "Premium net" = 2)`:
```{r RoundingHelper.Contract}
Tarif.EndowmentSI = InsuranceTarif$new(
type = "pureendowment",
tarif = "Endow1",
age = 40, policyPeriod = 20,
premiumRefund = 1,
mortalityTable = mort.AT.census.2011.unisex,
cost = initializeCosts(alpha = 0.04, gamma.contract = 0.0005),
i = 0.03,
sumInsured = 10000,
contractClosing = as.Date("2020-09-01")
)
Tarif.EndowmentSI.rounded = Tarif.EndowmentSI$createModification(
Rounding = list("Premium gross unit" = 3, "Premium net unit" = 6, "Premium net" = 2)
)
Contract.sumInsured = InsuranceContract$new(tarif = Tarif.EndowmentSI)
Contract.sumInsured.rounded = InsuranceContract$new(tarif = Tarif.EndowmentSI.rounded)
# premiums of the original tariff:
Contract.sumInsured$Values$premiums[c("unit.net", "-1et", "unit.gross", "gross")]
```
This rounding is applied immediately when the corresponding entity is calculated.
As a consequence, all further calculations depending on the entity will also be
affected. This means that e.g. rounding only the gross premium will also have a
slight effect on the net premium with contracts that grant premium refunds in
case of death, as the example above shows.
Here is a list of all rounding IDs used throughout the InsuranceTarif class.
Each of them can be used to adjust rounding just one particular value/vector:
```{r eval=TRUE,echo=FALSE,result='asis'}
src = list.files(path = here::here("R"), pattern = ".R$", full.names = TRUE)
filecontents = purrr::map(src, readLines) %>% unlist %>% as.vector
results = stringr::str_extract(filecontents, "\\$round\\(\"([^\"]*)\"", group = 1)
results = results[!is.na(results)]
results = results[!(results %in% c("raw", "hundred", "accurate", "non-existing"))] %>% sort
cat(paste('-', results), sep = '\n')
```
# Creating premium and contract grids
When developing a new product or comparing different products, it is often
......