154 remove formatters (#155)

Closes #154

---------

Signed-off-by: Marcin <[email protected]>
Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com>
Co-authored-by: Dawid Kałędkowski <[email protected]>
Co-authored-by: 27856297+dependabot-preview[bot]@users.noreply.github.com <27856297+dependabot-preview[bot]@users.noreply.github.com>

DESCRIPTION

@@ -21,7 +21,6 @@ Depends:
 Imports:
     checkmate,
     digest,
-    formatters (>= 0.3.1),
     lifecycle,
     logger (>= 0.2.0),
     methods,

NAMESPACE

@@ -55,6 +55,7 @@ S3method(to_relational_data,TealDataset)
 S3method(to_relational_data,TealDatasetConnector)
 S3method(to_relational_data,data.frame)
 S3method(to_relational_data,list)
+export("col_labels<-")
 export("data_label<-")
 export(as_cdisc)
 export(callable_code)
@@ -68,6 +69,8 @@ export(cdisc_dataset_connector_file)
 export(cdisc_dataset_file)
 export(code_cdisc_dataset_connector)
 export(code_dataset_connector)
+export(col_labels)
+export(col_relabel)
 export(csv_cdisc_dataset_connector)
 export(csv_dataset_connector)
 export(data_connection)
@@ -116,7 +119,6 @@ export(to_relational_data)
 export(validate_metadata)
 import(shiny)
 importFrom(digest,digest)
-importFrom(formatters,var_labels)
 importFrom(logger,log_trace)
 importFrom(shinyjs,show)
 importFrom(stats,setNames)

R/CodeClass.R

@@ -86,7 +86,7 @@ CodeClass <- R6::R6Class( # nolint
     #' @description
     #' Set code in form of character
     #' @param code (`character`) vector of code text to be set
-    #' @param `dataname` optional, (`character`) vector of `datanames` to assign code to. If empty then the code
+    #' @param dataname optional, (`character`) vector of `datanames` to assign code to. If empty then the code
     #' is considered to be "global"
     #' @param deps optional, (`character`) vector of `datanames` that given code depends on
     #'
@@ -106,7 +106,7 @@ CodeClass <- R6::R6Class( # nolint
     },
     #' @description
     #' Get the code for a given data names
-    #' @param `dataname` optional, (`character`) vector of `datanames` for which the code is extracted.
+    #' @param dataname optional, (`character`) vector of `datanames` for which the code is extracted.
     #' If `NULL` then get the code for all data names
     #' @param deparse optional, (`logical`) whether to return the deparsed form of a call
     #' @return `character` or `list` of calls

R/TealDataset.R

@@ -184,7 +184,7 @@ TealDataset <- R6::R6Class( # nolint
     #' Derive the column labels
     #' @return `character` vector.
     get_column_labels = function() {
-      formatters::var_labels(private$.raw_data, fill = FALSE)
+      col_labels(private$.raw_data, fill = FALSE)
     },
     #' @description
     #' Get the number of columns of the data

R/formatters_var_labels.R

@@ -0,0 +1,152 @@
+#' Get Label Attributes of Variables in a \code{data.frame}
+#'
+#' Variable labels can be stored as a \code{label} attribute for each variable.
+#' This functions returns a named character vector with the variable labels
+#' (empty sting if not specified)
+#'
+#' @param x a \code{data.frame} object
+#' @param fill boolean in case the \code{label} attribute does not exist if
+#'   \code{TRUE} the variable names is returned, otherwise \code{NA}
+#'
+#' @source This function was taken 1-1 from
+#' \href{https://cran.r-project.org/web/packages/formatters/index.html}{formatters} package, to reduce the complexity of
+#' the dependency tree.
+#'
+#' @seealso [col_relabel()] [`col_labels<-`]
+#'
+#' @return a named character vector with the variable labels, the names
+#'   correspond to the variable names
+#'
+#' @export
+#'
+#' @examples
+#' x <- iris
+#' col_labels(x)
+#' col_labels(x) <- paste("label for", names(iris))
+#' col_labels(x)
+col_labels <- function(x, fill = FALSE) {
+  stopifnot(is.data.frame(x))
+  if (NCOL(x) == 0) {
+    return(character())
+  }
+
+  y <- Map(function(col, colname) {
+    label <- attr(col, "label")
+
+    if (is.null(label)) {
+      if (fill) {
+        colname
+      } else {
+        NA_character_
+      }
+    } else {
+      if (!is.character(label) && !(length(label) == 1)) {
+        stop("label for variable ", colname, "is not a character string")
+      }
+      as.vector(label)
+    }
+  }, x, colnames(x))
+
+  labels <- unlist(y, recursive = FALSE, use.names = TRUE)
+
+  if (!is.character(labels)) {
+    stop("label extraction failed")
+  }
+
+  labels
+}
+
+#' Set Label Attributes of All Variables in a \code{data.frame}
+#'
+#' Variable labels can be stored as a \code{label} attribute for each variable.
+#' This functions sets all non-missing (non-NA) variable labels in a \code{data.frame}
+#'
+#' @inheritParams col_labels
+#' @param value new variable labels, \code{NA} removes the variable label
+#'
+#' @source This function was taken 1-1 from
+#' \href{https://cran.r-project.org/web/packages/formatters/index.html}{formatters} package, to reduce the complexity of
+#' the dependency tree.
+#'
+#' @seealso [col_labels()] [col_relabel()]
+#'
+#' @return modifies the variable labels of \code{x}
+#'
+#' @export
+#'
+#' @examples
+#' x <- iris
+#' col_labels(x)
+#' col_labels(x) <- paste("label for", names(iris))
+#' col_labels(x)
+#'
+#' if (interactive()) {
+#'   View(x) # in RStudio data viewer labels are displayed
+#' }
+`col_labels<-` <- function(x, value) {
+  stopifnot(
+    is.data.frame(x),
+    is.character(value),
+    ncol(x) == length(value)
+  )
+
+  theseq <- if (!is.null(names(value))) names(value) else seq_along(x)
+  # across columns of x
+  for (j in theseq) {
+    attr(x[[j]], "label") <- if (!is.na(value[j])) {
+      value[j]
+    } else {
+      NULL
+    }
+  }
+
+  x
+}
+
+#' Copy and Change Variable Labels of a \code{data.frame}
+#'
+#' Relabel a subset of the variables
+#'
+#' @inheritParams col_labels<-
+#' @param ... name-value pairs, where name corresponds to a variable name in
+#'   \code{x} and the value to the new variable label
+#'
+#' @return a copy of \code{x} with changed labels according to \code{...}
+#'
+#' @source This function was taken 1-1 from
+#' \href{https://cran.r-project.org/web/packages/formatters/index.html}{formatters} package, to reduce the complexity of
+#' the dependency tree.
+#'
+#' @seealso [col_labels()] [`col_labels<-`]
+#'
+#' @export
+#'
+#' @examples
+#' x <- col_relabel(iris, Sepal.Length = "Sepal Length of iris flower")
+#' col_labels(x)
+#'
+col_relabel <- function(x, ...) {
+  stopifnot(is.data.frame(x))
+  if (missing(...)) {
+    return(x)
+  }
+  dots <- list(...)
+  varnames <- names(dots)
+  stopifnot(!is.null(varnames))
+
+  map_varnames <- match(varnames, colnames(x))
+
+  if (any(is.na(map_varnames))) {
+    stop("variables: ", paste(varnames[is.na(map_varnames)], collapse = ", "), " not found")
+  }
+
+  if (any(vapply(dots, Negate(is.character), logical(1)))) {
+    stop("all variable labels must be of type character")
+  }
+
+  for (i in seq_along(map_varnames)) {
+    attr(x[[map_varnames[[i]]]], "label") <- dots[[i]]
+  }
+
+  x
+}

R/teal.data.R

@@ -15,5 +15,4 @@
 #' @importFrom stats setNames
 #' @importFrom shinyjs show
 #' @importFrom logger log_trace
-#' @importFrom formatters var_labels
 NULL

_pkgdown.yml

@@ -100,6 +100,9 @@ reference:
   - title: Helpers
     desc: Other useful functions for users and developers.
     contents:
+      - col_labels
+      - col_labels<-
+      - col_relabel
       - data_label
       - data_label<-
       - example_cdisc_data

inst/WORDLIST

@@ -11,3 +11,4 @@ iteratively
 pre
 repo
 reproducibility
+formatters

staged_dependencies.yaml

@@ -6,9 +6,6 @@ upstream_repos:
   insightsengineering/teal.logger:
     repo: insightsengineering/teal.logger
     host: https://github.com
-  insightsengineering/formatters:
-    repo: insightsengineering/formatters
-    host: https://github.com
 downstream_repos:
   insightsengineering/teal.slice:
     repo: insightsengineering/teal.slice

tests/testthat/test-CDISCTealDataset.R

@@ -1,7 +1,7 @@
 ## CDISCTealDataset ====
 testthat::test_that("CDISCTealDataset basics", {
   x <- data.frame(x = c(1, 2), y = c("a", "b"), stringsAsFactors = TRUE)
-  formatters::var_labels(x) <- c("X", "Y")
+  col_labels(x) <- c("X", "Y")
 
   testthat::expect_error(
     teal.data:::CDISCTealDataset$new(dataname = "abc", x = x)