add function footer to GENISISclasses

NAMESPACE

@@ -6,7 +6,7 @@ exportClasses(RD1)
 exportClasses(RE1)
 
 ## Generics and functions defined in this package
-export("header", "lt1", 
+export("header", "footer", "lt1", 
        "content",
        "country",
        "protocol", "lt1<-",

R/AllGeneric.R

@@ -2,6 +2,8 @@
 
 setGeneric("header", function(x) standardGeneric("header"))
 
+setGeneric("footer", function(x) standardGeneric("footer"))
+
 setGeneric("lt1", function(x) standardGeneric("lt1"))
 
 setGeneric("content", function(x) standardGeneric("content"))

R/GENESISClasses.R

@@ -8,6 +8,7 @@ require(data.table)
 setClass("RD1",
          slots=c(
            header="vector", # file header
+           footer="vector", # file footer
            rd1="data.table", # exposure table
            content="character", # content
            country="character", # country
@@ -17,6 +18,7 @@ setClass("RD1",
 
 # slot getters
 setMethod("header", "RD1", function(x) x@header)
+setMethod("footer", "RD1", function(x) x@footer)
 setMethod("rd1", "RD1", function(x) x@rd1)
 
 setMethod("content", "RD1", function(x) x@content)
@@ -27,8 +29,8 @@ setMethod("protocol", "RD1", function(x) x@protocol)
 setReplaceMethod("rd1", "RD1", function(x, value) {x@rd1 <- value; validObject(x); x})
 
 # constructor
-RegDeath1 <- function(header, rd1, content, country, protocol)
-  new("RD1", header=header, rd1=rd1, content=content, country=country, protocol=protocol)
+RegDeath1 <- function(header, footer, rd1, content, country, protocol)
+  new("RD1", header=header, footer=footer, rd1=rd1, content=content, country=country, protocol=protocol)
 
 # methods
 setMethod("length", "RD1", function(x) dim(x@rd1)[1])
@@ -39,13 +41,13 @@ setMethod("show", "RD1",
 
 setMethod("selectYears", "RD1", function(x, selectYears) {
   .rd1 <- x@rd1[Year %in% selectYears]
-  return(new("RD1", header=x@header, rd1=.rd1, content=x@content, country=x@country, protocol=x@protocol))
+  return(new("RD1", header=x@header, footer=x@footer, rd1=.rd1, content=x@content, country=x@country, protocol=x@protocol))
 }
 )
 
 setMethod("selectRegion", "RD1", function(x, selectRegion) {
   .rd1 <- x@rd1[Region_Code %in% selectRegion]
-  return(new("RD1", header=x@header, rd1=.rd1, content=x@content, country=x@country, protocol=x@protocol))
+  return(new("RD1", header=x@header, footer=x@footer, rd1=.rd1, content=x@content, country=x@country, protocol=x@protocol))
 }
 )
 
@@ -72,6 +74,7 @@ setValidity("RD1",
 setClass("RE1",
          slots=c(
            header="vector", # file header
+           footer="vector", # file footer
            re1="data.table", # exposure table
            content="character", # content
            country="character", # country
@@ -81,6 +84,7 @@ setClass("RE1",
 
 # slot getters
 setMethod("header", "RE1", function(x) x@header)
+setMethod("footer", "RE1", function(x) x@footer)
 setMethod("re1", "RE1", function(x) x@re1)
 
 setMethod("content", "RE1", function(x) x@content)
@@ -91,8 +95,8 @@ setMethod("protocol", "RE1", function(x) x@protocol)
 setReplaceMethod("re1", "RE1", function(x, value) {x@re1 <- value; validObject(x); x})
 
 # constructor
-RegExp1 <- function(header, re1, content, country, protocol)
-  new("RE1", header=header, re1=re1, content=content, country=country, protocol=protocol)
+RegExp1 <- function(header, footer, re1, content, country, protocol)
+  new("RE1", header=header, footer, re1=re1, content=content, country=country, protocol=protocol)
 
 # methods
 setMethod("length", "RE1", function(x) dim(x@re1)[1])
@@ -103,13 +107,13 @@ setMethod("show", "RE1",
 
 setMethod("selectYears", "RE1", function(x, selectYears) {
   .re1 <- x@re1[Year %in% selectYears]
-  return(new("RE1", header=x@header, re1=.re1, content=x@content, country=x@country, protocol=x@protocol))
+  return(new("RE1", header=x@header, footer=x@footer, re1=.re1, content=x@content, country=x@country, protocol=x@protocol))
 }
 )
 
 setMethod("selectRegion", "RE1", function(x, selectRegion) {
   .re1 <- x@re1[Region_Code %in% selectRegion]
-  return(new("RE1", header=x@header, re1=.re1, content=x@content, country=x@country, protocol=x@protocol))
+  return(new("RE1", header=x@header, footer=x@footer, re1=.re1, content=x@content, country=x@country, protocol=x@protocol))
 }
 )
 
@@ -164,7 +168,7 @@ readRegDeath <- function(infile)
 
   rdft <- merge(rdft,age_code1,by="Age_Name")
 
-  return(new("RD1", header=header, 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", country="Germany", protocol="unknown"))
 
 }
 
@@ -206,7 +210,7 @@ readRegExp <- function(infile)
 
   rexpt <- merge(rexpt, age_code2 ,by="Age_Name")
 
-  return(new("RE1", header=header, 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", country="Germany", protocol="unknown"))
 
 }
 

tests/Simple1.R

@@ -92,6 +92,7 @@ length((d1))
 d1
 
 header(d1)
+footer(d1)
 rd1(d1)
 
 # descriptive tables and a ranges
@@ -138,6 +139,7 @@ length((r1))
 r1
 
 header(r1)
+footer(r1)
 re1(r1)
 
 ##