replace .labels2() by tanularise:::.labels2()

SciViews · Jun 5, 2024 · 2bb567d · 2bb567d
1 parent c6a2489
commit 2bb567d
Show file tree

Hide file tree

Showing 4 changed files with 58 additions and 58 deletions.
diff --git a/R/tabularise.anova.R b/R/tabularise.anova.R
@@ -48,9 +48,9 @@ env = parent.frame()) {
 
   # Extract labels of data or origdata
   if (isTRUE(auto.labs)) {
-    labs <- .labels2(data, origdata = origdata, labs = labs)
+    labs <- tabularise:::.labels2(data, origdata = origdata, labs = labs)
   } else {
-    labs <- .labels2(x = NULL, labs = labs)
+    labs <- tabularise:::.labels2(x = NULL, labs = labs)
   }
 
   # Turn an object into a tidy tibble
@@ -198,9 +198,9 @@ kind = "ft", env = parent.frame()) {
 
   # Extract labels
   if (isTRUE(auto.labs)) {
-    labs <- .labels2(data, origdata = origdata, labs = labs)
+    labs <- tabularise:::.labels2(data, origdata = origdata, labs = labs)
   } else {
-    labs <- .labels2(NULL, labs = labs)
+    labs <- tabularise:::.labels2(NULL, labs = labs)
   }
 
   # Turn an object into a tidy tibble

diff --git a/R/tabularise.glm.R b/R/tabularise.glm.R
@@ -60,9 +60,9 @@ lang = getOption("data.io_lang", "en"), ..., kind = "ft", env = parent.frame())
   # co <- as.data.frame(rbind(coef(data)))
 
   if (isTRUE(auto.labs)) {
-    labs <- .labels2(x = data, origdata = origdata, labs = labs)
+    labs <- tabularise:::.labels2(x = data, origdata = origdata, labs = labs)
   } else {
-    labs <- .labels2(x = NULL, labs = labs)
+    labs <- tabularise:::.labels2(x = NULL, labs = labs)
   }
 
   # Create the flextable object
@@ -216,9 +216,9 @@ env = parent.frame()) {
 
   # Extract labels of data or origdata
   if (isTRUE(auto.labs)) {
-    labs <- .labels2(x = data, origdata = origdata, labs = labs)
+    labs <- tabularise:::.labels2(x = data, origdata = origdata, labs = labs)
   } else {
-    labs <- .labels2(x = NULL, labs = labs)
+    labs <- tabularise:::.labels2(x = NULL, labs = labs)
   }
 
   # Turn an object into a tidy tibble
@@ -348,9 +348,9 @@ tabularise_glance.glm <- function(data, header = TRUE, title = NULL,
 
   # Extract labels off data or origdata
   if (isTRUE(auto.labs)) {
-    labs <- .labels2(x = data, origdata = origdata, labs = labs)
+    labs <- tabularise:::.labels2(x = data, origdata = origdata, labs = labs)
   } else {
-    labs <- .labels2(x = NULL, labs = labs)
+    labs <- tabularise:::.labels2(x = NULL, labs = labs)
   }
 
   # Turn an object into a tidy tibble

diff --git a/R/tabularise.lm.R b/R/tabularise.lm.R
@@ -58,9 +58,9 @@ tabularise_coef.lm <- function(data, header = TRUE, title = NULL,
   # co <- as.data.frame(rbind(coef(data)))
 
   if (isTRUE(auto.labs)) {
-    labs <- .labels2(x = data, origdata = origdata, labs = labs)
+    labs <- tabularise:::.labels2(x = data, origdata = origdata, labs = labs)
   } else {
-    labs <- .labels2(x = NULL, labs = labs)
+    labs <- tabularise:::.labels2(x = NULL, labs = labs)
   }
 
   # Create the flextable object
@@ -192,9 +192,9 @@ tabularise_tidy.lm <- function(data, header = TRUE, title = NULL,
 
   # Extract labels off data or origdata
   if (isTRUE(auto.labs)) {
-    labs <- .labels2(x = data, origdata = origdata, labs = labs)
+    labs <- tabularise:::.labels2(x = data, origdata = origdata, labs = labs)
   } else {
-    labs <- .labels2(x = NULL, labs = labs)
+    labs <- tabularise:::.labels2(x = NULL, labs = labs)
   }
 
   # Turn an object into a tidy tibble
@@ -317,9 +317,9 @@ tabularise_glance.lm <- function(data, header = TRUE, title = NULL,
 
   # Extract labels of data or origdata
   if (isTRUE(auto.labs)) {
-    labs <- .labels2(x = data, origdata = origdata, labs = labs)
+    labs <- tabularise:::.labels2(x = data, origdata = origdata, labs = labs)
   } else {
-    labs <- .labels2(x = NULL, labs = labs)
+    labs <- tabularise:::.labels2(x = NULL, labs = labs)
   }
 
   # Turn an object into a tidy tibble

diff --git a/R/utils.R b/R/utils.R
@@ -25,48 +25,48 @@ align = "right", ...) {
 
 # TODO: this is duplicated in tabularise -> export from there and reuse here!
 # Extract labels and units
-.labels <- function(x, units = TRUE, ...) {
-  labels <- sapply(x, data.io::label, units = units)
-
-  if (any(labels != "")) {
-    # Use a \n before labels and the units
-    if (isTRUE(units))
-      labels <- sub(" +\\[([^]]+)\\]$", "\n [\\1]", labels)
-    # set names if empty
-    labels[labels == ""] <- names(x)[labels == ""]
-    # Specific case for I() using in a formula
-    labels[grepl("^I\\(.*\\)$", names(labels))] <- names(labels)[grepl("^I\\(.*\\)$", names(labels))]
-  }
-
-  if (all(labels == ""))
-    labels <- NULL
-
-  labels
-}
-
-.labels2 <- function(x, origdata = NULL, labs = NULL) {
-
-  #labs_auto <- NULL
-  if (is.null(origdata)) {
-    labs_auto <- .labels(x$model)
-  } else {
-    labs_auto <- .labels(origdata)
-  }
-
-  if (!is.null(labs)) {
-    if (!is.character(labs))
-      stop("labs is not character vector")
-    if (is.null(names(labs)))
-      stop("labs must be named character vector")
-    if (any(names(labs) %in% ""))
-      stop("all element must be named")
-    labs_res <- c(labs, labs_auto[!names(labs_auto) %in% names(labs)])
-  } else {
-    labs_res <- labs_auto
-  }
-
-  labs_res
-}
+# .labels <- function(x, units = TRUE, ...) {
+#   labels <- sapply(x, data.io::label, units = units)
+#
+#   if (any(labels != "")) {
+#     # Use a \n before labels and the units
+#     if (isTRUE(units))
+#       labels <- sub(" +\\[([^]]+)\\]$", "\n [\\1]", labels)
+#     # set names if empty
+#     labels[labels == ""] <- names(x)[labels == ""]
+#     # Specific case for I() using in a formula
+#     labels[grepl("^I\\(.*\\)$", names(labels))] <- names(labels)[grepl("^I\\(.*\\)$", names(labels))]
+#   }
+#
+#   if (all(labels == ""))
+#     labels <- NULL
+#
+#   labels
+# }
+
+# .labels2 <- function(x, origdata = NULL, labs = NULL) {
+#
+#   #labs_auto <- NULL
+#   if (is.null(origdata)) {
+#     labs_auto <- .labels(x$model)
+#   } else {
+#     labs_auto <- .labels(origdata)
+#   }
+#
+#   if (!is.null(labs)) {
+#     if (!is.character(labs))
+#       stop("labs is not character vector")
+#     if (is.null(names(labs)))
+#       stop("labs must be named character vector")
+#     if (any(names(labs) %in% ""))
+#       stop("all element must be named")
+#     labs_res <- c(labs, labs_auto[!names(labs_auto) %in% names(labs)])
+#   } else {
+#     labs_res <- labs_auto
+#   }
+#
+#   labs_res
+# }
 
 # Retrieve model parameters
 .params_equa <- function(x, intercept = "alpha", greek = "beta") {