add two slots for the total sum information stored in the GENESIS data

NAMESPACE

@@ -25,7 +25,9 @@ exportMethods(length)
 exportMethods(lt1)
 exportMethods(protocol)
 exportMethods(rd1)
+exportMethods(rd1total)
 exportMethods(re1)
+exportMethods(re1total)
 exportMethods(region)
 exportMethods(selectRegion)
 exportMethods(selectYears)

R/AllGeneric.R

@@ -23,11 +23,15 @@ setGeneric("ex1<-", function(object, value) standardGeneric("ex1<-"))
 
 setGeneric("rd1", function(object) standardGeneric("rd1"))
 
+setGeneric("rd1total", function(object) standardGeneric("rd1total"))
+
 setGeneric("rd1<-", function(object, value) standardGeneric("rd1<-"))
 
 setGeneric("selectRegion", function(object, selectRegion) standardGeneric("selectRegion"))
 
 setGeneric("re1", function(object) standardGeneric("re1"))
 
+setGeneric("re1total", function(object) standardGeneric("re1total"))
+
 setGeneric("re1<-", function(object, value) standardGeneric("re1<-"))
 

R/GENESISClasses.R

@@ -14,6 +14,7 @@ setClass("RD1",
            header="vector", # file header
            footer="vector", # file footer
            rd1="data.table", # exposure table
+           rd1total="data.table", # exposure table total sums          
            content="character", # content
            region="character", # region
            protocol="character" # protocol version
@@ -27,6 +28,8 @@ setMethod("header", "RD1", function(object) object@header)
 setMethod("footer", "RD1", function(object) object@footer)
 #' @export
 setMethod("rd1", "RD1", function(object) object@rd1)
+#' @export
+setMethod("rd1total", "RD1", function(object) object@rd1total)
 
 #' @export
 setMethod("content", "RD1", function(object) object@content)
@@ -41,8 +44,8 @@ setReplaceMethod("rd1", "RD1", function(object, value) {object@rd1 <- value; val
 
 # constructor
 #' @export
-RegDeath1 <- function(header, footer, rd1, content, region, protocol)
-  new("RD1", header=header, footer=footer, rd1=rd1, content=content, region=region, protocol=protocol)
+RegDeath1 <- function(header, footer, rd1, rd1total, content, region, protocol)
+  new("RD1", header=header, footer=footer, rd1=rd1, rd1total=rd1total, content=content, region=region, protocol=protocol)
 
 # methods
 #' @export
@@ -58,15 +61,17 @@ 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, region=object@region, protocol=object@protocol))
+  .rd1total <- object@rd1total[Year %in% selectYears]
+  return(new("RD1", header=object@header, footer=object@footer, rd1=.rd1, rd1total=.rd1total, content=object@content, region=object@region, protocol=object@protocol))
 }
 )
 
 #' @export
 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, region=object@region, protocol=object@protocol))
+  .rd1total <- object@rd1total[Region_Code %in% selectRegion]
+  return(new("RD1", header=object@header, footer=object@footer, rd1=.rd1, rd1total=.rd1total, content=object@content, region=object@region, protocol=object@protocol))
 }
 )
 
@@ -97,6 +102,7 @@ setClass("RE1",
            header="vector", # file header
            footer="vector", # file footer
            re1="data.table", # exposure table
+           re1total="data.table", # exposure table total sums
            content="character", # content
            region="character", # region
            protocol="character" # protocol version
@@ -110,6 +116,8 @@ setMethod("header", "RE1", function(object) object@header)
 setMethod("footer", "RE1", function(object) object@footer)
 #' @export
 setMethod("re1", "RE1", function(object) object@re1)
+#' @export
+setMethod("re1total", "RE1", function(object) object@re1total)
 
 #' @export
 setMethod("content", "RE1", function(object) object@content)
@@ -124,8 +132,8 @@ setReplaceMethod("re1", "RE1", function(object, value) {object@re1 <- value; val
 
 # constructor
 #' @export
-RegExp1 <- function(header, footer, re1, content, region, protocol)
-  new("RE1", header=header, footer, re1=re1, content=content, region=region, protocol=protocol)
+RegExp1 <- function(header, footer, re1, re1total, content, region, protocol)
+  new("RE1", header=header, footer, re1=re1, re1total=re1total, content=content, region=region, protocol=protocol)
 
 # methods
 #' @export
@@ -141,15 +149,17 @@ 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, region=object@region, protocol=object@protocol))
+  .re1total <- object@re1total[Year %in% selectYears]
+  return(new("RE1", header=object@header, footer=object@footer, re1=.re1, re1total=.re1total, content=object@content, region=object@region, protocol=object@protocol))
 }
 )
 
 #' @export
 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, region=object@region, protocol=object@protocol))
+  .re1total <- object@re1total[Region_Code %in% selectRegion]
+  return(new("RE1", header=object@header, footer=object@footer, re1=.re1, re1total=.re1total, content=object@content, region=object@region, protocol=object@protocol))
 }
 )
 
@@ -190,7 +200,11 @@ readRegDeath <- function(infile)
 
   data.table::setnames(rdft, c("V1","V2","V3","V4","V5","V6","V7","V8","V9","V10"),
            c("Year","Region_Code","Region_Name","Age_Name","Total1","Male","Female","D_Total","D_Male","D_Female"))
-
+
+  # extract the total sums
+  Age_Name <- NULL # to prevent a note
+  rd1total <- rdft[Age_Name=="Insgesamt"]
+
   # merge the lower age limit
   age_code1 <- data.table::data.table(Age_Name=c("unter 1 Jahr","1 bis unter 5 Jahre",
                                      "5 bis unter 10 Jahre","10 bis unter 15 Jahre",
@@ -206,7 +220,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", region="Germany", protocol="unknown"))
+  return(new("RD1", header=header, footer=footer, rd1=rdft, rd1total = rd1total, content="GENESIS-Tabelle: 12613-02-02-4", region="Germany", protocol="unknown"))
 
 }
 
@@ -234,6 +248,11 @@ readRegExp <- function(infile)
   Year <- NULL # avoid NOTE  
   rexpt[, Year:=2016]
 
+  Age_Name <- NULL # to prevent a note
+  # extract the total sums
+  re1total <- rexpt[Age_Name=="Insgesamt"]
+
+
   # merge the lower age limit
   age_code2 <- data.table::data.table(Age_Name=c("unter 3 Jahre","3 bis unter 6 Jahre",
                                      "6 bis unter 10 Jahre","10 bis unter 15 Jahre",
@@ -250,7 +269,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", region="Germany", protocol="unknown"))
+  return(new("RE1", header=header, footer=footer, re1=rexpt, re1total=re1total, content="GENESIS-Tabelle: 12613-02-02-4", region="Germany", protocol="unknown"))
 
 }
 

tests/Simple1.R

@@ -94,6 +94,7 @@ d1
 header(d1)
 footer(d1)
 rd1(d1)
+rd1total(d1)
 
 # descriptive tables and a ranges
 rd1(d1)[, table(Year)]
@@ -112,6 +113,7 @@ rd1(d2)[, table(Age_Name)]
 rd1(d2)[, range(AgeLow)]
 
 rd1(d2)
+rd1total(d2)
 
 # select a reagion
 (d3 <- selectRegion(d2, "13003"))
@@ -121,7 +123,9 @@ rd1(d3)[, table(Age_Name)]
 rd1(d3)[, range(AgeLow)]
 
 rd1(d3)
+rd1total(d3)
 
+merge(rd1(d3), rd1total(d3)[,c("Region_Code","Total1","Male","Female")], by = "Region_Code")
 
 class(d1)
 showClass("RD1")
@@ -141,6 +145,7 @@ r1
 header(r1)
 footer(r1)
 re1(r1)
+re1total(r1)
 
 ##
 # descriptive tables and a ranges
@@ -160,6 +165,7 @@ re1(r2)[, table(Age_Name)]
 re1(r2)[, range(AgeLow)]
 
 re1(r2)
+re1total(r2)
 
 # select a reagion
 (r3 <- selectRegion(r2, "13003"))
@@ -169,7 +175,9 @@ re1(r3)[, table(Age_Name)]
 re1(r3)[, range(AgeLow)]
 
 re1(r3)
+re1total(r3)
 
+merge(re1(r3), re1total(r3)[,c("Region_Code","Total1","Male","Female")], by = "Region_Code")
 
 class(r1)
 showClass("RE1")