Skip to content
Snippets Groups Projects
Commit 4778c5d7 authored by gdutz's avatar gdutz
Browse files

Compatibility with published SUF and PUF

parent 171dd51d
Branches
No related tags found
No related merge requests found
Package: leo Package: leo
Type: Package Type: Package
Title: Useful functions for LEO surveys Title: Useful functions for LEO surveys
Version: 0.1.31 Version: 0.2.1
Author: Gregor Dutz Author: Gregor Dutz
Maintainer: Gregor Dutz <gregor.dutz@uni-hamburg.de> Maintainer: Gregor Dutz <gregor.dutz@uni-hamburg.de>
Description: It does useful stuff. Description: Useful functions for LEO surveys.
License: MIT + file LICENSE License: MIT + file LICENSE
Encoding: UTF-8 Encoding: UTF-8
LazyData: true LazyData: true
......
...@@ -5,3 +5,9 @@ export(leo_getdesign) ...@@ -5,3 +5,9 @@ export(leo_getdesign)
export(leo_svydesign) export(leo_svydesign)
export(leo_tab) export(leo_tab)
export(leo_table) export(leo_table)
import(dplyr)
import(mitools)
import(purrr)
import(survey)
import(tidyselect)
importFrom(magrittr,"%>%")
#' Creates survey design objects for LEO 2010 and 2018. #' Creates survey design objects for LEO 2010 and 2018.
#' #'
#' @param df Survey data #' @param df Survey data
#' @param survey_name leo2010 and leo2018 (leo2018hoch) implemented #' @param survey Choose between leo2010 and leo2018 (leo2018hoch implements weighting based on population totals).
#' @return A survey design object. #' @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 #' @export
leo_svydesign <- function(df, survey_name = "leo2018", list = FALSE) { leo_svydesign <- function(df, survey_name = "leo2018", replist = FALSE) {
names(df) <- tolower(names(df)) names(df) <- tolower(names(df))
# create survey design object for LEO 2010 or LEO 2018 ---- # create survey design object for LEO 2010 or LEO 2018 ----
...@@ -17,7 +24,7 @@ leo_svydesign <- function(df, survey_name = "leo2018", list = FALSE) { ...@@ -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", 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") "pv1_alphalevel_62", "pv2_alphalevel_62", "pv3_alphalevel_62", "pv4_alphalevel_62", "pv5_alphalevel_62")
new=c("pv1", "pv2", "pv3", "pv4", "pv5", 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) df <- df %>% dplyr::rename_at(vars(old), ~new)
} }
...@@ -26,31 +33,31 @@ leo_svydesign <- function(df, survey_name = "leo2018", list = FALSE) { ...@@ -26,31 +33,31 @@ leo_svydesign <- function(df, survey_name = "leo2018", list = FALSE) {
# get column names of pvs and levels # get column names of pvs and levels
lit <- grep("^pv[0-9]+", colnames(df), value = TRUE) 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 # column names of all other variables
all <- df %>% dplyr::select(-tidyselect::one_of(lit), -tidyselect::one_of(alp)) all <- df %>% dplyr::select(-tidyselect::one_of(lit), -tidyselect::one_of(alp))
all <- colnames(all) all <- colnames(all)
# create list with one pv-variable and one level-variable each (and all other variables) # create list with one pv-variable and one level-variable each (and all other variables)
repList <- lit %>% 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(pv := !!x) %>%
dplyr::rename(alpha.pv := !!paste0("alpha.", x))}) dplyr::rename(alpha_pv := !!paste0("alpha_", x))})
# create further alpha-variables for different analyses # create further alpha-variables for different analyses
# alpha3 (three levels): low literate (Alpha 1-3), Alpha 4, above Alpha 4 # 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) # alpha2 (two levels): low literat (Alpha 1-3), high literate (Alpha 4 and above)
# lowlit (two levels): same as alpha2, but reversed levels # lowlit (two levels): same as alpha2, but reversed levels
repList <- lapply(repList, function(x) {x %>% repList <- lapply(repList, function(x) {x %>%
dplyr::mutate(alpha3 = ifelse(x$alpha.pv > 3, x$alpha.pv, 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(alpha2 = ifelse(x$alpha_pv > 3, 1, 0)) %>%
dplyr::mutate(lowlit = ifelse(x$alpha.pv > 3, 0, 1)) %>% dplyr::mutate(lowlit = ifelse(x$alpha_pv > 3, 0, 1)) %>%
dplyr::mutate(alpha3 = factor(alpha3, labels = (c("a1-3", "a4", "a5")))) %>% dplyr::mutate(alpha3 = factor(alpha3, labels = (c("a1-3", "a4", "a5")))) %>%
dplyr::mutate(alpha2 = factor(alpha2, labels = (c("a1-3", "a4-5")))) %>% dplyr::mutate(alpha2 = factor(alpha2, labels = (c("a1-3", "a4-5")))) %>%
dplyr::mutate(lowlit = factor(lowlit, labels = (c("a4-5", "a1-3")))) %>% 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 the imputation list is requested, return it and exit function
if (list == TRUE) { if (replist == TRUE) {
return(repList) return(repList)
} }
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment