Add testVmGlgExample function

NAMESPACE

@@ -77,6 +77,7 @@ export(rollingmean)
 export(setCost)
 export(showVmGlgExamples)
 export(sumProfits)
+export(testVmGlgExample)
 export(valueOrFunction)
 exportClasses(CalculationSingleEnum)
 exportClasses(PaymentTimeSingleEnum)

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"]
+    }
+}

man/testVmGlgExample.Rd

+% 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
+    )
+})
+}
+
+}