From 4778c5d77fb5a6b94f24c11e86eb7797e9d6d06e Mon Sep 17 00:00:00 2001 From: gdutz <30431062+gdutz@users.noreply.github.com> Date: Wed, 11 Aug 2021 15:25:34 +0200 Subject: [PATCH] Compatibility with published SUF and PUF --- DESCRIPTION | 4 ++-- NAMESPACE | 6 ++++++ R/leo_svydesign.R | 31 +++++++++++++++++++------------ 3 files changed, 27 insertions(+), 14 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index af6cfae..1c80286 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,10 +1,10 @@ Package: leo Type: Package Title: Useful functions for LEO surveys -Version: 0.1.31 +Version: 0.2.1 Author: Gregor Dutz Maintainer: Gregor Dutz <gregor.dutz@uni-hamburg.de> -Description: It does useful stuff. +Description: Useful functions for LEO surveys. License: MIT + file LICENSE Encoding: UTF-8 LazyData: true diff --git a/NAMESPACE b/NAMESPACE index 7c003c0..84289bc 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -5,3 +5,9 @@ export(leo_getdesign) export(leo_svydesign) export(leo_tab) export(leo_table) +import(dplyr) +import(mitools) +import(purrr) +import(survey) +import(tidyselect) +importFrom(magrittr,"%>%") diff --git a/R/leo_svydesign.R b/R/leo_svydesign.R index 1684a86..d0cdf97 100644 --- a/R/leo_svydesign.R +++ b/R/leo_svydesign.R @@ -1,11 +1,18 @@ #' Creates survey design objects for LEO 2010 and 2018. #' #' @param df Survey data -#' @param survey_name leo2010 and leo2018 (leo2018hoch) implemented -#' @return A survey design object. +#' @param survey Choose between leo2010 and leo2018 (leo2018hoch implements weighting based on population totals). +#' @param replist When true, the function returns an imputation list instead of survey design object. +#' @return A survey design or imputation list object. #' +#' @importFrom magrittr "%>%" +#' @import tidyselect +#' @import dplyr +#' @import purrr +#' @import survey +#' @import mitools #' @export -leo_svydesign <- function(df, survey_name = "leo2018", list = FALSE) { +leo_svydesign <- function(df, survey_name = "leo2018", replist = FALSE) { names(df) <- tolower(names(df)) # create survey design object for LEO 2010 or LEO 2018 ---- @@ -17,7 +24,7 @@ leo_svydesign <- function(df, survey_name = "leo2018", list = FALSE) { old=c("pv1_62", "pv2_62", "pv3_62", "pv4_62", "pv5_62", "pv1_alphalevel_62", "pv2_alphalevel_62", "pv3_alphalevel_62", "pv4_alphalevel_62", "pv5_alphalevel_62") new=c("pv1", "pv2", "pv3", "pv4", "pv5", - "alpha.pv1", "alpha.pv2", "alpha.pv3", "alpha.pv4", "alpha.pv5") + "alpha_pv1", "alpha_pv2", "alpha_pv3", "alpha_pv4", "alpha_pv5") df <- df %>% dplyr::rename_at(vars(old), ~new) } @@ -26,31 +33,31 @@ leo_svydesign <- function(df, survey_name = "leo2018", list = FALSE) { # get column names of pvs and levels lit <- grep("^pv[0-9]+", colnames(df), value = TRUE) - alp <- grep("^alpha.pv[0-9]+", colnames(df), value = TRUE) + alp <- grep("^alpha_pv[0-9]+", colnames(df), value = TRUE) # column names of all other variables all <- df %>% dplyr::select(-tidyselect::one_of(lit), -tidyselect::one_of(alp)) all <- colnames(all) # create list with one pv-variable and one level-variable each (and all other variables) repList <- lit %>% - purrr::map(function(x) {dplyr::select(df, all, paste0("alpha.", x), x) %>% + purrr::map(function(x) {dplyr::select(df, all, paste0("alpha_", x), x) %>% dplyr::rename(pv := !!x) %>% - dplyr::rename(alpha.pv := !!paste0("alpha.", x))}) + dplyr::rename(alpha_pv := !!paste0("alpha_", x))}) # create further alpha-variables for different analyses # alpha3 (three levels): low literate (Alpha 1-3), Alpha 4, above Alpha 4 # alpha2 (two levels): low literat (Alpha 1-3), high literate (Alpha 4 and above) # lowlit (two levels): same as alpha2, but reversed levels repList <- lapply(repList, function(x) {x %>% - dplyr::mutate(alpha3 = ifelse(x$alpha.pv > 3, x$alpha.pv, 1)) %>% - dplyr::mutate(alpha2 = ifelse(x$alpha.pv > 3, 1, 0)) %>% - dplyr::mutate(lowlit = ifelse(x$alpha.pv > 3, 0, 1)) %>% + dplyr::mutate(alpha3 = ifelse(x$alpha_pv > 3, x$alpha_pv, 1)) %>% + dplyr::mutate(alpha2 = ifelse(x$alpha_pv > 3, 1, 0)) %>% + dplyr::mutate(lowlit = ifelse(x$alpha_pv > 3, 0, 1)) %>% dplyr::mutate(alpha3 = factor(alpha3, labels = (c("a1-3", "a4", "a5")))) %>% dplyr::mutate(alpha2 = factor(alpha2, labels = (c("a1-3", "a4-5")))) %>% dplyr::mutate(lowlit = factor(lowlit, labels = (c("a4-5", "a1-3")))) %>% - dplyr::mutate(alpha.pv = labelled::to_factor(alpha.pv))}) + dplyr::mutate(alpha_pv = labelled::to_factor(alpha_pv))}) # if the imputation list is requested, return it and exit function - if (list == TRUE) { + if (replist == TRUE) { return(repList) } -- GitLab