From 2bb567d9f1029933bc959044df6a169e048d0b4b Mon Sep 17 00:00:00 2001 From: GuyliannEngels Date: Wed, 5 Jun 2024 22:28:31 +0200 Subject: [PATCH] replace .labels2() by tanularise:::.labels2() --- R/tabularise.anova.R | 8 ++--- R/tabularise.glm.R | 12 +++---- R/tabularise.lm.R | 12 +++---- R/utils.R | 84 ++++++++++++++++++++++---------------------- 4 files changed, 58 insertions(+), 58 deletions(-) diff --git a/R/tabularise.anova.R b/R/tabularise.anova.R index 6e80937..82fe058 100644 --- 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 index db7caff..6f8442c 100644 --- 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 index 17f52d4..35dd336 100644 --- 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 index 3100c8e..019f250 100644 --- 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") {