From 131e7db5e50221b434dfe7f7c49c6d7cda8b0513 Mon Sep 17 00:00:00 2001 From: Rainer Walke Date: Tue, 8 Oct 2019 13:07:39 +0200 Subject: [PATCH] replace slot name 'country' by 'region' --- .gitignore | 1 + NAMESPACE | 2 +- R/AllGeneric.R | 2 +- R/GENESISClasses.R | 28 ++++++++++++++-------------- R/HMDClasses.R | 38 +++++++++++++++++++------------------- man/LT1-class.Rd | 14 +++++++------- tests/Simple1.R | 8 ++++---- 7 files changed, 47 insertions(+), 46 deletions(-) diff --git a/.gitignore b/.gitignore index 26fad6f..be0b467 100644 --- a/.gitignore +++ b/.gitignore @@ -34,3 +34,4 @@ vignettes/*.pdf # Shiny token, see https://shiny.rstudio.com/articles/shinyapps.html rsconnect/ +.Rproj.user diff --git a/NAMESPACE b/NAMESPACE index b85b42c..6b19c74 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -18,7 +18,6 @@ exportMethods("lt1<-") exportMethods("rd1<-") exportMethods("re1<-") exportMethods(content) -exportMethods(country) exportMethods(ex1) exportMethods(footer) exportMethods(header) @@ -27,6 +26,7 @@ exportMethods(lt1) exportMethods(protocol) exportMethods(rd1) exportMethods(re1) +exportMethods(region) exportMethods(selectRegion) exportMethods(selectYears) exportMethods(show) diff --git a/R/AllGeneric.R b/R/AllGeneric.R index 8052771..ef0e091 100644 --- a/R/AllGeneric.R +++ b/R/AllGeneric.R @@ -8,7 +8,7 @@ setGeneric("lt1", function(object) standardGeneric("lt1")) setGeneric("content", function(object) standardGeneric("content")) -setGeneric("country", function(object) standardGeneric("country")) +setGeneric("region", function(object) standardGeneric("region")) setGeneric("protocol", function(object) standardGeneric("protocol")) diff --git a/R/GENESISClasses.R b/R/GENESISClasses.R index 6c99c2f..eeada71 100644 --- a/R/GENESISClasses.R +++ b/R/GENESISClasses.R @@ -15,7 +15,7 @@ setClass("RD1", footer="vector", # file footer rd1="data.table", # exposure table content="character", # content - country="character", # country + region="character", # region protocol="character" # protocol version ) ) @@ -31,7 +31,7 @@ setMethod("rd1", "RD1", function(object) object@rd1) #' @export setMethod("content", "RD1", function(object) object@content) #' @export -setMethod("country", "RD1", function(object) object@country) +setMethod("region", "RD1", function(object) object@region) #' @export setMethod("protocol", "RD1", function(object) object@protocol) @@ -41,8 +41,8 @@ setReplaceMethod("rd1", "RD1", function(object, value) {object@rd1 <- value; val # constructor #' @export -RegDeath1 <- function(header, footer, rd1, content, country, protocol) - new("RD1", header=header, footer=footer, rd1=rd1, content=content, country=country, protocol=protocol) +RegDeath1 <- function(header, footer, rd1, content, region, protocol) + new("RD1", header=header, footer=footer, rd1=rd1, content=content, region=region, protocol=protocol) # methods #' @export @@ -58,7 +58,7 @@ setMethod("show", "RD1", setMethod("selectYears", "RD1", function(object, selectYears) { Year <- NULL # evoid NOTE .rd1 <- object@rd1[Year %in% selectYears] - return(new("RD1", header=object@header, footer=object@footer, rd1=.rd1, content=object@content, country=object@country, protocol=object@protocol)) + return(new("RD1", header=object@header, footer=object@footer, rd1=.rd1, content=object@content, region=object@region, protocol=object@protocol)) } ) @@ -66,7 +66,7 @@ setMethod("selectYears", "RD1", function(object, selectYears) { setMethod("selectRegion", "RD1", function(object, selectRegion) { Region_Code <- NULL # evoid NOTE .rd1 <- object@rd1[Region_Code %in% selectRegion] - return(new("RD1", header=object@header, footer=object@footer, rd1=.rd1, content=object@content, country=object@country, protocol=object@protocol)) + return(new("RD1", header=object@header, footer=object@footer, rd1=.rd1, content=object@content, region=object@region, protocol=object@protocol)) } ) @@ -98,7 +98,7 @@ setClass("RE1", footer="vector", # file footer re1="data.table", # exposure table content="character", # content - country="character", # country + region="character", # region protocol="character" # protocol version ) ) @@ -114,7 +114,7 @@ setMethod("re1", "RE1", function(object) object@re1) #' @export setMethod("content", "RE1", function(object) object@content) #' @export -setMethod("country", "RE1", function(object) object@country) +setMethod("region", "RE1", function(object) object@region) #' @export setMethod("protocol", "RE1", function(object) object@protocol) @@ -124,8 +124,8 @@ setReplaceMethod("re1", "RE1", function(object, value) {object@re1 <- value; val # constructor #' @export -RegExp1 <- function(header, footer, re1, content, country, protocol) - new("RE1", header=header, footer, re1=re1, content=content, country=country, protocol=protocol) +RegExp1 <- function(header, footer, re1, content, region, protocol) + new("RE1", header=header, footer, re1=re1, content=content, region=region, protocol=protocol) # methods #' @export @@ -141,7 +141,7 @@ setMethod("show", "RE1", setMethod("selectYears", "RE1", function(object, selectYears) { Year <- NULL # evoid NOTE .re1 <- object@re1[Year %in% selectYears] - return(new("RE1", header=object@header, footer=object@footer, re1=.re1, content=object@content, country=object@country, protocol=object@protocol)) + return(new("RE1", header=object@header, footer=object@footer, re1=.re1, content=object@content, region=object@region, protocol=object@protocol)) } ) @@ -149,7 +149,7 @@ setMethod("selectYears", "RE1", function(object, selectYears) { setMethod("selectRegion", "RE1", function(object, selectRegion) { Region_Code <- NULL # evoid NOTE .re1 <- object@re1[Region_Code %in% selectRegion] - return(new("RE1", header=object@header, footer=object@footer, re1=.re1, content=object@content, country=object@country, protocol=object@protocol)) + return(new("RE1", header=object@header, footer=object@footer, re1=.re1, content=object@content, region=object@region, protocol=object@protocol)) } ) @@ -206,7 +206,7 @@ readRegDeath <- function(infile) rdft <- merge(rdft,age_code1,by="Age_Name") - return(new("RD1", header=header, footer=footer, rd1=rdft, content="GENESIS-Tabelle: 12613-02-02-4", country="Germany", protocol="unknown")) + return(new("RD1", header=header, footer=footer, rd1=rdft, content="GENESIS-Tabelle: 12613-02-02-4", region="Germany", protocol="unknown")) } @@ -250,7 +250,7 @@ readRegExp <- function(infile) rexpt <- merge(rexpt, age_code2 ,by="Age_Name") - return(new("RE1", header=header, footer=footer, re1=rexpt, content="GENESIS-Tabelle: 12613-02-02-4", country="Germany", protocol="unknown")) + return(new("RE1", header=header, footer=footer, re1=rexpt, content="GENESIS-Tabelle: 12613-02-02-4", region="Germany", protocol="unknown")) } diff --git a/R/HMDClasses.R b/R/HMDClasses.R index a5a2d35..5af034c 100644 --- a/R/HMDClasses.R +++ b/R/HMDClasses.R @@ -21,7 +21,7 @@ NULL #' The validation adds a pure numeric age AgeLow to the life table. #' #' @slot content describes the content -#' @slot country regional entity +#' @slot region regional entity #' @slot header includes the raw header information #' @slot lt1 stores the life table (data.table) #' @slot protocol contains the protocol information @@ -32,7 +32,7 @@ setClass("LT1", header="vector", # file header lt1="data.table", # life table content="character", # content - country="character", # country + region="character", # region protocol="character" # protocol version ) ) @@ -67,14 +67,14 @@ setMethod("lt1", "LT1", function(object) object@lt1) #' @rdname LT1-class setMethod("content", "LT1", function(object) object@content) -#' LT1 country +#' LT1 region #' -#' The \code{country}-method gets the regional information of an LT1 object +#' The \code{region}-method gets the regional information of an LT1 object #' -#' @return The \code{country}-method returns the regional information +#' @return The \code{region}-method returns the regional information #' @export #' @rdname LT1-class -setMethod("country", "LT1", function(object) object@country) +setMethod("region", "LT1", function(object) object@region) #' LT1 protocol #' @@ -107,13 +107,13 @@ setReplaceMethod("lt1", "LT1", function(object, value) {object@lt1 <- value; val #' @param header vector #' @param lt1 data.table #' @param content character -#' @param country character +#' @param region character #' @param protocol character #' @return The \code{LTable1}-constructor returns an LT1 object #' @export #' @rdname LT1-class -LTable1 <- function(header, lt1, content, country, protocol) - new("LT1", header=header, lt1=lt1, content=content, country=country, protocol=protocol) +LTable1 <- function(header, lt1, content, region, protocol) + new("LT1", header=header, lt1=lt1, content=content, region=region, protocol=protocol) ## methods @@ -146,7 +146,7 @@ setMethod("show", "LT1", setMethod("selectYears", "LT1", function(object, selectYears) { Year <- NULL # evoid NOTE .lt1 <- object@lt1[Year %in% selectYears] - return(new("LT1", header=object@header, lt1=.lt1, content=object@content, country=object@country, protocol=object@protocol)) + return(new("LT1", header=object@header, lt1=.lt1, content=object@content, region=object@region, protocol=object@protocol)) } ) @@ -186,7 +186,7 @@ setClass("EX1", header="vector", # file header ex1="data.table", # exposure table content="character", # content - country="character", # country + region="character", # region protocol="character" # protocol version ) ) @@ -200,7 +200,7 @@ setMethod("ex1", "EX1", function(object) object@ex1) #' @export setMethod("content", "EX1", function(object) object@content) #' @export -setMethod("country", "EX1", function(object) object@country) +setMethod("region", "EX1", function(object) object@region) #' @export setMethod("protocol", "EX1", function(object) object@protocol) @@ -210,8 +210,8 @@ setReplaceMethod("ex1", "EX1", function(object, value) {object@ex1 <- value; val # constructor #' @export -Exposure1 <- function(header, ex1, content, country, protocol) - new("EX1", header=header, ex1=ex1, content=content, country=country, protocol=protocol) +Exposure1 <- function(header, ex1, content, region, protocol) + new("EX1", header=header, ex1=ex1, content=content, region=region, protocol=protocol) # methods #' @export @@ -226,7 +226,7 @@ setMethod("show", "EX1", setMethod("selectYears", "EX1", function(object, selectYears) { Year <- NULL # evoid NOTE .ex1 <- object@ex1[Year %in% selectYears] - return(new("EX1", header=object@header, ex1=.ex1, content=object@content, country=object@country, protocol=object@protocol)) + return(new("EX1", header=object@header, ex1=.ex1, content=object@content, region=object@region, protocol=object@protocol)) } ) @@ -262,11 +262,11 @@ readLT1x1 <- function(infile) LT1 <- data.table::fread(infile) B1 <- sapply(strsplit(LT0,"[,\t;:]"), trimws) - country <- B1[[1]][1] + region <- B1[[1]][1] content <- paste(B1[[1]][2],B1[[1]][3], sep=", ") protocol <- B1[[1]][7] - return(new("LT1", header=LT0, lt1=LT1, content=content, country=country, protocol=protocol)) + return(new("LT1", header=LT0, lt1=LT1, content=content, region=region, protocol=protocol)) } @@ -279,11 +279,11 @@ readEX1x1 <- function(infile) EX1 <- data.table::fread(infile) B1 <- sapply(strsplit(EX0,"[,\t;:]"), trimws) - country <- B1[[1]][1] + region <- B1[[1]][1] content <- B1[[1]][2] protocol <- B1[[1]][7] - return(new("EX1", header=EX0, ex1=EX1, content=content, country=country, protocol=protocol)) + return(new("EX1", header=EX0, ex1=EX1, content=content, region=region, protocol=protocol)) } #### diff --git a/man/LT1-class.Rd b/man/LT1-class.Rd index 4b25c4e..57825b4 100644 --- a/man/LT1-class.Rd +++ b/man/LT1-class.Rd @@ -6,7 +6,7 @@ \alias{header,LT1-method} \alias{lt1,LT1-method} \alias{content,LT1-method} -\alias{country,LT1-method} +\alias{region,LT1-method} \alias{protocol,LT1-method} \alias{lt1<-,LT1-method} \alias{LTable1} @@ -21,13 +21,13 @@ \S4method{content}{LT1}(object) -\S4method{country}{LT1}(object) +\S4method{region}{LT1}(object) \S4method{protocol}{LT1}(object) \S4method{lt1}{LT1}(object) <- value -LTable1(header, lt1, content, country, protocol) +LTable1(header, lt1, content, region, protocol) \S4method{length}{LT1}(x) @@ -46,7 +46,7 @@ LTable1(header, lt1, content, country, protocol) \item{content}{character} -\item{country}{character} +\item{region}{character} \item{protocol}{character} @@ -61,7 +61,7 @@ The \code{lt1}-method returns the life-table The \code{content}-method returns the content information -The \code{country}-method returns the regional information +The \code{region}-method returns the regional information The \code{protocol}-method returns the protocol information @@ -82,7 +82,7 @@ The \code{lt1}-method gets the life table information of an LT1 object The \code{content}-method gets the life table information of an LT1 object -The \code{country}-method gets the regional information of an LT1 object +The \code{region}-method gets the regional information of an LT1 object The \code{protocol}-method gets the protocol information of an LT1 object @@ -107,7 +107,7 @@ The validation adds a pure numeric age AgeLow to the life table. \describe{ \item{\code{content}}{describes the content} -\item{\code{country}}{regional entity} +\item{\code{region}}{regional entity} \item{\code{header}}{includes the raw header information} diff --git a/tests/Simple1.R b/tests/Simple1.R index bebab4e..ee73ac6 100644 --- a/tests/Simple1.R +++ b/tests/Simple1.R @@ -27,7 +27,7 @@ lt1(o1)[, table(Age)] lt1(o1)[, range(ex)] content(o1) -country(o1) +region(o1) protocol(o1) # select some years @@ -64,7 +64,7 @@ ex1(e1)[, table(Age)] ex1(e1)[, range(AgeLow)] content(e1) -country(e1) +region(e1) protocol(e1) # select some years @@ -101,7 +101,7 @@ rd1(d1)[, table(Age_Name)] rd1(d1)[, range(AgeLow)] content(d1) -country(d1) +region(d1) protocol(d1) # select some years @@ -149,7 +149,7 @@ re1(r1)[, table(Age_Name)] re1(r1)[, range(AgeLow)] content(r1) -country(r1) +region(r1) protocol(r1) # select some years