Nur gew1 SPSS-Runden, bw NICHT

R/AddVariable.R

@@ -44,7 +44,8 @@
 #' # Beispiel 3:
 #' age_pub_fun <- function(balt){
 #'   x <- balt
-#'   x <- car::recode(x, "-3= -3; 0:14=0; 15:19=1; 20:24=2; 25:34=3; 35:44=4; 45:54=5; 55:59=6; 60:64=7; 65:200=8")
+#'   x <- car::recode(x, "-3= -3; 0:14=0; 15:19=1; 20:24=2; 
+#'   25:34=3; 35:44=4; 45:54=5; 55:59=6; 60:64=7; 65:200=8")
 #'   return(x)
 #' }
 #' mzTestData <- AddVariable(x=mzTestData, functionName=age_pub_fun, newVar="age_pub")

R/ImportData.R

@@ -91,7 +91,7 @@ vorhQuartaleUndPfade <- function() {
 #' Bootstrap-Gewichte eingelesen.
 #' @param weightDecimals Numerischer Wert oder NULL. Anzahl der Nachkommastellen der Stichprobengewichte, 
 #' gerundet nach SPSS RND Logik (0.5 bwz. -0.5 wird dabei immer "weg von 0" gerundet). 
-#' Falls NULL, werden die Gewichte so uebernommen wie sie in den eingelesenen Daten enthalten sind, diese Variante ist schneller.
+#' Falls NULL, werden die Gewichte nicht gerundet.
 #' @return Output ist eine Liste mit einem oder zwei Elementen, je nachdem ob
 #' \code{comp_diff_lag=NULL} oder nicht. Die Listenelemente sind Objekte der Klasse data.table.
 #' @seealso
@@ -176,12 +176,14 @@ ImportData <- function(year=NULL, quarter=NULL, comp_diff_lag=NULL, from=NULL, t
       rm(indat);gc()
     }
     for(j in 1:length(indatzr)){ 
-      q_gew <- names(indatzr[j][[1]])[grep("gew1",names(indatzr[j][[1]]))]
       if(is.null(weightDecimals)){
+        q_gew <- names(indatzr[j][[1]])[grep("gew1",names(indatzr[j][[1]]))] # will auch bw mitteln
         indatzr[j][[1]] <- indatzr[j][[1]][,(q_gew):=lapply(.SD,function(x){x/length(sequence)}), .SDcols=q_gew]
       }else{#bei STAT-Veroeffentlichungen werden ja Gewichte quasi 2 Mal gerundet. Einmal das gew1 und dann das darauf aufgauende gewjahr nochmal.
         # Quartalsgewichte werden aber in diesen Fall schon bei ImportDataQ bzw dann ImportDataJQ gerundet.
-        indatzr[j][[1]] <- indatzr[j][[1]][,(q_gew):=lapply(.SD,function(x){round.spss(x/length(sequence),digits=weightDecimals)}), .SDcols=q_gew]
+        q_gew <- names(indatzr[j][[1]])[grep("gew1_",names(indatzr[j][[1]]))] ## will bw nicht runden, nur mitteln
+        indatzr[j][[1]] <- indatzr[j][[1]][,("gew1"):=lapply(.SD,function(x){round.spss(x/length(sequence),digits=weightDecimals)}), .SDcols="gew1"]
+        indatzr[j][[1]] <- indatzr[j][[1]][,(q_gew):=lapply(.SD,function(x){x/length(sequence)}), .SDcols=q_gew]
       }
       names(indatzr)[j] <- paste0("dat_",paste0(from,collapse="q"),"_to_",paste0(to,collapse="q"))
     }
@@ -246,15 +248,17 @@ ImportDataQ <- function(j, q, comp_jahresgew=FALSE, whichVar=whichVar, hh=hh, fa
 
   if(is.null(weightDecimals)){
     if(comp_jahresgew){
-      q_gew <- names(dat)[grep("gew1",names(dat))] ## will ja auch die bw mitteln/runden
+      q_gew <- names(dat)[grep("gew1",names(dat))] ## will ja auch die bw mitteln
       dat <- dat[,(q_gew):=lapply(.SD,function(x){x/4}), .SDcols=q_gew]
     }
   }else{
-    q_gew <- names(dat)[grep("gew1",names(dat))] ## will ja auch die bw mitteln/runden
+    #q_gew <- names(dat)[grep("gew1",names(dat))] ## will ja auch die bw mitteln und runden
+    q_gew <- names(dat)[grep("gew1_",names(dat))] ## will bw NICHT runden
     if(comp_jahresgew){
-      dat <- dat[,(q_gew):=lapply(.SD,function(x){round.spss(round.spss(x,digits=weightDecimals)/4,digits=weightDecimals)}), .SDcols=q_gew]
+      dat <- dat[,("gew1"):=lapply(.SD,function(x){round.spss(round.spss(x,digits=weightDecimals)/4,digits=weightDecimals)}), .SDcols="gew1"]
+      dat <- dat[,(q_gew):=lapply(.SD,function(x){x/4}), .SDcols=q_gew]
     }else{
-      dat <- dat[,(q_gew):=lapply(.SD,function(x){round.spss(x,digits=weightDecimals)}), .SDcols=q_gew]
+      dat <- dat[,("gew1"):=lapply(.SD,function(x){round.spss(x,digits=weightDecimals)}), .SDcols="gew1"]
     }
   }
 

R/IndivImportData.R

@@ -42,8 +42,9 @@
 #' in \code{curr_inFile_bw} bzw. \code{prev_inFile_bw}. Default ist NULL, dabei
 #' ist die Variablenbezeichnung der Bootstrapgewichte \code{"gew1_1"}, \code{"gew1_2"}, \code{"gew1_3"}, \ldots wie beim Mikrozensus ueblich.
 #' @param weightName Character: Name des Gewichtsvektors der eingelesenen Daten, default ist \code{weightName="gew1"}.
-#' @param weightDecimals Numerischer Wert oder NULL. Anzahl der Nachkommastellen der Stichprobengewichte, gerundet nach SPSS RND Logik (0.5 bwz. -0.5 wird dabei immer "weg von 0" gerundet). 
-#' Falls NULL, werden die Gewichte so uebernommen wie sie in den eingelesenen Daten enthalten sind, diese Variante ist schneller.
+#' @param weightDecimals Numerischer Wert oder NULL. Anzahl der Nachkommastellen der (angepassten) Stichprobengewichte, 
+#' gerundet nach SPSS RND Logik (0.5 bwz. -0.5 wird dabei immer "weg von 0" gerundet). 
+#' Falls NULL, werden die Gewichte nicht gerundet.
 #' @return Output ist eine Liste mit einem oder zwei Elementen, je nachdem ob
 #' \code{prev_inFile=NULL} oder nicht. Die Listenelemente sind Objekte der Klasse data.table.
 #' Wurden mehrere Dateipfade angegeben, so enthaelt der Output angepasste Gewichte, 
@@ -456,11 +457,12 @@ IndivImportDataQ <- function(inFile, inFile_bw, multipleFiles=FALSE, nrMultipleF
       dat <- dat[,(q_gew_all):=lapply(.SD,function(x){x/nrMultipleFiles}), .SDcols=q_gew_all]
     }
   }else{
-    q_gew_all <- names(dat)[grep("gew1",names(dat))] ## will ja auch die bw mitteln/runden
     if(multipleFiles){
-      dat <- dat[,(q_gew_all):=lapply(.SD,function(x){round.spss(round.spss(x,digits=weightDecimals)/nrMultipleFiles,digits=weightDecimals)}), .SDcols=q_gew_all]
+      q_gew_all <- names(dat)[grep("gew1_",names(dat))] ## will die bw nur mitteln, nicht runden
+      dat <- dat[,("gew1"):=lapply(.SD,function(x){round.spss(round.spss(x,digits=weightDecimals)/nrMultipleFiles,digits=weightDecimals)}), .SDcols="gew1"]
+      dat <- dat[,(q_gew_all):=lapply(.SD,function(x){x/nrMultipleFiles}), .SDcols=q_gew_all]
     }else{
-      dat <- dat[,(q_gew_all):=lapply(.SD,function(x){round.spss(x,digits=weightDecimals)}), .SDcols=q_gew_all]
+      dat <- dat[,("gew1"):=lapply(.SD,function(x){round.spss(x,digits=weightDecimals)}), .SDcols="gew1"]
     }
   }