added remove lables fn to address build fail dpcy

Author: matthewphamilton

NAMESPACE

@@ -50,6 +50,7 @@ export(make_short_long_nms_vec)
 export(make_std_fn_dmt_spine)
 export(make_undmtd_fns_dir_chr)
 export(read_fns)
+export(remove_lbls_from_df)
 export(remove_obj_type_from_nm)
 export(replace_abbr)
 export(rowbind_all_tbs_in_r4_obj)
@@ -137,6 +138,7 @@ importFrom(rlang,exec)
 importFrom(rlang,sym)
 importFrom(sinew,makeOxyFile)
 importFrom(sinew,makeOxygen)
+importFrom(stats,na.omit)
 importFrom(stats,setNames)
 importFrom(stringi,stri_locate_last_fixed)
 importFrom(stringi,stri_replace_first_regex)
@@ -151,7 +153,6 @@ importFrom(stringr,str_replace)
 importFrom(stringr,str_replace_all)
 importFrom(stringr,str_sub)
 importFrom(stringr,str_trim)
-importFrom(summarytools,unlabel)
 importFrom(testit,assert)
 importFrom(tibble,add_case)
 importFrom(tibble,is_tibble)

R/fn_add.R

@@ -94,7 +94,6 @@ add_indefartls_to_phrases <- function (abbreviated_phrase_1L_chr, abbreviations_
 #' @importFrom dplyr filter pull bind_rows arrange
 #' @importFrom rlang sym
 #' @importFrom Hmisc label
-#' @importFrom summarytools unlabel
 #' @keywords internal
 add_lups <- function (template_lup, new_lup, key_var_nm_1L_chr, priority_lup_for_dupls_1L_chr = "template") 
 {
@@ -111,8 +110,8 @@ add_lups <- function (template_lup, new_lup, key_var_nm_1L_chr, priority_lup_for
         labels_chr <- Hmisc::label(new_lup) %>% unname()
     }
     if (!all(labels_chr %>% unique() == "")) {
-        template_lup <- template_lup %>% summarytools::unlabel()
-        new_lup <- new_lup %>% summarytools::unlabel()
+        template_lup <- template_lup %>% remove_lbls_from_df()
+        new_lup <- new_lup %>% remove_lbls_from_df()
         Hmisc::label(template_lup) <- as.list(labels_chr %>% 
             unname())
         Hmisc::label(new_lup) <- as.list(labels_chr %>% unname())

R/fn_remove.R

@@ -1,3 +1,21 @@
+#' Remove lbls from
+#' @description remove_lbls_from_df() is a Remove function that edits an object, removing a specified element or elements. Specifically, this function implements an algorithm to remove lbls from data.frame. Function argument data_df specifies the object to be updated. The function returns Unlabelled data (a data.frame).
+#' @param data_df Data (a data.frame)
+#' @return Unlabelled data (a data.frame)
+#' @rdname remove_lbls_from_df
+#' @export 
+#' @importFrom purrr reduce
+#' @keywords internal
+remove_lbls_from_df <- function (data_df) 
+{
+    unlabelled_data_df <- purrr::reduce(1:ncol(data_df), .init = data_df, 
+        ~{
+            class(.x[[.y]]) <- setdiff(class(.x[[.y]]), "labelled")
+            attr(.x[[.y]], "label") <- NULL
+            .x
+        })
+    return(unlabelled_data_df)
+}
 #' Remove object type from name
 #' @description remove_obj_type_from_nm() is a Remove function that edits an object, removing a specified element or elements. Specifically, this function implements an algorithm to remove object type from name. Function argument nms_chr specifies the object to be updated. Argument object_type_lup provides the object to be updated. The function returns Names (a character vector).
 #' @param nms_chr Names (a character vector)

R/fn_write.R

@@ -469,7 +469,7 @@ write_inst_dir <- function (path_to_pkg_rt_1L_chr = getwd())
 #' @return NULL
 #' @rdname write_links_for_website
 #' @export 
-
+#' @importFrom stats na.omit
 write_links_for_website <- function (path_to_pkg_rt_1L_chr = getwd(), user_manual_url_1L_chr = NA_character_, 
     developer_manual_url_1L_chr = NA_character_, project_website_url_1L_chr = NA_character_) 
 {
@@ -496,7 +496,7 @@ write_links_for_website <- function (path_to_pkg_rt_1L_chr = getwd(), user_manua
                   "  - text: Project website", NA_character_), 
                 ifelse(!is.na(project_website_url_1L_chr), paste0("    href: ", 
                   project_website_url_1L_chr), NA_character_), 
-                txt_chr) %>% na.omit()
+                txt_chr) %>% stats::na.omit()
         }, args_ls = list(user_manual_url_1L_chr = user_manual_url_1L_chr, 
             developer_manual_url_1L_chr = developer_manual_url_1L_chr, 
             project_website_url_1L_chr = project_website_url_1L_chr))

data-raw/fns/add.R

@@ -149,8 +149,8 @@ add_lups <- function(template_lup,
     labels_chr <- Hmisc::label(new_lup) %>% unname()
     }
   if(!all(labels_chr %>% unique() =="")){
-    template_lup <- template_lup %>% summarytools::unlabel()
-    new_lup <- new_lup %>% summarytools::unlabel()
+    template_lup <- template_lup %>% remove_lbls_from_df()
+    new_lup <- new_lup %>% remove_lbls_from_df()
     Hmisc::label(template_lup) <-  as.list(labels_chr %>% unname())
     Hmisc::label(new_lup) <- as.list(labels_chr %>% unname())
   }

data-raw/fns/remove.R

@@ -38,3 +38,14 @@ remove_obj_type_from_nm <- function(nms_chr,
   return(names_chr)
 
 }
+remove_lbls_from_df <- function(data_df){ # Adapted from: https://rdrr.io/github/dlindholm/doctoR/src/R/clear_labels.R
+  unlabelled_data_df <- purrr::reduce(1:ncol(data_df),
+                .init = data_df,
+                ~ {
+                  class(.x[[.y]]) <- setdiff(class(.x[[.y]]), 'labelled')
+                  attr(.x[[.y]],"label") <- NULL
+                  .x
+                }
+  )
+  return(unlabelled_data_df)
+  }

data-raw/fns/write.R

@@ -417,7 +417,7 @@ write_links_for_website <- function(path_to_pkg_rt_1L_chr = getwd(), # Needs dup
                      ifelse(!is.na(developer_manual_url_1L_chr), paste0("    href: ", developer_manual_url_1L_chr), NA_character_),
                      ifelse(!is.na(project_website_url_1L_chr), "  - text: Project website", NA_character_),
                      ifelse(!is.na(project_website_url_1L_chr), paste0("    href: ", project_website_url_1L_chr), NA_character_),
-                     txt_chr) %>% na.omit()
+                     txt_chr) %>% stats::na.omit()
                  },
                  args_ls = list(user_manual_url_1L_chr = user_manual_url_1L_chr,
                                 developer_manual_url_1L_chr = developer_manual_url_1L_chr,