diff --git a/NAMESPACE b/NAMESPACE index 48ea9787871f20267290b6136650ece7440ca1a6..f6653072c0035785e58f1b011fdfd68c51dd52d5 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,8 +1,7 @@ # Generated by roxygen2: do not edit by hand -export(getCohortTable) +export(makeQxDataFrame) export(plotValuationTables) -export(undampenTrend) export(valuationTable) export(valuationTable_ageShift) export(valuationTable_improvementFactors) @@ -10,6 +9,7 @@ export(valuationTable_joined) export(valuationTable_mixed) export(valuationTable_observed) export(valuationTable_period) +export(valuationTable_trendProjection) exportClasses(valuationTable) exportClasses(valuationTable_ageShift) exportClasses(valuationTable_improvementFactors) @@ -17,6 +17,7 @@ exportClasses(valuationTable_joined) exportClasses(valuationTable_mixed) exportClasses(valuationTable_observed) exportClasses(valuationTable_period) +exportClasses(valuationTable_trendProjection) exportMethods(ageShift) exportMethods(ages) exportMethods(baseTable) diff --git a/R/ValuationTables.R b/R/ValuationTables.R index d3b2afd82dabc517c87391938b1ceef3f400c9f5..cd00b9e5e031dd23d4b3e319e113dc04a55420ce 100644 --- a/R/ValuationTables.R +++ b/R/ValuationTables.R @@ -21,8 +21,6 @@ #' @slot loading Additional security loading on the resulting table (single numeric #' value, e.g. 0.05 adds 5% security margin to the probabilities) #' -#' @name valuationTable-class -#' @rdname valuationTable-class #' @export valuationTable #' @exportClass valuationTable valuationTable=setClass( @@ -32,7 +30,8 @@ valuationTable=setClass( contains="VIRTUAL" ); - +#' Class valuationTable_period - Period life tables +#' #' A period life table, giving death probabilities for each age, up to #' maximum age omega. Optionally apply selection factors to the probabilities #' @@ -49,6 +48,8 @@ valuationTable_period=setClass( ); +#' Class valuationTable_ageShift - Cohort life tables generated by age-shift +#' #' A cohort life table, obtained by age-shifting from a given base table (death probabilities # for a base birth year) #' @@ -63,6 +64,8 @@ valuationTable_ageShift=setClass( contains="valuationTable_period" ); +#' Class valuationTable_trendProjection - Cohort life table with age-specific trend +#' #' 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. @@ -74,8 +77,8 @@ valuationTable_ageShift=setClass( #' @slot 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. #' @slot 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}. #' -#' @export valuationTable_ageShift -#' @exportClass valuationTable_ageShift +#' @export valuationTable_trendProjection +#' @exportClass valuationTable_trendProjection valuationTable_trendProjection=setClass( "valuationTable_trendProjection", slots=list(baseYear="numeric", trend="numeric", dampingFunction="function", trend2="numeric"), @@ -83,6 +86,8 @@ valuationTable_trendProjection=setClass( contains="valuationTable_period" ); +#' Class valuationTable_improvementFactors - Cohort life table with improvement factors +#' #' A cohort life table, obtained by an improvment factor projection #' from a given base table (PODs for a given observation year). #' @@ -98,21 +103,27 @@ valuationTable_improvementFactors=setClass( contains="valuationTable_period" ); +#' Class valuationTable_observed - Life table from actual observations +#' #' A cohort life table described by actual observations (data frame of PODs #' per year and age) #' #' @slot data The observations +#' @slot years The observation years +#' @slot ages The observation ages #' #' @export valuationTable_observed #' @exportClass valuationTable_observed valuationTable_observed=setClass( "valuationTable_observed", - slots=list(data="data.frame"), - prototype=list(data=data.frame()), + slots=list(data="data.frame", years="numeric", ages="numeric"), + prototype=list(data=data.frame(), years=c(), ages=c()), contains="valuationTable" ); +#' Class valuationTable_joined - Life table created by joining two lift tables +#' #' A cohort life table obtained by joining two cohort life tables, each of which #' applies only to certain observation years (e.g. for the past use the observed #' PODs, and project them to the future with the trend projection) @@ -132,6 +143,8 @@ valuationTable_joined=setClass( contains="valuationTable" ); +#' Class valuationTable_mixed - Life table as a mix of two life tables +#' #' A cohort life table obtained by mixing two life tables with the given weights #' #' @slot table1 The first \code{valuationTable} @@ -152,91 +165,68 @@ valuationTable_mixed=setClass( #' Return the maximum age of the life table -#' -#' @name valuationTable -#' @rdname valuationTable-class #' @exportMethod getOmega setGeneric("getOmega", function(object) standardGeneric("getOmega")); -#' Return the maximum age of the period life table -#' -#' @name valuationTable_period-class -#' @rdname valuationTable_period-class -#' @aliases getOmega,valuationTable_period-method +#' @describeIn valuationTable_period Return the maximum age of the period life table setMethod("getOmega", "valuationTable_period", function (object) { max(object@ages,na.rm=TRUE); }) -#' Return the maximum age of the mixed life table -#' -#' @name valuationTable_mixed-class -#' @rdname valuationTable_mixed-class -#' @aliases getOmega,valuationTable_mixed-method +#' @describeIn valuationTable_mixed Return the maximum age of the mixed life table setMethod("getOmega", "valuationTable_mixed", function (object) { getOmega(object@table1); }) -#' Return the maximum age of the joined life table -#' -#' @name valuationTable_joined-class -#' @rdname valuationTable_joined-class -#' @aliases getOmega,valuationTable_joined-method +#' @describeIn valuationTable_joined Return the maximum age of the joined life table setMethod("getOmega", "valuationTable_joined", function (object) { getOmega(object@table1); }) +#' @describeIn valuationTable_observed Return the maximum age of the joined life table +setMethod("getOmega", "valuationTable_observed", + function (object) { + max(object@ages,na.rm=TRUE); + }) #' Return the defined ages of the life table -#' -#' @name valuationTable -#' @rdname valuationTable-class +#' @param object A life table object (instance of a \code{valuationTable} class) +#' @param ... Currently unused #' @exportMethod ages setGeneric("ages", function(object, ...) standardGeneric("ages")); -#' Return the defined ages of the life table -#' -#' @name valuationTable_period-class -#' @rdname valuationTable_period-class -#' @aliases ages,valuationTable_period-method +#' @describeIn valuationTable_period Return the defined ages of the life table setMethod("ages", "valuationTable_period", function (object, ...) { object@ages; }) -#' Return the defined ages of the life table -#' -#' @name valuationTable_mixed-class -#' @rdname valuationTable_mixed-class -#' @aliases ages,valuationTable_mixed-method +#' @describeIn valuationTable_mixed Return the defined ages of the life table setMethod("ages", "valuationTable_mixed", function (object, ...) { ages(object@table1); }) -#' Return the defined ages of the life table -#' -#' @name valuationTable_joined-class -#' @rdname valuationTable_joined-class -#' @aliases ages,valuationTable_joined-method +#' @describeIn valuationTable_joined Return the defined ages of the life table setMethod("ages", "valuationTable_joined", function (object, ...) { ages(object@table1); }) +#' @describeIn valuationTable_observed Return the defined ages of the life table +setMethod("ages", "valuationTable_observed", + function (object, ...) { + object@ages; + }) #' Return the age shift of the age-shifted life table given the birth year #' +#' @param object The life table object (class inherited from valuationTable) +#' @param ... Other parameters (currently unused) #' @param YOB The birth year for which the age shift should be determined. -#' -#' @name valuationTable_ageShift -#' @rdname valuationTable_ageShift-class #' @exportMethod ageShift setGeneric("ageShift", function(object, YOB=1975, ...) standardGeneric("ageShift")); -#' Return the age shift of the age-shifted life table given the birth year +#' @describeIn valuationTable_ageShift Return the age shift of the age-shifted life table given the birth year #' -#' @param YOB The birth year for which the age shift should be determined. -#' -#' @name valuationTable_ageShift-class -#' @rdname valuationTable_ageShift-class -#' @aliases ageShift,valuationTable_ageShift-method +#' @param YOB The birth year for which the age shift should be determined1. setMethod("ageShift","valuationTable_ageShift", function(object, YOB, ...) { shift = object@ageShifts[toString(YOB),]; @@ -258,30 +248,20 @@ setMethod("ageShift","valuationTable_ageShift", #' Return the (cohort) death probabilities of the life table given the birth year (if needed) #' +#' @param object The life table object (class inherited from valuationTable) +#' @param ... Other parameters (currently unused) #' @param YOB The birth year for which the death probabilities should be calculated -#' -#' @name valuationTable -#' @rdname valuationTable-class #' @exportMethod deathProbabilities setGeneric("deathProbabilities", function(object, ..., YOB=1975) standardGeneric("deathProbabilities")); -#' Return the (cohort) death probabilities of the life table given the birth year (if needed) -#' +#' @describeIn valuationTable_period Return the (cohort) death probabilities of the life table given the birth year (if needed) #' @param YOB The birth year for which the death probabilities should be calculated -#' -#' @name valuationTable_period-class -#' @rdname valuationTable_period-class -#' @aliases deathProbabilities,valuationTable_period-method setMethod("deathProbabilities", "valuationTable_period", function(object, ..., YOB=1975) { object@modification(object@deathProbs * (1+object@loading)); }) -#' Return the (cohort) death probabilities of the life table given the birth year (if needed) +#' @describeIn valuationTable_ageShift Return the (cohort) death probabilities of the life table given the birth year (if needed) #' #' @param YOB The birth year for which the death probabilities should be calculated -#' -#' @name valuationTable_ageShift-class -#' @rdname valuationTable_ageShift-class -#' @aliases deathProbabilities,valuationTable_ageShift-method setMethod("deathProbabilities","valuationTable_ageShift", function (object, ..., YOB=1975) { qx=object@deathProbs * (1+object@loading); @@ -294,13 +274,9 @@ setMethod("deathProbabilities","valuationTable_ageShift", object@modification(qx) }) -#' Return the (cohort) death probabilities of the life table given the birth year (if needed) +#' @describeIn valuationTable_trendProjection Return the (cohort) death probabilities of the life table given the birth year (if needed) #' #' @param YOB The birth year for which the death probabilities should be calculated -#' -#' @name valuationTable_trendProjection-class -#' @rdname valuationTable_trendProjection-class -#' @aliases deathProbabilities,valuationTable_trendProjection-method setMethod("deathProbabilities","valuationTable_trendProjection", function (object, ..., YOB=1975) { qx=object@deathProbs * (1+object@loading); @@ -317,26 +293,18 @@ setMethod("deathProbabilities","valuationTable_trendProjection", object@modification(finalqx) }) -#' Return the (cohort) death probabilities of the life table given the birth year (if needed) +#' @describeIn valuationTable_improvementFactors Return the (cohort) death probabilities of the life table given the birth year (if needed) #' #' @param YOB The birth year for which the death probabilities should be calculated -#' -#' @name valuationTable_improvementFactors-class -#' @rdname valuationTable_improvementFactors-class -#' @aliases deathProbabilities,valuationTable_improvementFactors-method setMethod("deathProbabilities","valuationTable_improvementFactors", function (object, ..., YOB=1975) { qx=object@deathProbs * (1+object@loading); finalqx=(1-object@improvement)^(YOB+0:(length(qx)-1)-object@baseYear)*qx; object@modification(finalqx) }) -#' Return the (cohort) death probabilities of the life table given the birth year (if needed) +#' @describeIn valuationTable_mixed Return the (cohort) death probabilities of the life table given the birth year (if needed) #' #' @param YOB The birth year for which the death probabilities should be calculated -#' -#' @name valuationTable_mixed-class -#' @rdname valuationTable_mixed-class -#' @aliases deathProbabilities,valuationTable_mixed-method setMethod("deathProbabilities","valuationTable_mixed", function (object, ..., YOB=1975) { qx1=deathProbabilities(object@table1, ..., YOB) * (1+object@loading); @@ -350,30 +318,20 @@ setMethod("deathProbabilities","valuationTable_mixed", #' Return the (period) death probabilities of the life table for a given observation year #' +#' @param object The life table object (class inherited from valuationTable) +#' @param ... Other parameters (currently unused) #' @param Period The observation year for which the period death probabilities should be determined -#' -#' @name valuationTable -#' @rdname valuationTable-class #' @exportMethod periodDeathProbabilities -setGeneric("periodDeathProbabilities", function(object, ...) standardGeneric("periodDeathProbabilities")); -#' Return the (period) death probabilities of the life table for a given observation year -#' +setGeneric("periodDeathProbabilities", function(object, ..., Period=1975) standardGeneric("periodDeathProbabilities")); +#' @describeIn valuationTable_period Return the (period) death probabilities of the life table for a given observation year #' @param Period The observation year for which the period death probabilities should be determined -#' -#' @name valuationTable_period-class -#' @rdname valuationTable_period-class -#' @aliases periodDeathProbabilities,valuationTable_period-method setMethod("periodDeathProbabilities", "valuationTable_period", - function(object, ...) { + function(object, ..., Period=1975) { object@modification(object@deathProbs * (1+object@loading)); }) -#' Return the (period) death probabilities of the life table for a given observation year +#' @describeIn valuationTable_ageShift Return the (period) death probabilities of the life table for a given observation year #' #' @param Period The observation year for which the period death probabilities should be determined -#' -#' @name valuationTable_ageShift-class -#' @rdname valuationTable_ageShift-class -#' @aliases periodDeathProbabilities,valuationTable_ageShift-method setMethod("periodDeathProbabilities","valuationTable_ageShift", function (object, ..., Period=1975) { # TODO @@ -383,13 +341,9 @@ setMethod("periodDeathProbabilities","valuationTable_ageShift", # if (shift.index) {} object@modification(qx) }) -#' Return the (period) death probabilities of the life table for a given observation year +#' @describeIn valuationTable_trendProjection Return the (period) death probabilities of the life table for a given observation year #' #' @param Period The observation year for which the period death probabilities should be determined -#' -#' @name valuationTable_trendProjection-class -#' @rdname valuationTable_trendProjection-class -#' @aliases periodDeathProbabilities,valuationTable_trendProjection-method setMethod("periodDeathProbabilities","valuationTable_trendProjection", function (object, ..., Period=1975) { qx=object@deathProbs * (1+object@loading); @@ -406,26 +360,18 @@ setMethod("periodDeathProbabilities","valuationTable_trendProjection", } object@modification(finalqx) }) -#' Return the (period) death probabilities of the life table for a given observation year +#' @describeIn valuationTable_improvementFactors Return the (period) death probabilities of the life table for a given observation year #' #' @param Period The observation year for which the period death probabilities should be determined -#' -#' @name valuationTable_improvementFactors-class -#' @rdname valuationTable_improvementFactors-class -#' @aliases periodDeathProbabilities,valuationTable_improvementFactors-method setMethod("periodDeathProbabilities","valuationTable_improvementFactors", function (object, ..., Period=1975) { qx=object@deathProbs * (1+object@loading); finalqx=(1-object@improvement)^(Period-object@baseYear)*qx; object@modification(finalqx) }) -#' Return the (period) death probabilities of the life table for a given observation year +#' @describeIn valuationTable_mixed Return the (period) death probabilities of the life table for a given observation year #' #' @param Period The observation year for which the period death probabilities should be determined -#' -#' @name valuationTable_mixed-class -#' @rdname valuationTable_mixed-class -#' @aliases periodDeathProbabilities,valuationTable_mixed-method setMethod("periodDeathProbabilities","valuationTable_mixed", function (object, ..., Period=1975) { qx1=periodDeathProbabilities(object@table1, ..., Period=Period) * (1+object@loading); @@ -438,20 +384,13 @@ setMethod("periodDeathProbabilities","valuationTable_mixed", #' Return the lifetable object (package lifecontingencies) for the cohort life table -#' +#' @param object The life table object (class inherited from valuationTable) #' @param ... Parameters to be handed to the \code{deathProbabilities} method of the life table -#' -#' @name valuationTable -#' @rdname valuationTable-class #' @exportMethod lifeTable setGeneric("lifeTable", function(object, ...) standardGeneric("lifeTable")); -#' Return the lifetable object (package lifecontingencies) for the cohort life table +#' @describeIn valuationTable Return the lifetable object (package lifecontingencies) for the cohort life table #' #' @param ... Parameters to be handed to the \code{deathProbabilities} method of the life table -#' -#' @name valuationTable-class -#' @rdname valuationTable-class -#' @aliases lifeTable,valuationTable-method setMethod("lifeTable","valuationTable", function (object, ...) { qx=deathProbabilities(object, ...); @@ -463,25 +402,18 @@ setMethod("lifeTable","valuationTable", #' Return the base year of the life table -#' -#' @name valuationTable -#' @rdname valuationTable-class +#' @param object The life table object (class inherited from valuationTable) +#' @param ... Other parameters (currently unused) #' @exportMethod baseYear setGeneric("baseYear", function(object, ...) standardGeneric("baseYear")); -#' Return the base year of the life table -#' -#' @name valuationTable-class -#' @rdname valuationTable-class -#' @aliases baseYear,valuationTable-method +#' @describeIn valuationTable Return the base year of the life table +#' @param object The life table object (class inherited from valuationTable) +#' @param ... Other parameters (currently unused) setMethod("baseYear","valuationTable", function (object, ...) { object@baseYear }) -#' Return the base year of the life table -#' -#' @name valuationTable_mixed-class -#' @rdname valuationTable_mixed-class -#' @aliases baseYear,valuationTable_mixed-method +#' @describeIn valuationTable_mixed Return the base year of the life table setMethod("baseYear","valuationTable_mixed", function (object, ...) { baseYear(object@table1) @@ -490,25 +422,16 @@ setMethod("baseYear","valuationTable_mixed", #' Return the base table of the life table -#' -#' @name valuationTable -#' @rdname valuationTable-class +#' @param object The life table object (class inherited from valuationTable) +#' @param ... Other parameters (currently unused) #' @exportMethod baseTable setGeneric("baseTable", function(object, ...) standardGeneric("baseTable")); -#' Return the base table of the life table -#' -#' @name valuationTable-class -#' @rdname valuationTable-class -#' @aliases baseTable,valuationTable-method +#' @describeIn valuationTable Return the base table of the life table setMethod("baseTable","valuationTable", function (object, ...) { c() }) -#' Return the base table of the life table -#' -#' @name valuationTable_period-class -#' @rdname valuationTable_period-class -#' @aliases baseTable,valuationTable_period-method +#' @describeIn valuationTable_period Return the base table of the life table setMethod("baseTable","valuationTable_period", function (object, ...) { object@deathProbs @@ -519,19 +442,15 @@ setMethod("baseTable","valuationTable_period", #' Return the period life table as a \code{valuationTable_period} object #' +#' @param object The life table object (class inherited from valuationTable) #' @param Period The observation year, for which the death probabilities should be determined -#' -#' @name valuationTable -#' @rdname valuationTable-class +#' @param ... Other parameters (currently unused) #' @exportMethod getPeriodTable setGeneric("getPeriodTable", function(object, Period, ...) standardGeneric("getPeriodTable")); -#' Return the period life table as a \code{valuationTable_period} object +#' @describeIn valuationTable Return the period life table as a \code{valuationTable_period} object #' #' @param Period The observation year, for which the death probabilities should be determined -#' -#' @name valuationTable-class -#' @rdname valuationTable-class -#' @aliases getPeriodTable,valuationTable-method +#' @param ... Currently unused setMethod("getPeriodTable","valuationTable", function (object, Period, ...) { valuationTable_period( @@ -546,20 +465,16 @@ setMethod("getPeriodTable","valuationTable", #' Return the cohort life table as a \code{valuationTable_period} object #' +#' @param object The life table object (class inherited from valuationTable) #' @param YOB The birth year for which the life table should be calculated -#' -#' @name valuationTable -#' @rdname valuationTable-class +#' @param ... Other parameters (currently unused) #' @exportMethod getCohortTable setGeneric("getCohortTable", function(object, YOB, ...) standardGeneric("getCohortTable")); -#' Return the cohort life table as a \code{valuationTable_period} object +#' @describeIn valuationTable Return the cohort life table as a \code{valuationTable_period} object #' #' @param YOB The birth year for which the life table should be calculated #' -#' @name valuationTable-class -#' @rdname valuationTable-class -#' @aliases getCohortTable,valuationTable-method -#' @export getCohortTable +# @export getCohortTable setMethod("getCohortTable","valuationTable", function (object, YOB, ...) { valuationTable_period( @@ -575,16 +490,10 @@ setMethod("getCohortTable","valuationTable", #' Return a \code{valuationTable_trensProjection} object with the trend damping removed. #' -#' @name valuationTable_trendProjection -#' @rdname valuationTable_trendProjection-class +#' @param object The life table object (class inherited from valuationTable) #' @exportMethod undampenTrend setGeneric("undampenTrend", function (object) standardGeneric("undampenTrend")); -#' Return a \code{valuationTable_trensProjection} object with the trend damping removed. -#' -#' @name valuationTable_trendProjection-class -#' @rdname valuationTable_trendProjection-class -#' @aliases undampenTrend,valuationTable_trendProjection-method -#' @export undampenTrend +#' @describeIn valuationTable_trendProjection Return a \code{valuationTable_trendProjection} object with the trend damping removed. setMethod("undampenTrend", "valuationTable_trendProjection", function (object) { object@dampingFunction=identity; diff --git a/R/plotValuationTables.R b/R/plotValuationTables.R index e31917423d9f87f353afb1d2952d3bf18c88dca2..e056851d5dc0718de1f09751ed6917f15871e80a 100644 --- a/R/plotValuationTables.R +++ b/R/plotValuationTables.R @@ -1,3 +1,4 @@ +#' @export makeQxDataFrame = function(..., YOB=1972, Period=NA) { data=list(...); names(data) = lapply(data, function(t) t@name); diff --git a/data/ValuationTables_Austria_Annuities.R b/data/ValuationTables_Austria_Annuities.R index ce5c9c81c16310e8c67e7c2a4af26c50d9897bcb..1788be27c89ccea5c0c0b1fd5daf600dc3972924 100644 --- a/data/ValuationTables_Austria_Annuities.R +++ b/data/ValuationTables_Austria_Annuities.R @@ -7,7 +7,7 @@ stopifnot(require(methods), require(utils), require(ValuationTables)) # Valuatio rr67.data = utils::read.csv("Austria_Annuities_RR67.csv", skip=2) -rr67 = ValuationTables::valuationTable_period( +rr67 = valuationTable_period( name = "ÖVM 59/61 RR67", ages = rr67.data$Alter, deathProbs = rr67.data$qx ); rm(rr67.data); @@ -192,3 +192,4 @@ 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") + diff --git a/data/ValuationTables_Austria_Census.R b/data/ValuationTables_Austria_Census.R index 5f9dd0508424e07c59b6db6f16edf56127033a0f..cfd187424b545f9c0ea3a0204393624e079dd19d 100644 --- a/data/ValuationTables_Austria_Census.R +++ b/data/ValuationTables_Austria_Census.R @@ -1,61 +1,51 @@ -# frame_files = lapply(sys.frames(), function(x) x$ofile) -# frame_files = Filter(Negate(is.null), frame_files) -# PATH <- dirname(frame_files[[length(frame_files)]]) -# rm(frame_files) -# setwd(dirname(PATH)) - -library("openxlsx") -# library("ggplot2") -library("ValuationTables") - +stopifnot(require(methods), require(utils), require(ValuationTables)) # ValuationTable classes; new; Excel reader +require(ValuationTables) ############################################################################### ### Volkszählungen Österreich ############################################################################### -a.vz.dataM = openxlsx::read.xlsx("Tables/A_Volkszaehlungen.xlsx", sheet="Austria_M", - startRow = 3, colNames = TRUE) -a.vz.dataF = openxlsx::read.xlsx("Tables/A_Volkszaehlungen.xlsx", sheet="Austria_F", - startRow = 3, colNames = TRUE) +a.vz.dataM = utils::read.csv("Austria_Census_Male.csv", skip=3); +a.vz.dataF = utils::read.csv("Austria_Census_Female.csv", skip=3); censtable = function(data, name, qslot, baseYear=1900) { qx=data[names(data)==qslot]; ix=complete.cases(qx); - 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="1868/71"); -mort.AT.census.1880.male = censtable(a.vz.dataM, name="ÖVSt 1879/82 M", baseYear=1880, qslot="1879/82"); -mort.AT.census.1890.male = censtable(a.vz.dataM, name="ÖVSt 1889/92 M", baseYear=1890, qslot="1889/92"); -mort.AT.census.1900.male = censtable(a.vz.dataM, name="ÖVSt 1899/1902 M", baseYear=1900, qslot="1899/1902"); -mort.AT.census.1910.male = censtable(a.vz.dataM, name="ÖVSt 1909/12 M", baseYear=1910, qslot="1909/12"); -mort.AT.census.1931.male = censtable(a.vz.dataM, name="ÖVSt 1930/33 M", baseYear=1931, qslot="1930/33"); -mort.AT.census.1951.male = censtable(a.vz.dataM, name="ÖVSt 1949/51 M", baseYear=1951, qslot="1949/51"); -mort.AT.census.1961.male = censtable(a.vz.dataM, name="ÖVSt 1959/61 M", baseYear=1961, qslot="1959/61"); -mort.AT.census.1971.male = censtable(a.vz.dataM, name="ÖVSt 1970/72 M", baseYear=1971, qslot="1970/72"); -mort.AT.census.1981.male = censtable(a.vz.dataM, name="ÖVSt 1980/82 M", baseYear=1981, qslot="1980/82"); -mort.AT.census.1991.male = censtable(a.vz.dataM, name="ÖVSt 1990/92 M", baseYear=1991, qslot="1990/92"); -mort.AT.census.2001.male = censtable(a.vz.dataM, name="ÖVSt 2000/02 M", baseYear=2001, qslot="2000/02"); -mort.AT.census.2011.male = censtable(a.vz.dataM, name="ÖVSt 2010/2012 M", baseYear=2011, qslot="2010/12"); +mort.AT.census.1869.male = censtable(a.vz.dataM, name="ÖVSt 1868/71 M", baseYear=1869, qslot="X1868.71"); +mort.AT.census.1880.male = censtable(a.vz.dataM, name="ÖVSt 1879/82 M", baseYear=1880, qslot="X1879.82"); +mort.AT.census.1890.male = censtable(a.vz.dataM, name="ÖVSt 1889/92 M", baseYear=1890, qslot="X1889.92"); +mort.AT.census.1900.male = censtable(a.vz.dataM, name="ÖVSt 1899/1902 M", baseYear=1900, qslot="X1899.1902"); +mort.AT.census.1910.male = censtable(a.vz.dataM, name="ÖVSt 1909/12 M", baseYear=1910, qslot="X1909.12"); +mort.AT.census.1931.male = censtable(a.vz.dataM, name="ÖVSt 1930/33 M", baseYear=1931, qslot="X1930.33"); +mort.AT.census.1951.male = censtable(a.vz.dataM, name="ÖVSt 1949/51 M", baseYear=1951, qslot="X1949.51"); +mort.AT.census.1961.male = censtable(a.vz.dataM, name="ÖVSt 1959/61 M", baseYear=1961, qslot="X1959.61"); +mort.AT.census.1971.male = censtable(a.vz.dataM, name="ÖVSt 1970/72 M", baseYear=1971, qslot="X1970.72"); +mort.AT.census.1981.male = censtable(a.vz.dataM, name="ÖVSt 1980/82 M", baseYear=1981, qslot="X1980.82"); +mort.AT.census.1991.male = censtable(a.vz.dataM, name="ÖVSt 1990/92 M", baseYear=1991, qslot="X1990.92"); +mort.AT.census.2001.male = censtable(a.vz.dataM, name="ÖVSt 2000/02 M", baseYear=2001, qslot="X2000.02"); +mort.AT.census.2011.male = censtable(a.vz.dataM, name="ÖVSt 2010/2012 M", baseYear=2011, qslot="X2010.12"); -mort.AT.census.1869.female = censtable(a.vz.dataF, name="ÖVSt 1868/71 F", baseYear=1869, qslot="1868/71"); -mort.AT.census.1880.female = censtable(a.vz.dataF, name="ÖVSt 1879/82 F", baseYear=1880, qslot="1879/82"); -mort.AT.census.1890.female = censtable(a.vz.dataF, name="ÖVSt 1889/92 F", baseYear=1890, qslot="1889/92"); -mort.AT.census.1900.female = censtable(a.vz.dataF, name="ÖVSt 1899/1902 F", baseYear=1900, qslot="1899/1902"); -mort.AT.census.1910.female = censtable(a.vz.dataF, name="ÖVSt 1909/12 F", baseYear=1910, qslot="1909/12"); -mort.AT.census.1931.female = censtable(a.vz.dataF, name="ÖVSt 1930/33 F", baseYear=1931, qslot="1930/33"); -mort.AT.census.1951.female = censtable(a.vz.dataF, name="ÖVSt 1949/51 F", baseYear=1951, qslot="1949/51"); -mort.AT.census.1961.female = censtable(a.vz.dataF, name="ÖVSt 1959/61 F", baseYear=1961, qslot="1959/61"); -mort.AT.census.1971.female = censtable(a.vz.dataF, name="ÖVSt 1970/72 F", baseYear=1971, qslot="1970/72"); -mort.AT.census.1981.female = censtable(a.vz.dataF, name="ÖVSt 1980/82 F", baseYear=1981, qslot="1980/82"); -mort.AT.census.1991.female = censtable(a.vz.dataF, name="ÖVSt 1990/92 F", baseYear=1991, qslot="1990/92"); -mort.AT.census.2001.female = censtable(a.vz.dataF, name="ÖVSt 2000/02 F", baseYear=2001, qslot="2000/02"); -mort.AT.census.2011.female = censtable(a.vz.dataF, name="ÖVSt 2010/2012 F", baseYear=2011, qslot="2010/12"); +mort.AT.census.1869.female = censtable(a.vz.dataF, name="ÖVSt 1868/71 F", baseYear=1869, qslot="X1868.71"); +mort.AT.census.1880.female = censtable(a.vz.dataF, name="ÖVSt 1879/82 F", baseYear=1880, qslot="X1879.82"); +mort.AT.census.1890.female = censtable(a.vz.dataF, name="ÖVSt 1889/92 F", baseYear=1890, qslot="X1889.92"); +mort.AT.census.1900.female = censtable(a.vz.dataF, name="ÖVSt 1899/1902 F", baseYear=1900, qslot="X1899.1902"); +mort.AT.census.1910.female = censtable(a.vz.dataF, name="ÖVSt 1909/12 F", baseYear=1910, qslot="X1909.12"); +mort.AT.census.1931.female = censtable(a.vz.dataF, name="ÖVSt 1930/33 F", baseYear=1931, qslot="X1930.33"); +mort.AT.census.1951.female = censtable(a.vz.dataF, name="ÖVSt 1949/51 F", baseYear=1951, qslot="X1949.51"); +mort.AT.census.1961.female = censtable(a.vz.dataF, name="ÖVSt 1959/61 F", baseYear=1961, qslot="X1959.61"); +mort.AT.census.1971.female = censtable(a.vz.dataF, name="ÖVSt 1970/72 F", baseYear=1971, qslot="X1970.72"); +mort.AT.census.1981.female = censtable(a.vz.dataF, name="ÖVSt 1980/82 F", baseYear=1981, qslot="X1980.82"); +mort.AT.census.1991.female = censtable(a.vz.dataF, name="ÖVSt 1990/92 F", baseYear=1991, qslot="X1990.92"); +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.ALL.male = makeQxDataFrame( +mort.AT.census.ALL.male = ValuationTables::makeQxDataFrame( mort.AT.census.1869.male, mort.AT.census.1880.male, mort.AT.census.1890.male, @@ -70,7 +60,7 @@ mort.AT.census.ALL.male = makeQxDataFrame( mort.AT.census.2001.male, mort.AT.census.2011.male); -mort.AT.census.ALL.female = makeQxDataFrame( +mort.AT.census.ALL.female = ValuationTables::makeQxDataFrame( mort.AT.census.1869.female, mort.AT.census.1880.female, mort.AT.census.1890.female, @@ -91,3 +81,4 @@ rm(a.vz.dataM, a.vz.dataF, censtable) # plotValuationTables(mort.AT.census.ALL.male, title="Vergleich österreichische Sterbetafeln, Männer", legend.position=c(1,0)) # plotValuationTables(mort.AT.census.ALL.female, title="Vergleich österreichische Sterbetafeln, Frauen", legend.position=c(1,0)) +