Add age calculation methods; use birthDate param instead of YOB

-) Add parameter birthDate, deprecate YOB instead (but fall back to YOB)
-) Add functions age.exactRounded and age.yearDifference for the two most common age calculation methods (nearest birthday at contract closing or difference of calendar years)

NAMESPACE

@@ -51,6 +51,8 @@ export(PP.rate.terminalBonusFund)
 export(PP.rate.totalInterest)
 export(PP.rate.totalInterest2)
 export(ProfitParticipation)
+export(age.exactRounded)
+export(age.yearDifference)
 export(applyHook)
 export(contractGrid)
 export(contractGridPremium)

R/HelperFunctions.R

@@ -182,6 +182,32 @@ deathBenefit.annuityDecreasing = function(interest) {
   }
 }
 
+
+#' Calculate the age of the insured based on exact age at contract closing, rounded
+#' to the nearest birthday.
+#'
+#' @param params The parameters of the contract.
+#' @param values Unused by default (already calculated values of the contract)
+#'
+#' @export
+age.exactRounded = function(params, values) {
+  round(time_length(
+    interval(params$ContractData$birthDate, params$ContractData$contractClosing),
+  "years"))
+}
+
+#' Calculate the age of the insured based on the difference of the bith year and
+#' contract closing year.
+#'
+#' @param params The parameters of the contract.
+#' @param values Unused by default (already calculated values of the contract)
+#'
+#' @export
+age.yearDifference = function(params, values) {
+  year(params$ContractData$contractClosing) - year(params$ContractData$birthDate)
+}
+
+
 #' Defines a frequency charge (surcharge for monthly/quarterly/semiannual) premium payments #'
 #' Tariffs are typically calculated with yearly premium installments. When
 #' premiums are paid more often then one a year (in advance), the insurance
@@ -648,3 +674,5 @@ sumPaddedArrays = function(arr1 = NULL, arr2 = NULL, pad1 = 0, pad2 = 0) {
 }
 
 
+
+

R/InsuranceContract.R

@@ -884,30 +884,63 @@ InsuranceContract = R6Class(
             args = list(...);
             # TODO-blocks
 
-            # Calculate YOB, age, contract closing etc. from each other
+            if (getOption('LIC.debug.consolidateContractData', FALSE)) {
+                browser();
+            }
+            # YOB is deprecated in favor of birthDate. If it is given, use January 1
+            if (is.null(self$Parameters$ContractData$birthDate) && !is.null(self$Parameters$ContractData$YOB)) {
+                self$Parameters$ContractData$birthDate = make_date(self$Parameters$ContractData$YOB, 1, 1)
+            }
+
+            # Calculate date/year of birth, age, contract closing etc. from each other
             # 1. Contract date (if not given) is NOW, unless age + YOB is given => Then year is derived as YOB+age
             if (is.null(self$Parameters$ContractData$contractClosing)) {
-                if (!is.null(self$Parameters$ContractData$age) && !is.null(self$Parameters$ContractData$YOB)) {
-                    # Use current day, but determine year from YOB and age
-                    self$Parameters$ContractData$contractClosing = Sys.Date() %>%
-                        'year<-'(self$Parameters$ContractData$YOB + self$Parameters$ContractData$age);
+                # Default is contractClosing is NOW:
+                self$Parameters$ContractData$contractClosing = Sys.Date()
+
+                # However, if age and DOB / YOB is given, calculate contract closing from that:
+                # age is given (and not a function that calculates age from DOB and Contract closing)
+                if (!is.null(self$Parameters$ContractData$age) &&
+                    !is.function(self$Parameters$ContractData$age)
+                ) {
+                    if (!is.null(self$Parameters$ContractData$birthDate)) {
+                        ag = self$Parameters$ContractData$age
+                        # Whole years are added as period (so the day stays the same), remaining fractions are added as dyears
+                        self$Parameters$ContractData$contractClosing = as.Date(self$Parameters$ContractData$birthDate +
+                            years(floor(self$Parameters$ContractData$age)) +
+                            dyears(self$Parameters$ContractData$age %% 1))
+                        # TODO: Always start at the nearest beginning of a month? Or leave the contract closing at any day?
+                    }
                 }
             }
 
-            # 2. Current age: If YOB is given, calculate from contract closing and YOB, otherwise assume 40
-            if (is.null(self$Parameters$ContractData$age)) {
-                if (is.null(self$Parameters$ContractData$YOB)) {
-                    self$Parameters$ContractData$age = 40; # No information to derive age => Assume 40
-                    warning("InsuranceContract: Missing age, no information to derive age from YOB and contractClosing => Assuming default age 40. Tariff: ", self$tarif$name)
+            # 2. Current age: If age is given, use it
+            if (!is.null(self$Parameters$ContractData$age)) {
+                self$Parameters$ContractData$age = valueOrFunction(
+                    self$Parameters$ContractData$age,
+                    params = self$Parameters, values = self$Values);
+            } else {
+            # 3. Otherwise, either use the birth date to calculate the age
+                if (!is.null(self$Parameters$ContractData$birthDate)) {
+                    # TODO: Decide for variant 1 or 2...
+                    # Variant 1: Exact age rounded to the nearest whole number
+                    self$Parameters$ContractData$age = age.exactRounded(self$Parameters, self$Values)
+                    # Variant 2: Year of contract closing - YOB
+                    self$Parameters$ContractData$age = age.yearDifference(self$Parameters, self$Values)
                 } else {
-                    self$Parameters$ContractData$age = year(self$Parameters$ContractData$contractClosing) -
-                        self$Parameters$ContractData$YOB;
+            # 4. Or use age=40 as default
+                    self$Parameters$ContractData$age = 40
+                    warning("InsuranceContract: Missing age, no information to derive age from YOB and contractClosing => Assuming default age 40. Tariff: ", self$tarif$name)
                 }
             }
-            if (is.null(self$Parameters$ContractData$YOB)) {
-                self$Parameters$ContractData$YOB = year(self$Parameters$ContractData$contractClosing) - self$Parameters$ContractData$age;
+            if (is.null(self$Parameters$ContractData$birthDate)) {
+                self$Parameters$ContractData$birthDate = as.Date(self$Parameters$ContractData$contractClosing -
+                    years(floor(self$Parameters$ContractData$age)) -
+                    dyears(self$Parameters$ContractData$age %% 1))
             }
 
+
+
             # Evaluate policy period, i.e. if a function is used, calculate its numeric value
             self$Parameters$ContractData$policyPeriod = valueOrFunction(
                 self$Parameters$ContractData$policyPeriod,
@@ -940,12 +973,15 @@ InsuranceContract = R6Class(
             #### #
             # For joint lives, some parameters can be given multiple times: age, sex
             # Collect all given values into one vector!
+
+            # TODO: First person has birthDate handled properly, handle all other persons, too!
             age = unlist(args[names(args) == "age"], use.names = FALSE)
-            if (!is.null(age)) {
-                self$Parameters$ContractData$age = age;
+            if (!is.null(age) && length(age) > 1) {
+                self$Parameters$ContractData$age = c(self$Parameters$ContractData$age[[1]], tail(age, -1));
+                # TODO: Calculate ages for all other persons, too. Or rather, allow multiple birthDate values, too
             }
             sex = unlist(args[names(args) == "sex"], use.names = FALSE)
-            if (!is.null(sex)) {
+            if (!is.null(sex) && length(sex) > 1) {
                 self$Parameters$ContractData$sex = sex;
             }
             if (is.null(self$Parameters$ContractData$ageDifferences)) {

R/InsuranceParameters.R

@@ -249,8 +249,11 @@ InsuranceContract.Values = list(
 #'     \item{\code{$initialCapital}}{Reserve/Capital that is already available
 #'               at contract inception, e.g. from a previous contract. No tax
 #'               or acquisition costs are applied to this capital.}
-#'     \item{\code{$YOB}}{Year of birth of the insured, used to determine the
+#'     \item{\code{$YOB (deprecated)}}{Year of birth of the insured, used to determine the
 #'               age for the application of the mortality table}
+#'     \item{\code{$birthDate}}{Date  of birth of the insured, used to determine the
+#'               age for the application of the mortality table. Alternatively,
+#'               the year alone can be passed as \code{YOB}.}
 #'     \item{\code{$age}}{Age of the insured}
 #'     \item{\code{$technicalAge}}{Technical age of the insured (when the age
 #'               for the application of the mortality table does not coincide
@@ -500,6 +503,7 @@ InsuranceContract.ParameterDefaults = list(
     ContractData = list(
         id = "Hauptvertrag",
         sumInsured = 100000,
+        birthDate = NULL,
         YOB = NULL,
         age = NULL,
         technicalAge = NULL,

R/InsuranceTarif.R

@@ -317,7 +317,7 @@ InsuranceTarif = R6Class(
       if (getOption('LIC.debug.getAges', FALSE)) {
         browser();
       }
-      ages = ages(params$ActuarialBases$mortalityTable, YOB = params$ContractData$YOB);
+            ages = ages(params$ActuarialBases$mortalityTable, YOB = year(params$ContractData$birthDate));
       age = params$ContractData$technicalAge;
       if (age > 0) {
         ages = ages[-age:-1];
@@ -335,12 +335,12 @@ InsuranceTarif = R6Class(
       }
       age = params$ContractData$technicalAge;
       ages = self$getAges(params);
-      q = MortalityTables::deathProbabilities(params$ActuarialBases$mortalityTable, YOB = params$ContractData$YOB, ageDifferences = params$ContractData$ageDifferences);
+      q = MortalityTables::deathProbabilities(params$ActuarialBases$mortalityTable, YOB = year(params$ContractData$birthDate), ageDifferences = params$ContractData$ageDifferences);
       if (age > 0) {
         q    = q[-age:-1];
       }
       if (!is.null(params$ActuarialBases$invalidityTable)) {
-        i = MortalityTables::deathProbabilities(params$ActuarialBases$invalidityTable, YOB = params$ContractData$YOB, ageDifferences = params$ContractData$ageDifferences);
+        i = MortalityTables::deathProbabilities(params$ActuarialBases$invalidityTable, YOB = year(params$ContractData$birthDate), ageDifferences = params$ContractData$ageDifferences);
         if (age > 0) {
           i    = i[-age:-1];
         }

R/exportInsuranceContractExample.R

@@ -59,7 +59,7 @@ exportInsuranceContractExample = function(contract, prf = 10, outdir = ".", base
         if (!missing(extraname) && !is.null(extraname)) {
             basename = paste(basename, "_", extraname, sep = "")
         }
-        basename = paste(basename, "_RZ", sprintf("%.2f", contract$Parameters$ActuarialBases$i), "_x", contract$Parameters$ContractData$age, "_YoB", contract$Parameters$ContractData$YOB, "_LZ", contract$Parameters$ContractData$policyPeriod, "_PrZ", contract$Parameters$ContractData$premiumPeriod, "_VS", contract$Parameters$ContractData$sumInsured, sep = "" )
+        basename = paste(basename, "_RZ", sprintf("%.2f", contract$Parameters$ActuarialBases$i), "_x", contract$Parameters$ContractData$age, "_YoB", year(params$ContractData$birthDate), "_LZ", contract$Parameters$ContractData$policyPeriod, "_PrZ", contract$Parameters$ContractData$premiumPeriod, "_VS", contract$Parameters$ContractData$sumInsured, sep = "" )
     }
 
     filename = paste(basename, ".xlsx", sep = "");

R/exportInsuranceContract_xlsx.R

@@ -239,7 +239,7 @@ getContractBlockValues = function(contract) {
       "Sum insured"         = contract$Parameters$ContractData$sumInsured,
       "Mortality table"     = contract$Parameters$ActuarialBases$mortalityTable@name,
       i                     = contract$Parameters$ActuarialBases$i,
-      "YOB"                 = contract$Parameters$ContractData$YOB,
+      "Birth Date"          = contract$Parameters$ContractData$birthDate,
       "Age"                 = contract$Parameters$ContractData$age,
       "Technical Age"       = contract$Parameters$ContractData$technicalAge,
       "Policy duration"     = contract$Parameters$ContractData$policyPeriod,

man/InsuranceContract.ParameterDefaults.Rd

@@ -44,8 +44,11 @@ default = "Hauptvertrag"}
 \item{\code{$initialCapital}}{Reserve/Capital that is already available
 at contract inception, e.g. from a previous contract. No tax
 or acquisition costs are applied to this capital.}
-\item{\code{$YOB}}{Year of birth of the insured, used to determine the
+\item{\code{$YOB (deprecated)}}{Year of birth of the insured, used to determine the
 age for the application of the mortality table}
+\item{\code{$birthDate}}{Date  of birth of the insured, used to determine the
+age for the application of the mortality table. Alternatively,
+the year alone can be passed as \code{YOB}.}
 \item{\code{$age}}{Age of the insured}
 \item{\code{$technicalAge}}{Technical age of the insured (when the age
 for the application of the mortality table does not coincide

man/age.exactRounded.Rd

+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/HelperFunctions.R
+\name{age.exactRounded}
+\alias{age.exactRounded}
+\title{Calculate the age of the insured based on exact age at contract closing, rounded
+to the nearest birthday.}
+\usage{
+age.exactRounded(params, values)
+}
+\arguments{
+\item{params}{The parameters of the contract.}
+
+\item{values}{Unused by default (already calculated values of the contract)}
+}
+\description{
+Calculate the age of the insured based on exact age at contract closing, rounded
+to the nearest birthday.
+}

man/age.yearDifference.Rd

+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/HelperFunctions.R
+\name{age.yearDifference}
+\alias{age.yearDifference}
+\title{Calculate the age of the insured based on the difference of the bith year and
+contract closing year.}
+\usage{
+age.yearDifference(params, values)
+}
+\arguments{
+\item{params}{The parameters of the contract.}
+
+\item{values}{Unused by default (already calculated values of the contract)}
+}
+\description{
+Calculate the age of the insured based on the difference of the bith year and
+contract closing year.
+}