Feature #64: Implement cost Waivers

-) Add costWaiver and minCosts params to define base costs (per tariff) and the percentage of the waiver (per contract)
-) Add helper function costs.baseAlpha to define a base alpha cost while leaving all other cost items unwaivable

Implements the code-parts of issue #64

NAMESPACE

@@ -54,6 +54,8 @@ export(ProfitParticipation)
 export(applyHook)
 export(contractGrid)
 export(contractGridPremium)
+export(costs.baseAlpha)
+export(costsDisplayTable)
 export(deathBenefit.annuityDecreasing)
 export(deathBenefit.linearDecreasing)
 export(exportInsuranceContract.xlsx)

R/InsuranceContract.R

@@ -909,7 +909,7 @@ InsuranceContract = R6Class(
             #### #
             # COSTS PARAMETERS: can be a function => evaluate it to get the real costs
             #### #
-            self$Parameters$Costs = private$evaluateCosts(self$Parameters$Costs)
+            self$Parameters$Costs = private$evaluateCosts()
 
             #### #
             # AGES for multiple joint lives:
@@ -953,8 +953,8 @@ InsuranceContract = R6Class(
             invisible(self)
         },
 
-        evaluateCosts = function(costs) {
-            self$tarif$getCostValues(costs, params = self$Parameters)
+        evaluateCosts = function() {
+            self$tarif$getCostValues(params = self$Parameters)
         },
 
         determineInternalValues = function(...) {

R/InsuranceParameters.R

@@ -142,6 +142,41 @@ initializeCosts = function(costs, alpha, Zillmer, beta, gamma, gamma.paidUp, gam
     costs
 }
 
+#' Helper function to define base costs with base alpha, but otherwise unchanged costs
+#'
+#' Returns a function that sets base alpha (and Zillmer) costs to the given value,
+#' but otherwise uses the full costs defined by the Costs parameter.
+#'
+#' This function can be set as minCosts parameter for a tariff and makes sure
+#' that only alpha costs are modified / waived, but no other costs.
+#'
+#' @param alpha The minimum alpha / Zillmer cost that cannot be waived
+#'
+#' @export
+costs.baseAlpha = function(alpha) {
+  function(params, values, costs) {
+    costs = setCost(costs, "alpha", "SumPremiums", "once", alpha)
+    if (costs["Zillmer", "SumPremiums", "once"] != 0) {
+      costs = setCost(costs, "Zillmer", "SumPremiums", "once", alpha)
+    }
+    costs
+  }
+}
+
+
+#' Helper function to display all cost definitions in a concise table
+#'
+#' Returns a data.frame with columns
+#'
+#' @export
+costsDisplayTable = function(costs) {
+  costtable = as.data.frame.table(setInsuranceValuesLabels(costs) )
+  colnames(costtable) = c("Kostenart", "Basis", "Periode", "Kostensatz");
+  costtable[costtable[,"Kostensatz"] != 0.0000,]
+}
+
+
+
 
 #' Data structure (filled only with NULL) for insurance contract class member values.
 #' @export
@@ -186,7 +221,7 @@ InsuranceContract.Values = list(
 #'     \item \code{$ActuarialBases} ... Actuarial bases for the contract
 #'               calculation (mortality/invalidity table, guaranteed interest,
 #'               surrender penalty, etc.)
-#'     \item \code{$Costs} ... Expenses charged to the contract (see [initializeCosts()])
+#'     \item \code{$Costs}, \code{$minCosts} ... Expenses charged to the contract (see [initializeCosts()])
 #'     \item \code{$Loadings} ... Loadings, rebates and other charges of the
 #'               tariff / contract (tax, unit costs, surcharge for no medial exam, premium/benefit frequency loading)
 #'     \item \code{$Features} ... Peculiarities of the tariff (to enable
@@ -276,6 +311,12 @@ 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{$costWaiver}}{The fraction of the costs that are waived (only
+#'               those cost components that are defined to be waivable, i.e. by
+#'               defining a corresponding \code{$minCosts}). Linearly interpolates
+#'               between \code{$Costs} and \code{$minCosts}, if the latter is set.
+#'               Otherwise is has no effect.}
 #' }
 #'
 #' ## Elements of sublist \code{InsuranceContract.ParameterDefault$ContractState}
@@ -343,6 +384,17 @@ InsuranceContract.Values = list(
 #'
 #' Definition of contractual costs charged to the contract. See [initializeCosts()].
 #'
+#' \describe{
+#'     \item{\code{$Costs}}{The full cost defined for the contract / tariff,
+#'               usually set with [initializeCosts()] and [setCost()]}
+#'     \item{\code{$minCosts}}{The minimum costs defined for the contract / tariff
+#'               that cannot be waived. Either an explicit cost definition structure
+#'               generated by [initializeCosts()] and [setCost()], or a
+#'               `function(params, values, costs)`, where the full costs are passed
+#'               as third parameter, so the function can modify only those cost parts
+#'               that can be waived at all. }
+#' }
+#'
 #' ## Elements of sublist \code{InsuranceContract.ParameterDefault$Loadings}
 #'
 #' \describe{
@@ -466,7 +518,9 @@ InsuranceContract.ParameterDefaults = list(
         premiumRefund = 0,                      # Proportion of premiums refunded on death (including additional risk, e.g. 1.10 = 110% of paid premiums)
         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 set to a function(len, params, values), e.g. deathBenefit = deathBenefit.linearDecreasing
+        deathBenefit = 1,                        # The yearly relative death benefit (relative to the initial sum insured); Can be set to a function(len, params, values), e.g. deathBenefit = deathBenefit.linearDecreasing
+
+        costWaiver = 0                          # The cost waiver (up to minCosts, 0=no cost waiver, 1=full cost waiver down to minCosts)
     ),
     ContractState = list(
         premiumWaiver = FALSE,                  # contract is paid-up
@@ -488,6 +542,7 @@ InsuranceContract.ParameterDefaults = list(
         benefitFrequencyOrder = 0
     ),
     Costs = initializeCosts(),
+    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
@@ -567,7 +622,7 @@ InsuranceContract.ParameterStructure$Loadings["premiumFrequencyLoading"] = list(
 #'                  initial parameters provided in \code{params}.
 #'
 #' @export
-InsuranceContract.ParametersFill = function(params = InsuranceContract.ParameterStructure, costs = NULL, ...) {
+InsuranceContract.ParametersFill = function(params = InsuranceContract.ParameterStructure, costs = NULL, minCosts = NULL, ...) {
     # params = InsuranceContract.ParameterStructure;
     params$ContractData = fillFields(params$ContractData, list(...));
     params$ContractState = fillFields(params$ContractState, list(...));
@@ -580,6 +635,7 @@ InsuranceContract.ParametersFill = function(params = InsuranceContract.Parameter
     # Costs are a special case, because they are an array rather than a list:
     # TODO: Find a way to partially override
     if (!missing(costs)) params$Costs = costs;
+    if (!missing(minCosts)) params$minCosts = minCosts;
     params
 }
 
@@ -618,6 +674,9 @@ InsuranceContract.ParametersFallback = function(params, fallback, ppParameters =
             params$Costs = fallback$Costs;
         }
     }
+    if (is.null(params$minCosts)) {
+      params$minCosts = fallback$minCosts;
+    }
     params
 }
 

R/InsuranceTarif.R

@@ -351,11 +351,21 @@ InsuranceTarif = R6Class(
     #' an array of the required dimensions. This function makes sures that the
     #' latter function is actually evaluated.
     #'
-    #' @param costs The cost parameter passed to the tarif definition or the
-    #' contract (either an array of the form returned by [initializeCosts()] or
-    #' a function(params, values) returning such an array)
-    getCostValues = function(costs, params) {
-        valueOrFunction(costs, params = params, values = NULL)
+    #' @param params The parameters of the contract / tariff
+    getCostValues = function(params) {
+      costs = valueOrFunction(params$Costs, params = params, values = NULL)
+      baseCost = valueOrFunction(params$minCosts, params = params, values = NULL, costs = costs)
+      if (!is.null(baseCost)) {
+        costWaiver = valueOrFunction(params$ContractData$costWaiver, params = params, values = NULL, costs = costs, minCosts = baseCost)
+        if (is.numeric(costWaiver)) {
+          costs = costs * (1 - costWaiver) + baseCost * costWaiver
+        } else if (is.boolean(costWaiver)) {
+          if (isTRUE(costWaiver)) {
+            costs = baseCost
+          }
+        }
+      }
+      costs
     },
 
     #' @description Returns the unit premium cash flow for the whole contract period.

R/exportInsuranceContract_xlsx.R

@@ -295,10 +295,10 @@ costValuesAsDF = function(costValues) {
 exportLoadingsTable = function(wb, sheet, contract, crow, ccol, styles = styles, seprows = 3, tariffs.handled = c()) {
   tarifname = contract$tarif$tarif
   if (!(tarifname %in% tariffs.handled)) {
-    # TODO: Detect cost structures overridden at contract-level! => Currently only the default tariff costs are printed!
-    costtable = as.data.frame.table(setInsuranceValuesLabels(contract$Parameters$Costs) )
-    colnames(costtable) = c("Kostenart", "Basis", "Periode", "Kostensatz");
-    costtable = costtable[costtable[,"Kostensatz"] != 0.0000,]
+    costtable = costsDisplayTable(contract$Parameters$Costs)
+    # costtable = as.data.frame.table(setInsuranceValuesLabels(contract$Parameters$Costs) )
+    # colnames(costtable) = c("Kostenart", "Basis", "Periode", "Kostensatz");
+    # costtable = costtable[costtable[,"Kostensatz"] != 0.0000,]
     cap = sprintf("Kosten (Tarif %s)", tarifname)
     writeValuesTable(wb, sheet, costtable, crow = crow, ccol = 1, tableName = tableName("Kosten_", tarifname), styles = styles, caption = cap);
     # writeDataTable(wb, sheet, costtable, startCol = 1, startRow = crow + 1, colNames = TRUE, rowNames = FALSE,

man/InsuranceContract.ParameterDefaults.Rd

@@ -18,7 +18,7 @@ penalty already applied, alpha costs already (partially) refunded)
 \item \code{$ActuarialBases} ... Actuarial bases for the contract
 calculation (mortality/invalidity table, guaranteed interest,
 surrender penalty, etc.)
-\item \code{$Costs} ... Expenses charged to the contract (see \code{\link[=initializeCosts]{initializeCosts()}})
+\item \code{$Costs}, \code{$minCosts} ... Expenses charged to the contract (see \code{\link[=initializeCosts]{initializeCosts()}})
 \item \code{$Loadings} ... Loadings, rebates and other charges of the
 tariff / contract (tax, unit costs, surcharge for no medial exam, premium/benefit frequency loading)
 \item \code{$Features} ... Peculiarities of the tariff (to enable
@@ -107,6 +107,12 @@ 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{$costWaiver}}{The fraction of the costs that are waived (only
+those cost components that are defined to be waivable, i.e. by
+defining a corresponding \code{$minCosts}). Linearly interpolates
+between \code{$Costs} and \code{$minCosts}, if the latter is set.
+Otherwise is has no effect.}
 }
 }
 
@@ -175,6 +181,17 @@ used => then leave this at 0)}
 \subsection{Elements of sublist \code{InsuranceContract.ParameterDefault$Costs}}{
 
 Definition of contractual costs charged to the contract. See \code{\link[=initializeCosts]{initializeCosts()}}.
+
+\describe{
+\item{\code{$Costs}}{The full cost defined for the contract / tariff,
+usually set with \code{\link[=initializeCosts]{initializeCosts()}} and \code{\link[=setCost]{setCost()}}}
+\item{\code{$minCosts}}{The minimum costs defined for the contract / tariff
+that cannot be waived. Either an explicit cost definition structure
+generated by \code{\link[=initializeCosts]{initializeCosts()}} and \code{\link[=setCost]{setCost()}}, or a
+\verb{function(params, values, costs)}, where the full costs are passed
+as third parameter, so the function can modify only those cost parts
+that can be waived at all. }
+}
 }
 
 \subsection{Elements of sublist \code{InsuranceContract.ParameterDefault$Loadings}}{

man/InsuranceContract.ParameterStructure.Rd

@@ -5,7 +5,7 @@
 \alias{InsuranceContract.ParameterStructure}
 \title{Full insurance contract parameter structure.}
 \format{
-An object of class \code{list} of length 8.
+An object of class \code{list} of length 9.
 }
 \usage{
 InsuranceContract.ParameterStructure

man/InsuranceContract.ParametersFill.Rd

@@ -7,6 +7,7 @@
 InsuranceContract.ParametersFill(
   params = InsuranceContract.ParameterStructure,
   costs = NULL,
+  minCosts = NULL,
   ...
 )
 }

man/InsuranceTarif.Rd

@@ -408,19 +408,13 @@ Not to be called directly, but implicitly by the \link{InsuranceContract} object
 Obtain the cost structure from the cost parameter and the
 given paremeter set
 \subsection{Usage}{
-\if{html}{\out{<div class="r">}}\preformatted{InsuranceTarif$getCostValues(costs, params)}\if{html}{\out{</div>}}
+\if{html}{\out{<div class="r">}}\preformatted{InsuranceTarif$getCostValues(params)}\if{html}{\out{</div>}}
 }
 
 \subsection{Arguments}{
 \if{html}{\out{<div class="arguments">}}
 \describe{
-\item{\code{costs}}{The cost parameter passed to the tarif definition or the
-contract (either an array of the form returned by \code{\link[=initializeCosts]{initializeCosts()}} or
-a function(params, values) returning such an array)}
-
-\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{params}}{The parameters of the contract / tariff}
 }
 \if{html}{\out{</div>}}
 }

man/costs.baseAlpha.Rd

+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/InsuranceParameters.R
+\name{costs.baseAlpha}
+\alias{costs.baseAlpha}
+\title{Helper function to define base costs with base alpha, but otherwise unchanged costs}
+\usage{
+costs.baseAlpha(alpha)
+}
+\arguments{
+\item{alpha}{The minimum alpha / Zillmer cost that cannot be waived}
+}
+\description{
+Returns a function that sets base alpha (and Zillmer) costs to the given value,
+but otherwise uses the full costs defined by the Costs parameter.
+}
+\details{
+This function can be set as minCosts parameter for a tariff and makes sure
+that only alpha costs are modified / waived, but no other costs.
+}

man/costsDisplayTable.Rd

+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/InsuranceParameters.R
+\name{costsDisplayTable}
+\alias{costsDisplayTable}
+\title{Helper function to display all cost definitions in a concise table}
+\usage{
+costsDisplayTable(costs)
+}
+\description{
+Returns a data.frame with columns
+}