From 231dfce6b910a182614286225a444a0bae06599f Mon Sep 17 00:00:00 2001
From: Reinhold Kainhofer <reinhold@kainhofer.com>
Date: Sun, 31 Oct 2021 11:42:55 +0100
Subject: [PATCH] Add testVmGlgExample function
---
NAMESPACE | 1 +
R/showVmGlgExamples.R | 125 ++++++++++++++++++++++++++++++++++++++++
man/testVmGlgExample.Rd | 90 +++++++++++++++++++++++++++++
3 files changed, 216 insertions(+)
create mode 100644 man/testVmGlgExample.Rd
diff --git a/NAMESPACE b/NAMESPACE
index 13acd86..62208a0 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -77,6 +77,7 @@ export(rollingmean)
export(setCost)
export(showVmGlgExamples)
export(sumProfits)
+export(testVmGlgExample)
export(valueOrFunction)
exportClasses(CalculationSingleEnum)
exportClasses(PaymentTimeSingleEnum)
diff --git a/R/showVmGlgExamples.R b/R/showVmGlgExamples.R
index 709f672..e455fb6 100644
--- a/R/showVmGlgExamples.R
+++ b/R/showVmGlgExamples.R
@@ -113,3 +113,128 @@ showVmGlgExamples = function(contract, prf = 10, t = 10, t_prf = 12, file = "",
cat(paste(output, collapse = '\r\n'), file = file)
}
+
+
+#' Perform unit tests of given standard values of the insurance contract example
+#'
+#' Check the values of the example calculation of the given insurance contract
+#' as required by the Austrian regulation (LV-VMGLV, "LV
+#' Versicherungsmathematische Grundlagen Verordnung").
+#' Missing params not passed to the function call will be silently ignored and
+#' not cause unit test failures.
+#'
+#' @param contract The insurance contract to calculate and check
+#' @param t Time for which to check all values (except premium-free values)
+#' @param prf Time of premium waiver (premium-free)
+#' @param t_prf Time for which to check all values after the premium waiver
+#' @param net, Zillmer, gross, written, savings, risk, ZillmerRes, ZillmerRes.prf, VwKostenRes, VwKostenRes.prf, Bilanzreserve, Prämienübertrag, Rückkaufsreserve, Rückkaufswert, Abschlusskostenrücktrag, Rückkaufswert.prf, VS.prf Values as printed out by showVmGlgExamples
+#' @param tolerance If non-NULL, will ignore small floating point differences. It uses same algorithm as all.equal()
+#'
+#' @examples
+#' library(MortalityTables)
+#' mortalityTables.load("Austria_Annuities_AVOe2005R")
+#'
+#' \dontrun{
+#' test_that("Testtarif", {
+#' # A trivial deferred annuity tariff with no costs:
+#' tariff = InsuranceTarif$new(name="Test Annuity", type="annuity",
+#' mortalityTable = AVOe2005R.unisex, i=0.01)
+#' contract = InsuranceContract$new(
+#' tariff,
+#' age = 35, YOB = 1981,
+#' policyPeriod = 30, premiumPeriod = 15, deferralPeriod = 15,
+#' sumInsured = 1000,
+#' contractClosing = as.Date("2016-10-01")
+#' );
+#'
+#' testVmGlgExample(
+#' contract, t = 10,
+#' net = 850.09, # NOT_CHECKED: Zillmer = 950.09,
+#' gross = 850.09,
+#' written = 884.09,
+#' savings = 857.09, risk = -7.00,
+#' ZillmerRes = 9011.40,
+#' ZillmerRes.prf = 9205.96,
+#' VwKostenRes = 0.00,
+#' VwKostenRes.prf = 0.00,
+#' Bilanzreserve = 9250.35,
+#' Prämienübertrag = 212.52,
+#' Rückkaufsreserve = 9011.40,
+#' Rückkaufswert = 9011.40,
+#' Abschlusskostenrücktrag = 0.00,
+#' Rückkaufswert.prf = 9205.96,
+#' VS.prf = 685.12
+#' )
+#' })
+#'}
+#'
+#' @export
+testVmGlgExample = function(contract, prf = 10, t = 10, t_prf = 12, net, Zillmer, gross, written, savings, risk,
+ ZillmerRes, ZillmerRes.prf, VwKostenRes, VwKostenRes.prf,
+ Bilanzreserve, Prämienübertrag,
+ Rückkaufsreserve, Rückkaufswert, Abschlusskostenrücktrag,
+ Rückkaufswert.prf, VS.prf, tolerance = 0.01
+) {
+ has.prf = prf < contract$Parameters$ContractData$premiumPeriod;
+
+ if (has.prf) {
+ contract.prf = contract$clone();
+ contract.prf$premiumWaiver(t = prf)
+ }
+ if (!missing(net)) {
+ eval(bquote(expect_equal(contract$Values$premiums[["net"]], .(net), tolerance = tolerance)))
+ }
+ if (!missing(Zillmer)) {
+ eval(bquote(expect_equal(contract$Values$premiums[["Zillmer"]], .(Zillmer), tolerance = tolerance)))
+ }
+ if (!missing(gross)) {
+ eval(bquote(expect_equal(contract$Values$premiums[["gross"]], .(gross), tolerance = tolerance)))
+ }
+ if (!missing(written)) {
+ eval(bquote(expect_equal(contract$Values$premiums[["written"]], .(written), tolerance = tolerance)))
+ }
+ if (!missing(savings)) {
+ eval(bquote(expect_equal(contract$Values$premiumComposition[[t + 1, "Zillmer.savings"]], .(savings), tolerance = tolerance)))
+ }
+ if (!missing(risk)) {
+ eval(bquote(expect_equal(contract$Values$premiumComposition[[t + 1, "Zillmer.risk"]], .(risk), tolerance = tolerance)))
+ }
+
+ if (!missing(ZillmerRes)) {
+ eval(bquote(expect_equal(contract$Values$reserves[[t + 1, "Zillmer"]], .(ZillmerRes), tolerance = tolerance)))
+ }
+ if (!missing(ZillmerRes.prf)) {
+ eval(bquote(expect_equal(contract.prf$Values$reserves[[t_prf + 1, "Zillmer"]], .(ZillmerRes.prf), tolerance = tolerance)))
+ }
+ if (!missing(VwKostenRes)) {
+ eval(bquote(expect_equal(contract$Values$reserves[[t + 1, "gamma"]], .(VwKostenRes), tolerance = tolerance)))
+ }
+ if (!missing(VwKostenRes.prf)) {
+ eval(bquote(expect_equal(contract.prf$Values$reserves[[t_prf + 1, "gamma"]], .(VwKostenRes.prf), tolerance = tolerance)))
+ }
+
+
+ if (!missing(Bilanzreserve)) {
+ eval(bquote(expect_equal(contract$Values$reservesBalanceSheet[[t + 1, "Balance Sheet Reserve"]], .(Bilanzreserve), tolerance = tolerance)))
+ }
+ if (!missing(Prämienübertrag)) {
+ eval(bquote(expect_equal(contract$Values$reservesBalanceSheet[[t + 1, "unearned Premiums"]], .(Prämienübertrag), tolerance = tolerance)))
+ }
+
+ if (!missing(Rückkaufsreserve)) {
+ eval(bquote(expect_equal(contract$Values$reserves[[t + 1, "reduction"]], .(Rückkaufsreserve), tolerance = tolerance)))
+ }
+ if (!missing(Rückkaufswert)) {
+ eval(bquote(expect_equal(contract$Values$reserves[[t + 1, "Surrender"]], .(Rückkaufswert), tolerance = tolerance)))
+ }
+ if (!missing(Abschlusskostenrücktrag)) {
+ eval(bquote(expect_equal(contract$Values$reserves[[t + 1, "alphaRefund"]], .(Abschlusskostenrücktrag), tolerance = tolerance)))
+ }
+ if (!missing(Rückkaufswert.prf)) {
+ eval(bquote(expect_equal(contract.prf$Values$reserves[t_prf + 1, "Surrender"], .(Rückkaufswert.prf), tolerance = tolerance)))
+ }
+ if (!missing(VS.prf)) {
+ eval(bquote(expect_equal(contract.prf$Values$reserves[t_prf + 1, "PremiumFreeSumInsured"], .(VS.prf), tolerance = tolerance)))
+ # OR: contract$Values$reserves[t + 1, "PremiumFreeSumInsured"]
+ }
+}
diff --git a/man/testVmGlgExample.Rd b/man/testVmGlgExample.Rd
new file mode 100644
index 0000000..c32ff86
--- /dev/null
+++ b/man/testVmGlgExample.Rd
@@ -0,0 +1,90 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/showVmGlgExamples.R
+\name{testVmGlgExample}
+\alias{testVmGlgExample}
+\title{Perform unit tests of given standard values of the insurance contract example}
+\usage{
+testVmGlgExample(
+ contract,
+ prf = 10,
+ t = 10,
+ t_prf = 12,
+ net,
+ Zillmer,
+ gross,
+ written,
+ savings,
+ risk,
+ ZillmerRes,
+ ZillmerRes.prf,
+ VwKostenRes,
+ VwKostenRes.prf,
+ Bilanzreserve,
+ Prämienübertrag,
+ Rückkaufsreserve,
+ Rückkaufswert,
+ Abschlusskostenrücktrag,
+ Rückkaufswert.prf,
+ VS.prf,
+ tolerance = 0.01
+)
+}
+\arguments{
+\item{contract}{The insurance contract to calculate and check}
+
+\item{prf}{Time of premium waiver (premium-free)}
+
+\item{t}{Time for which to check all values (except premium-free values)}
+
+\item{t_prf}{Time for which to check all values after the premium waiver}
+
+\item{net, }{Zillmer, gross, written, savings, risk, ZillmerRes, ZillmerRes.prf, VwKostenRes, VwKostenRes.prf, Bilanzreserve, Prämienübertrag, Rückkaufsreserve, Rückkaufswert, Abschlusskostenrücktrag, Rückkaufswert.prf, VS.prf Values as printed out by showVmGlgExamples}
+
+\item{tolerance}{If non-NULL, will ignore small floating point differences. It uses same algorithm as all.equal()}
+}
+\description{
+Check the values of the example calculation of the given insurance contract
+as required by the Austrian regulation (LV-VMGLV, "LV
+Versicherungsmathematische Grundlagen Verordnung").
+Missing params not passed to the function call will be silently ignored and
+not cause unit test failures.
+}
+\examples{
+library(MortalityTables)
+mortalityTables.load("Austria_Annuities_AVOe2005R")
+
+\dontrun{
+test_that("Testtarif", {
+ # A trivial deferred annuity tariff with no costs:
+ tariff = InsuranceTarif$new(name="Test Annuity", type="annuity",
+ mortalityTable = AVOe2005R.unisex, i=0.01)
+ contract = InsuranceContract$new(
+ tariff,
+ age = 35, YOB = 1981,
+ policyPeriod = 30, premiumPeriod = 15, deferralPeriod = 15,
+ sumInsured = 1000,
+ contractClosing = as.Date("2016-10-01")
+ );
+
+ testVmGlgExample(
+ contract, t = 10,
+ net = 850.09, # NOT_CHECKED: Zillmer = 950.09,
+ gross = 850.09,
+ written = 884.09,
+ savings = 857.09, risk = -7.00,
+ ZillmerRes = 9011.40,
+ ZillmerRes.prf = 9205.96,
+ VwKostenRes = 0.00,
+ VwKostenRes.prf = 0.00,
+ Bilanzreserve = 9250.35,
+ Prämienübertrag = 212.52,
+ Rückkaufsreserve = 9011.40,
+ Rückkaufswert = 9011.40,
+ Abschlusskostenrücktrag = 0.00,
+ Rückkaufswert.prf = 9205.96,
+ VS.prf = 685.12
+ )
+})
+}
+
+}
--
GitLab