add a S4 class for GENESIS-Tabelle: 12613-02-02-4

R/eo1.R

@@ -147,6 +147,59 @@ setValidity("EX1",
             }
 )
 
+
+
+####
+# Class for 'exposures 1x1'GENESIS-Tabelle: 12613-02-02-4'
+
+setClass("RD1",
+         slots=c(
+           header1="vector", # file header
+           rd1="data.table", # exposure table
+           content="character", # content
+           country="character", # country
+           protocol="character" # protocol version
+         )
+)
+
+# slot getters
+setMethod("header1", "RD1", function(x) x@header1)
+
+setGeneric("rd1", function(x) standardGeneric("rd1"))
+setMethod("rd1", "RD1", function(x) x@rd1)
+
+setMethod("content", "RD1", function(x) x@content)
+setMethod("country", "RD1", function(x) x@country)
+setMethod("protocol", "RD1", function(x) x@protocol)
+
+# slot setters
+setGeneric("rd1<-", function(x, value) standardGeneric("rd1<-"))
+setReplaceMethod("rd1", "RD1", function(x, value) {x@rd1 <- value; validObject(x); x})
+
+# constructor
+RegDeath1 <- function(header1, rd1, content, country, protocol)
+  new("RD1", header1=header1, rd1=rd1, content=content, country=country, protocol=protocol)
+
+# methods
+setMethod("length", "RD1", function(x) dim(x@rd1)[1])
+setMethod("show", "RD1",
+          function(object)
+            cat(class(object), "instance with length", length(object), "\n")
+)
+
+setMethod("selectYears", "RD1", function(x, selectYears) {
+  .rd1 <- x@rd1[Year %in% selectYears]
+  return(new("RD1", header1=x@header1, rd1=.rd1, content=x@content, country=x@country, protocol=x@protocol))
+}
+)
+
+setGeneric("selectRegion", function(x, selectRegion) standardGeneric("selectRegion"))
+setMethod("selectRegion", "RD1", function(x, selectRegion) {
+  .rd1 <- x@rd1[Region_Code %in% selectRegion]
+  return(new("RD1", header1=x@header1, rd1=.rd1, content=x@content, country=x@country, protocol=x@protocol))
+}
+)
+
 ####
 
 
@@ -181,6 +234,35 @@ readEX1x1 <- function(infile)
   return(new("EX1", header1=EX0, ex1=EX1, content=content, country=country, protocol=protocol))
 }
 
+# read all information from 'GENESIS-Tabelle: 12613-02-02-4'
+# Statistische Ämter des Bundes und der Länder, Deutschland, 2019
+readRegDeath <- function(infile)
+{
+  rdft0 <- readLines(infile, n=7)
+  rdft <- fread(infile, skip=7)
+
+  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"))
+
+  # merge the lower age limit
+  age_code1 <- data.table(Age_Name=c("unter 1 Jahr","1 bis unter 5 Jahre",
+                                     "5 bis unter 10 Jahre","10 bis unter 15 Jahre",
+                                     "15 bis unter 20 Jahre","20 bis unter 25 Jahre",
+                                     "25 bis unter 30 Jahre","30 bis unter 35 Jahre",
+                                     "35 bis unter 40 Jahre","40 bis unter 45 Jahre",
+                                     "45 bis unter 50 Jahre","50 bis unter 55 Jahre",
+                                     "55 bis unter 60 Jahre","60 bis unter 65 Jahre",
+                                     "65 bis unter 70 Jahre","70 bis unter 75 Jahre",
+                                     "75 bis unter 80 Jahre","80 bis unter 85 Jahre",
+                                     "85 Jahre und mehr"),
+                          AgeLow=c(0,1,seq(5,85,by=5)))
+
+  rdft <- merge(rdft,age_code1,by="Age_Name")
+
+  return(new("RD1", header1=rdft0, rd1=rdft, content="GENESIS-Tabelle: 12613-02-02-4", country="Germany", protocol="unknown"))
+
+}
+
 ####
 
 # example and trials
@@ -253,9 +335,55 @@ ex1(e2)[, range(AgeLow)]
 
 ex1(e2)
 
-
 class(e1)
 showClass("EX1")
 showMethods("length")
 
+# read all information from 'GENESIS-Tabelle: 12613-02-02-4'
+# Statistische Ämter des Bundes und der Länder, Deutschland, 2019
+# Gestorbene nach Geschlecht, Nationalität und Altersgruppen -
+# Jahressumme - regionale Tiefe: Kreise und krfr. Städte
+infile3 <- file.path("..","data","12613-02-02-4.csv")
+
+d1 <- readRegDeath(infile3)
+
+length((d1))
+d1
+
+header1(d1)
+rd1(d1)
+
+# descriptive tables and a ranges
+rd1(d1)[, table(Year)]
+rd1(d1)[, table(Age_Name)]
+rd1(d1)[, range(AgeLow)]
+
+content(d1)
+country(d1)
+protocol(d1)
+
+# select some years
+(d2 <- selectYears(d1, c(2016)))
+# descriptive tables and a ranges
+rd1(d2)[, table(Year)]
+rd1(d2)[, table(Age_Name)]
+rd1(d2)[, range(AgeLow)]
+
+rd1(d2)
+
+# select a reagion
+(d3 <- selectRegion(d2, "13003"))
+# descriptive tables and a ranges
+rd1(d3)[, table(Year)]
+rd1(d3)[, table(Age_Name)]
+rd1(d3)[, range(AgeLow)]
+
+rd1(d3)
+
+
+class(d1)
+showClass("RD1")
+showMethods("length")
+
+
 sessionInfo()