S4 class for 'GENESIS-Tabelle: 12411-03-03-4'

R/eo1.R

@@ -150,7 +150,7 @@ setValidity("EX1",
 
 
 ####
-# Class for 'exposures 1x1'GENESIS-Tabelle: 12613-02-02-4'
+# Class for 'GENESIS-Tabelle: 12613-02-02-4'
 
 setClass("RD1",
          slots=c(
@@ -200,6 +200,57 @@ setMethod("selectRegion", "RD1", function(x, selectRegion) {
 }
 )
 
+
+####
+# Class for 'GENESIS-Tabelle: 12411-03-03-4'
+
+setClass("RE1",
+         slots=c(
+           header1="vector", # file header
+           re1="data.table", # exposure table
+           content="character", # content
+           country="character", # country
+           protocol="character" # protocol version
+         )
+)
+
+# slot getters
+setMethod("header1", "RE1", function(x) x@header1)
+
+setGeneric("re1", function(x) standardGeneric("re1"))
+setMethod("re1", "RE1", function(x) x@re1)
+
+setMethod("content", "RE1", function(x) x@content)
+setMethod("country", "RE1", function(x) x@country)
+setMethod("protocol", "RE1", function(x) x@protocol)
+
+# slot setters
+setGeneric("re1<-", function(x, value) standardGeneric("re1<-"))
+setReplaceMethod("re1", "RE1", function(x, value) {x@re1 <- value; validObject(x); x})
+
+# constructor
+RegExp1 <- function(header1, re1, content, country, protocol)
+  new("RE1", header1=header1, re1=re1, content=content, country=country, protocol=protocol)
+
+# methods
+setMethod("length", "RE1", function(x) dim(x@re1)[1])
+setMethod("show", "RE1",
+          function(object)
+            cat(class(object), "instance with length", length(object), "\n")
+)
+
+setMethod("selectYears", "RE1", function(x, selectYears) {
+  .re1 <- x@re1[Year %in% selectYears]
+  return(new("RE1", header1=x@header1, 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", header1=x@header1, re1=.re1, content=x@content, country=x@country, protocol=x@protocol))
+}
+)
+
 ####
 
 
@@ -263,6 +314,41 @@ readRegDeath <- function(infile)
 
 }
 
+
+# read all information from 'GENESIS-Tabelle: 12613-02-02-4'
+# Statistische Ämter des Bundes und der Länder, Deutschland, 2019
+readRegExp <- function(infile)
+{
+  (rexpt0 <- readLines(infile, n=9))
+  rexpt <- fread(infile, skip=9)
+
+  setnames(rexpt, c("V1","V2","V3","V4","V5","V6","V7","V8","V9","V10","V11","V12"),
+           c("Region_Code","Region_Name","Age_Name","Total1","Male","Female","D_Total","D_Male","D_Female",
+             "A_Total","A_Male","A_Female"))
+  # add the year
+  rexpt[, Year:=2016]
+
+  # merge the lower age limit
+  age_code2 <- data.table(Age_Name=c("unter 3 Jahre","3 bis unter 6 Jahre",
+                                     "6 bis unter 10 Jahre","10 bis unter 15 Jahre",
+                                     "15 bis unter 18 Jahre","18 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 bis unter 90 Jahre","90 Jahre und mehr"),
+                          AgeLow=c(0,3,6,10,15,18,seq(20,90,by=5)))
+
+  rexpt <- merge(rexpt, age_code2 ,by="Age_Name")
+
+  return(new("RE1", header1=rexpt0, re1=rexpt, content="GENESIS-Tabelle: 12613-02-02-4", country="Germany", protocol="unknown"))
+
+}
+
+
 ####
 
 # example and trials
@@ -386,4 +472,51 @@ showClass("RD1")
 showMethods("length")
 
 
+# read all information from 'GENESIS-Tabelle: 12411-03-03-4'
+# Statistische Ämter des Bundes und der Länder, Deutschland, 2019
+# Bevölkerung nach Geschlecht, Nationalität und Altersgruppen
+infile4 <- file.path("..","data","12411-03-03-4.csv")
+
+r1 <- readRegExp(infile4)
+
+length((r1))
+r1
+
+header1(r1)
+re1(r1)
+
+##
+# descriptive tables and a ranges
+re1(r1)[, table(Year)]
+re1(r1)[, table(Age_Name)]
+re1(r1)[, range(AgeLow)]
+
+content(r1)
+country(r1)
+protocol(r1)
+
+# select some years
+(r2 <- selectYears(r1, c(2016)))
+# descriptive tables and a ranges
+re1(r2)[, table(Year)]
+re1(r2)[, table(Age_Name)]
+re1(r2)[, range(AgeLow)]
+
+re1(r2)
+
+# select a reagion
+(r3 <- selectRegion(r2, "13003"))
+# descriptive tables and a ranges
+re1(r3)[, table(Year)]
+re1(r3)[, table(Age_Name)]
+re1(r3)[, range(AgeLow)]
+
+re1(r3)
+
+
+class(r1)
+showClass("RE1")
+showMethods("length")
+
+
 sessionInfo()