#############################################################################################################################################################################

###### Repliationscode zur GESIS Survey Guideline
###### Sand, Matthias und Kunz, Tanja (2020). Gewichtung in der Praxis. Mannheim, GESIS – Leibniz-Institut für Sozialwissenschaften (GESIS Survey Guidelines).
###### DOI: 10.15465/gesis-sg_030
###### Teil 1:  Designgewichtung von Telefonstichproben (Kapitel 2.1)

#############################################################################################################################################################################

rm(list = ls())
library(foreign)
library(doParallel)
library(missForest)

registerDoParallel(cores = 4)

Pfad <- paste0(getwd(),"/")
RCS <- read.spss(paste0(Pfad,"ZA6803_v4-0-1.sav"),use.value.labels = T,to.data.frame = T)

RCS_short <- RCS[,c("lfdn","pre101_alter","pre102","pre103","pre115","pre116","pre125","pre128","pre129","pre130","pre131","pre133",
                    "pre132")]
colnames(RCS_short) <- c("lfdn","Alter","Geschlecht","Schulabschluss","Haushaltsgroesse","rel._HH_Groesse","Tel_Kennung","AZ_Fest",
                         "AZ_Fest_Mob","Mobilfunknutzung","AZ_Mob","Nutzung_Fest_Mobil","Nutz_Mob")

### Aenderungen zur besseren Bearbeitung ###

RCS_short$AZ_Fest <- as.numeric(as.character(RCS_short$AZ_Fest))
RCS_short$AZ_Fest_Mob <- as.numeric(as.character(RCS_short$AZ_Fest_Mob))
RCS_short$rel._HH_Groesse <- as.numeric(as.character(RCS_short$rel._HH_Groesse))
RCS_short$Nutz_Mob <- as.numeric(RCS_short$Nutz_Mob)
RCS_short$AZ_Mob <- as.numeric(as.character(RCS_short$AZ_Mob))
RCS_short$AZ_Fest[RCS_short$Tel_Kennung == "Mobilfunk"] <- RCS_short$AZ_Fest_Mob[RCS_short$Tel_Kennung == "Mobilfunk"]
RCS_short$Alter <- as.integer(as.character(RCS_short$Alter))
#RCS_short$Haushaltsgroesse <- as.integer(as.character(RCS_short$Haushaltsgroesse))

### Aenderungen unter Annahmen ####

RCS_short$Mobilfunknutzung[is.na(RCS_short$Mobilfunknutzung)] <- "nein" # Alle NAs aus dem Festnetz kontaktiert
RCS_short$AZ_Mob[RCS_short$Mobilfunknutzung == "nein"] <- 0 # Landline-Onlys sollten keine Festnetznummer besitzen
RCS_short$rel._HH_Groesse[is.na(RCS_short$rel._HH_Groesse)] <- 1 # mindestens eine Erhebungsrelevante Person im Haushalt
RCS_short$Nutz_Mob[is.na(RCS_short$Nutz_Mob)] <- 1 # mindestens eine Erhebungsrelevante Person im Haushalt

### weitere relevante Variablen zur Gewichtung ####

RCS_short$gros_Fest <- 361900 # Brutto Festnetz
RCS_short$gros_Mob <- 155100 # Brutto Mobilfunk
RCS_short$AR_Fest <- 178831800 # Groesse der ADM-Auswahlrahmen war unbekannt. Deshalb wurden die Groessen aus dem GESIS-Rahmen als Proxy 
RCS_short$AR_Mob <- 328710000


#### Berechnung der Inklusionswahrscheinlichkeiten ####

RCS_short$pi_F <- with(RCS_short, gros_Fest/AR_Fest*AZ_Fest/rel._HH_Groesse) # pi Festnetz
RCS_short$pi_M <- with(RCS_short, gros_Mob/AR_Mob*AZ_Mob) # pi Mobilfunk
RCS_short$pi_M_star <-with(RCS_short, gros_Mob/AR_Mob*AZ_Mob/Nutz_Mob) # pi Mobilfunk mit zusaetzl. Nutzern 
RCS_short$pi <- RCS_short$pi_F+RCS_short$pi_M # Gemeinsame Inklusionswahrscheinlichkeit
RCS_short$pi_star <- RCS_short$pi_F+RCS_short$pi_M_star # + zus. Nutzer

### Designgewichte ###

RCS_short$di <- 1/RCS_short$pi # Designgewicht
RCS_short$di_star <- 1/RCS_short$pi_star
RCS_short$di_norm <- RCS_short$di/(sum(RCS_short$di)) * nrow(RCS_short) # Designgewicht normiert auf SP-Groesse

#### Einfache Imputation -> nicht-parametrisch (random forest) und nur als "Showcase"###

set.seed(1508)
RCS2 <- missForest(RCS_short,variablewise = T,verbose = T,parallelize = "forests")
RCS_short2 <- as.data.frame(RCS2$ximp)

#### Ergebnisse ####
tapply(RCS_short2$di_norm,RCS_short2$Geschlecht,function(x) sum(x)/nrow(RCS_short))
# maennlich  weiblich 
# 0.5207845 0.4792155

tapply(RCS_short2$di_norm,RCS_short2$Schulabschluss, function(x) sum(x)/nrow(RCS_short))

# Schule beendet ohne Abschluss 
# 0.0066578057 
# Hauptschulabschluss, Volksschulabschluss, Abschluss der polytechnischen Oberschu 
# 0.1596923098 
# Realschulabschluss, Mittlere Reife, Fachschulreife oder Abschluss der polytechni 
# 0.3072278790 
# Fachhochschulreife (Abschluss einer Fachoberschule etc.) 
# 0.0983640075 
# Abitur bzw. erweiterte Oberschule mit Abschluss 12. Klasse (Hochschulreife) 
# 0.4197964523 
# anderen Schulabschluss 
# 0.0074482113 
# noch in der Schule 
# 0.0008133344

RCS_short2$Alter2 <- cut(RCS_short2$Alter,breaks = c(18,30,40,50,60,70,80,90,100),include.lowest = T,right = F)

tapply(RCS_short2$di_norm,RCS_short2$Alter2, function(x) sum(x)/nrow(RCS_short))
# [18,30)     [30,40)     [40,50)     [50,60)     [60,70)     [70,80)     [80,90) 
# 0.128391010 0.103456655 0.142377313 0.230141593 0.197522321 0.147012816 0.048477138 
# [90,100] 
# 0.002487649 

save(RCS,RCS_short2,file = "RCS_DW.Rdata")