From 69df59494f380ab57f36dc540acd84b7ab272c17 Mon Sep 17 00:00:00 2001
From: Reinhold Kainhofer <reinhold@kainhofer.com>
Date: Sat, 11 Feb 2023 22:50:41 +0100
Subject: [PATCH] Implement premiumRefundPeriod
For deferred contracts, by default the premium refund only applies during the deferral period, for all other contracts during the whole contract. This can be overwritten with the premiumRefundPeriod parameter (implemented as a function premiumRefundPeriod.default).
Fixes #86
---
NAMESPACE | 1 +
R/HelperFunctions.R | 20 +++++++-
R/InsuranceContract.R | 9 ++++
R/InsuranceParameters.R | 6 +++
R/InsuranceTarif.R | 6 +--
man/InsuranceContract.ParameterDefaults.Rd | 5 ++
man/premiumRefundPeriod.default.Rd | 19 ++++++++
tests/testthat/test-CF-Annuity-Deferred.R | 6 +--
tests/testthat/test-premiumRefundPeriod.R | 55 ++++++++++++++++++++++
9 files changed, 119 insertions(+), 8 deletions(-)
create mode 100644 man/premiumRefundPeriod.default.Rd
create mode 100644 tests/testthat/test-premiumRefundPeriod.R
diff --git a/NAMESPACE b/NAMESPACE
index 2a20d65..1588dbf 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -82,6 +82,7 @@ export(makeContractGridDimname)
export(makeContractGridDimnames)
export(pad0)
export(padLast)
+export(premiumRefundPeriod.default)
export(rollingmean)
export(setCost)
export(showVmGlgExamples)
diff --git a/R/HelperFunctions.R b/R/HelperFunctions.R
index ef96a53..8c84b0e 100644
--- a/R/HelperFunctions.R
+++ b/R/HelperFunctions.R
@@ -144,8 +144,24 @@ isRegularPremiumContract = function(params, values) { params$ContractData$premiu
#'
#' @export
deathBenefit.linearDecreasing = function(len, params, values) {
- protectionPeriod = params$ContractData$policyPeriod - params$ContractData$deferralPeriod;
- pad0((protectionPeriod:0) / protectionPeriod, l = len)
+ protectionPeriod = params$ContractData$policyPeriod - params$ContractData$deferralPeriod;
+ pad0((protectionPeriod:0) / protectionPeriod, l = len)
+}
+
+
+#' Default premium refund period: for deferred contracts the deferral period, otherwise the whole contract
+#'
+#' If a premium refund is set for the tariff, the default is the full contract
+#' period, except for deferred contracts (typically deferred life annuities),
+#' for which the deferral period is the refund period.
+#'
+#' @param params The full parameter set of the insurance contract (including
+#' all inherited values from the tariff and the profit participation)
+#' @param values The values calculated from the insurance contract so far
+#'
+#' @export
+premiumRefundPeriod.default = function(params, values) {
+ ifelse(params$ContractData$deferralPeriod > 0, params$ContractData$deferralPeriod, params$ContractData$policyPeriod)
}
diff --git a/R/InsuranceContract.R b/R/InsuranceContract.R
index 1579491..33e1e65 100644
--- a/R/InsuranceContract.R
+++ b/R/InsuranceContract.R
@@ -1062,6 +1062,10 @@ InsuranceContract = R6Class(
self$Parameters$ContractData$policyPeriod,
params = self$Parameters, values = self$Values);
+ self$Parameters$ContractData$guaranteedPeriod = valueOrFunction(
+ self$Parameters$ContractData$guaranteedPeriod,
+ params = self$Parameters, values = self$Values);
+
#### #
# PREMIUM PAYMENT PERIOD (default: policyPeriod, can be given as function or numeric value)
#### #
@@ -1098,6 +1102,11 @@ InsuranceContract = R6Class(
self$Parameters$ContractData$policyPeriod
)
+ # Premium refund period (if applicable):
+ self$Parameters$ContractData$premiumRefundPeriod = valueOrFunction(
+ self$Parameters$ContractData$premiumRefundPeriod,
+ params = self$Parameters, values = self$Values);
+
#### #
# AGES for multiple joint lives:
#### #
diff --git a/R/InsuranceParameters.R b/R/InsuranceParameters.R
index cd44b44..bdacecd 100644
--- a/R/InsuranceParameters.R
+++ b/R/InsuranceParameters.R
@@ -334,6 +334,11 @@ InsuranceContract.Values = list(
#' \item{\code{$benefitFrequency}}{Number of benefit payments per year, default is 1.}
#' \item{\code{$premiumRefund}}{Proportion of (gross) premiums refunded on
#' death (including additional risk, e.g. 1.10 = 110% of paid premiums)}
+#' \item{\code{$premiumRefundPeriod}}{The period, during which the premium
+#' refund on death applies. By default, deferred contracts will
+#' refund premiums only during the deferral period, all other
+#' contracts during the whole contract. Default is
+#' \code{premiumRefundPeriod.default}}
#' \item{\code{$premiumIncrease}}{The yearly growth factor of the premium,
#' i.e. 1.05 means +5% increase each year; a vector describes the
#' premiums for all years}
@@ -577,6 +582,7 @@ InsuranceContract.ParameterDefaults = list(
benefitFrequency = 1, # number of benefit payments per year (for annuities) or death benefit at the end of every 1/k-th year
premiumRefund = 0, # Proportion of premiums refunded on death (including additional risk, e.g. 1.10 = 110% of paid premiums)
+ premiumRefundPeriod = premiumRefundPeriod.default, # The time period, during which the premium refund upon death will be paid (default: deferral period, otherwise whole contract)
premiumIncrease = 1, # The yearly growth factor of the premium, i.e. 1.05 means +5% increase each year; a Vector describes the premiums for all years
annuityIncrease = 1, # The yearly growth factor of the annuity payments, i.e. 1.05 means +5% incrase each year; a vector describes the annuity unit payments for all years
deathBenefit = 1, # The yearly relative death benefit (relative to the initial sum insured); Can be fixed, e.g. 0.5 for 50% death cover, or set to a function(len, params, values) like deathBenefit = deathBenefit.linearDecreasing
diff --git a/R/InsuranceTarif.R b/R/InsuranceTarif.R
index 47820b3..010c523 100644
--- a/R/InsuranceTarif.R
+++ b/R/InsuranceTarif.R
@@ -607,7 +607,7 @@ InsuranceTarif = R6Class(
# Death Benefits
cf$death_SumInsured = pad0(values$cashFlowsBasic$death, cflen);
if ((!is.null(params$Features$absPremiumRefund)) && (params$Features$absPremiumRefund > 0)) {
- cf$death_SumInsured = cf$death_SumInsured + pad0(padLast(params$Features$absPremiumRefund, cflen - 1), cflen);
+ cf$death_SumInsured = cf$death_SumInsured + pad0(padLast(params$Features$absPremiumRefund, min(cflen - 1, params$ContractData$premiumRefundPeriod)), cflen);
}
cf$disease_SumInsured = pad0(values$cashFlowsBasic$disease, cflen);
cf$death_PremiumFree = cf$death_SumInsured;
@@ -615,8 +615,8 @@ InsuranceTarif = R6Class(
if (params$ContractData$premiumRefund != 0) {
totalpremiumcf = cf$premiums_advance + pad0(c(0, cf$premiums_arrears), cflen);
- # death benefit for premium refund is the sum of all premiums so far:
- cf$death_GrossPremium = pad0(Reduce("+", totalpremiumcf[0:params$ContractData$policyPeriod], accumulate = TRUE), cflen)
+ # death benefit for premium refund is the sum of all premiums so far, but only during the premium refund period, afterwards it's 0:
+ cf$death_GrossPremium = pad0(pad0(Reduce("+", totalpremiumcf[0:params$ContractData$policyPeriod], accumulate = TRUE), params$ContractData$premiumRefundPeriod), cflen)
cf$death_Refund_past = cf$death_GrossPremium
cf$death_Refund_past[(cf$death_GrossPremium > 0)] = 1;
}
diff --git a/man/InsuranceContract.ParameterDefaults.Rd b/man/InsuranceContract.ParameterDefaults.Rd
index 5c8ad7a..ac7bfb5 100644
--- a/man/InsuranceContract.ParameterDefaults.Rd
+++ b/man/InsuranceContract.ParameterDefaults.Rd
@@ -94,6 +94,11 @@ are paid in advance (default) or arrears. Value is of type
\item{\code{$benefitFrequency}}{Number of benefit payments per year, default is 1.}
\item{\code{$premiumRefund}}{Proportion of (gross) premiums refunded on
death (including additional risk, e.g. 1.10 = 110\% of paid premiums)}
+\item{\code{$premiumRefundPeriod}}{The period, during which the premium
+refund on death applies. By default, deferred contracts will
+refund premiums only during the deferral period, all other
+contracts during the whole contract. Default is
+\code{premiumRefundPeriod.default}}
\item{\code{$premiumIncrease}}{The yearly growth factor of the premium,
i.e. 1.05 means +5\% increase each year; a vector describes the
premiums for all years}
diff --git a/man/premiumRefundPeriod.default.Rd b/man/premiumRefundPeriod.default.Rd
new file mode 100644
index 0000000..6b04c52
--- /dev/null
+++ b/man/premiumRefundPeriod.default.Rd
@@ -0,0 +1,19 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/HelperFunctions.R
+\name{premiumRefundPeriod.default}
+\alias{premiumRefundPeriod.default}
+\title{Default premium refund period: for deferred contracts the deferral period, otherwise the whole contract}
+\usage{
+premiumRefundPeriod.default(params, values)
+}
+\arguments{
+\item{params}{The full parameter set of the insurance contract (including
+all inherited values from the tariff and the profit participation)}
+
+\item{values}{The values calculated from the insurance contract so far}
+}
+\description{
+If a premium refund is set for the tariff, the default is the full contract
+period, except for deferred contracts (typically deferred life annuities),
+for which the deferral period is the refund period.
+}
diff --git a/tests/testthat/test-CF-Annuity-Deferred.R b/tests/testthat/test-CF-Annuity-Deferred.R
index bfc70ac..7afdbec 100644
--- a/tests/testthat/test-CF-Annuity-Deferred.R
+++ b/tests/testthat/test-CF-Annuity-Deferred.R
@@ -28,14 +28,14 @@ test_that("Deferred Annuity Cash Flows", {
expect_equal(Contract.DefAnnuity$Parameters$ContractData$premiumPeriod, 25)
- expect_true(all(Contract.DefAnnuity$Values$cashFlows %>% select(-premiums_advance, -survival_advance, -death_GrossPremium, -death_Refund_past) == 0))
+ expect_true(all(Contract.DefAnnuity$Values$cashFlows %>% dplyr::select(-premiums_advance, -survival_advance, -death_GrossPremium, -death_Refund_past) == 0))
# 25 years premium cash flow
expect_equal(Contract.DefAnnuity$Values$cashFlows$premiums_advance, c(rep(1, 25), rep(0, 56)))
# premium payment start after 25 years
expect_equal(Contract.DefAnnuity$Values$cashFlows$survival_advance, c(rep(0, 25), rep(1, 55),0))
# premium payment start after 25 years
- expect_equal(Contract.DefAnnuity$Values$cashFlows$death_GrossPremium, c(1:25, rep(25, 55),0))
+ expect_equal(Contract.DefAnnuity$Values$cashFlows$death_GrossPremium, c(1:25, rep(0, 56)))
# death refund flag
- expect_equal(Contract.DefAnnuity$Values$cashFlows$death_Refund_past, c(rep(1, 80), 0))
+ expect_equal(Contract.DefAnnuity$Values$cashFlows$death_Refund_past, c(rep(1, 25), rep(0, 56)))
})
diff --git a/tests/testthat/test-premiumRefundPeriod.R b/tests/testthat/test-premiumRefundPeriod.R
new file mode 100644
index 0000000..40bb1fe
--- /dev/null
+++ b/tests/testthat/test-premiumRefundPeriod.R
@@ -0,0 +1,55 @@
+test_that("premiumRefundPeriod", {
+ library(MortalityTables)
+ mortalityTables.load("Austria_Annuities_AVOe2005R")
+
+ #--------------------------------------------------------------------------- -
+ # For deferred contracts, premium refund applies during deferral only by default
+ #--------------------------------------------------------------------------- -
+ Tarif.DefAnnuity = InsuranceTarif$new(
+ type = "annuity",
+
+ policyPeriod = function(params, values) { 120 - params$ContractData$age},
+ deferralPeriod = function(params, values) { 65 - params$ContractData$age},
+ premiumPeriod = function(params, values) { 65 - params$ContractData$age},
+ premiumRefund = 1,
+ mortalityTable = AVOe2005R.unisex
+ )
+ Contract.DefAnnuity = InsuranceContract$new(
+ tarif = Tarif.DefAnnuity,
+ age = 40, YOB = 1980,
+ sumInsured = 1200,
+ contractClosing = as.Date("2020-09-01"),
+ calculate = "cashflows"
+ )
+ expect_equal(Contract.DefAnnuity$Parameters$ContractData$policyPeriod, 80)
+ expect_equal(Contract.DefAnnuity$Parameters$ContractData$deferralPeriod, 25)
+ expect_equal(Contract.DefAnnuity$Parameters$ContractData$premiumPeriod, 25)
+ expect_equal(Contract.DefAnnuity$Parameters$ContractData$premiumRefundPeriod, 25)
+
+ # premium refund only during the frist 25 years (linearly increasing), then 0
+ expect_equal(Contract.DefAnnuity$Values$cashFlows[,"death_GrossPremium"], c(1:25, rep(0, 81-25)))
+ expect_equal(Contract.DefAnnuity$Values$cashFlows[,"death_Refund_past"], c(rep(1, 25), rep(0, 81-25)))
+
+
+
+ #--------------------------------------------------------------------------- -
+ # For all other contracts without deferral period, refund period is whole contract
+ #--------------------------------------------------------------------------- -
+ Tarif.PureEnd = InsuranceTarif$new(
+ type = "pureendowment",
+
+ policyPeriod = 25,
+ premiumRefund = 1,
+ mortalityTable = AVOe2005R.unisex
+ )
+ Contract.PureEnd = InsuranceContract$new(
+ tarif = Tarif.PureEnd,
+ age = 40, YOB = 1980,
+ sumInsured = 10000,
+ contractClosing = as.Date("2020-09-01"),
+ calculate = "cashflows"
+ )
+ # premium refund during the whole contract (25 years), the last year is the survival date without any death benefits
+ expect_equal(Contract.PureEnd$Values$cashFlows[,"death_GrossPremium"], c(1:25, 0))
+ expect_equal(Contract.PureEnd$Values$cashFlows[,"death_Refund_past"], c(rep(1, 25), 0))
+})
--
GitLab