diff --git a/DESCRIPTION b/DESCRIPTION index 7830ffa1377d1f7b02fdbd38fe0ab3a32eaaa8de..377bba09ba67620ed718078dad924b558329a26d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -45,6 +45,7 @@ Collate: 'InsuranceContract.R' 'addDataTableWorksheet.R' 'contractGrid.R' + 'create_LIC_project.R' 'exportInsuranceContract_xlsx.R' 'showVmGlgExamples.R' 'exportInsuranceContractExample.R' diff --git a/R/create_LIC_project.R b/R/create_LIC_project.R new file mode 100644 index 0000000000000000000000000000000000000000..6c07a5a23d0d51cea93483b4178a1d207640642a --- /dev/null +++ b/R/create_LIC_project.R @@ -0,0 +1,49 @@ +# Custom project creation function, copied as a starting point from +# https://rstudio.github.io/rstudio-extensions/rstudio_project_templates.html +# Copying functions and replacements originally taken from +# https://blog.devgenius.io/make-your-own-rstudio-project-template-1f77c4888e79 +# and heavily modified + +create_LIC_project <- function(path, ...) { + # ensure path exists + dir.create(path, recursive = TRUE, showWarnings = FALSE) + + + + # LIC.src <- function (..., lib.loc = NULL, mustWork = FALSE){ + # system.file(..., package = "LifeInsuranceContracts", lib.loc = lib.loc, mustWork = mustWork) + # } + # + # from <- LIC.src("templatedemo") + # + # fs::dir_copy( + # path = from, + # new_path = path, + # overwrite = TRUE + # ) + + # generate header for file + header <- c( + "# This file was generated by a call to 'ptexamples::hello_world()'.", + "# The following inputs were received:", + "" + ) + + # collect inputs and paste together as 'Parameter: Value' + dots <- list(...) + text <- lapply(seq_along(dots), function(i) { + key <- names(dots)[[i]] + val <- dots[[i]] + paste0(key, ": ", val) + }) + + # collect into single text string + contents <- paste( + paste(header, collapse = "\n"), + paste(text, collapse = "\n"), + sep = "\n" + ) + + # write to index file + writeLines(contents, con = file.path(path, "RechnungGesamtbestand.R")) +} diff --git a/inst/rstudio/templates/project/LifeInsuranceContracts.dcf b/inst/rstudio/templates/project/LifeInsuranceContracts.dcf new file mode 100644 index 0000000000000000000000000000000000000000..ce4aeb5dccbb2eaaa4c5f4e94a5d013ecef73085 --- /dev/null +++ b/inst/rstudio/templates/project/LifeInsuranceContracts.dcf @@ -0,0 +1,10 @@ +Binding: create_LIC_project +Title: LifeInsuranceContracts Implementation +Subtitle: Company-specific product definitions using the LifeInsuranceContracts package +OpenFiles: RechnungGesamtbestand.R +Caption: Company-specific LifeInsuranceContracts product implementation + +Parameter: Company +Widget: TextInput +Label: Company (letters only, no spaces, special characters etc.) + diff --git a/inst/rstudio/templates/project/LifeInsuranceContracts/.Rbuildignore b/inst/rstudio/templates/project/LifeInsuranceContracts/.Rbuildignore new file mode 100644 index 0000000000000000000000000000000000000000..0e18abd9d5ca74e9fc4b7d8717c88d5629e80c97 --- /dev/null +++ b/inst/rstudio/templates/project/LifeInsuranceContracts/.Rbuildignore @@ -0,0 +1,8 @@ +^.*\.Rproj$ +^\.Rproj\.user$ +^Polizzeninfos/2020- +^Polizzeninfos/2021- +^Polizzeninfos/2022- +^\.RData$ +^\.git$ +^Vergleichsrechner/ diff --git a/inst/rstudio/templates/project/LifeInsuranceContracts/.gitignore b/inst/rstudio/templates/project/LifeInsuranceContracts/.gitignore new file mode 100644 index 0000000000000000000000000000000000000000..3865c7eb6383ee0cc1222356af5092c5c4c6442e --- /dev/null +++ b/inst/rstudio/templates/project/LifeInsuranceContracts/.gitignore @@ -0,0 +1,6 @@ +.Rproj.user +.Rhistory +.RData +.Ruserdata +Ergebnisse_Gesamtbestand_Vergleichsrechnung +20*_Nachrechnung/ diff --git a/inst/rstudio/templates/project/LifeInsuranceContracts/DESCRIPTION b/inst/rstudio/templates/project/LifeInsuranceContracts/DESCRIPTION new file mode 100644 index 0000000000000000000000000000000000000000..1b35ed472b0ec1b52c36aa6f712571cbf707bcde --- /dev/null +++ b/inst/rstudio/templates/project/LifeInsuranceContracts/DESCRIPTION @@ -0,0 +1,28 @@ +Package: LifeInsuranceContractsXXXCOMPANYXXX +Type: Package +Title: LifeInsuranceContract Implementation for XXXCOMPANYXXX +Version: 0.1 +Date: 2023-12-31 +Description: Implementation of XXXCOMPANYXXX life insurance products. +License: Proprietory (using XXXCOMPANYXXX's tariff plans) +Authors@R: c(person("Firstname", "Lastname", role = c("aut", "cre"), + email = "email@example.com")) +Author: Firstname Lastname [aut, cre] +Maintainer: Firstname Lastname <email@example.com> +Depends: R (>= 3.1.0), + LifeInsuranceContracts, + MortalityTables, + here +Encoding: UTF-8 +LazyData: true +Recommends: + openxlsx +URL: +BugReports: +RoxygenNote: 7.2.3 +Collate: + 'XXXCOMPANYXXX_General.R' + 'XXXCOMPANYXXX_Tarif1.R' +Suggests: + testthat (>= 3.0.0) +Config/testthat/edition: 3 diff --git a/inst/rstudio/templates/project/LifeInsuranceContracts/NAMESPACE b/inst/rstudio/templates/project/LifeInsuranceContracts/NAMESPACE new file mode 100644 index 0000000000000000000000000000000000000000..6ae926839dd1829f1016a96f766d970ff184ad97 --- /dev/null +++ b/inst/rstudio/templates/project/LifeInsuranceContracts/NAMESPACE @@ -0,0 +1,2 @@ +# Generated by roxygen2: do not edit by hand + diff --git a/inst/rstudio/templates/project/LifeInsuranceContracts/R/XXXCOMPANYXXX_General.R b/inst/rstudio/templates/project/LifeInsuranceContracts/R/XXXCOMPANYXXX_General.R new file mode 100644 index 0000000000000000000000000000000000000000..c571c783c40dadf7afed9c18b317319cdacb4320 --- /dev/null +++ b/inst/rstudio/templates/project/LifeInsuranceContracts/R/XXXCOMPANYXXX_General.R @@ -0,0 +1,197 @@ +library(tidyverse) + +##########################################################################m# +# Datenstruktur für Tarife #### +##########################################################################m# + +# Idea / approach taken from the `memoise` package (In-memory cache) +# XXXCOMPANYXXX.Tariffs.init = function() { +# tariffs = new.env(TRUE, emptyenv()) +# tariff_set = function(key, value) { +# assign(key, value, envir = tariffs) +# } +# tariff_get = function(key) { +# get(key, envir = tariffs, inherits = FALSE) +# } +# tariff_exists = function(key) { +# exists(key, envir = tariffs) +# } +# list( +# get = tariff_get, +# set = tariff_set, +# exists = +# ) +# } +#' @export +XXXCOMPANYXXX.Tariffs = c() + +#' @export +XXXCOMPANYXXX.register = function(Tarif, Produkt, GV = NULL, AVB = NULL) { + if (is.null(Produkt)) { + warning("Product name missing in call to XXXCOMPANYXXX.register!"); + return(); + } + locked = FALSE + # TODO: Unlocking does not work => Once the package is built/installed, + # new products/tariffs cannot be added via XXXCOMPANYXXX.register. + # => Figure out a way to store all registered tariffs in a list + # that is not locked / that can be unlocked! + if ("package:LifeInsuranceContractsXXXCOMPANYXXX" %in% search()) { + pkgenv = as.environment("package:LifeInsuranceContractsXXXCOMPANYXXX") + locked = bindingIsLocked("XXXCOMPANYXXX.Tariffs", pkgenv) + # if (locked) { + # unlockBinding("XXXCOMPANYXXX.Tariffs", pkgenv) + # locked = bindingIsLocked("XXXCOMPANYXXX.Tariffs", pkgenv) + # } + # nsenv = as.environment("namespace:LifeInsuranceContractsXXXCOMPANYXXX") + # locked = bindingIsLocked("XXXCOMPANYXXX.Tariffs", pkgenv) + # if (locked) { + # unlockBinding("XXXCOMPANYXXX.Tariffs", pkgenv) + # locked = bindingIsLocked("XXXCOMPANYXXX.Tariffs", pkgenv) + # } + } + # assign("XXXCOMPANYXXX.Tariffs", 123, -1, as.environment("package:LifeInsuranceContractsXXXCOMPANYXXX")) + # if (locked) { + # warning("") + # } + # unlockBinding("XXXCOMPANYXXX.Tariffs", as.environment("package:LifeInsuranceContractsXXXCOMPANYXXX")) + # unlockBinding(XXXCOMPANYXXX.Tariffs, pryr::where("XXXCOMPANYXXX.Tariffs")) + if (!locked && !is.null(GV) && !is.null(AVB)) { + XXXCOMPANYXXX.Tariffs[[paste0(Produkt, "/GV", GV, "/AVB", AVB)]] <<- Tarif + } + if (!locked && !is.null(GV)) { + XXXCOMPANYXXX.Tariffs[[paste0(Produkt, "/GV", GV)]] <<- Tarif + } + if (!locked && !is.null(AVB)) { + XXXCOMPANYXXX.Tariffs[[paste0(Produkt, "/AVB", AVB)]] <<- Tarif + } + Tarif +} +#' @export +XXXCOMPANYXXX.Tariff = function(Produkt, GV = NULL, AVB = NULL) { + if (is.null(Produkt)) { + warning("Tariff name missing in call to XXXCOMPANYXXX.Tariff!"); + return(NULL); + } + if (is.null(GV) && is.null(AVG)) { + warning("Both profit class and terms indicator missing in call to XXXCOMPANYXXX.Tariff!"); + return(NULL); + } + id = Produkt; + if (!is.null(GV)) { + id = paste0(id, "/GV", GV); + } + if (!is.null(AVB)) { + id = paste0(id, "/AVB", AVB); + } + XXXCOMPANYXXX.Tariffs[[id]] +} + + +##########################################################################m# +# GEWINNBETEILIGUNGSSÄTZE #### +##########################################################################m# + + +XXXCOMPANYXXX.Gesamtverzinsung = c( + `2000` = 0.07, + `2005` = 0.05, + `2006` = 0.045, + `2005` = 0.04, + `2006` = 0.035, + `2007` = 0.03, + `2012` = 0.025, + `2015` = 0.02, + `2020` = 0.0175, + `2023` = 0.015 +) + + +##########################################################################m# +# STERBETAFELN #### +##########################################################################m# + + +mortalityTables.load("Austria_Census") +mortalityTables.load("Austria_Annuities_EROMF") +mortalityTables.load("Austria_Annuities_AVOe2005R") +mortalityTables.load("Austria_Annuities_AVOe1996R") + + +##########################################################################m# +# Österr. Volkssterbetafel 2000/02 #### + +#' @export +XXXCOMPANYXXX.Sterbetafel2001 = function(params, ...) { + if (params$ContractData$sex == "female") { + mort.AT.census.2001.female + } else { + mort.AT.census.2001.male + } +} + +#' @export +XXXCOMPANYXXX.Sterbetafel2001.unisex = mortalityTable.mixed( + name = "ÖVSt 2000/02 unisex 70:30", + table1 = mort.AT.census.2001.male, weight1 = 70, + table2 = mort.AT.census.2001.female, weight2 = 30 +) + + + + + +##########################################################################m# +# Rententafel AVÖ 1996-R #### + +#' @export +XXXCOMPANYXXX.AVOe1996R.AV = function(params, ...) { + if (params$ContractData$sex == "female") { + AVOe1996R.male.av325 + } else { + AVOe1996R.female.av325 + } +} + + + + + + +########################################################################## +# RÜCKKAUFSFORMELN #### +##########################################################################m# + +#' @export +XXXCOMPANYXXX.surrender.increasing90 = function(surrenderReserve, params, values) { + n = params$ContractData$policyPeriod; + surrenderReserve * (0.9 + 0.08*pmax(((0:n) - 3) / (n - 3), 0)) +} + + +##########################################################################m# +# KOSTENFORMELN #### +##########################################################################m# + + + +##########################################################################m# +# RABATTFORMELN #### +##########################################################################m# + + + +##########################################################################m# +# TECHNISCHES ALTER #### +##########################################################################m# + +#' z.B. Frauen werden um 5 Jahre verjüngt, Mindestalter 20 +#' etc. + + + + +##########################################################################m# +# TARIFSPEZIFIKA (HOOKS) der XXXCOMPANYXXX #### +##########################################################################m# + diff --git a/inst/rstudio/templates/project/LifeInsuranceContracts/R/XXXCOMPANYXXX_Gewinnplan1.R b/inst/rstudio/templates/project/LifeInsuranceContracts/R/XXXCOMPANYXXX_Gewinnplan1.R new file mode 100644 index 0000000000000000000000000000000000000000..c583001e9afcee14451f822875ab15b99cc27ec3 --- /dev/null +++ b/inst/rstudio/templates/project/LifeInsuranceContracts/R/XXXCOMPANYXXX_Gewinnplan1.R @@ -0,0 +1,42 @@ +#' @include XXXCOMPANYXXX_General.R + +############################################################################~# +# XXXCOMPANYXXX Gewinnplan 1 #### +# Profits: #### +# * Interest profit: (profit rate - guaranteed interest)*reserve #### +# * Terminal profit: once/twice the last interest profit assignment #### +############################################################################~# + + +#' @export +XXXCOMPANYXXX.Gewinnplan1 = ProfitParticipation$new( + name = "XXXCOMPANYXXX Gewinnplan 1, Version 1", + profitComponents = c("interest", "terminal"), + profitClass = "1", + + waitingPeriod = 3, + + guaranteedInterest = 0.03, + interestProfitRate = pmax(XXXCOMPANYXXX.Gesamtverzinsung - 0.03, 0), + totalInterest = XXXCOMPANYXXX.Gesamtverzinsung, + getTerminalBonusRate = function(res, rates, params, values) { + # Schlussgewinn (Vielfaches des letzten Zinsgewinns) + # lfd. Prämie: LZ<20: 1x, LZ>=20: 2x + if (params$ContractData$policyPeriod < 20) { + 1 + } else { + 2 + } + }, + + getInterestOnProfits = PP.rate.interestProfitPlusGuarantee, + + getInterestProfitBase = PP.base.contractualReserve, + getTerminalBonusBase = PP.base.totalProfitAssignment, + + calculateSurvivalBenefit = function(profits, rates, ...) { profits[,"regularBonus"] * (1 + rates$guaranteedInterest + rates$interestProfitRate) + profits[,"terminalBonus"]}, + calculateDeathBenefitAccrued = PP.benefit.Profit, + calculateSurrenderBenefitAccrued = PP.benefit.Profit, + calculatePremiumWaiverBenefitAccrued = PP.benefit.Profit, + calculatePremiumWaiverBenefitTerminal = PP.benefit.None +); diff --git a/inst/rstudio/templates/project/LifeInsuranceContracts/R/XXXCOMPANYXXX_Tarif1.R b/inst/rstudio/templates/project/LifeInsuranceContracts/R/XXXCOMPANYXXX_Tarif1.R new file mode 100644 index 0000000000000000000000000000000000000000..22311d8f2540a963564d4919d629062a6e887424 --- /dev/null +++ b/inst/rstudio/templates/project/LifeInsuranceContracts/R/XXXCOMPANYXXX_Tarif1.R @@ -0,0 +1,37 @@ +#' @include XXXCOMPANYXXX_General.R + + +##############################################################################m## +# Tarif1 +##############################################################################m## + +# XXXCOMPANYXXX Versicherung, Tarif 1 +# Typ: Endowment with level death and survival benefits, level premiums +# Guaranteed interest: i=3%, Mortality rates: XXXCOMPANYXXX.Sterbetafel2001.unisex + +XXXCOMPANYXXX.costs = initializeCosts( + alpha = 0.04, Zillmer = 0.025, + beta = 0.02, + gamma = 0.002, + gamma.paidUp = 0.005 +) + +#' @export +XXXCOMPANYXXX.Tarif1 = InsuranceTarif$new( + name = "Tarif1", + type = "endowment", + tarif = "Endowment Comfort", + desc = "Endowment with level death and survival benefits, level premiums, guaranteed interest 3%", + + mortalityTable = XXXCOMPANYXXX.Sterbetafel2001.unisex, + i = 0.03, + tax = 0.04, + costs = XXXCOMPANYXXX.costs, + premiumFrequencyLoading = freqCharge(3, 2, 1, 0), + + surrenderValueCalculation = XXXCOMPANYXXX.surrender.increasing90, + profitParticipationScheme = XXXCOMPANYXXX.Gewinnplan1 +) %>% + XXXCOMPANYXXX.register("Tarif1", GV = "1"); + + diff --git a/inst/rstudio/templates/project/LifeInsuranceContracts/R/XXXCOMPANYXXX_Tarif2.R b/inst/rstudio/templates/project/LifeInsuranceContracts/R/XXXCOMPANYXXX_Tarif2.R new file mode 100644 index 0000000000000000000000000000000000000000..18ae9aad65c3a2c7997cb69b399abf0d21df3c74 --- /dev/null +++ b/inst/rstudio/templates/project/LifeInsuranceContracts/R/XXXCOMPANYXXX_Tarif2.R @@ -0,0 +1,46 @@ +#' @include XXXCOMPANYXXX_General.R + + +##############################################################################m## +# Tarif2 +##############################################################################m## + +# XXXCOMPANYXXX Versicherung, Tarif2 +# Whole life insurance + +XXXCOMPANYXXX.costs2 = initializeCosts( + alpha = 0.035, + gamma = 0.005, + gamma.paidUp = 0.005 +) + +#' @export +XXXCOMPANYXXX.Tarif2 = InsuranceTarif$new( + name = "Tarif2", + type = "wholelife", + tarif = "Death Comfort", + desc = "Whole life insurance with single premium, guaranteed interest 3%", + + mortalityTable = XXXCOMPANYXXX.Sterbetafel2001.unisex, + i = 0.03, + tax = 0.04, + costs = XXXCOMPANYXXX.costs2, + premiumFrequencyLoading = freqCharge(3, 2, 1, 0), + + sumRebate = function(params, values) { + SI = params$ContractData$sumInsured + if(SI >= 1000000) { + 0.002 + } else if (500000 <= SI) { + 0.001 + } else if (200000 <= SI) { + 0.0005 + } else { + 0 + } + }, + surrenderValueCalculation = XXXCOMPANYXXX.surrender.increasing90 +) %>% + XXXCOMPANYXXX.register("Tarif2", GV = "2"); + + diff --git a/inst/rstudio/templates/project/LifeInsuranceContracts/XXXCOMPANYXXXRechnungGesamtbestand.R b/inst/rstudio/templates/project/LifeInsuranceContracts/XXXCOMPANYXXXRechnungGesamtbestand.R new file mode 100644 index 0000000000000000000000000000000000000000..8414a92ad39908d89d22d2128dc8002943a70618 --- /dev/null +++ b/inst/rstudio/templates/project/LifeInsuranceContracts/XXXCOMPANYXXXRechnungGesamtbestand.R @@ -0,0 +1,561 @@ +# This file was created from a template provided by the LifeInsuranceContracts +# package. It's purpose is to read in a set of contract data and calculate the +# corresponding reserves (e.g. to validate the official numbers in the financial +# statements). +# +# Steps: +# 1. Implement the corresponding products in the files in the R/ subdirectory. +# Use the LifeInsuranceContracts documentation available at +# https://cran.r-project.org/web/packages/LifeInsuranceContracts/vignettes/using-the-lifeinsurancecontracts-package.html +# 2. Install the package (using the "Install" button in RStudio's "Build" pane) +# 3. Set up the mapping of the columns of the contract data source to the package's arguments. +# The columns of the input data can be directly mapped to named arguments in LifeInsuranceContract$new(..) calls. +# 4. If some columns need manual modifications (e.g. sex or frequencies +# expressed with other values than the package expects), update the +# VTmodify.* functions below correspondingly. +# 5. Update the column types in the readXXXCOMPANYXXXBestand(..) function. This helps +# preventing errors, as these columnt are always cast to the required type. +# 6. The calculate_contract(..) function might need to some adjustments / +# modifications, in particular when modified contracts, premiums waivers, +# additional tariffs / single-payment add-ons etc. are present. +# 7. Depending on which columns / data are available in the company-provided +# contract data, the column modifications / calculations of other reserves, +# etc. at the end of the calculate_portfolio(...) function might need to +# be adjusted. +# 8. Update the `files` and `outfile` variables to point to the input files +# ("Bestandsdaten") and the output file name +# 9. Call the calculate_portfolio function on the contract data set (potentially +# filtered to some subsets to prevent performance issues) +# +# Typically, a call to calculate a portfolio and store the results in a dedicated +# (Excel) output file is: +# results = NULL; results = calculate_portfolio(bestandinfos.all, +# tarif = c("ProdName1", "ProdName2"), GV = c("123"), debug =TRUE) +# results %>% +# openxlsx::write.xlsx(outfile("Prods-1-2"), asTable = TRUE, +# overwrite = TRUE, creator = "Your Name", +# sheetName = "Vergleichsrechnung", tabColour = "#FFE600") +# openXL(outfile("Prods-1-2")) +# +# +# +# General Overview of the calculation procedure +# 1. The contract data are read in from the filenames provided in the `files` +# list and stored in the data.frame called `bestandinfos.all`. +# a. Each file is read using the function `readXXXCOMPANYXXXBestand`. +# b. The `readXXXCOMPANYXXXBestand` function uses read_excel to read in the raw data, +# then ensures the defined columns have the proper data type. +# c. The columns are renamed according to the mapping in `colMapping` +# d. All contracts are sorted by `Polizzennummer` +# e. Additional modifications are done by the function `VTmodify.general`. +# f. Further custom modifications can be manually added either in readXXXCOMPANYXXXBestand or in VTmodify.general +# 2. All contracts are calculated by a call to `calculate_portfolio`. The arguments +# tarif and GV can be used to restrict the calculation only to certain +# products and/or profit classes. Additionally, n_max can be used to +# calculate only the first n_max contracts. +# The `calculate_portfolio` function does its work with the following steps: +# a. The portfolio data is filted with the given tariff, GV, skip, n_max arguments +# b. Only the relevant columns of the portfolio data are taken, some +# sanity checks (sumInsured > 0, premiumFrequency >= 0) are applied. +# c. Grouping happend by column SliceID. This allows humtiple portfolio +# data rows to be combined to one contract with several slices / sum +# increases, which are calculated as one contract (see section "10.3 +# Dynamic Increases" of the LifeInsuranceContracts vignette). If each +# slice / dynamic increase is supposed to be calculated individually +# and independent from the main contract / other increases, then the +# column mapped to the SliceID column needs to have a different value +# for each portfolio data row. If SliceID uses contract numbers, all +# dynamics, etc. belonging to the same contract number will be combined +# and calculated using $addDynamics +# d. Each contract (entries with distinct SliceID value) is calculated in +# a loop using the by_slice function, which calls the calculate_contract +# function for each contract. +# 3. The `calculate_contract` function calculates one individual contract, with +# the individual columns of the portfolio data passed as named parameters +# to the function. +# a. A progress message is printed (if applicable) +# b. All slices are arranged by date, with the slice starting first +# assumed to be the main contract part. +# c. For the main contract, an instance of the LifeInsuranceContract +# (with the given tariff / product) is created and all values of the +# contract are automatically calculated by the package by default. +# d. All additional slices (e.g. dynamic increases) with the same SliceID +# are added using the $addDynamics method of the LifeInsuranceContract +# class. The slice start date and duration are adjusted correspondingly. +# e. The reserves are extracted from the contract and stored in the final +# data.frame +# z. If debug=TRUE, a column is added to the resulting data.frame containing the R code to reproduce with full contract. +# 4. The calculate_portfolio combines the data.frames returned for each +# contract's calculate_contract call into one large data frame, adds some +# derived columns and returns the data frame as result of the calculations. +# +# +# +# COLUMN MAPPING +# -------------- +# The following columns / named parameters are typically used by a LifeInsuranceTariff +# implementation or the concrete contract as a LifeInsuranceContract object. Most +# parameters are not mandatory. +# Additional arguments / columns are possible and will be preserved, even if +# they are not used by the contract. +# * `Polizzennummer` +# * `SliceID` +# * `balanceSheetDate` +# * `tarif` +# * `GV` +# * `i` +# * `sex` +# * `age` +# * `contractClosing` +# * `sliceDate` +# * `policyPeriod` +# * `premiumPeriod` + +# * `premiumFrequency` +# * `annuityFrequency` +# * `sumInsured` + +# Columns used for comparison with the calculated values: +# * `Bruttoprämie` +# * `Sparprämie` +# * `Risikoprämie` +# * `Kostenprämie` +# * `Bilanzreserve` +# * `Gewinnreserve` +# * `Prämienübertrag` + +################################################################################ + + +library(here) +library(lubridate) +library(readxl) +library(magrittr) +library(purrr) +library(purrrlyr) +library(openxlsx) +library(tictoc) +library(tidyverse) +library(LifeInsuranceContractsXXXCOMPANYXXX) +mortalityTables.load("Austria_*") + + + +########################################################################m# +# Database structure definitions / mapping #### +########################################################################m# + +colMapping = c( + # Polizzen- und Tarifdefinition + `Polizzennummer` = "PolNr", + `SliceID` = "PolNr", # Grouping will happen by SliceID + `balanceSheetDate` = "Datum", + `tarif` = "Produkt", # Used to search for the LifeInsuranctTarif object + `GV` = "Gewinnverband", + + # Parameter des Vertrags + `i` = "Garantiezins", + `sex` = "Geschlecht", + `age` = "Eintrittsalter", # Alternatively, birth can be given + # `birthDate` = "GebDat", + `contractClosing` = "Abschluss", + `sliceDate` = "Abschluss", + `policyPeriod` = "LZ", + + `premiumFrequency` = "ZW", + `sumInsured` = "vs", + `initialCapital` = "Anfangskapital", + `costWaiver` = "Kostenverzicht", + + # Kontrollgrößen (lt. Geschäftsplan abgeleitet) + + `Bruttoprämie` = "BPr", + `Sparprämie` = "SparPr", + `Risikoprämie` = "RisikoPr", + `Kostenprämie` = "KostenPr", + + # Deckungskapital am jeweiligen Jahrestag der Versicherung + `DKt` = "VK", + `DKt+1` = "VK1", + `DKt+2` = "VK2", + + # Bilanzwerte + `Bilanzreserve` = "BilRes", + `Gewinnreserve` = "GewRes", + `Bilanz-Verwaltungskostenreserve` = "VerwKostRes", + `Netto-Bilanzreserve` = "NettoBilRes"#, + # `Prämienübertrag` = "???" +) +colNamesRelevant = names(colMapping) %>% `[<-`(., . == "", NA_character_) %>% coalesce(colMapping) + +Problempolizzen = c() + + + +########################################################################m# +# Helper functions #### +########################################################################m# + +cleanDate = function(dt) { + if (is.POSIXct(dt) || is.POSIXlt(dt) || is.Date(dt) || is.logical(dt)) + as.Date(dt) + else if (is.numeric(dt)) + as.Date(dt, origin = "1899-12-30") + else if (is.character(dt)) { + warning("date column was read in as string: ", dt) + Reduce(c, map(dt, function(d) { + # browser() + if (is.character(d) && !is.na(d) && str_detect(d, "^[0-9]+$")) + d = as.numeric(d) + if (is.numeric(d)) + return(as.Date(d, origin = "1899-12-30")) + as.Date(d) + })) + } +} + + + +VTmodify.general = function(data) { + #browser() + + data %>% + separate(tarif, into = c("tarif", "Produkt"), sep = "[ ]+", extra = "merge", fill = "left") %>% + mutate( + sex = recode( + as.character(sex), + "M" = "male", "W" = "female", "F" = "female", "U" = "unisex", + "m" = "male", "w" = "female", "f" = "female", "u" = "unisex", + `0` = "male", `1` = "female", .default = "unisex"), + premiumFrequency = recode( + as.character(premiumFrequency), + "J" = 1, "H" = 2, "V" = 4, "M" = 12, "E" = 0, .default = 1), + policyPeriod = round(time_length(difftime(policyPeriod, contractClosing), "years")), + + # TODO: Apply further adjustments to the input data, e.g. + # costWaiver = ifelse(costWaiver == "N", 0, 1), + # sumRebate = -sumRebate, + # sumInsured = if_else(VS == 0, Rentenhoehe, VS), + + # TODO: Rabatte, etc. + + id = paste0(tarif, "/GV", GV) + ) +} + + +######################################## +readXXXCOMPANYXXXBestand = function(file, sheet = 1, ...) { + charColumns = c( + "tarif", "GV" + ) + dateColumns = c( + "balanceSheetDate", + "contractClosing", + "sliceDate", + "birthData" + ); + percentColumns = c( + "i" + ) + permilleColumns = c( + + ) + numericColumns = c( + "policyPeriod", "age", + "sumInsured", "initialCapital" + ); + mapping = colMapping[names(colMapping) != ""] + + # browser() + data = read_excel(file, sheet = sheet, ..., na = c("", "01.01.0100", "01.01.1000", "-328716", -328716)) %>% + # Apply all renamings from colMapping: + select(all_of(mapping), !all_of(mapping)) %>% + mutate( + across(any_of(dateColumns), cleanDate), + across(any_of(numericColumns), as.numeric), + across(any_of(charColumns), as.character), + across(any_of(percentColumns), function(x) { as.numeric(x)/100 }), + across(any_of(permilleColumns), function(x) { as.numeric(x)/1000 }) + ) %>% + arrange(Polizzennummer) %>% # Sortiere Verträge nach Polizzennummer + VTmodify.general() + data + +} + + +###############################################################m# +## Definitionen: Kontrollrechnung der Deckungsrückstellung #### +###############################################################m# + +CountPol = 0 +CountSlice = 0 + +calculate_contract = function(ctr.data, balanceSheetDate = as.Date("2023-12-31"), progress = 100, tariffs = XXXCOMPANYXXX.Tariffs, debug = FALSE, ...) { + # browser() + CountPol <<- CountPol + 1 + CountSlice <<- CountSlice + NROW(ctr.data) + # browser() + if (CountPol %% progress == 0) { + print(paste0(CountPol, "/", CountSlice, ": Vertrag Nr. ", ctr.data[[1, "Polizzennummer"]], ", Tarif:", ctr.data[[1, "tarif"]], " GV", ctr.data[[1, "GV"]], ", ", NROW(ctr.data), " Scheiben")) + } + + # Main part is the slice that + # a) starts first. + # If two slices start at the same time, main part is + # b) the one with an initialCapital, or + # c) the one with the longest premium period (to exclude single payments from being the main part) or + # d) the highest sum insured + ctr.data = ctr.data %>% arrange(sliceDate, desc(initialCapital), desc(premiumPeriod), desc(sumInsured)) + mainPart.orig = head(ctr.data, 1) + mainPart.begin = mainPart.orig$sliceDate + + # Simplification: Adjust main part so the contract end is always a full number of + # years away (otherwise the reserves towards the end will be off considerably) + # if (!is.na(mainPart.orig$Vertragsende)) { + # mainPart.begin = mainPart.orig$sliceDate %>% + # `month<-`(month(mainPart.orig$Vertragsende)) + # } + # Changes in the current year might move the date after the balance sheet + # date => as a workaround let the contract begin last year! + while (mainPart.begin > balanceSheetDate) { + year(mainPart.begin) = year(mainPart.begin) - 1 + } + + # If main part begins after contract, adjust the contract date to the main part's begin + # Also recalculate the policy period from the (potentially changed) start and end dates of the main slice + ctr.data = ctr.data %>% + mutate(contractClosing = mainPart.begin) + + mainPart = head(ctr.data, 1) #%>% + # mutate(policyPeriod = year(Vertragsende) - year(contractClosing)) + dynamics = tail(ctr.data, -1) + # browser() + + # Calculate main part + args = as.list(mainPart) + tarifName = args$tarif; + tarifID = paste0(tarifName, "/", args$GV); + args$tarif = XXXCOMPANYXXX.Tariff(tarifName, args$GV) + + if (is.null(args$tarif)) { + warning("Unable to find Tarif for Product/GV", tarifID) + return( + data.frame(tarif = "?", mainPart.orig, Scheiben = NROW(ctr.data), date = balanceSheetDate, time = 0, Zillmer = 0, gamma = 0, `Balance Sheet Reserve` = 0, `unearned Premiums` = 0) + ) + } + + ################### + # Tariff-specific adjustments to the input data: + #------------------ + # TODO: Implement all required tariff-specific adjustments here + + if (debug) { + dbg.args = args; + dbg.args$tarif = NULL; + + arguments = sapply(substitute(list(...))[-1], deparse); + prepare.dbg.args = function(x) { + if (is.function(x)) {paste(deparse(x), collapse = "\n\t\t")} + else if (is.expression(x)) {as.character(x)} + else if (is.na(x)) {x} + else if (is.numeric(x)) {x} + else if (is.character(x)) {deparse(as.character(x))} + else if (is.Date(x)) {paste0("as.Date(\"", x, "\")")} + else if (is.list(x)) {deparse(x)} + else x + } + + code = paste0( + "InsuranceContract$new(\n\t", + paste( + c( + paste0("XXXCOMPANYXXX.Tariff(\"", tarifName, "\", ", dbg.args$GV, ")"), # ? und 117 + paste(paste0("`", names(dbg.args), "`"), map(dbg.args, prepare.dbg.args), sep = " = ", collapse = ",\n\t"), + paste0("balanceSheetDate = as.Date(\"", balanceSheetDate, "\")"), + paste(names(arguments), arguments, sep = " = ", collapse = ",\n\t") + ), + collapse = ", \n\t" + ), + ")"); + } + contract = do.call( + InsuranceContract$new, + c(args, list(balanceSheetDate = balanceSheetDate, ...)) + ) + + # Loop through all dynamics and call contract$addDynamics + by_row(dynamics, function(dyn, ...) { + # Vereinfachte Annahme: Dynamik ist immer am Jahrestag der Versicherung => Vergleiche nur Vertrags- mit Scheibenbeginnjahr + # TODO: Einmal-Zuzahlungen müssen erkannt und anders gehandhabt werden! + t = year(dyn$sliceDate) - year(dyn$contractClosing) + contract$addDynamics(t = t, SumInsuredDelta = dyn$sumInsured) + if (debug) { + code <<- paste0(code, "$\naddDynamics(t = ", t, ", SumInsuredDelta = ", dyn$sumInsured, ")") + } + }, ...) + + + Bilanzreserve = contract$Values$reservesBalanceSheet %>% `colnames<-`(c("Datum", "t", "Res.Netto.EY", "Res.Zillmer.EY", "Res.VwK.EY", "BilRes.EY", "PÜ.EY")) + BilDRSt = Bilanzreserve %>% filter(Datum == balanceSheetDate) + if (debug) { + BilDRSt$code = code + } + t = which(Bilanzreserve$Datum == balanceSheetDate) + + data.frame( + tarif = contract$tarif$name, + mainPart.orig, + Scheiben = NROW(ctr.data), + + # TODO: Weitere Vergleichswerte zurückliefern + Premium.net.Cmp = contract$Values$premiumComposition[[t, "net"]], + Premium.Zillmer.Cmp = contract$Values$premiumComposition[[t, "Zillmer"]], + Premium.gross.Cmp = contract$Values$premiumComposition[[t, "gross"]], + Premium.written.Cmp = contract$Values$premiumComposition[[t, "charged"]] - contract$Values$premiumComposition[[1, "tax"]], + Premium.savings.Cmp = contract$Values$premiumComposition[[t, "savings"]], + Premium.risk.Cmp = contract$Values$premiumComposition[[t, "risk"]], + Premium.alphaZ.Cmp = contract$Values$premiumComposition[[t, "alpha.Zillmer"]], + Premium.costs.Cmp = "TODO", + Premium.gamma.Cmp = contract$Values$premiumComposition[[t, "gamma"]], + Premium.sumRebate.Cmp = -contract$Values$premiumComposition[[t, "rebate.sum"]], + + DKt.Cmp = contract$Values$reserves[[t, "contractual"]], + `DKt+1.Cmp` = if (t+1 > NROW(contract$Values$reserves)) 0 else contract$Values$reserves[[t+1, "contractual"]], + `DKt+2.Cmp` = if (t+2 > NROW(contract$Values$reserves)) 0 else contract$Values$reserves[[t+2, "contractual"]], + + BilDRSt) +} + + +calculate_portfolio = function(bestand, tarif = NULL, GV = NULL, n_max = Inf, skip = 0, progress = 25, debug = FALSE, ...) { + # browser() + if (!missing(tarif) && !is.null(tarif)) { + bestand = filter(bestand, tarif %in% !!tarif) + } + if (!missing(GV) && !is.null(GV)) { + bestand = filter(bestand, GV %in% !!GV) + } + if (!missing(skip) && !is.null(skip) && skip > 0) { + bestand = tail(bestand, -skip) + } + if (!missing(n_max) && !is.null(n_max) && n_max < Inf && n_max>0) { + bestand = head(bestand, n_max) + } + + input = bestand %>% + select(all_of(colNamesRelevant)) %>% + filter(sumInsured > 0, premiumFrequency >= 0) %>% # <- Sanity Checks! + # group_by(Polizzennummer) + group_by(SliceID) + + CountPol <<- 0 + CountSlice <<- 0 + tic() + # browser() + Werte.berechnet = input %>% + by_slice(calculate_contract, balanceSheetDate = ymd("2021-12-31"), .collate = "rows", progress = progress, debug = debug, ...) + toc() + + Werte.berechnet %>% + mutate( + across(any_of( + c("contractClosing", "sliceDate", "premiumWaiverDate", "date", "birthDate") + ), as.Date, origin = "1970-01-01")) %>% + mutate( + # TODO: Implement comparisons to all values given in the XXXCOMPANYXXX portfolio file! + #date = as.Date(date, origin = "1970-01-01"), + BilRes.VU = bestand$Bilanzreserve, #`Bilanzreserve`, #+ `Bilanz.Verwaltungskostenreserve` ,#+ `Reserve.prämienfrei`, + Fehlbetrag = BilRes.Cmp - BilRes.VU, + `abs.FB` = abs(Fehlbetrag), + `rel.FB` = Fehlbetrag / BilRes.Cmp, + # `abs.FB NP` = abs(`Premium.net` - `Nettoprämie`), + `abs.FB BP` = abs(`Premium.gross.Cmp` - `Bruttoprämie`), + # `Monate verschoben` = (month(Vertragsende) != month(sliceDate)), + exclude = c(""), + Grund = c(""), + Bilanzdaten = NULL + ) +} + + + + + +###############################################################m# +## Bestände einlesen #### +###############################################################m# + +files = c( + # here("Polizzeninfos", "2021-YE", "Einzelposten_2112.xlsx") + here("Polizzeninfos", "2022-YE", "Einzelposten_2212.xlsx") +) +outfile = function(tarif) { here(paste0("XXXCOMPANYXXX_2022-YE_Vergleichsrechnung", paste(tarif, collapse = "_", sep= "_"), ".xlsx"))} + +bestandinfos.all = bind_rows(map(unique(unname(unlist(files))), readXXXCOMPANYXXXBestand, skip = 0, guess_max = 99999, n_max = 99999)) +bestandinfos.all %<>% + filter(SATZTYP != "3A") + +# Filter out all problematic contracts +bestandinfos = bestandinfos.all %>% + filter(!Polizzennummer %in% Problempolizzen) + + + +## PLAUSICHECKS auf Bestandsinfo: #### + +# Gesamtzahl verschiedene Polizzen +bestandinfos.all$Polizzennummer %>% unique %>% length +bestandinfos$Polizzennummer %>% unique %>% length + +# 1) Schnelle übersicht über Anzahl Scheiben pro Vertrag +bestandinfos %>% + group_by(Polizzennummer) %>% + summarize(n = n()) %>% + group_by(n) %>% summarize(Anzahl = n()) +bestandinfos %>% + group_by(Polizzennummer) %>% + summarize(n = n()) %>% + ggplot(aes(x = n)) + geom_histogram(binwidth = 1) + + stat_bin(aes(y=..count.., label=..count..), geom= "text", vjust=-.5) + +# 2) Überblick über Verträge, deren Scheiben alle nach Vertragsbeginn beginnen (Vertragsänderungen) + + +# 3) Prämienfreigestellte Verträge: +# -) Scheiben, die ab Abschluss prämienfrei sind +# -) Haben HV und alle Scheiben denselben Prf-Zeitpunkt? + +# 4) Basic sanity checks: VS<0, keine Prämienzahlung +bestandinfos %>% filter(premiumFrequency < 1) +bestandinfos %>% filter(sumInsured <= 0) +bestandinfos %>% filter(sliceDate < contractClosing) + + +bestandinfos %>% + group_by(Polizzennummer, GV) %>% + summarize(Anzahl = n()) %>% + filter(Anzahl>1) + + +##############################################################################m# +## +## CALCULATION #### +## +##############################################################################m# + + +# Calculate Tarif1 and Tarif2 => Copy and adjust for each run / company-specific implementation + +results = NULL; +results = calculate_portfolio(bestandinfos.all, + tarif = c("Tarif1", "Tarif2"), + #GV = c("108", "109", "111", "113", "115", "117"), + progress = 1, n_max = 9999, debug =TRUE) +results %>% + openxlsx::write.xlsx(outfile("Tarif-1-2"), asTable = TRUE, overwrite = TRUE, sheetName = "Vergleichsrechnung", tabColour = "#80FF8F") +openXL(outfile("Tarif-1-2")) + + + diff --git a/inst/rstudio/templates/project/LifeInsuranceContracts/tests/testthat.R b/inst/rstudio/templates/project/LifeInsuranceContracts/tests/testthat.R new file mode 100644 index 0000000000000000000000000000000000000000..e0b550c9a2eefca1d3d9c0fb0261a46943339c86 --- /dev/null +++ b/inst/rstudio/templates/project/LifeInsuranceContracts/tests/testthat.R @@ -0,0 +1,4 @@ +library(testthat) +library(LifeInsuranceContractsXXXCOMPANYXXX) + +test_check("LifeInsuranceContractsXXXCOMPANYXXX") diff --git a/inst/rstudio/templates/project/LifeInsuranceContracts/tests/testthat/.gitignore b/inst/rstudio/templates/project/LifeInsuranceContracts/tests/testthat/.gitignore new file mode 100644 index 0000000000000000000000000000000000000000..66e54ae32f6a2693464817ee3ac5fc2fb3daaacf --- /dev/null +++ b/inst/rstudio/templates/project/LifeInsuranceContracts/tests/testthat/.gitignore @@ -0,0 +1 @@ +testthat-problems.rds diff --git a/inst/rstudio/templates/project/LifeInsuranceContracts/tests/testthat/test-Tarif1.R b/inst/rstudio/templates/project/LifeInsuranceContracts/tests/testthat/test-Tarif1.R new file mode 100644 index 0000000000000000000000000000000000000000..dc411b5150efa46a7f29c0ff639b6e59cc4afadd --- /dev/null +++ b/inst/rstudio/templates/project/LifeInsuranceContracts/tests/testthat/test-Tarif1.R @@ -0,0 +1,41 @@ +# LifeInsuranceContracts::vmGlgExample.generateTest( +# XXXCOMPANYXXX.Tarif1, +# age=35, policyPeriod=30, sumInsured=100000, +# contractClosing = as.Date("2000-07-01")) + + +test_that("Tarif1", { + contract = InsuranceContract$new( + XXXCOMPANYXXX.Tarif1, + age = 35, + policyPeriod = 30, + sumInsured = 100000, + contractClosing = as.Date("2000-07-01") + ); + exportInsuranceContract.xlsx(contract, here("test-Tarif1.xlsx")) + openxlsx::openXL(here("test-Tarif1.xlsx")) + # showVmGlgExamples(contract, t = 10, prf = 10, t_prf = 12); + + testVmGlgExample( + contract, + t = 10, prf = 10, t_prf = 12, + net = 2208.00, + Zillmer = 2308.67, + gross = 2621.51, + written = 2726.37, + savings = 2126.58, + risk = 182.10, + ZillmerRes = 23118.57, + ZillmerRes.prf = 19931.70, + VwKostenRes = -0.00, + VwKostenRes.prf = 2245.90, + Bilanzreserve = 24560.53, + Praemienuebertrag = 1310.76, + Rueckkaufsreserve = 23118.57, + Rueckkaufswert = 21286.21, + Abschlusskostenruecktrag = 0.00, + Rueckkaufswert.prf = 22177.59, + VS.prf = 33014.59, + absTolerance = 0.01 + ); +}) diff --git a/inst/rstudio/templates/project/LifeInsuranceContracts/tests/testthat/test-Tarif2.R b/inst/rstudio/templates/project/LifeInsuranceContracts/tests/testthat/test-Tarif2.R new file mode 100644 index 0000000000000000000000000000000000000000..d3e6585c8724461544579d713a9d2d1b202f059a --- /dev/null +++ b/inst/rstudio/templates/project/LifeInsuranceContracts/tests/testthat/test-Tarif2.R @@ -0,0 +1,40 @@ +# LifeInsuranceContracts::vmGlgExample.generateTest( +# XXXCOMPANYXXX.Tarif2, +# age=35, policyPeriod = 85, sumInsured=100000, +# contractClosing = as.Date("2000-07-01"), +# t = 40) + + +test_that("Tarif2", { + contract = InsuranceContract$new( + XXXCOMPANYXXX.Tarif2, + age = 35, + policyPeriod = 85, + sumInsured = 1e+05, + contractClosing = as.Date("2000-07-01") + ); + # showVmGlgExamples(contract, t = 40, prf = 10, t_prf = 12); + + testVmGlgExample( + contract, + t = 40, prf = 10, t_prf = 12, + net = 1210.13, + Zillmer = 1210.13, + gross = 1930.16, + written = 2007.37, + savings = -137.47, + risk = 1347.60, + ZillmerRes = 63074.49, + ZillmerRes.prf = 10471.41, + VwKostenRes = -0.00, + VwKostenRes.prf = 2659.34, + Bilanzreserve = 63949.81, + Praemienuebertrag = 965.08, + Rueckkaufsreserve = 63074.49, + Rueckkaufswert = 63074.49, + Abschlusskostenruecktrag = 0.00, + Rueckkaufswert.prf = 13130.75, + VS.prf = 80461.07, + absTolerance = 0.01 + ); +}) diff --git a/man/InsuranceContract.ParameterDefaults.Rd b/man/InsuranceContract.ParameterDefaults.Rd index 6f30bfcf9a2b0e4334a85e3fd7255955fd7d5e03..c8fe4b31e92f74f71d39d40d1908f5e2873b8195 100644 --- a/man/InsuranceContract.ParameterDefaults.Rd +++ b/man/InsuranceContract.ParameterDefaults.Rd @@ -316,6 +316,7 @@ participation rates are defined at the level of profit classes.} \item{\code{$adjustPresentValues}}{Adjust the present value vectors that are later used to derive premiums and reserves. \code{function(presentValues, params, values)}} \item{\code{$adjustPresentValuesCosts}}{Adjust the present value cost vectors used to derive premiums and reserves. \code{function(presentValuesCosts, params, values)}} \item{\code{$adjustPremiumCoefficients}}{Function with signature \code{function(coeff, type, premiums, params, values, premiumCalculationTime)} to adjust the coefficients for premium calculation after their default setup. Use cases are e.g. term-fix tariffs where the Zillmer premium term contains the administration cost over the whole contract, but not other gamma- or beta-costs.} +\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)}} }