diff --git a/DESCRIPTION b/DESCRIPTION index f9e94ff9fef8dbe28b164ad176ff8624e13f7da2..c4b78d2479ee0b506b3bcdbfb85497002ab0117f 100644 --- a/DESCRIPTION +++ b/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' diff --git a/NAMESPACE b/NAMESPACE index 8481cfa6914c7f799deedbfd234d828bc822a7c3..47dcd9a25bea71821d3413ff7f23e2b778885065 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/ages.R b/R/ages.R index ff28f762f5e4606c0af9f22c91754ccaf234a6ae..d1b129584c5a404406e593ef07468b7868fc1353 100644 --- a/R/ages.R +++ b/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); diff --git a/R/valuationTables.load.R b/R/valuationTables.load.R new file mode 100644 index 0000000000000000000000000000000000000000..a2ed13331ad1e4278f34db5e1395388b80a41bfc --- /dev/null +++ b/R/valuationTables.load.R @@ -0,0 +1,15 @@ +#' 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)); + } +} diff --git a/src/Tables/Austria_Annuities.xlsx b/data-raw/Austria_Annuities.xlsx similarity index 100% rename from src/Tables/Austria_Annuities.xlsx rename to data-raw/Austria_Annuities.xlsx diff --git a/data-raw/Austria_Census.xlsx b/data-raw/Austria_Census.xlsx new file mode 100644 index 0000000000000000000000000000000000000000..308b8e3a7e3afa82ba504f2c8142952727a05490 Binary files /dev/null and b/data-raw/Austria_Census.xlsx differ diff --git a/data/Austria_Annuities_AVOe1996R.csv b/inst/extdata/Austria_Annuities_AVOe1996R.csv similarity index 100% rename from data/Austria_Annuities_AVOe1996R.csv rename to inst/extdata/Austria_Annuities_AVOe1996R.csv diff --git a/data/Austria_Annuities_AVOe2005R.csv b/inst/extdata/Austria_Annuities_AVOe2005R.csv similarity index 100% rename from data/Austria_Annuities_AVOe2005R.csv rename to inst/extdata/Austria_Annuities_AVOe2005R.csv diff --git a/data/Austria_Annuities_AVOe2005R_AVBasis.csv b/inst/extdata/Austria_Annuities_AVOe2005R_AVBasis.csv similarity index 100% rename from data/Austria_Annuities_AVOe2005R_AVBasis.csv rename to inst/extdata/Austria_Annuities_AVOe2005R_AVBasis.csv diff --git a/data/Austria_Annuities_AVOe2005R_AVShifts.csv b/inst/extdata/Austria_Annuities_AVOe2005R_AVShifts.csv similarity index 100% rename from data/Austria_Annuities_AVOe2005R_AVShifts.csv rename to inst/extdata/Austria_Annuities_AVOe2005R_AVShifts.csv diff --git a/data/Austria_Annuities_EROMF.csv b/inst/extdata/Austria_Annuities_EROMF.csv similarity index 100% rename from data/Austria_Annuities_EROMF.csv rename to inst/extdata/Austria_Annuities_EROMF.csv diff --git a/data/Austria_Annuities_EROMF_AV.csv b/inst/extdata/Austria_Annuities_EROMF_AV.csv similarity index 100% rename from data/Austria_Annuities_EROMF_AV.csv rename to inst/extdata/Austria_Annuities_EROMF_AV.csv diff --git a/data/Austria_Annuities_RR67.csv b/inst/extdata/Austria_Annuities_RR67.csv similarity index 100% rename from data/Austria_Annuities_RR67.csv rename to inst/extdata/Austria_Annuities_RR67.csv diff --git a/data/Austria_Census_Female.csv b/inst/extdata/Austria_Census_Female.csv similarity index 100% rename from data/Austria_Census_Female.csv rename to inst/extdata/Austria_Census_Female.csv diff --git a/data/Austria_Census_Male.csv b/inst/extdata/Austria_Census_Male.csv similarity index 100% rename from data/Austria_Census_Male.csv rename to inst/extdata/Austria_Census_Male.csv diff --git a/data/ValuationTables_Austria_Annuities.R b/inst/extdata/ValuationTables_Austria_Annuities.R similarity index 80% rename from data/ValuationTables_Austria_Annuities.R rename to inst/extdata/ValuationTables_Austria_Annuities.R index 1788be27c89ccea5c0c0b1fd5daf600dc3972924..813565221b0b6d87464e273bba66a2521000d58b 100644 --- a/data/ValuationTables_Austria_Annuities.R +++ b/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() diff --git a/data/ValuationTables_Austria_Census.R b/inst/extdata/ValuationTables_Austria_Census.R similarity index 93% rename from data/ValuationTables_Austria_Census.R rename to inst/extdata/ValuationTables_Austria_Census.R index cfd187424b545f9c0ea3a0204393624e079dd19d..3f147e437127c92c272875cd17397b8e6133dfe5 100644 --- a/data/ValuationTables_Austria_Census.R +++ b/inst/extdata/ValuationTables_Austria_Census.R @@ -1,18 +1,18 @@ 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, diff --git a/man/ages.Rd b/man/ages.Rd index 142107aca58763a04be285bc446514d0e8dc938e..3843939cf255244a8aa8111d5f07aa73e477663e 100644 --- a/man/ages.Rd +++ b/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 }} diff --git a/man/valuationTable_trendProjection-class.Rd b/man/valuationTable_trendProjection-class.Rd deleted file mode 100644 index 48bf30db88285d4e37a5cc9ed18ba68c30990c89..0000000000000000000000000000000000000000 --- a/man/valuationTable_trendProjection-class.Rd +++ /dev/null @@ -1,57 +0,0 @@ -% 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}.} -}} - diff --git a/man/valuationTables.load.Rd b/man/valuationTables.load.Rd new file mode 100644 index 0000000000000000000000000000000000000000..4c17dd771e76e3781c91fd5c418fa3ced600f86f --- /dev/null +++ b/man/valuationTables.load.Rd @@ -0,0 +1,15 @@ +% 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 +} + diff --git a/src/Tables/Austria_Census.xlsx b/src/Tables/Austria_Census.xlsx deleted file mode 100644 index c0faf655b151f8b37b72396f3fdf3d1c4076a55e..0000000000000000000000000000000000000000 Binary files a/src/Tables/Austria_Census.xlsx and /dev/null differ