leo_svydesign.R

#' Creates survey design objects for LEO 2010 and 2018.
#'
#' @param df Survey data
#' @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 %>%
#' @importFrom rlang :=
#' @importFrom rlang .data
#' @export
leo_svydesign <- function(df, survey = "leo2018", replist = FALSE) {
  names(df) <- tolower(names(df))

  # create survey design object for LEO 2010 or LEO 2018 ----
  if (survey == "leo2010" || survey == "leo2018" || survey == "leo2018hoch") {
    if (survey == "leo2010") {
      # remove logits
      df <- df %>% dplyr::select(-tidyselect::matches("^pv[1-5]$"))
      # rename variables for pvs and levels
      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")
      df <- df %>% dplyr::rename_at(dplyr::vars(old), ~new)
    }

    # some functions need a helper variable
    df$a <- as.numeric(1)

    # 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)
    # 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) %>%
          dplyr::rename(pv = !!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 = factor(.data$alpha3, labels = (c("a1-3", "a4", "a5")))) %>%
        dplyr::mutate(alpha2 = factor(.data$alpha2, labels = (c("a1-3", "a4-5")))) %>%
        dplyr::mutate(lowlit = factor(.data$lowlit, labels = (c("a4-5", "a1-3")))) %>%
        dplyr::mutate(alpha_pv = labelled::to_factor(.data$alpha_pv))})

    # if the imputation list is requested, return it and exit function
    if (replist == TRUE) {
      return(repList)
    }

    # create survey design
    if (survey == "leo2018") {
      design <- survey::svydesign(
        ids = ~0,
        weights = ~pgewges,
        data = mitools::imputationList(repList))
    } else if (survey == "leo2018hoch") {
      design <- survey::svydesign(
        ids = ~0,
        weights = ~phochges,
        data = mitools::imputationList(repList))
    } else if (survey == "leo2010") {
      design <- survey::svydesign(
        ids = ~0,
        weights = ~gewleointegr,
        data = mitools::imputationList(repList))
    }

  }

  # implement other surveys here----

  return(design)
}