From 2158cfdfaf524b2f4f74b6c5b07e94eafe00ef2e Mon Sep 17 00:00:00 2001 From: Angelika Meraner Date: Mon, 30 May 2016 10:22:34 +0200 Subject: [PATCH] Nur gew1 SPSS-Runden, bw NICHT --- R/AddVariable.R | 3 ++- R/ImportData.R | 18 +++++++++++------- R/IndivImportData.R | 12 +++++++----- 3 files changed, 20 insertions(+), 13 deletions(-) diff --git a/R/AddVariable.R b/R/AddVariable.R index 9b4abd4..56225ee 100644 --- a/R/AddVariable.R +++ b/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") diff --git a/R/ImportData.R b/R/ImportData.R index d7e9e61..f3e1a60 100644 --- a/R/ImportData.R +++ b/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"] } } diff --git a/R/IndivImportData.R b/R/IndivImportData.R index a318f92..05d4705 100644 --- a/R/IndivImportData.R +++ b/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"] } }