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