Allow (premium|benefit)FrequencyLoading to be a function or a fixed value; set...

Allow (premium|benefit)FrequencyLoading to be a function or a fixed value; set premiumFrequencyOrder to -1 if loading is given

The (premium|benefit)FrequencyLoading parameters are evaluated using a new function evaluateFrequencyLoading, which handles functions, named lists, and fixed values.

Also, set premiumFrequencyOrder automatically to -1 (i.e. no adjustment due to multiple payments per yer) when a loading is given.

R/InsuranceParameters.R

@@ -548,8 +548,8 @@ InsuranceContract.ParameterDefaults = list(
         surrenderValueCalculation = NULL,       # By default no surrender penalties
         premiumWaiverValueCalculation = NULL,   # By default, surrender value will be used
 
-        premiumFrequencyOrder = 0,              # Order of the approximation for payments within the year (unless an extra frequency loading is used => then leave this at 0)
-        benefitFrequencyOrder = 0
+        premiumFrequencyOrder = function(params, ...) { if (is.null(params$Loadings$premiumFrequencyLoading)) 0 else -1}, # Order of the approximation for payments within the year (unless an extra frequency loading is used => then leave this at 0)
+        benefitFrequencyOrder = function(params, ...) { if (is.null(params$Loadings$benefitFrequencyLoading)) 0 else -1}
     ),
     Costs = initializeCosts(),
     minCosts = NULL,               # Base costs, which cannot be waived
@@ -565,8 +565,8 @@ InsuranceContract.ParameterDefaults = list(
         premiumRebate = 0,                      # gross premium reduction for large premiums, % of gross premium # TODO
         partnerRebate = 0,                      # Partner rabate on premium (including loading and other rebates) if more than one similar contract is concluded
         extraChargeGrossPremium = 0,            # extra charges on gross premium (smoker, leisure activities, BMI too high, etc.)
-        benefitFrequencyLoading = list("1" = 0.0, "2" = 0.0, "4" = 0.0, "12" = 0.0), # TODO: Properly implement this as a function
-        premiumFrequencyLoading = list("1" = 0.0, "2" = 0.0, "4" = 0.0, "12" = 0.0), # TODO: Properly implement this as a function
+        benefitFrequencyLoading = NULL, # TODO: Properly implement this as a function
+        premiumFrequencyLoading = NULL, # TODO: Properly implement this as a function
         alphaRefundPeriod = 5                   # How long acquisition costs should be refunded in case of surrender
     ),
     Features = list(                            # Special cases for the calculations

R/InsuranceTarif.R

@@ -665,12 +665,12 @@ InsuranceTarif = R6Class(
 
       i = params$ActuarialBases$i;
       v = 1/(1 + i);
-      benefitFreqCorr = correctionPaymentFrequency(i = i,
-                                                   m = params$ContractData$benefitFrequency,
-                                                   order = params$ActuarialBases$benefitFrequencyOrder);
-      premiumFreqCorr = correctionPaymentFrequency(i = i,
-                                                   m = params$ContractData$premiumFrequency,
-                                                   order = params$ActuarialBases$premiumFrequencyOrder);
+            benefitFreqCorr = correctionPaymentFrequency(
+              i = i, m = params$ContractData$benefitFrequency,
+              order = valueOrFunction(params$ActuarialBases$benefitFrequencyOrder, params = params, values = values));
+            premiumFreqCorr = correctionPaymentFrequency(
+              i = i, m = params$ContractData$premiumFrequency,
+              order = valueOrFunction(params$ActuarialBases$premiumFrequencyOrder, params = params, values = values));
 
       pvRefund = calculatePVDeath(px, qx, values$cashFlows$death_GrossPremium, v = v);
       pvRefundPast = calculatePVDeath(
@@ -1011,14 +1011,14 @@ InsuranceTarif = R6Class(
       values$premiums[["unitcost"]] = premium.unitcosts;
 
 
-      frequencyLoading = valueOrFunction(loadings$premiumFrequencyLoading, params = params, values = values);
+            frequencyLoading = self$evaluateFrequencyLoading(loadings$premiumFrequencyLoading, params$ContractData$premiumFrequency, params = params, values = values)
       premiumBeforeTax = (values$premiums[["unit.gross"]]*(1 + noMedicalExam.relative + extraChargeGrossPremium) + noMedicalExam - sumRebate - extraRebate) * sumInsured * (1 - advanceProfitParticipation);
       if (params$Features$unitcostsInGross) {
         premiumBeforeTax = premiumBeforeTax + premium.unitcosts;
       }
       premiumBeforeTax = premiumBeforeTax * (1 - premiumRebate - advanceProfitParticipationUnitCosts - partnerRebate);
       # TODO / FIXME: Add a check that frequencyLoading has an entry for the premiumFrequency -> Otherwise do not add any loading (currently NULL is returned, basically setting all premiums to NULL)
-      premiumBeforeTax.y = premiumBeforeTax * (1 + frequencyLoading[[toString(params$ContractData$premiumFrequency)]]);
+            premiumBeforeTax.y = premiumBeforeTax * (1 + frequencyLoading);
       premiumBeforeTax = premiumBeforeTax.y / params$ContractData$premiumFrequency;
       values$premiums[["written_yearly"]] = premiumBeforeTax.y * (1 + tax)
       values$premiums[["written_beforetax"]] = premiumBeforeTax;
@@ -1352,9 +1352,9 @@ InsuranceTarif = R6Class(
       afterRebates     = afterProfit + rebate.premium + rebate.partner;
 
       # premium frequency loading
-      frequencyLoading = valueOrFunction(params$Loadings$premiumFrequencyLoading, params = params, values = values);
+            frequencyLoading = self$evaluateFrequencyLoading(loadings$premiumFrequencyLoading, params$ContractData$premiumFrequency, params = params, values = values)
 
-      afterFrequency   = afterRebates * (1 + frequencyLoading[[toString(params$ContractData$premiumFrequency)]]);
+            afterFrequency   = afterRebates * (1 + frequencyLoading);
       charge.frequency = afterFrequency - afterRebates;
 
       # insurance tax
@@ -1481,6 +1481,29 @@ InsuranceTarif = R6Class(
       apply(values, 2, pv)
     },
 
+        #' @description Calculate the premium frequency loading, i.e. the surcharge
+        #' on the premium for those cases where the premium is not paid yearly.
+        #' Return values can be either a numeric value or a named list with all
+        #' possible premium frequencies as keys.
+        #' @param loading The premiumFrequencyLoading parameter of the Contract or Tariff to be evaluated
+        #' @param frequency The premiumFrequency parameter of the contract
+        evaluateFrequencyLoading = function(loading, frequency, params, values) {
+            frequencyLoading = valueOrFunction(loading, frequency = frequency, params = params, values = values);
+            if (is.null(frequencyLoading)) {
+              0
+            } else if (is.list(frequencyLoading)) {
+                if (as.character(frequency) %in% names(frequencyLoading)) {
+                    frequencyLoading[[as.character(frequency)]]
+                } else {
+                    warning("Unable to handle premium frequency ", frequency, " with the given loading ", frequencyLoading);
+                }
+            } else if (is.numeric(frequencyLoading)) {
+                frequencyLoading
+            } else {
+                warning("premiumFrequencyLoading must be a number or a named list, given: ", frequencyLoading);
+                0
+            }
+        },
 
 
 

man/InsuranceTarif.Rd

@@ -165,6 +165,7 @@ all fields.}
 \item \href{#method-premiumDecomposition}{\code{InsuranceTarif$premiumDecomposition()}}
 \item \href{#method-calculateFutureSums}{\code{InsuranceTarif$calculateFutureSums()}}
 \item \href{#method-calculatePresentValues}{\code{InsuranceTarif$calculatePresentValues()}}
+\item \href{#method-evaluateFrequencyLoading}{\code{InsuranceTarif$evaluateFrequencyLoading()}}
 \item \href{#method-clone}{\code{InsuranceTarif$clone()}}
 }
 }
@@ -1097,6 +1098,35 @@ scheme and the contract)}
 }
 }
 \if{html}{\out{<hr>}}
+\if{html}{\out{<a id="method-evaluateFrequencyLoading"></a>}}
+\if{latex}{\out{\hypertarget{method-evaluateFrequencyLoading}{}}}
+\subsection{Method \code{evaluateFrequencyLoading()}}{
+Calculate the premium frequency loading, i.e. the surcharge
+on the premium for those cases where the premium is not paid yearly.
+Return values can be either a numeric value or a named list with all
+possible premium frequencies as keys.
+\subsection{Usage}{
+\if{html}{\out{<div class="r">}}\preformatted{InsuranceTarif$evaluateFrequencyLoading(loading, frequency, params, values)}\if{html}{\out{</div>}}
+}
+
+\subsection{Arguments}{
+\if{html}{\out{<div class="arguments">}}
+\describe{
+\item{\code{loading}}{The premiumFrequencyLoading parameter of the Contract or Tariff to be evaluated}
+
+\item{\code{frequency}}{The premiumFrequency parameter of the contract}
+
+\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>}}
+}
+}
+\if{html}{\out{<hr>}}
 \if{html}{\out{<a id="method-clone"></a>}}
 \if{latex}{\out{\hypertarget{method-clone}{}}}
 \subsection{Method \code{clone()}}{