Provide function to load sample tables provided by the package. Austrian...

Provide function to load sample tables provided by the package. Austrian tables are already properly loaded.

DESCRIPTION

@@ -21,7 +21,6 @@ Description: This package provides classes to implement cohort life tables
 License: GPL (>= 2)
 RoxygenNote: 5.0.1
 Collate:
-    'ValuationTables.R'
     'valuationTable.R'
     'valuationTable.period.R'
     'valuationTable.ageShift.R'
@@ -45,3 +44,4 @@ Collate:
     'plotValuationTables.R'
     'setLoading.R'
     'undampenTrend.R'
+    'valuationTables.load.R'

NAMESPACE

@@ -11,6 +11,7 @@ export(valuationTable.mixed)
 export(valuationTable.observed)
 export(valuationTable.period)
 export(valuationTable.trendProjection)
+export(valuationTables.load)
 exportClasses(valuationTable)
 exportClasses(valuationTable.ageShift)
 exportClasses(valuationTable.improvementFactors)

R/ages.R

@@ -3,7 +3,7 @@ NULL
 
 #' Return the defined ages of the life table
 #'
-#' @param object A life table object (instance of a \code{valuationTable} class)
+#' @param object A life table object (instance of a \code{\linkS4class{valuationTable}} class)
 #' @param ... Currently unused
 #'
 #' @exportMethod ages
@@ -15,13 +15,13 @@ setMethod("ages", "valuationTable.period",
               object@ages;
           })
 
-#' @describeIn ages Return the defined ages of the life table
+# @describeIn ages Return the defined ages of the life table
 setMethod("ages", "valuationTable.mixed",
           function (object, ...) {
               ages(object@table1);
           })
 
-#' @describeIn ages Return the defined ages of the life table
+# @describeIn ages Return the defined ages of the life table
 setMethod("ages", "valuationTable.joined",
           function (object, ...) {
               ages(object@table1);

R/valuationTables.load.R

+#' Load a named set of life tables provided by the \link{ValuationTables} package
+#'
+#' @param dataset The set of life tables to be loaded. A list of all available data sets is provided by the
+#'
+#' @export
+valuationTables.load = function(dataset) {
+    setname = gsub("[^-A-Za-z0-9_.]", "", dataset);
+    filename = system.file("extdata", paste("ValuationTables_", setname, ".R", sep = ""), package="ValuationTables");
+    if (filename != "") {
+        sys.source(filename, envir = globalenv())
+        #envir=topenv())
+    } else {
+        warning(sprintf("Unable to locate dataset '%s' provided by the ValuationTables package!", setname));
+    }
+}

data/ValuationTables_Austria_Annuities.R → inst/extdata/ValuationTables_Austria_Annuities.R

@@ -5,9 +5,9 @@ stopifnot(require(methods), require(utils), require(ValuationTables)) # Valuatio
 ### RR67 Rententafel für Männer, 3%
 ###############################################################################
 
-rr67.data = utils::read.csv("Austria_Annuities_RR67.csv", skip=2)
+rr67.data = utils::read.csv(system.file("extdata", "Austria_Annuities_RR67.csv", package="ValuationTables"), skip=2)
 
-rr67 = valuationTable_period(
+rr67 = valuationTable.period(
   name = "ÖVM 59/61 RR67", ages = rr67.data$Alter, deathProbs = rr67.data$qx
 );
 rm(rr67.data);
@@ -17,38 +17,40 @@ rm(rr67.data);
 ### EROM/EROF 85 and G 1985 (period and age-shifted generation)
 ###############################################################################
 
-eromf.data = utils::read.csv("Austria_Annuities_EROMF.csv", skip=2)
 
-erom85.male = new("valuationTable_period",
+eromf.data = utils::read.csv(system.file("extdata", "Austria_Annuities_EROMF.csv", package="ValuationTables"), skip=2)
+
+erom85.male = new("valuationTable.period",
   name = "EROM 85, male", ages = eromf.data$Alter, deathProbs = eromf.data$EROM.85
 );
-erom85.female = new("valuationTable_period",
+erom85.female = new("valuationTable.period",
   name = "EROF 85, female", ages = eromf.data$Alter, deathProbs = eromf.data$EROF.85
 );
 
-EROM.G1950.male = new("valuationTable_period",
+EROM.G1950.male = new("valuationTable.period",
   name = "EROM G 1950 Basistafel, male",
   ages = eromf.data$Alter,
   deathProbs = eromf.data$EROM.G1950,
   baseYear = 1950
 );
-EROF.G1950.female = new("valuationTable_period",
+EROF.G1950.female = new("valuationTable.period",
   name = "EROF G 1950 Basistafel, female",
   ages = eromf.data$Alter,
   deathProbs = eromf.data$EROF.G1950,
   baseYear = 1950
 );
 
-eromf.data.av = utils::read.csv("Austria_Annuities_EROMF_AV.csv", skip=2)
 
-EROM.G1950.male.av = valuationTable_ageShift(
+eromf.data.av = utils::read.csv(system.file("extdata", "Austria_Annuities_EROMF_AV.csv", package="ValuationTables"), skip=2)
+
+EROM.G1950.male.av = valuationTable.ageShift(
   name = "EROM G 1950 mit Altersverschiebung, male",
   ages = eromf.data$Alter,
   deathProbs = eromf.data$EROM.G1950,
   ageShifts = eromf.data.av["Shift.M"],
   baseYear = 1950
 );
-EROF.G1950.female.av = valuationTable_ageShift(
+EROF.G1950.female.av = valuationTable.ageShift(
   name = "EROF G 1950 mit Altersverschiebung, female",
   ages = eromf.data$Alter,
   deathProbs = eromf.data$EROF.G1950,
@@ -63,7 +65,7 @@ rm(eromf.data, eromf.data.av)
 # AVÖ 1996R exact (Male, Female), 1st-order only
 ###############################################################################
 
-AVOe1996R.exakt.data = utils::read.csv("Austria_Annuities_AVOe1996R.csv", skip=2)
+AVOe1996R.exakt.data = utils::read.csv(system.file("extdata", "Austria_Annuities_AVOe1996R.csv", package="ValuationTables"), skip=2)
 
 AVOe1996R.trend.switching = function(year) {
   if (year <= 1971) {
@@ -79,7 +81,7 @@ AVOe1996R.trend.switching = function(year) {
   }
 }
 
-AVÖ1996R.male = new("valuationTable_trendProjection",
+AVÖ1996R.male = new("valuationTable.trendProjection",
   name = "AVÖ 1996R male",
   ages = AVOe1996R.exakt.data$age, baseYear = 1991,
   deathProbs = AVOe1996R.exakt.data$qx1991 * AVOe1996R.exakt.data$factorM,
@@ -87,7 +89,7 @@ AVÖ1996R.male = new("valuationTable_trendProjection",
   trend2 = AVOe1996R.exakt.data$trendM.short,
   dampingFunction = AVOe1996R.trend.switching
 );
-AVÖ1996R.female = new("valuationTable_trendProjection",
+AVÖ1996R.female = new("valuationTable.trendProjection",
   name = "AVÖ 1996R female",
   ages = AVOe1996R.exakt.data$age, baseYear = 1991,
   deathProbs = AVOe1996R.exakt.data$qy1991 * AVOe1996R.exakt.data$factorF,
@@ -95,7 +97,7 @@ AVÖ1996R.female = new("valuationTable_trendProjection",
   trend2 = AVOe1996R.exakt.data$trendF.short,
   dampingFunction = AVOe1996R.trend.switching
 );
-AVÖ1996R.male.group = new("valuationTable_trendProjection",
+AVÖ1996R.male.group = new("valuationTable.trendProjection",
   name = "AVÖ 1996R male, group",
   ages = AVOe1996R.exakt.data$age, baseYear = 1991,
   deathProbs = AVOe1996R.exakt.data$qx1991 * AVOe1996R.exakt.data$factorMG,
@@ -103,7 +105,7 @@ AVÖ1996R.male.group = new("valuationTable_trendProjection",
   trend2 = AVOe1996R.exakt.data$trendM.short,
   dampingFunction = AVOe1996R.trend.switching
 );
-AVÖ1996R.female.group = new("valuationTable_trendProjection",
+AVÖ1996R.female.group = new("valuationTable.trendProjection",
   name = "AVÖ 1996R female, group",
   ages = AVOe1996R.exakt.data$age, baseYear = 1991,
   deathProbs = AVOe1996R.exakt.data$qy1991 * AVOe1996R.exakt.data$factorFG,
@@ -121,7 +123,7 @@ rm(AVOe1996R.exakt.data)
 # gender-specific tables also have 2nd-order tables, unisex only 1st-order table
 ###############################################################################
 
-AVOe2005R.exakt.data = utils::read.csv("Austria_Annuities_AVOe2005R.csv", skip = 2);
+AVOe2005R.exakt.data = utils::read.csv(system.file("extdata", "Austria_Annuities_AVOe2005R.csv", package="ValuationTables"), skip = 2);
 
 AVOe2005R.trend.damping = function(t) {
   100*atan(t/100)
@@ -129,7 +131,7 @@ AVOe2005R.trend.damping = function(t) {
 AVOe2005R_gen = function(nm, probs, trend) {
   with(
     AVOe2005R.exakt.data,
-    new("valuationTable_trendProjection",
+    new("valuationTable.trendProjection",
       name = nm,
       ages = age, baseYear = 2001,
       deathProbs = AVOe2005R.exakt.data[[probs]], trend = AVOe2005R.exakt.data[[trend]],
@@ -161,11 +163,12 @@ AVOe2005R.unisex.nodamping.group    = undampenTrend(AVOe2005R.unisex.group);
 #AVÖ 2005R with age-shifting (Male, Female, unisex), 1st-order only
 ###############################################################################
 
-AVOe2005R.av.base = utils::read.csv("Austria_Annuities_AVOe2005R_AVBasis.csv", skip=2);
-AVOe2005R.av.verschiebung = utils::read.csv("Austria_Annuities_AVOe2005R_AVShifts.csv", skip=2);
+
+AVOe2005R.av.base = utils::read.csv(system.file("extdata", "Austria_Annuities_AVOe2005R_AVBasis.csv", package="ValuationTables"), skip=2);
+AVOe2005R.av.verschiebung = utils::read.csv(system.file("extdata", "Austria_Annuities_AVOe2005R_AVShifts.csv", package="ValuationTables"), skip=2);
 
 AVOe2005R_gen.av = function(nm, probs, shft) {
-  new("valuationTable_ageShift",
+  new("valuationTable.ageShift",
     name = nm,
     ages = AVOe2005R.av.base$age,
     deathProbs = AVOe2005R.av.base[[probs]],
@@ -193,3 +196,5 @@ AVOe2005R.unisex.group.av = AVOe2005R_gen.av("AVÖ 2005R unisex group (age-shift
 # plotValuationTables(mort.AT.census.2001.male, AVOe2005R.male, YOB = 1972, title = "Vergleich österreichische Sterbetafeln")
 # plotValuationTables(getCohortTable(AVOe2005R.male, YOB = 1972), getCohortTable(AVOe2005R.male, YOB = 2016), title = "Vergleich österreichische Sterbetafeln")
 
+# makeQxDataFrame(mort.AT.census.1869.male, mort.AT.census.1869.female, mort.AT.census.2011.male, mort.AT.census.2011.female, AVOe2005R.male, AVOe2005R.female, YOB = 1972)
+# makeQxDataFrame()

data/ValuationTables_Austria_Census.R → inst/extdata/ValuationTables_Austria_Census.R

 stopifnot(require(methods), require(utils), require(ValuationTables)) # ValuationTable classes; new; Excel reader
 
 
-require(ValuationTables)
 ###############################################################################
 ### Volkszählungen Österreich
 ###############################################################################
 
-a.vz.dataM = utils::read.csv("Austria_Census_Male.csv", skip=3);
-a.vz.dataF = utils::read.csv("Austria_Census_Female.csv", skip=3);
+
+a.vz.dataM = utils::read.csv(system.file("extdata", "Austria_Census_Male.csv", package="ValuationTables"), skip=3);
+a.vz.dataF = utils::read.csv(system.file("extdata", "Austria_Census_Female.csv", package="ValuationTables"), skip=3);
 
 censtable = function(data, name, qslot, baseYear=1900) {
   qx=data[names(data)==qslot];
   ix=complete.cases(qx);
-  ValuationTables::valuationTable_period(name=name, ages=data$x[ix], deathProbs=qx[ix,], baseYear=baseYear)
+  ValuationTables::valuationTable.period(name=name, ages=data$x[ix], deathProbs=qx[ix,], baseYear=baseYear)
 }
 
 mort.AT.census.1869.male = censtable(a.vz.dataM, name="ÖVSt 1868/71 M",   baseYear=1869, qslot="X1868.71");
@@ -43,7 +43,7 @@ mort.AT.census.1991.female = censtable(a.vz.dataF, name="ÖVSt 1990/92 F",   bas
 mort.AT.census.2001.female = censtable(a.vz.dataF, name="ÖVSt 2000/02 F",   baseYear=2001, qslot="X2000.02");
 mort.AT.census.2011.female = censtable(a.vz.dataF, name="ÖVSt 2010/2012 F", baseYear=2011, qslot="X2010.12");
 
-mort.AT.census.2001.unisex = valuationTable_mixed(table1=mort.AT.census.2001.male, table2=mort.AT.census.2001.female)
+mort.AT.census.2001.unisex = valuationTable.mixed(table1=mort.AT.census.2001.male, table2=mort.AT.census.2001.female)
 
 mort.AT.census.ALL.male = ValuationTables::makeQxDataFrame(
               mort.AT.census.1869.male,

man/ages.Rd

@@ -3,8 +3,6 @@
 \docType{methods}
 \name{ages}
 \alias{ages}
-\alias{ages,valuationTable.joined-method}
-\alias{ages,valuationTable.mixed-method}
 \alias{ages,valuationTable.observed-method}
 \alias{ages,valuationTable.period-method}
 \title{Return the defined ages of the life table}
@@ -13,14 +11,10 @@ ages(object, ...)
 
 \S4method{ages}{valuationTable.period}(object, ...)
 
-\S4method{ages}{valuationTable.mixed}(object, ...)
-
-\S4method{ages}{valuationTable.joined}(object, ...)
-
 \S4method{ages}{valuationTable.observed}(object, ...)
 }
 \arguments{
-\item{object}{A life table object (instance of a \code{valuationTable} class)}
+\item{object}{A life table object (instance of a \code{\linkS4class{valuationTable}} class)}
 
 \item{...}{Currently unused}
 }
@@ -31,10 +25,6 @@ Return the defined ages of the life table
 \itemize{
 \item \code{valuationTable.period}: Return the defined ages of the life table
 
-\item \code{valuationTable.mixed}: Return the defined ages of the life table
-
-\item \code{valuationTable.joined}: Return the defined ages of the life table
-
 \item \code{valuationTable.observed}: Return the defined ages of the life table
 }}
 

man/valuationTable_trendProjection-class.Rd

-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/ValuationTables.R
-\docType{class}
-\name{valuationTable_trendProjection-class}
-\alias{deathProbabilities,valuationTable_trendProjection-method}
-\alias{periodDeathProbabilities,valuationTable_trendProjection-method}
-\alias{undampenTrend,valuationTable_trendProjection-method}
-\alias{valuationTable_trendProjection}
-\alias{valuationTable_trendProjection-class}
-\title{A cohort life table, obtained by a trend projection from a given base table
-(PODs for a given observation year). Typically, the trend is obtained by
-the Lee-Carter method or some other trend estimation.
-The dampingFunction can be used to modify the cumulative years (e.g. G(tau+x) instead of tau+x)
-If trend2 is given, the G(tau+x) gives the weight of the first trend, 1-G(tau+x) the weight of the second trend}
-\usage{
-\S4method{deathProbabilities}{valuationTable_trendProjection}(object, ...,
-  YOB = 1975)
-
-\S4method{periodDeathProbabilities}{valuationTable_trendProjection}(object, ...,
-  Period = 1975)
-
-undampenTrend(object)
-
-\S4method{undampenTrend}{valuationTable_trendProjection}(object)
-}
-\arguments{
-\item{YOB}{The birth year for which the death probabilities should be calculated}
-
-\item{Period}{The observation year for which the period death probabilities should be determined}
-}
-\description{
-A cohort life table, obtained by a trend projection from a given base table
-(PODs for a given observation year). Typically, the trend is obtained by
-the Lee-Carter method or some other trend estimation.
-The dampingFunction can be used to modify the cumulative years (e.g. G(tau+x) instead of tau+x)
-If trend2 is given, the G(tau+x) gives the weight of the first trend, 1-G(tau+x) the weight of the second trend
-
-Return the (cohort) death probabilities of the life table given the birth year (if needed)
-
-Return the (period) death probabilities of the life table for a given observation year
-
-Return a \code{valuationTable_trensProjection} object with the trend damping removed.
-
-Return a \code{valuationTable_trensProjection} object with the trend damping removed.
-}
-\section{Slots}{
-
-\describe{
-\item{\code{baseYear}}{The base year of the trend projection (\code{baseTable} describes the death probabilities in this year)}
-
-\item{\code{trend}}{The yearly improvements of the log-death probabilities (per age)}
-
-\item{\code{dampingFunction}}{A possible damping of the trend. This is a function \code{damping(delta_years)} that gets a vector of years from the baseYear and should return the dampened values.}
-
-\item{\code{trend2}}{The alternate trend. If given, the damping function interpolates between \code{trend} and \code{trend2}, otherwise the dumping function simply modifies the coefficients of \code{trend}.}
-}}
-

man/valuationTables.load.Rd

+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/valuationTables.load.R
+\name{valuationTables.load}
+\alias{valuationTables.load}
+\title{Load a named set of life tables provided by the \link{ValuationTables} package}
+\usage{
+valuationTables.load(dataset)
+}
+\arguments{
+\item{dataset}{The set of life tables to be loaded. A list of all available data sets is provided by the}
+}
+\description{
+Load a named set of life tables provided by the \link{ValuationTables} package
+}
+