diff --git a/DESCRIPTION b/DESCRIPTION
index caacfd2..0feb734 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,7 +1,7 @@
Package: modelit
Type: Package
-Version: 1.4.6
-Title: Statistical Models for 'SciViews::R'
+Version: 1.4.8
+Title: 'SciViews::R' - Statistical Models
Description: Create and use statistical models (linear, general, nonlinear...)
with extensions to support rich-formatted tables, equations and plots for the
'SciViews::R' dialect.
@@ -17,38 +17,40 @@ Depends:
R (>= 4.2.0),
broom (>= 1.0.4)
Imports:
- chart (>= 1.5.0),
- data.io (>= 1.5.0),
- flextable (>= 0.9.1),
- generics (>= 0.1.3),
- ggplot2 (>= 3.4.2),
- knitr (>= 1.42),
- modelr (>= 0.1.11),
- officer (>= 0.6.2),
- rlang (>= 1.1.1),
- stats (>= 4.2.0),
- svFlow (>= 1.2.0),
- tabularise (>= 0.6.0)
+ chart (>= 1.5.0),
+ equatiomatic (>= 0.4.4),
+ flextable (>= 0.9.1),
+ generics (>= 0.1.3),
+ ggplot2 (>= 3.4.2),
+ knitr (>= 1.42),
+ modelr (>= 0.1.11),
+ officer (>= 0.6.2),
+ rlang (>= 1.1.1),
+ stats (>= 4.2.0),
+ svBase (>= 1.7.0),
+ svFlow (>= 1.2.0),
+ tabularise (>= 0.6.0)
Suggests:
+ data.io (>= 1.7.0),
broom.mixed (>= 0.2.9.4),
datasets (>= 4.2.0),
dplyr (>= 1.1.4),
equatags (>= 0.2.0),
- equatiomatic (>= 0.3.0),
parsnip (>= 1.1.0),
rmarkdown (>= 2.21),
spelling (>= 2.2.1),
testthat (>= 3.0.0)
Remotes:
- SciViews/data.io,
SciViews/chart,
+ SciViews/data.io,
+ SciViews/svBase,
SciViews/svFlow,
SciViews/tabularise
License: MIT + file LICENSE
URL: https://github.com/SciViews/modelit, https://www.sciviews.org/modelit/
BugReports: https://github.com/SciViews/modelit/issues
Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
VignetteBuilder: knitr
Encoding: UTF-8
Language: en-US
diff --git a/NAMESPACE b/NAMESPACE
index eb80960..ffe6758 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -2,6 +2,7 @@
S3method(AIC,model_fit)
S3method(BIC,model_fit)
+S3method(anova,lm_)
S3method(anova,model_fit)
S3method(as.function,lm)
S3method(as.function,model_fit)
@@ -24,6 +25,7 @@ S3method(nobs,model_fit)
S3method(plot,model_fit)
S3method(residuals,model_fit)
S3method(rstandard,model_fit)
+S3method(summary,lm_)
S3method(summary,model_fit)
S3method(tabularise_coef,glm)
S3method(tabularise_coef,lm)
@@ -32,6 +34,7 @@ S3method(tabularise_coef,summary.glm)
S3method(tabularise_coef,summary.lm)
S3method(tabularise_coef,summary.nls)
S3method(tabularise_default,anova)
+S3method(tabularise_default,aov)
S3method(tabularise_default,glm)
S3method(tabularise_default,lm)
S3method(tabularise_default,nls)
@@ -50,20 +53,25 @@ S3method(variable.names,model_fit)
S3method(vcov,model_fit)
export(add_predictions)
export(add_residuals)
+export(anova_)
export(autoplot.lm)
export(autoplot.nls)
export(fit_model)
export(geom_ref_line)
+export(glm_)
+export(lm_)
export(mae)
+export(nls_)
export(qae)
export(rmse)
export(rsquare)
+export(summary_)
importFrom(broom,augment)
importFrom(broom,glance)
importFrom(broom,tidy)
importFrom(chart,chart)
importFrom(chart,combine_charts)
-importFrom(data.io,label)
+importFrom(equatiomatic,equation)
importFrom(flextable,add_footer_lines)
importFrom(flextable,add_header_lines)
importFrom(flextable,align)
@@ -123,10 +131,18 @@ importFrom(stats,residuals)
importFrom(stats,rstandard)
importFrom(stats,variable.names)
importFrom(stats,vcov)
+importFrom(svBase,gettext_)
+importFrom(svBase,gettextf_)
+importFrom(svBase,label)
+importFrom(svBase,ngettext_)
+importFrom(svBase,prepare_data_dot)
+importFrom(svBase,recall_with_data_dot)
+importFrom(svBase,stop_)
+importFrom(svBase,warning_)
importFrom(svFlow,"%>.%")
importFrom(tabularise,colformat_sci)
-importFrom(tabularise,equation)
importFrom(tabularise,para_md)
+importFrom(tabularise,tabularise)
importFrom(tabularise,tabularise_coef)
importFrom(tabularise,tabularise_default)
importFrom(tabularise,tabularise_glance)
diff --git a/NEWS.md b/NEWS.md
index 5e978b9..c96cff7 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,3 +1,33 @@
+# modelit 1.4.8
+
+- Dependency to svBase and equatiomatic updated, and dependencies to data.io and svMisc eliminated.
+
+- Refactored all tabularise\_\*\*\*() methods for glm, summary.glm, anova, aov objects (e.g., tabularise_glance.glm(), tabularise_default.glm(), tabularise_tidy.glm(), etc.) to improve internal consistency and prepare for multi-format table rendering using {flextable}, {tinytable}, and {gt}.
+
+- added summary\_() and anova\_() functions. These two functions provide the same information as the summary() and anova() functions. They add an attribute that preserves a link to the object used in these two functions. Adding this argument makes it possible to retrieve information from the original object that would otherwise be lost when using summary() or anova().
+
+- Added the experimental glm\_() and nls\_() functions, which extend [stats::glm()] and [stats::nls()] by attaching additional metadata such as variable labels and units. The order of arguments has been modified to start with data =. All three functions — lm\_(), glm\_(), and nls\_() — use a data-dot mechanism inspired by svMisc::eval_data_dot(). Note: nls\_() uses model = TRUE by default, whereas the base nls() function uses model = FALSE.
+
+- The `equation=` argument now accepts `NA` in addition to `TRUE`, `FALSE`, and character strings, offering more flexibility in how model equations are displayed and used:
+
+ - `TRUE` *(default)*: The equation is automatically generated and added to the table header. Its parameters are also used in the "Term" column.
+
+ - `FALSE`: No equation is generated or displayed, and its parameters are not used in the "Term" column.
+
+ - `NA`: The equation is generated but not displayed in the table header. Its parameters are still used in the "Term" column.
+
+ - *Character string*: A custom equation is provided directly and added to the table header.
+
+ This enhancement allows for finer control over equation display and ensures that model parameters remain accessible even when the equation is hidden.
+
+# modelit 1.4.7
+
+- Refactored all tabularise\_\*\*\*() methods for lm, summary.lm, nls, summary.nls objects (e.g., tabularise_glance.lm(), tabularise_default.lm(), tabularise_tidy.lm(), etc.) to improve internal consistency and prepare for multi-format table rendering using {flextable}, {tinytable}, and {gt}.
+
+- Labels are now fully integrated into tabularise\_\*\*\*.nls and tabularise\_\*\*\*.summary.nls, allowing consistent and readable output for nonlinear model summaries.
+
+- Added the experimental lm\_() function, which extends [stats::lm()] by attaching additional metadata such as variable labels and units. Also introduced summary.lm\_() and anova.lm\_() methods to preserve the additional metadata.
+
# modelit 1.4.6
- Better selection of X and Y variables in `chart.nls()` and `autoplot.nls()`.
diff --git a/R/chart.lm.R b/R/chart.lm.R
index 49a1f59..18ff023 100644
--- a/R/chart.lm.R
+++ b/R/chart.lm.R
@@ -65,7 +65,7 @@
#' chart(trees_lm5, origdata = trees) # origdata required here!
chart.lm <- function(data, type = "model", ..., origdata = NULL, title,
labels = "AUTO", name = deparse(substitute(data)),
-lang = getOption("data.io_lang", "en"), env = parent.frame()) {
+lang = getOption("SciViews_lang", "en"), env = parent.frame()) {
if (type == "residuals") {
a <- autoplot.lm(data, ..., name = name, type = "resfitted",
title = "", lang = lang, env = env)
@@ -95,7 +95,7 @@ autoplot.lm <- function(object, origdata = NULL,
type = c("model", "resfitted", "qqplot", "scalelocation", "cooksd",
"resleverage", "cookleverage", "reshist", "resautocor"), title, xlab, ylab,
..., name = deparse(substitute(object)),
-lang = getOption("data.io_lang", "en"), env = parent.frame()) {
+lang = getOption("SciViews_lang", "en"), env = parent.frame()) {
# TODO: chart style if invoked via chart(), otherwise default ggplot theme
# TODO: lindia::resx() but several plots for more complex formulas and one
# could question the validity of this plot as the distrubition of residuals
diff --git a/R/chart.nls.R b/R/chart.nls.R
index 1336ec3..6c62101 100644
--- a/R/chart.nls.R
+++ b/R/chart.nls.R
@@ -50,7 +50,7 @@
#' # The four most important residual analysis plots in one figure
#' chart$residuals(chick1_logis)
chart.nls <- function(data, type = "model", ..., title, labels = "AUTO",
-name = deparse(substitute(data)), lang = getOption("data.io_lang", "en"),
+name = deparse(substitute(data)), lang = getOption("SciViews_lang", "en"),
env = parent.frame()) {
if (type == "residuals") {
a <- autoplot.nls(data, ..., name = name, type = "resfitted",
@@ -79,7 +79,7 @@ class(chart.nls) <- c("function", "subsettable_type")
autoplot.nls <- function(object,
type = c("model", "resfitted", "qqplot", "scalelocation", "reshist",
"resautocor"), title, xlab, ylab, ..., name = deparse(substitute(object)),
- lang = getOption("data.io_lang", "en"), env = parent.frame()) {
+ lang = getOption("SciViews_lang", "en"), env = parent.frame()) {
# TODO: chart style if invoked via chart(), otherwise default ggplot theme
# Needed to avoid spurious R CMD check errors
diff --git a/R/lm_.R b/R/lm_.R
new file mode 100644
index 0000000..2d41236
--- /dev/null
+++ b/R/lm_.R
@@ -0,0 +1,361 @@
+#' Fitting Linear Models with Enhanced Output (Experimental)
+#'
+#' @description
+#' `lm_()` is an **experimental** wrapper around the base [stats::lm()] function.
+#' It behaves similarly to `lm()`, but enriches the returned object with additional metadata.
+#' The order of the arguments differs from `lm()`, and the function uses evaluation
+#' through [svBase::prepare_data_dot] and [svBase::recall_with_data_dot] to support the data-dot mechanism.
+#'
+#' @param data A `data.frame` containing the variables in the model.
+#' @param formula An object of class `formula`: a symbolic description of the model to be fitted.
+#' @param ... Additional arguments passed to [stats::lm()].
+#' @param .data an alias for the `data` argument
+#'
+#' @return An object of class `lm_`, which inherits from `lm`, and includes additional
+#' components such as `labels`. If no additional attributes are added, a standard `lm` object is returned.
+#'
+#' @export
+#'
+#' @examples
+#' data(iris)
+#'
+#' # Add labels to variables
+#' attr(iris$Sepal.Length, "label") <- "Sepal Length (cm)"
+#' attr(iris$Petal.Length, "label") <- "Petal Length (cm)"
+#'
+#' # Fit the model using lm_()
+#' res <- lm_(iris, formula = Petal.Length ~ Sepal.Length + Species)
+#'
+#' . <- iris
+#' res1 <- lm_(Petal.Length ~ Sepal.Length + Species)
+#'
+#'
+#' res
+#' class(res)
+#' summary(res)
+#'
+#' # Access labels
+#' res$labels
+#'
+lm_ <- function(data = (.), formula, ..., .data = data) {
+
+ if (!prepare_data_dot(data))
+ return(recall_with_data_dot(arg = "data"))
+
+ res <- stats::lm(data = data, formula = formula, ...)
+
+ # Extract labels
+ if (!is.null(res$model)) {
+ labs <- .labels3(res)
+ } else {
+ labs <- .labels3(res, origdata = data)
+ }
+
+ res$labels <- labs
+
+ # Add custom class if labels were successfully added
+ if (!is.null(res$labels)) {
+ class(res) <- c("lm_", class(res))
+ }
+
+ res
+}
+
+#' Summarizing Linear Model Fits with Enhanced Output
+#'
+#' @description
+#' `summary.lm_()` is a method for objects of class `lm_`, extending the standard
+#' [summary.lm()] functionality.
+#' It returns a summary object similar to `summary.lm`, but includes additional
+#' metadata such as variable labels (if available), making the output more
+#' informative for reporting and interpretation.
+#'
+#' This method is part of the experimental `lm_()` modeling framework.
+#'
+#' @param object An object of class `lm_`, typically returned by [lm_()].
+#' @param ... Additional arguments passed to [stats::summary.lm()].
+#'
+#' @return An object of class `summary.lm_`, which inherits from `summary.lm` and
+#' includes an optional `labels` component if available in the original model.
+#'
+#' @export
+#'
+#' @examples
+#' data(iris)
+#'
+#' # Add labels to variables
+#' attr(iris$Sepal.Length, "label") <- "Sepal Length (cm)"
+#' attr(iris$Petal.Length, "label") <- "Petal Length (cm)"
+#' attr(iris$Species, "label") <- "Iris Species"
+#'
+#' # Fit model using lm_()
+#' model <- lm_(iris, formula = Petal.Length ~ Sepal.Length + Species)
+#'
+#' # Get summary with labels
+#' summary_model <- summary(model)
+#' summary_model
+#'
+#' # Access labels
+#' summary_model$labels
+#'
+summary.lm_ <- function(object, ...) {
+ res <- stats::summary.lm(object = object, ...)
+
+ # Add labels if available
+ if (!is.null(object$labels)) {
+ res$labels <- object$labels
+ }
+
+ # Add custom class if labels were added
+ if (!is.null(res$labels)) {
+ class(res) <- c("summary.lm_", class(res))
+ }
+
+ res
+}
+
+#' ANOVA Tables for Enhanced Linear Models (`lm_`)
+#'
+#' @description
+#' `anova.lm_()` is a method for objects of class `lm_`, extending the standard
+#' [stats::anova()] functionality.
+#' It returns an ANOVA table similar to the base version but includes additional
+#' metadata such as variable labels (if available), making the output more
+#' informative for interpretation and reporting.
+#'
+#' This method is part of the experimental `lm_()` modeling framework.
+#'
+#' @param object An object of class `lm_`, typically returned by [lm_()].
+#' @param ... Additional arguments passed to [stats::anova()].
+#'
+#' @return An object of class `anova_`, which inherits from `anova` and may include
+#' a `labels` component if available in the original model.
+#'
+#' @export
+#'
+#' @examples
+#' data(iris)
+#'
+#' # Add labels to variables
+#' attr(iris$Sepal.Length, "label") <- "Sepal Length (cm)"
+#' attr(iris$Petal.Length, "label") <- "Petal Length (cm)"
+#'
+#' # Fit model using lm_()
+#' model <- lm_(iris, Petal.Length ~ Sepal.Length + Species)
+#'
+#' # Get ANOVA table with labels
+#' anova_model <- anova(model)
+#' anova_model
+#'
+#' # Access labels
+#' anova_model$labels
+#'
+anova.lm_ <- function(object, ...) {
+ res <- .anova.lm(object = object, ...)
+
+ # Add labels if available
+ if (!is.null(object$labels)) {
+ attr(res, "labels") <- object$labels
+ }
+
+ # Add custom class if labels were added
+ if (!is.null(res$labels)) {
+ class(res) <- c("anova_", class(res))
+ }
+ res
+}
+
+.anova.lm <- getS3method("anova", "lm")
+
+#' Fitting Generalized Linear Models with Enhanced Output (Experimental)
+#'
+#' @description
+#' `glm_()` is an **experimental** wrapper around the base [stats::glm()]
+#' function. It behaves similarly to `glm()`, but enriches the returned object
+#' with additional metadata. The order of the arguments differs from `glm()`,
+#' and the function uses evaluation through [svBase::prepare_data_dot] and
+#' [svBase::recall_with_data_dot] to support the data-dot mechanism.
+#'
+#' @param data A `data.frame` containing the variables in the model.
+#' @param formula An object of class `formula`: a symbolic description of the
+#' model to be fitted.
+#' @param ... Additional arguments passed to [stats::glm()].
+#' @param .data an alias for the `data` argument
+#'
+#' @return An object of class `glm_`, which inherits from `glm`, and includes
+#' additional components such as `labels`. If no additional attributes are
+#' added, a standard `glm` object is returned.
+#'
+#' @export
+#'
+#' @examples
+#' data(iris)
+#'
+#' # Add labels to variables
+#' attr(iris$Sepal.Length, "label") <- "Sepal Length (cm)"
+#' attr(iris$Petal.Length, "label") <- "Petal Length (cm)"
+#'
+#' # Fit the model using lm_()
+#' res <- glm_(iris, formula = Petal.Length ~ Sepal.Length + Species)
+#'
+#' res
+#' class(res)
+#' summary(res)
+#'
+#' # Access labels
+#' res$labels
+#'
+glm_ <- function(data = (.), formula, ..., .data = data) {
+
+
+ if (!prepare_data_dot(data))
+ return(recall_with_data_dot(arg = "data"))
+
+ res <- stats::glm(data = data, formula = formula, ...)
+
+ # Extract labels
+ if (!is.null(res$model)) {
+ labs <- .labels3(res)
+ } else {
+ labs <- .labels3(res, origdata = data)
+ }
+
+ res$labels <- labs
+
+ # Add custom class if labels were successfully added
+ if (!is.null(res$labels)) {
+ class(res) <- c("glm_", class(res))
+ }
+
+ res
+}
+
+
+#' Fitting Non Linear Models with Enhanced Output (Experimental)
+#'
+#' @description
+#' `nls_()` is an **experimental** wrapper around the base [stats::nls()]
+#' function. It behaves similarly to `glm()`, but enriches the returned object
+#' with additional metadata. The order of the arguments differs from `glm()`,
+#' and the function uses evaluation through [svBase::recall_with_data_dot()] to support
+#' the data-dot mechanism.
+#'
+#' @param data A `data.frame` containing the variables in the model.
+#' @param formula An object of class `formula`: a symbolic description of the
+#' model to be fitted.
+#' @param model logical. If true, the model frame is returned as part of the
+#' object. Default is FALSE.
+#' @param ... Additional arguments passed to [stats::nls()].
+#' @param .data an alias for the `data` argument
+#'
+#' @return An object of class `nls_`, which inherits from `nls`, and includes
+#' additional components such as `labels`. If no additional attributes are
+#' added, a standard `nls` object is returned.
+#'
+#' @export
+#'
+#' @examples
+#' chick1 <- ChickWeight[ChickWeight$Chick == 1, ]
+#' # Add labels to variables
+#' attr(chick1$weight, "label") <- "Body weight [gm]"
+#' attr(chick1$Time, "label") <- "Number of days"
+#'
+#' chick1_nls <- nls_(data = chick1, weight ~ SSlogis(Time, Asym, xmid, scal))
+#'
+#'
+#' chick1_nls
+#' class(chick1_nls)
+#' summary(chick1_nls)
+#'
+#' # Access labels
+#' chick1_nls
+#'
+nls_ <- function(data = (.), formula, model = TRUE, ..., .data = data) {
+
+ if (!prepare_data_dot(data))
+ return(recall_with_data_dot(arg = "data"))
+
+ res <- stats::nls(data = data, formula = formula, model = model, ...)
+
+ # Extract labels
+ if (!is.null(res$model)) {
+ labs <- .labels3(res)
+ } else {
+ labs <- .labels3(res, origdata = data)
+ }
+
+ res$labels <- labs
+
+ # Add custom class if labels were successfully added
+ if (!is.null(res$labels)) {
+ class(res) <- c("nls_", class(res))
+ }
+
+ res
+}
+
+#' Object summaries with the original object as an attribute
+#'
+#' @description
+#' This function attempts to summarize an object using the standard [base::summary()]
+#' function. The original object is attached as an attribute to the result for
+#' reference.
+#'
+#' @param object An object to be summarized.
+#' @param ... Additional arguments passed to the `summary()` function.
+#'
+#' @return A summary object with an additional `"object"` attribute containing
+#' the original input.
+#' @export
+#'
+#' @examples
+#'
+#' is_lm <- lm(data = iris, Petal.Length ~ Sepal.Length)
+#' summary(is_lm)
+#'
+#' summary_(is_lm)
+#' attr(summary_(is_lm), "object")
+#'
+summary_ <- function(object, ...) {
+ res <- try(summary(object, ...), silent = TRUE)
+ if (inherits(res, "try-error")) {
+ warning("Unable to summarize the object.")
+ return(NULL)
+ }
+ attr(res, "object") <- object
+ res
+}
+
+#' ANOVA tables with the original object as an attribute
+#'
+#' @description
+#' This function attempts to compute anova or deviance tables using the
+#' standard [stats::anova()] function. The original object is attached as an
+#' attribute to the result for reference.
+#'
+#' @param object An object for which anova or deviance tables should be computed.
+#' @param ... Additional arguments passed to the `anova()` function.
+#'
+#' @return An anova object with an additional `"object"` attribute containing
+#' the original input.
+#' @export
+#'
+#' @examples
+#' is_lm <- lm(data = iris, Petal.Length ~ Sepal.Length)
+#' anova(is_lm)
+#'
+#' anova_(is_lm)
+#' attr(anova_(is_lm), "object")
+
+anova_ <- function(object, ...) {
+ res <- try(anova(object, ...), silent = TRUE)
+ if (inherits(res, "try-error")) {
+ warning("Unable to compute ANOVA for the object.")
+ return(NULL)
+ }
+ attr(res, "object") <- object
+ res
+}
+
+
+
diff --git a/R/modelit-internal.R b/R/modelit-internal.R
new file mode 100644
index 0000000..71df990
--- /dev/null
+++ b/R/modelit-internal.R
@@ -0,0 +1,522 @@
+# gettext(), stop(), warning()
+gettext <- svBase::gettext_
+gettextf <- svBase::gettextf_
+ngettext <- svBase::ngettext_
+# stop <- svBase::stop_ #
+# warning <- svBase::warning_
+
+# Need this for R CMD check to pass
+. <- NULL
+
+# Internal functions for .extract_infos_***()
+.pvalue_format <- function(x, breaks = c(-Inf, 0.001, 0.01, 0.05, 0.1, Inf),
+ labels = c("***", " **", " *", " .", " ")) {
+ #x <- get(as.character(substitute(x)), inherits = TRUE)
+ z <- cut(x, breaks = breaks, labels = labels)
+ z <- as.character(z)
+ z[is.na(x)] <- ""
+ z
+}
+
+.extract_colnames <- function(df, labs, lang) {
+ vec <- labs[names(labs) %in% names(df)]
+ vec1 <- gettext(vec, lang = lang)
+ names(vec1) <- names(vec)
+
+ #Remove elements with missing or empty names
+ vec1 <- vec1[!is.na(names(vec1)) & names(vec1) != ""]
+
+ vec1
+}
+
+.labels_factor <- function(df) {
+ if (!is.data.frame(df)) {
+ # warning("No dataframe found.")
+ return(NULL)
+ # stop("Input must be a data frame.")
+ }
+
+ factor_cols <- which(sapply(df, is.factor))
+ if (length(factor_cols) == 0) {
+ # warning("No factor columns found in the data frame.")
+ return(NULL)
+ }
+
+ # Not needed anymore
+ #if (!requireNamespace("data.io", quietly = TRUE))
+ # stop("Package 'data.io' is required but not installed.")
+
+ #class(df)
+ df <- as.data.frame(df)
+ #class(df)
+ labels <- vapply(df[,factor_cols, drop = FALSE], svBase::label, character(1),
+ units = FALSE)
+ valid_vars <- names(labels)[labels != ""]
+ if (length(valid_vars) == 0) {
+ #warning("No labeled factor variables found.")
+ return(NULL)
+ }
+
+ # Fusion of result and names generation
+ result <- vector("character")
+ result_names <- vector("character")
+
+ for (var in valid_vars) {
+ levs <- levels(df[[var]])
+ result <- c(result, paste0(labels[[var]], " [", levs, "]"))
+ result_names <- c(result_names, paste0(var, levs))
+ }
+
+ names(result) <- result_names
+ return(result)
+}
+
+.labels3 <- function(x, origdata = NULL, labs = NULL) {
+ if (is.null(origdata)) {
+ labs_auto <- c(.labels(x$model), .labels_factor(x$model))
+ }
+ else {
+ labs_auto <- c(.labels(origdata), .labels_factor(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
+}
+
+# Extract labels and units
+.labels <- function(x, units = TRUE, ...) {
+ labels <- sapply(x, svBase::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
+}
+
+.extend_labs_with_interactions <- function(labs, terms) {
+ if (!is.character(labs) || is.null(names(labs))) {
+ return(NULL)
+ }
+ if (!is.character(terms)) {
+ return(labs)
+ }
+
+ for (term in terms) {
+ if (grepl(":", term)) {
+ parts <- unlist(strsplit(term, ":"))
+ missing_parts <- parts[!parts %in% names(labs)]
+
+ if (length(missing_parts) > 0) {
+ warning(sprintf(
+ "The following terms are missing in 'labs' for the interaction '%s': %s",
+ term, paste(missing_parts, collapse = ", ")
+ ))
+ next
+ }
+
+ interaction_label <- paste(labs[parts], collapse = " x ")
+ labs[term] <- interaction_label
+ }
+ }
+ labs <- gsub("\n", " ", labs)
+ return(labs)
+}
+
+.extract_labels <- function(df, data, auto.labs, origdata, labs) {
+ if (isTRUE(auto.labs)) {
+ labs <- .labels3(x = data, origdata = origdata, labs = labs)
+ # Compare the names of labs with the rownames
+ labs <- .extend_labs_with_interactions(labs = labs, terms = df[["term"]])
+ } else {
+ labs <- .labels3(x = NULL, labs = labs)
+ }
+
+ labs
+}
+
+.extract_terms <- function(df, labs, lang) {
+ vals <- df[["term"]]
+ terms <- labs[names(labs) %in% vals]
+
+ if (any(vals == "(Intercept)"))
+ terms <- c("(Intercept)" = gettext("Intercept", lang = lang)[[1]], terms)
+
+ if (any(vals == "Residuals"))
+ terms <- c(terms, "Residuals" = gettext("Residuals", lang = lang)[[1]])
+
+ terms
+}
+
+.extract_equation <- function(data, equation, labs, ...) {
+
+ if (!(is.logical(equation) || is.character(equation))) {
+ stop("The 'equation' argument must be TRUE, FALSE, NA, or a character string.")
+ }
+
+ equa <- NULL
+
+ if (isTRUE(equation) || is.na(equation)) {
+ equa <- try({
+ if (!is.null(labs)) {
+ equation(data, swap_var_names = labs, ...)
+ } else {
+ equation(data, auto.labs = FALSE, ...)
+ }
+ }, silent = TRUE)
+ if (inherits(equa, "try-error"))
+ equa <- NULL
+ }
+
+ if (is.character(equation)) {
+ equa <- equation
+ }
+
+ equa
+}
+
+.params_equa <- function(x, intercept = "alpha", greek = "beta") {
+ vals <- NULL
+
+ if (intercept != greek && grepl(intercept, x)) {
+ it <- paste0("\\\\", intercept)
+ res <- regmatches(x, gregexpr(it, x))[[1]]
+ vals <- paste0("$",res, "$")
+ }
+
+ if (grepl(greek, x)) {
+ g <- paste0("\\\\", greek,"_\\{\\d*\\}")
+ res <- regmatches(x, gregexpr(g, x))[[1]]
+ res1 <- paste0("$",res, "$")
+ vals <- c(vals, res1)
+ }
+
+ vals
+}
+
+.extract_title <- function(title, lang = "en", default = "Linear model") {
+ res <- NULL
+
+ if (isTRUE(title)) {
+ res <- gettext(default, lang = lang)[[1]]
+ }
+
+ if (is.character(title)) {
+ res <- title
+ }
+ return(res)
+}
+
+# Internal functions for format_table()
+
+.create_flextable <- function(x, header = TRUE) {
+ df <- x$df
+
+ ft <- flextable(df) |>
+ colformat_sci()
+
+ if ("p.value" %in% colnames(df)) {
+ ft <- ft |>
+ colformat_sci(j = "p.value", lod = 2e-16)
+ }
+
+ if (!is.null(x$cols)) {
+ ft <- .add_colnames(ft, x$cols)
+ }
+
+ if (!is.null(x$terms)) {
+ vec <- x$terms
+ if (is.character(vec) && !is.null(names(vec)) && all(nzchar(names(vec)))) {
+ ft <- .add_labs(ft, vec)
+ } else {
+ ft <- .add_params(ft, vec)
+ }
+ }
+
+ if (isTRUE(header)) {
+ ft <- .add_header2(ft, title = x$title, equation = x$equa)
+ }
+
+ # footer and psignif
+ n <- 0 # use to define align right and left
+
+ if (!is.null(x$psignif)) {
+ ft <- .add_signif(ft, x$psignif)
+ n <- 1
+ }
+
+ if (!is.null(x$footer)) {
+ vals <- x$footer
+ ft <- add_footer_lines(ft, top = FALSE, values = para_md(vals))
+ ft <- align(ft, i = seq_len(length(vals)) + n , align = "left",
+ part = "footer")
+ }
+
+ ft <- autofit(ft, part = c("header", "body"))
+
+ if (!is.null(df$signif)) {
+ ft <- width(ft, j = "signif", width = 0.4)
+ }
+
+ return(ft)
+}
+
+format_table <- function(df, kind, header) {
+ switch(kind,
+ df = df,
+ tt = stop("Not implemented yet"),
+ ft = .create_flextable(df, header = header),
+ gt = stop("Not implemented yet")
+ )
+}
+
+.add_signif <- function(x, signif) {
+
+ if (!inherits(x, "flextable")) {
+ stop(sprintf("Function `%s` supports only flextable objects.",
+ ".add_signif_stars()"))}
+
+ ft <- x
+ s <- signif
+
+ ft <- add_footer_lines(ft, values = s)
+ align(ft, i = 1, align = "right", part = "footer")
+}
+
+.add_header2 <- function(x, title, equation) {
+
+ if (!inherits(x, "flextable")) {
+ stop(sprintf("Function `%s` supports only flextable objects.",
+ ".add_header2()")) }
+
+ ft <- x
+
+ if (is.character(equation)) {
+ ft <- add_header_lines(ft, values = as_paragraph(as_equation(equation)))
+ ft <- align(ft, i = 1, align = "center", part = "header")
+ }
+
+ if (is.character(title)) {
+ ft <- add_header_lines(ft, values = as_paragraph(title))
+ ft <- align(ft, i = 1, align = "center", part = "header")
+ }
+
+ h_nrow <- nrow_part(ft, part = "header")
+
+ if (h_nrow > 2) {
+ ft |>
+ border_inner_h(border = officer::fp_border(width = 0), part = "header") |>
+ hline(i = nrow_part(ft, "header") - 1,
+ border = officer::fp_border(width = 1.5, color = "#666666"),
+ part = "header") ->
+ ft
+ }
+
+ ft
+}
+
+.add_colnames <- function(x, labs) {
+
+ if (!inherits(x, "flextable")) {
+ stop(sprintf("Function `%s` supports only flextable objects.",
+ ".add_colnames()")) }
+
+ ft <- x
+
+ for (i in seq_along(labs))
+ ft <- mk_par(ft, i = 1, j = names(labs)[i],
+ value = para_md(labs[i]), part = "header")
+
+ ft
+}
+
+.add_labs <- function(x, labs) {
+ if (!inherits(x, "flextable")) {
+ stop(sprintf("Function `%s` supports only flextable objects.",
+ ".add_colnames()")) }
+
+ ft <- x
+
+ labs_red <- labs[names(labs) %in% ft$body$dataset$term]
+
+ for (i in seq_along(labs_red))
+ ft <- mk_par(ft, i = names(labs_red)[i], j = "term",
+ value = para_md(labs_red[i]), part = "body")
+
+ ft
+}
+
+.add_params <- function(x, params) {
+
+ if (!inherits(x, "flextable")) {
+ stop(sprintf("Function `%s` supports only flextable objects.",
+ ".add_colnames()")) }
+
+ ft <- x
+
+ if (length(params) == length(ft$body$dataset$term))
+ ft <- mk_par(ft, j = "term", value = para_md(params), part = "body")
+
+ ft
+}
+
+# Internal functions of flextable
+# .pvalue_format <- function(x) {
+# #x <- get(as.character(substitute(x)), inherits = TRUE)
+# z <- cut(x, breaks = c(-Inf, 0.001, 0.01, 0.05, 0.1, Inf),
+# labels = c("***", " **", " *", " .", " "))
+# z <- as.character(z)
+# z[is.na(x)] <- ""
+# z
+# }
+#
+#
+# # Add pvalue signif
+# .add_signif_stars <- function(x, i = NULL, j = NULL, part = "body",
+# align = "right", ...) {
+#
+# if (!inherits(x, "flextable")) {
+# stop(sprintf("Function `%s` supports only flextable objects.",
+# ".add_signif_stars()"))}
+#
+# ft <- mk_par(x, i = i, j = j,
+# value = as_paragraph(.pvalue_format(.data$p.value)))
+# ft <- add_footer_lines(ft,
+# values = c("0 <= '***' < 0.001 < '**' < 0.01 < '*' < 0.05"))
+# align(ft, i = 1, align = align, part = "footer")
+# }
+#
+# # TODO: this is duplicated in tabularise -> export from there and reuse here!
+
+# # .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") {
+# vals <- NULL
+#
+# if (intercept != greek && grepl(intercept, x)) {
+# it <- paste0("\\\\", intercept)
+# res <- regmatches(x, gregexpr(it, x))[[1]]
+# vals <- paste0("$",res, "$")
+# }
+#
+# if (grepl(greek, x)) {
+# g <- paste0("\\\\", greek,"_\\{\\d*\\}")
+# res <- regmatches(x, gregexpr(g, x))[[1]]
+# res1 <- paste0("$",res, "$")
+# vals <- c(vals, res1)
+# }
+#
+# vals
+# }
+#
+# # Change labels of header
+# .header_labels <- function(x, info_lang, ...) {
+#
+# if (!inherits(x, "flextable")) {
+# stop(sprintf("Function `%s` supports only flextable objects.",
+# "header_labels_lm()")) }
+#
+# ft <- x
+#
+# hlabs <- info_lang[["labs"]]
+# hlabs_red <- hlabs[names(hlabs) %in% ft$header$col_keys]
+#
+# for (i in seq_along(hlabs_red))
+# ft <- mk_par(ft, i = 1, j = names(hlabs_red)[i],
+# value = para_md(hlabs_red[i]), part = "header")
+#
+# ft
+# }
+#
+# # Add header
+# .add_header <- function(x, info_lang, header = TRUE, title = NULL, equation,
+# ...) {
+#
+# # If title is not provided, determine if we have to use TRUE or FALSE
+# if (missing(title)) {
+# title <- header # Default to same as header, but...
+# # if a caption is defined in the chunk, it defauts to FALSE
+# if (!is.null(knitr::opts_current$get('tbl-cap')))
+# title <- FALSE
+# }
+#
+# if (!inherits(x, "flextable")) {
+# stop(sprintf("Function `%s` supports only flextable objects.",
+# ".add_header()")) }
+#
+# ft <- x
+#
+# if (isTRUE(header)) {
+# if (is.character(equation)) {
+# ft <- add_header_lines(ft,
+# values = as_paragraph(as_equation(equation)))
+# ft <- align(ft, i = 1, align = "right", part = "header")
+# }
+#
+# if (isTRUE(title)) {
+# ft <- add_header_lines(ft, values = info_lang[["header"]])
+# ft <- align(ft, i = 1, align = "right", part = "header")
+# }
+#
+# if (is.character(title)) {
+# ft <- add_header_lines(ft,
+# values = as_paragraph(title))
+# ft <- align(ft, i = 1, align = "right", part = "header")
+# }
+# }
+#
+# h_nrow <- nrow_part(ft, part = "header")
+#
+# if (h_nrow > 2) {
+# ft |>
+# border_inner_h(border = officer::fp_border(width = 0), part = "header") |>
+# hline(i = nrow_part(ft, "header") - 1,
+# border = officer::fp_border(width = 1.5, color = "#666666"),
+# part = "header") ->
+# ft
+# }
+#
+# ft
+# }
diff --git a/R/modelit-package.R b/R/modelit-package.R
index b8d3ee1..399ad07 100644
--- a/R/modelit-package.R
+++ b/R/modelit-package.R
@@ -1,4 +1,4 @@
-#' Statistical Models for 'SciViews::R'
+#' 'SciViews::R' - Statistical Models
#'
#' The \{modelit\} package provides an extension to base R functions for model
#' fitting like [lm()], [glm()] or [nls()] with enhanced plots and utilitarian
@@ -16,35 +16,21 @@
#' - [as.function()] transforms an **lm** or **nls** model into a function that
#' can be plotted using `stat_function()`.
#'
-#' @docType package
-#' @name modelit-package
-
## usethis namespace: start
-#' @importFrom stats AIC anova BIC coef confint cooks.distance deviance family fitted formula hatvalues nobs predict residuals rstandard variable.names vcov
+#' @importFrom broom augment glance tidy
#' @importFrom chart chart combine_charts
+#' @importFrom flextable add_footer_lines add_header_lines align as_equation
+#' @importFrom flextable as_paragraph autofit border_inner_h flextable
+#' @importFrom flextable hline italic mk_par ncol_keys nrow_part width
+#' @importFrom generics fit
#' @importFrom ggplot2 aes aes_string geom_abline geom_bar geom_histogram geom_hline geom_point geom_qq geom_qq_line geom_smooth geom_vline ggtitle labs stat_function stat_smooth theme
-#' @importFrom svFlow %>.%
-#' @importFrom broom augment glance tidy
#' @importFrom modelr add_predictions add_residuals geom_ref_line mae qae rmse rsquare
-#' @importFrom generics fit
-#' @importFrom data.io label
-#' @importFrom flextable add_footer_lines
-#' @importFrom flextable add_header_lines
-#' @importFrom flextable align
-#' @importFrom flextable as_equation
-#' @importFrom flextable as_paragraph
-#' @importFrom flextable autofit
-#' @importFrom flextable border_inner_h
-#' @importFrom flextable flextable
-#' @importFrom flextable hline
-#' @importFrom flextable italic
-#' @importFrom flextable mk_par
-#' @importFrom flextable ncol_keys
-#' @importFrom flextable nrow_part
-#' @importFrom flextable width
#' @importFrom officer fp_border
+#' @importFrom stats AIC anova BIC coef confint cooks.distance deviance family fitted formula hatvalues nobs predict residuals rstandard variable.names vcov
#' @importFrom stats coef pf
-#' @importFrom tabularise colformat_sci equation
-#' @importFrom tabularise para_md
+#' @importFrom svFlow %>.%
+#' @importFrom svBase label gettext_ gettextf_ ngettext_ stop_ warning_ prepare_data_dot recall_with_data_dot
+#' @importFrom tabularise colformat_sci para_md tabularise
+#' @importFrom equatiomatic equation
## usethis namespace: end
-NULL
+"_PACKAGE"
diff --git a/R/tabularise.anova.R b/R/tabularise.anova.R
index 82fe058..e5fd7b4 100644
--- a/R/tabularise.anova.R
+++ b/R/tabularise.anova.R
@@ -12,14 +12,12 @@
#' @param labs Labels to change the default names in the `term` column of the
#' table. By default it is `NULL` and nothing is changed.
#' @param lang The natural language to use. The default value is set with,
-#' e.g., `options(data.io_lang = "fr")` for French.
+#' e.g., `options(SciViews_lang = "fr")` for French.
#' @param show.signif.stars If `TRUE`, add the significance stars to the table.
#' The default is taken from `getOption("show.signif.stars")`.
#' @param ... Additional arguments (not used for now)
#' @param kind The kind of table to produce: "tt" for tinytable, or "ft" for
#' flextable (default).
-#' @param env The environment where to evaluate lazyeval expressions (not used
-#' for now)
#'
#' @return A **flextable** object you can print in different form or rearrange
#' with the \{flextable\} functions.
@@ -27,13 +25,30 @@
#' @importFrom tabularise tabularise_default colformat_sci
#' @method tabularise_default anova
#' @examples
-#' iris_anova <- anova(lm(data = iris, Petal.Length ~ Species))
-#' tabularise::tabularise(iris_anova)
+#' is <- data.io::read("iris", package = "datasets")
+#'
+#' is_lm1 <- lm(data = is, petal_length ~ species)
+#'
+#' library(tabularise)
+#'
+#' anova(is_lm1) |> tabularise_default()
+#' # identical
+#' anova(is_lm1) |> tabularise()
+#' # Use labels
+#' anova(is_lm1) |> tabularise(origdata = is)
+#'
+#' # alternative with anova_() in {modelit} package
+#' anova_(is_lm1) |> tabularise()
+#'
+#' is_lm2 <- lm(data = is, petal_length ~ sepal_length + species)
+#'
+#' anova(is_lm1, is_lm2) |> tabularise(origdata = is)
+#' anova_(is_lm1, is_lm2) |> tabularise()
+#'
tabularise_default.anova <- function(data, header = TRUE, title = header,
-auto.labs = TRUE, origdata = NULL, labs = NULL,
-lang = getOption("data.io_lang", "en"),
-show.signif.stars = getOption("show.signif.stars", TRUE), ..., kind = "ft",
-env = parent.frame()) {
+ auto.labs = TRUE, origdata = NULL, labs = NULL,
+ lang = getOption("SciViews_lang", "en"),
+ show.signif.stars = getOption("show.signif.stars", TRUE), ..., kind = "ft") {
# If title is not provided, determine if we have to use TRUE or FALSE
if (missing(title)) {
@@ -43,133 +58,19 @@ env = parent.frame()) {
title <- FALSE
}
- # Select the language
- info_lang <- .infos_lang.anova(lang = lang)
-
- # Extract labels of data or origdata
- if (isTRUE(auto.labs)) {
- labs <- tabularise:::.labels2(data, origdata = origdata, labs = labs)
- } else {
- labs <- tabularise:::.labels2(x = NULL, labs = labs)
- }
-
- # Turn an object into a tidy tibble
- data_t <- as.data.frame(broom::tidy(data))
-
- if (grepl("^Model", attr(data, "heading")[2])) {
- data_t$term <- paste(info_lang[["Model"]], 1:nrow(data_t))
- info_lang$labs[["term"]] <- info_lang$Model[["Model"]]
- }
-
- rownames(data_t) <- data_t$term
-
- if (isTRUE(show.signif.stars) && "p.value" %in% names(data_t)) {
- ft <- flextable::flextable(data_t, col_keys = c(names(data_t), "signif"))
- } else {
- ft <- flextable::flextable(data_t)
- }
-
- ft <- colformat_sci(ft)
- if ("p.value" %in% names(data_t))
- ft <- colformat_sci(ft, j = "p.value", lod = 2e-16)
-
- # Rename headers labels
- ft <- .header_labels(ft, info_lang = info_lang)
-
- statis <- info_lang[["statistic"]]
- statis_red <- statis[names(statis) %in% names(data)]
-
- if (length(statis_red) == 1) {
- ft <- mk_par(ft, i = 1, j = "statistic",
- value = para_md(statis_red), part = "header")
- }
-
- # Rename terms column
- if (isTRUE(auto.labs)) {
- if (any(data_t$term %in% "Residuals")) {
- ft <- mk_par(ft, i = "Residuals", j = 1, part = "body",
- value = as_paragraph(info_lang[["residuals"]]))
- }
- if (any(data_t$term %in% "NULL")) {
- ft <- mk_par(ft, i = "NULL", j = 1, part = "body",
- value = as_paragraph(info_lang[["NULL"]]))
- }
- }
-
- if (!is.null(labs)) {
- labs_red <- labs[names(labs) %in% data_t$term]
- for (i in seq_along(labs_red))
- ft <- mk_par(ft, i = names(labs_red)[i], j = 1,
- value = para_md(labs_red[i]), part = "body")
- }
-
- # Add header
- if (isTRUE(header)) {
- if (isTRUE(title)) {
- heading <- paste0(attr(data, "heading"), collapse = "")
- heading <- gsub("\n\n", "\n", heading)
- heading <- sub("\n$", "", heading)
-
- if (!is.null(labs)) {
- header <- c(info_lang[["method"]], info_lang[["header"]],
- gsub("\n", " ", labs))
- } else {
- header <- c(info_lang[["method"]], info_lang[["header"]])
- }
-
- for (i in seq_len(length(header)))
- heading <- gsub(names(header)[i], header[i], heading, fixed = TRUE)
-
-
- if (length(heading) == 1) {
- ft <- add_header_lines(ft, values = heading)
- ft <- align(ft, i = 1, align = "right", part = "header")
- }
- }
-
- if (is.character(title)) {
- ft <- add_header_lines(ft, values = as_paragraph(title))
- ft <- align(ft, i = 1, align = "right", part = "header")
- }
- }
-
- # Add information on the p.value (with internal function)
- if (ncol_keys(ft) > ncol(data_t)) {
- ft <- .add_signif_stars(ft, j = "signif")
- }
-
- # Adjust cell with autofit()
- ft <- autofit(ft, part = c("header", "body"))
+ df_list <- .extract_infos_anova(
+ data, show.signif.stars = show.signif.stars, lang = lang, auto.labs = auto.labs,
+ origdata = origdata, labs = labs, title = title,
+ colnames = colnames_anova)
- if ("p.value" %in% names(data_t) && isTRUE(show.signif.stars))
- ft <- width(ft, j = "signif", width = 0.4)
-
- ft
+ # formatted table
+ format_table(df_list, kind = kind, header = header)
}
-
#' Tidy version of the anova object into a flextable object
#'
#' @param data An **anova** object
-#' @param header If `TRUE` (by default), add a header to the table
-#' @param title If `TRUE`, add a title to the table header. Default to the same
-#' value than header, except outside of a chunk where it is `FALSE` if a table
-#' caption is detected (`tbl-cap` YAML entry).
-#' @param auto.labs If `TRUE` (by default), use labels (and units) from
-#' `origdata=`.
-#' @param origdata The original data set used for the ANOVA (used for changing
-#' the labels). By default, it is `NULL`.
-#' @param labs Labels to use to change the names of elements in the `term`
-#' column. By default, it is `NULL`.
-#' @param lang The natural language to use. The default value can be set with,
-#' e.g., `options(data.io_lang = "fr")` for French.
-#' @param show.signif.stars If `TRUE`, add the significance stars to the table.
-#' The default is taken from `getOption("show.signif.stars")`.
-#' @param ... Additional arguments (not used for now)
-#' @param kind The kind of table to produce: "tt" for tinytable, or "ft" for
-#' flextable (default).
-#' @param env The environment where to evaluate lazyeval expressions (not used
-#' for now)
+#' @param ... Additional arguments used [tabularise_default.anova()]
#'
#' @return A **flextable** object you can print in different form or rearrange
#' with the \{flextable\} functions.
@@ -177,211 +78,244 @@ env = parent.frame()) {
#' @importFrom tabularise tabularise_default colformat_sci
#' @method tabularise_tidy anova
#' @examples
-#' iris_anova <- anova(lm(data = iris, Petal.Length ~ Species))
-#' tabularise::tabularise$tidy(iris_anova)
-tabularise_tidy.anova <- function(data, header = TRUE, title = header,
-auto.labs = TRUE, origdata = NULL, labs = NULL,
-lang = getOption("data.io_lang", "en"),
-show.signif.stars = getOption("show.signif.stars", TRUE), ...,
-kind = "ft", env = parent.frame()) {
+#' is <- data.io::read("iris", package = "datasets")
+#'
+#' is_lm1 <- lm(data = is, petal_length ~ species)
+#'
+#' library(tabularise)
+#'
+#' anova(is_lm1) |> tabularise_tidy()
+#' # identical
+#' anova(is_lm1) |> tabularise$tidy()
+#' # Use labels
+#' anova(is_lm1) |> tabularise$tidy(origdata = is)
+#'
+#' # alternative with anova_() in {modelit} package
+#' anova_(is_lm1) |> tabularise$tidy()
+tabularise_tidy.anova <- function(data,...) {
+ tabularise_default.anova(data = data, ...)
+}
- # If title is not provided, determine if we have to use TRUE or FALSE
- if (missing(title)) {
- title <- header # Default to same as header, but...
- # if a caption is defined in the chunk, it defauts to FALSE
- if (!is.null(knitr::opts_current$get('tbl-cap')))
- title <- FALSE
- }
+#' Create a rich-formatted table from an aov object
+#'
+#' @param data An **aov** object
+#' @param ... Additional arguments passed to [tabularise_default.anova()]
+#' @return **flextable** object you can print in different form or rearrange
+#' with the \{flextable\} functions.
+#' @export
+#' @importFrom tabularise tabularise_default colformat_sci
+#' @method tabularise_default aov
+#' @examples
+#' iris_aov <- aov(data = iris, Petal.Length ~ Species)
+#' tabularise::tabularise$tidy(iris_aov)
+tabularise_default.aov <- function(data, ...) {
+ tabularise_default.anova(anova_(data), ...)
+}
- # Select language
- info_lang <- .infos_lang.anova(lang = lang)
+#' Tidy version of the aov object into a flextable object
+#'
+#' @param data An **aov** object
+#' @param ... Additional arguments passed to [tabularise_default.anova()]
+#' @return **flextable** object you can print in different form or rearrange
+#' with the \{flextable\} functions.
+#' @export
+#' @importFrom tabularise tabularise_default colformat_sci
+#' @method tabularise_tidy aov
+#' @examples
+#' iris_aov <- aov(data = iris, Petal.Length ~ Species)
+#' tabularise::tabularise$tidy(iris_aov)
+tabularise_tidy.aov <- function(data, ...) {
+ tabularise_default.anova(anova_(data), ...)
+}
- # Extract labels
- if (isTRUE(auto.labs)) {
- labs <- tabularise:::.labels2(data, origdata = origdata, labs = labs)
- } else {
- labs <- tabularise:::.labels2(NULL, labs = labs)
- }
+# A list of internals functions and objects
+
+colnames_anova <- c(
+ term = "Term",
+ "model" = "Model",
+ "df" = "Df",
+ "df.residual" = "Residuals Df",
+ rss = "Residual sum of squares",
+ "sumsq" = "Sum of squares",
+ "meansq" = "Mean squares",
+ "p.value" = "*p* value",
+ num.df = "Num. Df",
+ NumDF = "Num. Df",
+ den.df = "Denom. Df",
+ DenDF = "Denom. Df",
+ deviance = "Deviance",
+ residual.deviance = "Residual deviance",
+ "F value" = "*F*~obs.~ value",
+ "F" = "*F*~obs.~ value",
+ Chisq = "$\\chi2_{obs.}$",
+ signif = "",
+ npar = "Number of parameters")
+
+.trad_anova <- gettext(
+ "Type III Analysis of Variance Table with Satterthwaite's method" =
+ "Type III analysis of variance with Satterthwaite's method",
+ "Analysis of Deviance Table" = "Analysis of deviance",
+ "Analysis of Variance Table" = "Analysis of variance",
+ "Anova Table (Type II tests)" = "Type II analysis of variance",
+ "Anova Table (Type III tests)" = "Type III analysis of variance",
+ "Analysis of Deviance Table (Type II tests)" = "Type II analysis of deviance table",
+ "Analysis of Deviance Table (Type III tests)" = "Type III analysis of deviance table",
+ "Response:" = "Response:",
+ "Model:" = "Model:",
+ "Model" = "Model",
+ "link:" = "link:",
+ "Terms added sequentially (first to last)" = "Terms added sequentially (first to last)",
+ term = "Term",
+ "model" = "Model",
+ "df" = "Df",
+ "df.residual" = "Residuals Df",
+ rss = "Residual sum of squares",
+ "sumsq" = "Sum of squares",
+ "meansq" = "Mean squares",
+ "p.value" = "*p* value",
+ num.df = "Num. Df",
+ NumDF = "Num. Df",
+ den.df = "Denom. Df",
+ DenDF = "Denom. Df",
+ deviance = "Deviance",
+ residual.deviance = "Residual deviance",
+ "F value" = "*F*~obs.~ value",
+ "F" = "*F*~obs.~ value",
+ Chisq = "$\\chi2_{obs.}$",
+ "NULL" = "None",
+ Residuals = "Residuals",
+ npar = "Number of parameters"
+)
- # Turn an object into a tidy tibble
- data_t <- as.data.frame(broom::tidy(data))
- rownames(data_t) <- data_t$term
+# See utils.R for internal functions used by various .extract_infos_***
+#
+.extract_infos_anova <- function(data,
+ show.signif.stars = getOption("show.signif.stars", TRUE),
+ lang = "en", auto.labs = TRUE, origdata = NULL , labs = NULL,
+ title = TRUE, colnames = colnames_anova, ...) {
- if (isTRUE(show.signif.stars) && "p.value" %in% names(data_t)) {
- ft <- flextable(data_t, col_keys = c(names(data_t), "signif"))
- } else {
- ft <- flextable::flextable(data_t)
- }
+ if (!inherits(data, c("anova")))
+ stop(".extract_infos_anova() can apply only anova object.")
- ft <- colformat_sci(ft)
- if ("p.value" %in% names(data_t))
- ft <- colformat_sci(ft, j = "p.value", lod = 2e-16)
+ # df
+ df <- as.data.frame(broom::tidy(data))
+ rownames(df) <- df$term
- # Rename headers labels
- ft <- .header_labels(ft, info_lang = info_lang)
+ # statistic variable has 3 possible signification: "F value", "F", "Chisq"
+ statistic_cols <- c("F value", "F", "Chisq")
+ names(df)[names(df) == "statistic"] <-
+ statistic_cols[statistic_cols %in% names(data)][1]
- statis <- info_lang[["statistic"]]
- statis_red <- statis[names(statis) %in% names(data)]
+ # the term variable
+ if (grepl("^Model", attr(data, "heading")[2]))
+ names(df)[names(df) == "term"] <- "model"
- if (length(statis_red) == 1) {
- ft <- mk_par(ft, i = 1, j = "statistic",
- value = para_md(statis_red), part = "header")
- }
+ if (isTRUE(show.signif.stars))
+ df$signif <- .pvalue_format(df$p.value)
- # Rename terms column
- if (isTRUE(auto.labs)) {
- if (any(data_t$term %in% "Residuals")) {
- ft <- mk_par(ft, i = "Residuals", j = 1, part = "body",
- value = as_paragraph(info_lang[["residuals"]]))
- }
- if (any(data_t$term %in% "NULL")) {
- ft <- mk_par(ft, i = "NULL", j = 1, part = "body",
- value = as_paragraph(info_lang[["NULL"]]))
- }
+ # psignif
+ if (isTRUE(show.signif.stars)) {
+ psignif <- "0 <= '***' < 0.001 < '**' < 0.01 < '*' < 0.05"
+ } else {
+ psignif <- NULL
}
- if (!is.null(labs)) {
- labs_red <- labs[names(labs) %in% data_t$term]
+ lang <- tolower(lang)
+ cols <- .extract_colnames(df, labs = colnames, lang = lang)
+
+ data_obj <- attr(data, "object")
- for (i in seq_along(labs_red))
- ft <- mk_par(ft, i = names(labs_red)[i], j = 1,
- value = para_md(labs_red[i]), part = "body")
+ if (is.null(data_obj)) {
+ labels <- .extract_labels(df = df, data = data, auto.labs = auto.labs,
+ origdata = origdata, labs = labs)
+ } else {
+ labels <- .extract_labels(df = df, data = data_obj, auto.labs = auto.labs,
+ origdata = origdata, labs = labs)
}
- if (isTRUE(header)) {
+ if (is.null(df[["term"]])) {
if (isTRUE(title)) {
- method <- info_lang[["method"]]
- headings <- attr(data, "heading")[1]
+ df$model <- paste(gettext("Model", lang = lang)[[1]], 1:nrow(df))
+ } else {
+ if (!is.null(labels)) {
+ labels_red <- gsub("\n", " ", labels)
+ for (i in seq_len(length(labels_red)))
+ df$model<- gsub(names(labels_red)[i], labels_red[i], df$model, fixed = TRUE)
+ }
+ }
+ } else {
+ terms <- .extract_terms(df, labs = labels, lang = lang)
+ }
+
- res <- sapply(names(method), function(name)
- grepl(paste0("^",name), headings))
- method <- method[res]
+ # extract title
+ # Handle the 'heading' attribute if title is TRUE
+ if (isTRUE(title)) {
+ heading <- attr(data, "heading")
+ heading <- unlist(strsplit(heading, "\n\n"))
+ heading <- sub("\n$", "", heading)
- if (length(method) == 1) {
- ft <- add_header_lines(ft, values = method)
- ft <- align(ft, i = 1, align = "right", part = "header")
+ # Standardize heading if it starts with "Data"
+ if (grepl("^Data", heading)[[1]]) {
+ heading[[1]] <- "Analysis of Variance Table"
+
+ # Format model headings if present
+ if (grepl("^Models:", heading)[[2]]) {
+ heading <- heading[-2]
+ heading[-1] <- paste0("Model ", seq_along(heading[-1]), ": ", heading[-1])
}
}
- if (is.character(title)) {
- ft <- add_header_lines(ft, values = as_paragraph(title))
- ft <- align(ft, i = 1, align = "right", part = "header")
+ # Replace label names in heading if labels are provided
+ if (!is.null(labels)) {
+ labels_red <- gsub("\n", " ", labels)
+ for (i in seq_len(length(labels_red)))
+ heading <- gsub(names(labels_red)[i], labels_red[i], heading, fixed = TRUE)
}
- }
-
- # Add information on the p.value
- if (ncol_keys(ft) > ncol(data_t))
- ft <- .add_signif_stars(ft, j = "signif")
-
- ft <- autofit(ft, part = c("header", "body"))
- if ("p.value" %in% names(data_t) && isTRUE(show.signif.stars))
- ft <- width(ft, j = "signif", width = 0.4)
- ft
-}
+ # Map verbose headers to simplified versions
+ header_anova <- c(
+ "Type III Analysis of Variance Table with Satterthwaite's method" =
+ "Type III analysis of variance with Satterthwaite's method",
+ "Analysis of Deviance Table" = "Analysis of deviance",
+ "Analysis of Variance Table" = "Analysis of variance",
+ "Anova Table (Type II tests)" = "Type II analysis of variance",
+ "Anova Table (Type III tests)" = "Type III analysis of variance",
+ "Analysis of Deviance Table (Type II tests)" = "Type II analysis of deviance table",
+ "Analysis of Deviance Table (Type III tests)" = "Type III analysis of deviance table",
+ "Response:" = "Response:",
+ "Model:" = "Model:",
+ "Model" = "Model",
+ "link:" = "link:",
+ "Terms added sequentially (first to last)" = "Terms added sequentially (first to last)"
+ )
+
+ # Translate headers based on language
+ header_anovat <- gettext(header_anova, lang = lang)
+ names(header_anovat) <- names(header_anova)
+
+ # Apply header replacements
+ for (i in seq_len(length(header_anovat)))
+ heading <- gsub(names(header_anovat)[i], header_anovat[i], heading, fixed = TRUE)
+
+ title <- paste0(heading, collapse = "\n")
-#' Tidy version of the aov object into a flextable object
-#'
-#' @param data An **anova** object
-#' @param ... Additional arguments passed to [tabularise_tidy.anova()]
-#' @param kind The kind of table to produce: "tt" for tinytable, or "ft" for
-#' flextable (default).
-#' @param env The environment where to evaluate the object.
-#'
-#' @return **flextable** object you can print in different form or rearrange
-#' with the \{flextable\} functions.
-#' @export
-#' @importFrom tabularise tabularise_default colformat_sci
-#' @method tabularise_tidy aov
-#' @examples
-#' iris_aov <- aov(data = iris, Petal.Length ~ Species)
-#' tabularise::tabularise$tidy(iris_aov)
-tabularise_tidy.aov <- function(data, ..., kind = "ft", env = parent.frame()) {
- tabularise_tidy(anova(data), ..., kind = kind, env = env)
-}
+ } else {
+ title <- NULL
+ }
-# Choose the lang and the infos_lang
-.infos_lang.anova <- function(lang) {
- lang <- tolower(lang)
- if (lang == "fr") {
- info_lang <- infos_fr.anova
- } else {# Only english for now as second alternative
- info_lang <- infos_en.anova
+ # Preserve title if it's a character string
+ if (is.character(title)) {
+ title <- title
}
- info_lang
-}
-infos_en.anova <- list(
- method = c(
- "Type III Analysis of Variance Table with Satterthwaite's method" =
- "Type III analysis of variance with Satterthwaite's method",
- "Analysis of Deviance Table" =
- "Analysis of deviance",
- "Analysis of Variance Table" =
- "Analysis of variance"
- ),
- header = c(
- "Response:" = "Response:"
- ),
- labs = c(
- term = "Term",
- "df" = "Df",
- "df.residual" = "Residuals Df",
- rss = "Residual sum of squares",
- "sumsq" = "Sum of squares",
- "meansq" = "Mean squares",
- "p.value" = "*p* value",
- num.df = "Num. Df",
- NumDF = "Num. Df",
- den.df = "Denom. Df",
- DenDF = "Denom. Df",
- deviance = "Deviance",
- residual.deviance = "Residual deviance"),
- statistic = c(
- "F value" = "*F*~obs.~ value",
- "F" = "*F*~obs.~ value",
- Chisq = "$\\chi2_{obs.}$"),
- residuals = c(Residuals = "Residuals"),
- "NULL" = c("NULL" = "None"),
- Model = c("Model" = "Model")
-)
+ list(
+ df = df,
+ title = title,
+ cols = cols,
+ equa = NULL,
+ terms = terms,
+ psignif = psignif,
+ footer = NULL)
+}
-infos_fr.anova <- list(
- method = c(
- "Type III Analysis of Variance Table with Satterthwaite's method" =
- "Analyse de la variance de type III avec m\u00e9thode Sattertwaite",
- "Analysis of Deviance Table" =
- "Analyse de la d\u00e9viance",
- "Analysis of Variance Table" =
- "Analyse de la variance"
- ),
- header = c(
- "Response:" = "R\u00e9ponse :",
- "Model:" = "Mod\u00e8le :",
- "Model" = "Mod\u00e8le",
- "link:" = "Lien :",
- "Terms added sequentially (first to last)" =
- "Termes ajout\u00e9s s\u00e9quentiellement (du premier au dernier)"
- ),
- labs = c(
- "term" = "Terme",
- "df.residual" = "Ddl des r\u00e9sidus",
- rss = "Somme des carr\u00e9s des r\u00e9sidus",
- "df" = "Ddl",
- "sumsq" = "Somme des carr\u00e9s",
- "meansq" = "Carr\u00e9s moyens",
- "p.value" = "Valeur de *p*",
- num.df = "Ddl num.",
- NumDF = "Ddl num.",
- den.df = "Ddl d\u00e9nom.",
- DenDF = "Ddl d\u00e9nom.",
- deviance = "D\u00e9viance",
- residual.deviance = "D\u00e9viance r\u00e9siduelle"),
- statistic = c(
- "F value" = "Valeur de *F*~obs.~",
- "F" = "Valeur de *F*~obs.~",
- Chisq = "$\\chi2_{obs.}$"),
- residuals = c(Residuals = "R\u00e9sidus"),
- "NULL" = c("NULL" = "Aucun"),
- Model = c("Model" = "Mod\u00e8le")
-)
diff --git a/R/tabularise.glm.R b/R/tabularise.glm.R
index 60eaee9..8addd37 100644
--- a/R/tabularise.glm.R
+++ b/R/tabularise.glm.R
@@ -1,4 +1,4 @@
-# when we calculate a glm with the glm function, we obtain an object of
+# When we calculate a glm with the glm function, we obtain an object of
# type `glm` and `lm`. So `tabularise()` using the `lm` method
# The equatiomatic package is not capable of extracting an equation from an
# object of type summary.glm
@@ -10,25 +10,37 @@
#' to [stats::coef()], but in a rich-formatted **flextable** object.
#'
#' @param data A **glm** object
-#' @param header If `TRUE` (by default), add a header to the table
+#' @param header Logical. If `TRUE` (default), a header is added to the table.
+#' The header includes both the title and the equation (if applicable).
+#' If set to `FALSE`, neither the title nor the equation will be displayed in
+#' the table header, even if the `title` or `equation` parameters are provided.
#' @param title If `TRUE`, add a title to the table header. Default to the same
#' value than header, except outside of a chunk where it is `FALSE` if a table
#' caption is detected (`tbl-cap` YAML entry).
-#' @param equation If `TRUE` (by default), add an equation to the table header.
-#' The equation can also be passed in the form of a character string (LaTeX).
+#' @param equation Logical or character. Controls whether an equation is added
+#' to the table header and how parameters are used. Accepted values are:
+#' - `TRUE`: The equation is generated and added to the table header. Its
+#' parameters are also used in the "Term" column.
+#' - `FALSE` (by default): No equation is generated or displayed, and its
+#' parameters are not used in the "Term" column.
+#' - `NA`: The equation is generated but not displayed in the table header.
+#' Its parameters are used in the "Term" column.
+#' - Character string: A custom equation is provided directly and added to
+#' the table header.
#' @param auto.labs If `TRUE` (by default), use labels (and units) automatically
-#' from `origdata=`.
+#' from data or `origdata=`.
#' @param origdata The original data set this model was fitted to. By default it
-#' is `NULL` and labels of the original data set are not used.
+#' is `NULL` and no label is used.
#' @param labs Labels to change the names of elements in the `term` column of
-#' the table. By default, it is `NULL` and no change is performed.
+#' the table. By default it is `NULL` and nothing is changed.
#' @param lang The natural language to use. The default value can be set with,
-#' e.g., `options(data.io_lang = "fr")` for French.
-#' @param ... Additional arguments (not used yet).
+#' e.g., `options(SciViews_lang = "fr")` for French.
+#' @param footer If `TRUE` (`FALSE` by default), add a footer to the table.
+#' @param ... Additional arguments
#' @param kind The kind of table to produce: "tt" for tinytable, or "ft" for
#' flextable (default).
-#' @param env The environment where to evaluate lazyeval expressions (unused for
-#' now).
+#' @param env The environment where to evaluate formulas (you probably do not
+#' need to change the default).
#'
#' @return A **flextable** object is returned. You can print it in different
#' formats (HTML, LaTeX, Word, PowerPoint) or rearrange it with the
@@ -39,9 +51,22 @@
#' @examples
#' iris_glm <- glm(data = iris, Petal.Length ~ Sepal.Length)
#' tabularise::tabularise$coef(iris_glm)
-tabularise_coef.glm <- function(data, header = TRUE, title = NULL,
-equation = header, auto.labs = TRUE, origdata = NULL, labs = NULL,
-lang = getOption("data.io_lang", "en"), ..., kind = "ft", env = parent.frame()) {
+#'
+#' # If the 'iris' dataset has labels and units, they can be used to enhance
+#' # the output table
+#' iris <- svBase::labelise(iris, self = FALSE, label = list(
+#' Sepal.Length = "Length of the sepals",
+#' Petal.Length = "Length of the petals",
+#' Species = "Species"), units = c(rep("cm", 4), NA))
+#'
+#' iris_glm1 <- glm(data = iris, Petal.Length ~ Sepal.Length + Species)
+#' tabularise::tabularise$coef(iris_glm1)
+#'
+tabularise_coef.glm <- function(data, header = FALSE, title = header,
+ equation = header, auto.labs = TRUE, origdata = NULL, labs = NULL,
+ footer = FALSE, lang = getOption("SciViews_lang",
+ default = Sys.getenv("LANGUAGE",unset = "en")), ..., kind = "ft",
+ env = parent.frame()) {
# If title is not provided, determine if we have to use TRUE or FALSE
if (missing(title)) {
@@ -51,74 +76,50 @@ lang = getOption("data.io_lang", "en"), ..., kind = "ft", env = parent.frame())
title <- FALSE
}
- # Choose the language
- info_lang <- .infos_lang.glm(lang = lang)
-
- # Extract coef
- co <- coef(data)
- co <- data.frame(term = names(co), estimate = co)
- # co <- as.data.frame(rbind(coef(data)))
-
- if (isTRUE(auto.labs)) {
- labs <- tabularise:::.labels2(x = data, origdata = origdata, labs = labs)
- } else {
- labs <- tabularise:::.labels2(x = NULL, labs = labs)
- }
-
- # Create the flextable object
- ft <- flextable(co) |>
- colformat_sci()
-
- ft <- .header_labels(ft, info_lang = info_lang)
-
- # Header and equation
- if (isTRUE(equation)) {
- if (!is.null(labs)) {
- equa <- equation(data, swap_var_names = labs, ...)
- } else {
- equa <- equation(data, auto.labs = FALSE,...)
- }
-
- ft <- .add_header(ft, data = data, info_lang = info_lang, header = header,
- title = title, equation = equa)
- } else {
- equa <- NULL
- ft <- .add_header(ft, data = data, info_lang = info_lang, header = header,
- title = title, equation = equation)
- }
-
- if (isTRUE(auto.labs) && any(co$term %in% "(Intercept)")) {
- ft <- mk_par(ft, i = "(Intercept)", j = 1, part = "body",
- value = as_paragraph(info_lang[["(Intercept)"]]))
- }
-
- if (!is.null(labs)) {
- labs_red <- labs[names(labs) %in% co$term]
+ df_list <- .extract_infos_glm(
+ data, type = "coef", conf.int = FALSE, conf.level = 0.95,
+ show.signif.stars = FALSE, lang = lang, auto.labs = auto.labs,
+ origdata = origdata, labs = labs, equation = equation, title = title,
+ colnames = colnames_glm, footer = footer, ...)
- for (i in seq_along(labs_red))
- ft <- mk_par(ft, i = names(labs_red)[i], j = "term",
- value = para_md(labs_red[i]), part = "body")
- }
-
- if (isTRUE(equation) & !is.null(equa)) {
- params <- .params_equa(equa,...)
- if (length(params) == length(co$term))
- ft <- mk_par(ft, j = "term", value = para_md(params), part = "body")
- }
-
- autofit(ft, part = c("header", "body"))
+ # formatted table
+ format_table(df_list, kind = kind, header = header)
}
#' Create a rich-formatted table from a glm object
#'
#' @param data A **glm** object
-#' @param footer If `TRUE` (by default), add a footer to the table
+#' @param header Logical. If `TRUE` (`FALSE` by default), a header is added to the table.
+#' The header includes both the title and the equation (if applicable).
+#' If set to `FALSE`, neither the title nor the equation will be displayed in
+#' the table header, even if the `title` or `equation` parameters are provided.
+#' @param title If `TRUE` (`FALSE` by default), add a title to the table header. Default to the same
+#' value than header, except outside of a chunk where it is `FALSE` if a table
+#' caption is detected (`tbl-cap` YAML entry).
+#' @param equation Logical or character. Controls whether an equation is added
+#' to the table header and how parameters are used. Accepted values are:
+#' - `TRUE`: The equation is generated and added to the table header. Its
+#' parameters are also used in the "Term" column.
+#' - `FALSE` (by default): No equation is generated or displayed, and its
+#' parameters are not used in the "Term" column.
+#' - `NA`: The equation is generated but not displayed in the table header.
+#' Its parameters are used in the "Term" column.
+#' - Character string: A custom equation is provided directly and added to
+#' the table header.
+#' @param auto.labs If `TRUE` (by default), use labels (and units) automatically
+#' from data or `origdata=`.
+#' @param origdata The original data set this model was fitted to. By default it
+#' is `NULL` and no label is used.
+#' @param labs Labels to change the names of elements in the `term` column of
+#' the table. By default it is `NULL` and nothing is changed.
+#' @param footer If `TRUE` (`FALSE` by default), add a footer to the table
#' @param lang The natural language to use. The default value can be set with,
-#' e.g., `options(data.io_lang = "fr")` for French.
-#' @param ... Additional arguments passed to [modelit::tabularise_coef.glm()]
+#' e.g., `options(SciViews_lang = "fr")` for French.
+#' @param ... Additional arguments
#' @param kind The kind of table to produce: "tt" for tinytable, or "ft" for
#' flextable (default).
-#' @param env The environment where to evaluate the model.
+#' @param env The environment where to evaluate formulas (you probably do not
+#' need to change the default).
#'
#' @return A **flextable** object is returned. You can print it in different
#' formats (HTML, LaTeX, Word, PowerPoint) or rearrange it with the
@@ -129,28 +130,31 @@ lang = getOption("data.io_lang", "en"), ..., kind = "ft", env = parent.frame())
#' @examples
#' iris_glm <- glm(data = iris, Petal.Length ~ Sepal.Length)
#' tabularise::tabularise(iris_glm)
-tabularise_default.glm <- function(data, footer = TRUE,
- lang = getOption("data.io_lang", "en"), ..., kind = "ft",
+#' tabularise::tabularise(iris_glm, header = TRUE, footer = TRUE)
+#' tabularise::tabularise(iris_glm, header = TRUE, footer = FALSE)
+#' tabularise::tabularise(iris_glm, header = TRUE, equation = NA,footer = TRUE)
+tabularise_default.glm <- function(data, header = FALSE, title = header,
+ equation = header, auto.labs = TRUE, origdata = NULL, labs = NULL,
+ footer = FALSE, lang = getOption("SciViews_lang",
+ default = Sys.getenv("LANGUAGE",unset = "en")), ..., kind = "ft",
env = parent.frame()) {
- ft <- tabularise_coef.glm(data = data, ...)
- if (isTRUE(footer)) {
- info_lang <- .infos_lang.glm(lang = lang)
-
- digits <- max(3L, getOption("digits") - 3L)
- footer <- info_lang[["footer"]]
- vals <- c(
- paste(footer[["df"]], data$df.null, footer[["total"]], data$df.residual,
- footer[["residual"]]),
- paste(footer[["null.deviance"]],
- format(signif(data$null.deviance, digits))),
- paste(footer[["resid.deviance"]], format(signif(data$deviance,
- digits)), footer[["AIC"]], format(signif(data$aic, digits)))
- )
- ft <- add_footer_lines(ft, values = vals)
+ # If title is not provided, determine if we have to use TRUE or FALSE
+ if (missing(title)) {
+ title <- header # Default to same as header, but...
+ # if a caption is defined in the chunk, it defaults to FALSE
+ if (!is.null(knitr::opts_current$get('tbl-cap')))
+ title <- FALSE
}
- autofit(ft, part = c("header", "body"))
+ df_list <- .extract_infos_glm(
+ data, type = "coef", conf.int = FALSE, conf.level = 0.95,
+ show.signif.stars = FALSE, lang = lang, auto.labs = auto.labs,
+ origdata = origdata, labs = labs, equation = equation, title = title,
+ colnames = colnames_glm, footer = footer, ..., env = env)
+
+ # formatted table
+ format_table(df_list, kind = kind, header = header)
}
#' Create a tidy version of the glm object as a rich-formatted table
@@ -161,16 +165,27 @@ tabularise_default.glm <- function(data, footer = TRUE,
#' Word, PowerPoint), or rearranged later on.
#'
#' @param data A **glm** object
-#' @param header If `TRUE` (by default), add a header to the table
-#' @param title If `TRUE`, add a title to the table header. Default to the same
+#' @param header Logical. If `TRUE` (`TRUE` by default), a header is added to the table.
+#' The header includes both the title and the equation (if applicable).
+#' If set to `FALSE`, neither the title nor the equation will be displayed in
+#' the table header, even if the `title` or `equation` parameters are provided.
+#' @param title If `TRUE` (`TRUE` by default), add a title to the table header. Default to the same
#' value than header, except outside of a chunk where it is `FALSE` if a table
#' caption is detected (`tbl-cap` YAML entry).
-#' @param equation If `TRUE` (by default), add an equation to the table header.
-#' The equation can also be passed in the form of a character string (LaTeX).
+#' @param equation Logical or character. Controls whether an equation is added
+#' to the table header and how parameters are used. Accepted values are:
+#' - `TRUE` (default) : The equation is generated and added to the table
+#' header. Its parameters are also used in the "Term" column.
+#' - `FALSE`: No equation is generated or displayed, and its parameters are
+#' not used in the "Term" column.
+#' - `NA`: The equation is generated but not displayed in the table header.
+#' Its parameters are used in the "Term" column.
+#' - Character string: A custom equation is provided directly and added to
+#' the table header.
#' @param auto.labs If `TRUE` (by default), use labels (and units) automatically
-#' from `origdata=`. `
+#' from data or `origdata=`.
#' @param origdata The original data set this model was fitted to. By default it
-#' is `NULL` and variables labels from this data set are not used.
+#' is `NULL` and no label is used.
#' @param labs Labels to change the names of elements in the `term` column of
#' the table. By default it is `NULL` and nothing is changed.
#' @param conf.int If `TRUE`, add the confidence interval. The default is
@@ -178,14 +193,14 @@ tabularise_default.glm <- function(data, footer = TRUE,
#' @param conf.level The confidence level to use for the confidence interval if
#' `conf.int = TRUE`. The default is 0.95.
#' @param lang The natural language to use. The default value can be set with,
-#' e.g., `options(data.io_lang = "fr")` for French.
+#' e.g., `options(SciViews_lang = "fr")` for French.
#' @param show.signif.stars If `TRUE`, add the significance stars to the table.
-#' Its value is obtained from `getOption("show.signif.stars")`.
-#' @param ... Additional arguments passed to [tabularise::equation()]
+#' The default is `getOption("show.signif.stars")`
+#' @param ... Additional arguments
#' @param kind The kind of table to produce: "tt" for tinytable, or "ft" for
#' flextable (default).
-#' @param env The environment where to evaluate lazyeval expressions (unused for
-#' now).
+#' @param env The environment where to evaluate formulas (you probably do not
+#' need to change the default).
#'
#' @return A **flextable** object is returned. You can print it in different
#' formats (HTML, LaTeX, Word, PowerPoint), or rearrange it with the
@@ -195,102 +210,40 @@ tabularise_default.glm <- function(data, footer = TRUE,
#' @importFrom rlang .data
#' @method tabularise_tidy glm
#' @examples
+#' #' # If the 'iris' dataset has labels and units, they can be used to enhance
+#' # the output table
+#' iris <- svBase::labelise(iris, self = FALSE, label = list(
+#' Sepal.Length = "Length of the sepals",
+#' Petal.Length = "Length of the petals",
+#' Species = "Species"), units = c(rep("cm", 4), NA))
#' iris_glm <- glm(data = iris, Petal.Length ~ Sepal.Length)
+#'
#' tabularise::tabularise$tidy(iris_glm)
+#' tabularise::tabularise$tidy(iris_glm, conf.int = TRUE)
+#' tabularise::tabularise$tidy(iris_glm, conf.int = TRUE, equation = NA)
tabularise_tidy.glm <- function(data, header = TRUE, title = NULL,
-equation = header, auto.labs = TRUE, origdata = NULL, labs = NULL,
-conf.int = FALSE, conf.level = 0.95, lang = getOption("data.io_lang", "en"),
-show.signif.stars = getOption("show.signif.stars", TRUE), ..., kind = "ft",
-env = parent.frame()) {
+ equation = header, auto.labs = TRUE, origdata = NULL, labs = NULL,
+ conf.int = FALSE, conf.level = 0.95, lang = getOption("SciViews_lang",
+ default = Sys.getenv("LANGUAGE",unset = "en")),
+ show.signif.stars = getOption("show.signif.stars", TRUE), ..., kind = "ft",
+ env = parent.frame()) {
# If title is not provided, determine if we have to use TRUE or FALSE
if (missing(title)) {
title <- header # Default to same as header, but...
- # if a caption is defined in the chunk, it defauts to FALSE
+ # if a caption is defined in the chunk, it defaults to FALSE
if (!is.null(knitr::opts_current$get('tbl-cap')))
title <- FALSE
}
- # Choose the language
- info_lang <- .infos_lang.glm(lang = lang)
-
- # Extract labels of data or origdata
- if (isTRUE(auto.labs)) {
- labs <- tabularise:::.labels2(x = data, origdata = origdata, labs = labs)
- } else {
- labs <- tabularise:::.labels2(x = NULL, labs = labs)
- }
-
- # Turn an object into a tidy tibble
- data_t <- as.data.frame(broom::tidy(x = data, conf.int = conf.int,
- conf.level = conf.level))
- rownames(data_t) <- data_t$term
-
- if (isTRUE(conf.int)) {
- data_t <- data_t[, c("term", "estimate", "conf.low", "conf.high",
- "std.error", "statistic", "p.value")]
- }
-
- s <- colnames(coef(summary(data)))
- if (any(s %in% "z value"))
- colnames(data_t)[colnames(data_t) == "statistic"] <- "statistic2"
-
- if (isTRUE(show.signif.stars)) {
- ft <- flextable(data_t, col_keys = c(names(data_t), "signif"))
- } else {
- ft <- flextable(data_t)
- }
- ft <- colformat_sci(ft)
- ft <- colformat_sci(ft, j = "p.value", lod = 2e-16)
-
- # Rename headers labels
- ft <- .header_labels(ft, info_lang = info_lang)
-
- # headers
- if (isTRUE(equation)) {
- if (!is.null(labs)) {
- equa <- equation(data, swap_var_names = labs, ...)
- } else {
- equa <- equation(data, auto.labs = FALSE, ...)
- }
-
- ft <- .add_header(ft, data = data, info_lang = info_lang, header = header,
- title = title, equation = equa)
- } else {
- equa <- NULL
- ft <- .add_header(ft, data = data, info_lang = info_lang, header = header,
- title = title, equation = equation)
- }
-
- if (isTRUE(auto.labs) && any(data_t$term %in% "(Intercept)")) {
- ft <- mk_par(ft, i = "(Intercept)", j = 1, part = "body",
- value = as_paragraph(info_lang[["(Intercept)"]]))
- }
-
- if (!is.null(labs)) {
- labs_red <- labs[names(labs) %in% data_t$term]
-
- for (i in seq_along(labs_red))
- ft <- mk_par(ft, i = names(labs_red)[i], j = 1,
- value = para_md(labs_red[i]), part = "body")
- }
-
- if (isTRUE(equation) && !is.null(equa)) {
- params <- .params_equa(equa)
- if (length(params) == length(data_t$term))
- ft <- mk_par(ft, j = "term", value = para_md(params), part = "body")
- }
-
- # Add information on the p.value
- if (ncol_keys(ft) > ncol(data_t))
- ft <- .add_signif_stars(ft, j = "signif")
-
- ft <- autofit(ft, part = c("header", "body"))
-
- if (isTRUE(show.signif.stars))
- ft <- width(ft, j = "signif", width = 0.4)
+ df_list <- .extract_infos_glm(
+ data, type = "tidy", conf.int = conf.int, conf.level = 0.95,
+ show.signif.stars = show.signif.stars, lang = lang, auto.labs = auto.labs,
+ origdata = origdata, labs = labs, equation = equation, title = title,
+ colnames = colnames_glm, footer = FALSE, ..., env = env)
- ft
+ # formatted table
+ format_table(df_list, kind = kind, header = header)
}
#' Create a glance version of the glm object as a rich-formatted table
@@ -301,25 +254,34 @@ env = parent.frame()) {
#' Word, PowerPoint), or rearranged later on.
#'
#' @param data A **glm** object
-#' @param header If `TRUE` (by default), add an header to the table
-#' @param title If `TRUE`, add a title to the table header. Default to the same
+#' @param header Logical. If `TRUE` (`TRUE` by default), a header is added to the table.
+#' The header includes both the title and the equation (if applicable).
+#' If set to `FALSE`, neither the title nor the equation will be displayed in
+#' the table header, even if the `title` or `equation` parameters are provided.
+#' @param title If `TRUE` (`TRUE` by default), add a title to the table header. Default to the same
#' value than header, except outside of a chunk where it is `FALSE` if a table
#' caption is detected (`tbl-cap` YAML entry).
-#' @param equation If `TRUE` (by default), add an equation to the table header.
-#' The equation can also be passed in the form of a character string (LaTeX).
+#' @param equation Logical or character. Controls whether an equation is added
+#' to the table header and how parameters are used. Accepted values are:
+#' - `TRUE` (default) : The equation is generated and added to the table
+#' header. Its parameters are also used in the "Term" column.
+#' - `FALSE`: No equation is generated or displayed, and its parameters are
+#' not used in the "Term" column.
+#' - Character string: A custom equation is provided directly and added to
+#' the table header.
#' @param auto.labs If `TRUE` (by default), use labels (and units) automatically
-#' from `origdata=`.
+#' from data or `origdata=`.
#' @param origdata The original data set this model was fitted to. By default it
-#' is `NULL` and original labels are not used.
+#' is `NULL` and no label is used.
#' @param labs Labels to change the names of elements in the `term` column of
#' the table. By default it is `NULL` and nothing is changed.
#' @param lang The natural language to use. The default value can be set with,
-#' e.g., `options(data.io_lang = "fr")` for French.
-#' @param ... Additional arguments passed to [tabularise::equation()]
+#' e.g., `options(SciViews_lang = "fr")` for French.
+#' @param ... Additional arguments passed to [equatiomatic::equation()]
#' @param kind The kind of table to produce: "tt" for tinytable, or "ft" for
#' flextable (default).
-#' @param env The environment where to evaluate lazyeval expressions (unused for
-#' now).
+#' @param env The environment where to evaluate formulas (you probably do not
+#' need to change the default).
#'
#' @return A **flextable** object is produced that you can print in different
#' formats (HTML, LaTeX, Word, PowerPoint) or rearrange with the \{flextable\}
@@ -330,71 +292,30 @@ env = parent.frame()) {
#' @examples
#' iris_glm <- glm(data = iris, Petal.Length ~ Sepal.Length)
#' tabularise::tabularise$glance(iris_glm)
-tabularise_glance.glm <- function(data, header = TRUE, title = NULL,
- equation = TRUE, auto.labs = TRUE, origdata = NULL, labs = NULL,
- lang = getOption("data.io_lang", "en"), ..., kind = "ft",
+#' tabularise::tabularise$glance(iris_glm, equation = FALSE)
+#' tabularise::tabularise$glance(iris_glm, equation = "my personal equation")
+#'
+tabularise_glance.glm <- function(data, header = TRUE, title = header,
+ equation = header, auto.labs = TRUE, origdata = NULL, labs = NULL,
+ lang = getOption("SciViews_lang", "en"), ..., kind = "ft",
env = parent.frame()) {
# If title is not provided, determine if we have to use TRUE or FALSE
if (missing(title)) {
title <- header # Default to same as header, but...
- # if a caption is defined in the chunk, it defauts to FALSE
+ # if a caption is defined in the chunk, it defaults to FALSE
if (!is.null(knitr::opts_current$get('tbl-cap')))
title <- FALSE
}
- # Choose the language
- info_lang <- .infos_lang.glm(lang = lang)
-
- # Extract labels off data or origdata
- if (isTRUE(auto.labs)) {
- labs <- tabularise:::.labels2(x = data, origdata = origdata, labs = labs)
- } else {
- labs <- tabularise:::.labels2(x = NULL, labs = labs)
- }
-
- # Turn an object into a tidy tibble
- data_t <- as.data.frame(broom::glance(x = data))
- rownames(data_t) <- data_t$term
-
- # Use flextable
- ft <- flextable(data_t)
- ft <- colformat_sci(ft)
- #ft <- colformat_sci(ft, j = "p.value", lod = 2e-16)
-
- # Rename headers labels
- ft <- .header_labels(ft, info_lang = info_lang)
-
- # Headers
- if (isTRUE(equation)) {
- if (!is.null(labs)) {
- equa <- equation(data, swap_var_names = labs, ...)
- } else {
- equa <- equation(data, auto.labs = FALSE, ...)
- }
-
- ft <- .add_header(ft, data = data, info_lang = info_lang, header = header,
- equation = equa)
- } else {
- equa <- NULL
- ft <- .add_header(ft, data = data, info_lang = info_lang, header = header,
- equation = equation)
- }
-
- if (isTRUE(auto.labs) && any(data_t$term %in% "(Intercept)")) {
- ft <- mk_par(ft, i = "(Intercept)", j = 1, part = "body",
- value = as_paragraph(info_lang[["(Intercept)"]]))
- }
-
- if (!is.null(labs)) {
- labs_red <- labs[names(labs) %in% data_t$term]
+ df_list <- .extract_infos_glm(
+ data, type = "glance", conf.int = FALSE, conf.level = 0.95,
+ show.signif.stars = FALSE, lang = lang, auto.labs = auto.labs,
+ origdata = origdata, labs = labs, equation = equation, title = title,
+ colnames = colnames_glm, footer = FALSE, ..., env = env)
- for (i in seq_along(labs_red))
- ft <- mk_par(ft, i = names(labs_red)[i], j = 1,
- value = para_md(labs_red[i]), part = "body")
- }
-
- autofit(ft, part = c("header", "body"))
+ # formatted table
+ format_table(df_list, kind = kind, header = header)
}
#' Create a rich-formatted table using the table of coefficients of the summary.glm object
@@ -404,10 +325,27 @@ tabularise_glance.glm <- function(data, header = TRUE, title = NULL,
#' from the [summary()] of a **glm** object.
#'
#' @param data A **summary.glm** object
-#' @param ... Additional arguments passed to [modelit::tabularise_tidy.glm()]
+#' @param header If `TRUE` (by default), add a header to the table
+#' @param title If `TRUE`, add a title to the table header. Default to the same
+#' value than header, except outside of a chunk where it is `FALSE` if a table
+#' caption is detected (`tbl-cap` YAML entry).
+#' @param equation If `TRUE` (by default), try to add a equation to the table
+#' header. The equation can also be passed in the form of a character string.
+#' @param auto.labs If `TRUE` (by default), use labels (and units) automatically
+#' from data or `origdata=`.
+#' @param origdata The original data set this model was fitted to. By default it
+#' is `NULL` and no label is used.
+#' @param labs Labels to change the names of elements in the `term` column of
+#' the table. By default it is `NULL` and nothing is changed.
+#' @param lang The natural language to use. The default value can be set with,
+#' e.g., `options(SciViews_lang = "fr")` for French.
+#' @param show.signif.stars If `TRUE`, add the significance stars to the table.
+#' The default is `getOption("show.signif.stars")`
+#' @param ... Additional arguments
#' @param kind The kind of table to produce: "tt" for tinytable, or "ft" for
#' flextable (default).
-#' @param env The environment where to evaluate the model.
+#' @param env The environment where to evaluate formulas (you probably do not
+#' need to change the default).
#'
#' @return A **flextable** object that you can print in different formats
#' (HTML, LaTeX, Word, PowerPoint) or rearrange with the \{flextable\}
@@ -419,14 +357,29 @@ tabularise_glance.glm <- function(data, header = TRUE, title = NULL,
#' @examples
#' iris_glm <- glm(data = iris, Petal.Length ~ Sepal.Length)
#' iris_glm_sum <- summary(iris_glm)
-#' tabularise::tabularise$coef(iris_glm_sum)
-tabularise_coef.summary.glm <- function(data, ..., kind = "ft",
+#' tabularise::tabularise_coef(iris_glm_sum)
+tabularise_coef.summary.glm <- function(data, header = TRUE, title = NULL,
+ equation = header, auto.labs = TRUE, origdata = NULL, labs = NULL,
+ lang = getOption("SciViews_lang", default = Sys.getenv("LANGUAGE",unset = "en")),
+ show.signif.stars = getOption("show.signif.stars", TRUE), ..., kind = "ft",
env = parent.frame()) {
- lm_original <- data$call
- data <- eval(lm_original, envir = env)
+ # If title is not provided, determine if we have to use TRUE or FALSE
+ if (missing(title)) {
+ title <- header # Default to same as header, but...
+ # if a caption is defined in the chunk, it defaults to FALSE
+ if (!is.null(knitr::opts_current$get('tbl-cap')))
+ title <- FALSE
+ }
+
+ df_list <- .extract_infos_glm(
+ data, type = "coef", conf.int = FALSE, conf.level = 0.95,
+ show.signif.stars = show.signif.stars, lang = lang, auto.labs = auto.labs,
+ origdata = origdata, labs = labs, equation = equation, title = title,
+ colnames = colnames_glm, footer = FALSE, ..., env = env)
- tabularise_tidy.glm(data = data, ..., kind = kind, env = env)
+ # formatted table
+ format_table(df_list, kind = kind, header = header)
}
#' Create a rich-formatted table from a summary.glm object
@@ -435,13 +388,28 @@ tabularise_coef.summary.glm <- function(data, ..., kind = "ft",
#' Create a rich-formatted table version of the [summary()] of a **glm** object.
#'
#' @param data A **summary.glm** object
-#' @param footer If `TRUE` (by default), add a footer to the table
+#' @param header If `TRUE` (by default), add a header to the table
+#' @param title If `TRUE`, add a title to the table header. Default to the same
+#' value than header, except outside of a chunk where it is `FALSE` if a table
+#' caption is detected (`tbl-cap` YAML entry).
+#' @param equation If `TRUE` (by default), try to add a equation to the table
+#' header. The equation can also be passed in the form of a character string.
+#' @param auto.labs If `TRUE` (by default), use labels (and units) automatically
+#' from data or `origdata=`.
+#' @param origdata The original data set this model was fitted to. By default it
+#' is `NULL` and no label is used.
+#' @param labs Labels to change the names of elements in the `term` column of
+#' the table. By default it is `NULL` and nothing is changed.
#' @param lang The natural language to use. The default value can be set with,
-#' e.g., `options(data.io_lang = "fr")` for French.
-#' @param ... Additional arguments passed to [modelit::tabularise_coef.summary.glm()]
+#' e.g., `options(SciViews_lang = "fr")` for French.
+#' @param show.signif.stars If `TRUE`, add the significance stars to the table.
+#' The default is `getOption("show.signif.stars")`
+#' @param footer If `TRUE` (by default), add a footer to the table
+#' @param ... Additional arguments
#' @param kind The kind of table to produce: "tt" for tinytable, or "ft" for
#' flextable (default).
-#' @param env The environment where to evaluate the model.
+#' @param env The environment where to evaluate formulas (you probably do not
+#' need to change the default).
#'
#' @return A **flextable** object that you can print in different form or
#' rearrange with the \{flextable\} functions.
@@ -454,148 +422,227 @@ tabularise_coef.summary.glm <- function(data, ..., kind = "ft",
#' iris_glm <- glm(data = iris, Petal.Length ~ Sepal.Length)
#' iris_glm_sum <- summary(iris_glm)
#' tabularise::tabularise(iris_glm_sum)
-tabularise_default.summary.glm <- function(data, footer = TRUE,
- lang = getOption("data.io_lang", "en"), ..., kind = "ft",
- env = parent.frame()) {
+tabularise_default.summary.glm <- function(data, header = TRUE, title = NULL,
+ equation = header, auto.labs = TRUE, origdata = NULL, labs = NULL,
+ lang = getOption("SciViews_lang", default = Sys.getenv("LANGUAGE",unset = "en")),
+ show.signif.stars = getOption("show.signif.stars", TRUE), footer = TRUE,
+ ..., kind = "ft", env = parent.frame()) {
+
+ # If title is not provided, determine if we have to use TRUE or FALSE
+ if (missing(title)) {
+ title <- header # Default to same as header, but...
+ # if a caption is defined in the chunk, it defaults to FALSE
+ if (!is.null(knitr::opts_current$get('tbl-cap')))
+ title <- FALSE
+ }
- ft <- tabularise_coef.summary.glm(data = data, lang = lang,..., kind = kind,
- env = env)
+ df_list <- .extract_infos_glm(
+ data, type = "coef", conf.int = FALSE, conf.level = 0.95,
+ show.signif.stars = show.signif.stars, lang = lang, auto.labs = auto.labs,
+ origdata = origdata, labs = labs, equation = equation, title = title,
+ colnames = colnames_glm, footer = footer, ..., env = env)
- if (isTRUE(footer)) {
- info_lang <- .infos_lang.glm(lang = lang)
-
- digits <- max(3L, getOption("digits") - 3L)
- footer <- info_lang[["footer"]]
- vals <- c(
- paste0("(", footer[["dispersion"]], " ", footer[[data$family$family]],
- ": ", format(signif(data$dispersion, digits)), ")"),
- paste(footer[["null.deviance"]],
- format(signif(data$null.deviance, digits)), footer[["on"]],
- data$df.null, footer[["df2"]]),
- paste(footer[["resid.deviance"]],
- format(signif(data$deviance, digits)), footer[["on"]],
- max(data$df), footer[["df2"]]),
- paste(footer[["AIC"]], format(signif(data$aic, digits)), " - ",
- footer[["iter"]], data$iter)
+ # formatted table
+ format_table(df_list, kind = kind, header = header)
+}
+
+# A list of internals functions
+
+colnames_glm <- c(
+ term = "Term",
+ estimate = "Estimate",
+ conf.low = "Lower bound (CI)",
+ conf.high = "Upper bound (CI)",
+ std.error = "Standard Error",
+ t.value = "*t* value",
+ sigma = "Sigma",# The misnomer “Residual standard error”
+ r.squared = "R^2^",
+ adj.r.squared = "Adj.R^2^",
+ AIC = "AIC",
+ BIC = "BIC",
+ statistic = "*t* value",
+ statistic2 = "*z* value",
+ p.value = "*p* value",
+ deviance = "Deviance",
+ logLik = "Log-Likelihood",
+ null.deviance = "Total deviance",
+ df.null = "Total df",
+ df = "Num. df",
+ df.residual = "Residuals df",
+ nobs = "N",
+ signif = "",
+ "(Intercept)" = "Intercept")
+
+.trads <- gettext(
+ term = "Term",
+ estimate = "Estimate",
+ conf.low = "Lower bound (CI)",
+ conf.high = "Upper bound (CI)",
+ std.error = "Standard Error",
+ t.value = "*t* value",
+ sigma = "Sigma",# The misnomer “Residual standard error”
+ r.squared = "R^2^",
+ adj.r.squared = "Adj.R^2^",
+ AIC = "AIC",
+ BIC = "BIC",
+ statistic = "*t* value",
+ statistic2 = "*z* value",
+ p.value = "*p* value",
+ deviance = "Deviance",
+ logLik = "Log-Likelihood",
+ null.deviance = "Total deviance",
+ df.null = "Total df",
+ df = "Num. df",
+ df.residual = "Residuals df",
+ nobs = "N",
+ "(Intercept)" = "Intercept",
+ header = "Generalized Linear Model",
+ lang = "fr")
+
+# See utils.R for internal functions used by various .extract_infos_***
+
+.extract_footer_glm <- function(data, lang = "en") {
+ digits <- max(3L, getOption("digits") - 3L)
+ domain <- "R-modelit"
+
+ if (inherits(data, "summary.glm")) {
+ footer_glm <- c(gaussian = "Gaussian family", binomial = "Binomial family",
+ Gamma = "Gamma family", inverse.gaussian = "Inverse Gaussian family",
+ poisson = "Poisson family",
+ quasi = "Quasi-Gaussian family",
+ quasibinomial = "Quasi-Binomial family",
+ quasipoisson = "Quasi-Poisson family")
+ family_glm <- gettext(footer_glm[data$family$family], lang = lang)
+
+ res <- paste(
+ gettextf("(Dispersion parameter for %s: %.*g)", family_glm, digits,
+ data$dispersion, domain = domain, lang = lang),
+ gettextf("Total deviance: %.*g on %.*g degrees of freedom", digits,
+ data$null.deviance, digits, data$df.null, domain = domain, lang = lang),
+ gettextf("Residual deviance: %.*g on %.*g degrees of freedom", digits,
+ data$deviance, digits, max(data$df), domain = domain, lang = lang),
+ gettextf("AIC: %.*g - Number of Fisher Scoring iterations: %.*g", digits,
+ data$aic, digits, max(data$iter), domain = domain, lang = lang),
+ sep = "\n")
+ res
+ } else {
+ res <- paste(
+ gettextf("Degrees of Freedom: %.*g Total (i.e. no model); %.*g Residual",
+ digits, data$df.null, digits, data$df.residual, domain = domain,
+ lang = lang),
+ gettextf("Total deviance: %.*g", digits, data$null.deviance,
+ domain = domain, lang = lang),
+ gettextf("Residual deviance: %.*g AIC: %.*g",digits, data$deviance,
+ digits, data$ai, domain = domain, lang = lang),
+ sep = "\n")
+ res
+ }
+}
+
+.extract_infos_glm <- function(data, type = "coef", conf.int = FALSE,
+ conf.level = 0.95, show.signif.stars = TRUE, lang = "en",
+ colnames = colnames_glm, auto.labs = TRUE, origdata = NULL, labs = NULL,
+ equation = TRUE, title = TRUE, footer = TRUE, env = parent.frame()) {
+
+ if (!inherits(data, c("glm", "summary.glm")))
+ stop(".extract_infos_glm() can apply only glm and summary.glm object.")
+
+ type <- match.arg(type, choices = c("coef", "glance", "tidy"))
+
+ if (inherits(data, "summary.glm") && type != "coef") {
+ #TODO: Implement support for type = "glance" and type = "coef"
+ message(".extract_infos_glm() can only apply type = 'coef' to a summary.glm object.")
+ #type <- "tidy"
+ }
+
+ if (inherits(data, "summary.glm")) {
+ s <- data$coefficients
+ df <- data.frame(term = rownames(s), s)
+ colnames(df) <- c("term", "estimate", "std.error", "statistic", "p.value")
+
+ if (any(colnames(s) %in% "z value"))
+ colnames(df)[colnames(df) == "statistic"] <- "statistic2"
+
+ rownames(df) <- df$term
+
+ } else {
+ df <- switch(type,
+ coef = {
+ df <- coef(data)
+ df <- data.frame(term = names(df), estimate = df)},
+ glance = {
+ df <- as.data.frame(broom::glance(x = data))
+ rownames(df) <- df$term
+ df},
+ tidy = {
+ df <- as.data.frame(broom::tidy(x = data, conf.int = conf.int,
+ conf.level = conf.level))
+ rownames(df) <- df$term
+
+ s <- colnames(coef(summary(data)))
+ if (any(s %in% "z value"))
+ colnames(df)[colnames(df) == "statistic"] <- "statistic2"
+
+ if (isTRUE(conf.int)) {
+ df <- df[, c("term", "estimate", "conf.low", "conf.high",
+ "std.error", "statistic", "p.value")]
+ }
+
+ if (isTRUE(show.signif.stars))
+ df$signif <- .pvalue_format(df$p.value)
+ df}
)
- ft <- add_footer_lines(ft, top = FALSE, values = para_md(vals))
- ft <- align(ft, i = seq_len(length(vals)) + 1 , align = "left",
- part = "footer")
}
- autofit(ft, part = c("header", "body"))
-}
+ if (isTRUE(show.signif.stars)) {
+ psignif <- "0 <= '***' < 0.001 < '**' < 0.01 < '*' < 0.05"
+ } else {
+ psignif <- NULL
+ }
-# Choose the lang and the infos_lang
-.infos_lang.glm <- function(lang) {
lang <- tolower(lang)
+ cols <- .extract_colnames(df, labs = colnames_glm, lang = lang)
+
+ data_obj <- attr(data, "object")
- if (lang != "fr") lang <- "en" # Only en or fr for now
+ if (is.null(data_obj)) {
+ labels <- .extract_labels(df = df, data = data, auto.labs = auto.labs,
+ origdata = origdata, labs = labs)
+
+ equa <- .extract_equation(data, equation = equation, labs = labels)
- if (lang == "fr") {
- info_lang <- infos_fr.glm
} else {
- info_lang <- infos_en.glm
+ labels <- .extract_labels(df = df, data = data_obj, auto.labs = auto.labs,
+ origdata = origdata, labs = labs)
+
+ equa <- .extract_equation(data_obj, equation = equation, labs = labels)
}
- info_lang
-}
+ if ((isTRUE(equation) || is.na(equation)) && !is.null(equa)) {
+ terms <- .params_equa(equa)
+ } else {
+ terms <- .extract_terms(df, labs = labels, lang = lang)
+ }
-infos_en.glm <- list(
- labs = c(
- term = "Term",
- estimate = "Estimate",
- conf.low = "Lower bound (CI)",
- conf.high = "Upper bound (CI)",
- std.error = "Standard Error",
- t.value = "*t* value",
- sigma = "RSE",
- r.squared = "R^2^",
- adj.r.squared = "Adj.R^2^",
- AIC = "AIC",
- BIC = "BIC",
- statistic = "*t* value",
- statistic2 = "*z* value",
- p.value = "*p* value",
- deviance = "Deviance",
- logLik = "Log-Likelihood",
- null.deviance = "Total deviance",
- df.null = "Total df",
- df = "Num. df",
- df.residual = "Residuals df",
- nobs = "N",
- "(Intercept)" = "Intercept"),
- footer = c(
- "df" = "Degrees of freedom:",
- "total" = "Total (i.e. no model)",
- "residual" = "Residual",
- "dispersion" = "Dispersion parameter for",
- # Various choices for family
- gaussian = "Gaussian family",
- binomial = "Binomial family",
- Gamma = "Gamma family",
- inverse.gaussian = "Inverse Gaussian family",
- poisson = "Poisson family",
- quasi = "Quasi-Gaussian family",
- quasibinomial = "Quasi-Binomial family",
- quasipoisson = "Quasi-Poisson family",
- "null.deviance" = "Total deviance:",
- "on" = "on",
- "df2" = "degrees of freedom",
- "resid.deviance" = "Residual deviance:",
- AIC = "AIC:",
- "iter" = "Number of Fisher Scoring iterations:"),
- "(Intercept)" = "Intercept",
- "summary" = "Model summary",
- "header" = "Generalized Linear Model"
-)
-
-infos_fr.glm <- list(
- labs = c(
- term = "Terme",
- estimate = "Valeur estim\u00e9e",
- conf.low = "Limite basse (IC)",
- conf.high = "Limite haute (IC)",
- std.error = "Ecart type",
- t.value = "Valeur de *t*",
- p.value = "Valeur de *p*",
- sigma = "RSE",
- r.squared = "R^2^",
- adj.r.squared = "R^2^ ajust\u00e9",
- deviance = "D\u00e9viance",
- logLik = "Log-vraisemblance",
- null.deviance = "D\u00e9viance totale",
- df.null = "Ddl totaux",
- AIC = "AIC",
- BIC = "BIC",
- statistic = "Valeur de *t*",
- statistic2 = "Valeur de *z*",
- df = "Ddl mod\u00e8le",
- df.residual = "Ddl r\u00e9sidus",
- nobs = "N",
- "(Intercept)" = "Ordonn\u00e9e \u00e0 l'origine"
- ),
- footer = c(
- "df" = "Degr\u00e9s de libert\u00e9 :",
- "total" = "Totaux (i.e., hors mod\u00e8le)",
- "residual" = "R\u00e9sidus",
- "dispersion" = "Param\u00e8tre de dispersion pour une",
- # Various choices for family
- gaussian = "famille Gaussienne",
- binomial = "famille Binomiale",
- Gamma = "famille Gamma",
- inverse.gaussian = "famille Gaussienne inverse",
- poisson = "famille Poisson",
- quasi = "famille Quasi-Gaussienne",
- quasibinomial = "famille Quasi-Binomiale",
- quasipoisson = "famille Quasi-Poisson",
- "null.deviance" = "D\u00e9viance totale :",
- "on" = "pour",
- "df2" = "degr\u00e9s de libert\u00e9",
- "resid.deviance" = "D\u00e9viance r\u00e9siduelle :",
- AIC = "AIC :",
- "iter" = "Nombre d'it\u00e9rations de la fonction de score de Fisher:"),
- "(Intercept)" = "Ordonn\u00e9e \u00e0 l'origine",
- "summary" = "R\u00e9sum\u00e9 du mod\u00e8le",
- "header" = "Mod\u00e8le lin\u00e9aire g\u00e9n\u00e9ralis\u00e9"
-)
+ if (is.na(equation))
+ equa <- NULL
+
+ title <- .extract_title(title, lang, default = "Generalized Linear Model")
+
+ if (isTRUE(footer)) {
+ footer <- .extract_footer_glm(data, lang)
+ } else {
+ footer <- NULL
+ }
+
+ list(
+ df = df,
+ title = title,
+ cols = cols,
+ equa = equa,
+ terms = terms,
+ psignif = psignif,
+ footer = footer
+ )
+
+}
diff --git a/R/tabularise.lm.R b/R/tabularise.lm.R
index d3b28d2..a171a7d 100644
--- a/R/tabularise.lm.R
+++ b/R/tabularise.lm.R
@@ -6,12 +6,24 @@
#' \{flextable\}.
#'
#' @param data An **lm** object
-#' @param header If `TRUE` (by default), add a header to the table
-#' @param title If `TRUE`, add a title to the table header. Default to the same
-#' value than header, except outside of a chunk where it is `FALSE` if a table
-#' caption is detected (`tbl-cap` YAML entry).
-#' @param equation If `TRUE` (by default), add a equation to the table header.
-#' The equation can also be passed in the form of a character string.
+#' @param header Logical. If `TRUE` (`FALSE`by default), a header is added to
+#' the table. The header includes both the title and the equation (if
+#' applicable). If set to `FALSE`, neither the title nor the equation will be
+#' displayed in the table header, even if the `title` or `equation` parameters
+#' are provided.
+#' @param title If `TRUE` (`FALSE`by default) , add a title to the table header.
+#' Default to the same value than header, except outside of a chunk where it is
+#' `FALSE` if a table caption is detected (`tbl-cap` YAML entry).
+#' @param equation Logical or character. Controls whether an equation is added
+#' to the table header and how parameters are used. Accepted values are:
+#' - `TRUE`: The equation is generated and added to the table header. Its
+#' parameters are also used in the "Term" column.
+#' - `FALSE` (by default): No equation is generated or displayed, and its
+#' parameters are not used in the "Term" column.
+#' - `NA`: The equation is generated but not displayed in the table header.
+#' Its parameters are used in the "Term" column.
+#' - Character string: A custom equation is provided directly and added to
+#' the table header.
#' @param auto.labs If `TRUE` (by default), use labels (and units) automatically
#' from data or `origdata=`.
#' @param origdata The original data set this model was fitted to. By default it
@@ -19,12 +31,10 @@
#' @param labs Labels to change the names of elements in the `term` column of
#' the table. By default it is `NULL` and nothing is changed.
#' @param lang The natural language to use. The default value can be set with,
-#' e.g., `options(data.io_lang = "fr")` for French.
+#' e.g., `options(SciViews_lang = "fr")` for French.
#' @param ... Additional arguments
#' @param kind The kind of table to produce: "tt" for tinytable, or "ft" for
#' flextable (default).
-#' @param env The environment where to evaluate lazyeval expressions (unused for
-#' now).
#'
#' @return A **flextable** object that you can print in different formats
#' (HTML, LaTeX, Word, PowerPoint) or rearrange with the \{flextable\}
@@ -34,12 +44,31 @@
#' @importFrom knitr opts_current
#' @method tabularise_coef lm
#' @examples
+#' data(iris)
+#' # Fit a simple linear model: Petal.Length as a function of Sepal.Length
#' iris_lm <- lm(data = iris, Petal.Length ~ Sepal.Length)
#' tabularise::tabularise$coef(iris_lm)
-tabularise_coef.lm <- function(data, header = TRUE, title = NULL,
+#'
+#' # If the 'iris' dataset has labels and units, they can be used to enhance
+#' # the output table
+#' iris <- svBase::labelise(iris, self = FALSE, label = list(
+#' Sepal.Length = "Length of the sepals",
+#' Petal.Length = "Length of the petals",
+#' Species = "Species"), units = c(rep("cm", 4), NA))
+#'
+#' iris_lm1 <- lm(data = iris, Petal.Length ~ Sepal.Length + Species)
+#' tabularise::tabularise$coef(iris_lm1)
+#'
+#' # The same table but without showing the model equation
+#' tabularise::tabularise$coef(iris_lm, equation = FALSE)
+#'
+#' iris_lm2 <- lm(data = iris, Petal.Length ~ Sepal.Length * Species)
+#' tabularise::tabularise$coef(iris_lm2)
+#'
+tabularise_coef.lm <- function(data, header = FALSE, title = header,
equation = header, auto.labs = TRUE, origdata = NULL, labs = NULL,
- lang = getOption("data.io_lang", "en"), ..., kind = "ft",
- env = parent.frame()) {
+ lang = getOption("SciViews_lang", default = Sys.getenv("LANGUAGE",unset = "en")),
+ ..., kind = "ft") {
# If title is not provided, determine if we have to use TRUE or FALSE
if (missing(title)) {
@@ -49,61 +78,14 @@ tabularise_coef.lm <- function(data, header = TRUE, title = NULL,
title <- FALSE
}
- # Choose the language
- info_lang <- .infos_lang.lm(lang = lang)
-
- # Extract coefficients
- co <- coef(data)
- co <- data.frame(term = names(co), estimate = co)
- # co <- as.data.frame(rbind(coef(data)))
-
- if (isTRUE(auto.labs)) {
- labs <- tabularise:::.labels2(x = data, origdata = origdata, labs = labs)
- } else {
- labs <- tabularise:::.labels2(x = NULL, labs = labs)
- }
-
- # Create the flextable object
- ft <- flextable(co) |>
- colformat_sci()
- ft <- .header_labels(ft, info_lang = info_lang)
-
- # Header and equation
- if (isTRUE(equation)) {
- if (!is.null(labs)) {
- equa <- equation(data, swap_var_names = labs, ...)
- } else {
- equa <- equation(data, auto.labs = FALSE, ...)
- }
-
- ft <- .add_header(ft, data = data, info_lang = info_lang, header = header,
- title = title, equation = equa)
- } else {
- equa <- NULL
- ft <- .add_header(ft, data = data, info_lang = info_lang, header = header,
- title = title, equation = equation)
- }
-
- if (isTRUE(auto.labs) && any(co$term %in% "(Intercept)")) {
- ft <- mk_par(ft, i = "(Intercept)", j = 1, part = "body",
- value = as_paragraph(info_lang[["(Intercept)"]]))
- }
-
- if (!is.null(labs)) {
- labs_red <- labs[names(labs) %in% co$term]
-
- for (i in seq_along(labs_red))
- ft <- mk_par(ft, i = names(labs_red)[i], j = "term",
- value = para_md(labs_red[i]), part = "body")
- }
+ df_list <- .extract_infos_lm(
+ data, type = "coef", conf.int = FALSE, conf.level = 0.95,
+ show.signif.stars = FALSE, lang = lang, auto.labs = auto.labs,
+ origdata = origdata, labs = labs, equation = equation, title = title,
+ colnames = colnames_lm, footer = FALSE)
- if (isTRUE(equation) & !is.null(equa)) {
- params <- .params_equa(equa,...)
- if (length(params) == length(co$term))
- ft <- mk_par(ft, j = "term", value = para_md(params), part = "body")
- }
-
- autofit(ft, part = c("header", "body"))
+ # formatted table
+ format_table(df_list, kind = kind, header = header)
}
#' Create a rich-formatted table from an lm object
@@ -116,7 +98,6 @@ tabularise_coef.lm <- function(data, header = TRUE, title = NULL,
#' @param ... Additional arguments passed to [modelit::tabularise_coef.lm()]
#' @param kind The kind of table to produce: "tt" for tinytable, or "ft" for
#' flextable (default).
-#' @param env The environment where to evaluate the model.
#' @return A **flextable** object that you can print in different formats (HTML,
#' LaTeX, Word, PowerPoint) or rearrange with the \{flextable\} functions.
#' @export
@@ -125,10 +106,10 @@ tabularise_coef.lm <- function(data, header = TRUE, title = NULL,
#' @examples
#' iris_lm <- lm(data = iris, Petal.Length ~ Sepal.Length)
#' tabularise::tabularise(iris_lm)
-tabularise_default.lm <- function(data, ..., kind = "ft", env = parent.frame()) {
+tabularise_default.lm <- function(data, ..., kind = "ft") {
# Note: there isn't much in print(lm_obj) than the table of coefficients
# so, we produce the same table as tabularise$coef() here
- tabularise_coef.lm(data = data, ..., kind = kind, env = env)
+ tabularise_coef.lm(data = data, ..., kind = kind)
}
#' Tidy version of the lm object into a flextable object
@@ -138,12 +119,24 @@ tabularise_default.lm <- function(data, ..., kind = "ft", env = parent.frame())
#' object.
#'
#' @param data An **lm** object
-#' @param header If `TRUE` (by default), add an header to the table
-#' @param title If `TRUE`, add a title to the table header. Default to the same
-#' value than header, except outside of a chunk where it is `FALSE` if a table
-#' caption is detected (`tbl-cap` YAML entry).
-#' @param equation If `TRUE` (by default), add an equation to the table header.
-#' The equation can also be passed in the form of a character string (LaTeX).
+#' @param header Logical. If `TRUE` (`TRUE`by default), a header is added to
+#' the table. The header includes both the title and the equation (if
+#' applicable). If set to `FALSE`, neither the title nor the equation will be
+#' displayed in the table header, even if the `title` or `equation` parameters
+#' are provided.
+#' @param title If `TRUE` (by default) , add a title to the table header.
+#' Default to the same value than header, except outside of a chunk where it is
+#' `FALSE` if a table caption is detected (`tbl-cap` YAML entry).
+#' @param equation Logical or character. Controls whether an equation is added
+#' to the table header and how parameters are used. Accepted values are:
+#' - `TRUE`(by default): The equation is generated and added to the table
+#' header. Its parameters are also used in the "Term" column.
+#' - `FALSE`: No equation is generated or displayed, and its
+#' parameters are not used in the "Term" column.
+#' - `NA`: The equation is generated but not displayed in the table header.
+#' Its parameters are used in the "Term" column.
+#' - Character string: A custom equation is provided directly and added to
+#' the table header.
#' @param auto.labs If `TRUE` (by default), use labels (and units) automatically
#' from data or `origdata=`.
#' @param origdata The original data set this model was fitted to. By default it
@@ -155,14 +148,12 @@ tabularise_default.lm <- function(data, ..., kind = "ft", env = parent.frame())
#' @param conf.level The confidence level to use for the confidence interval if
#' `conf.int = TRUE`. The default is 0.95.
#' @param lang The natural language to use. The default value can be set with,
-#' e.g., `options(data.io_lang = "fr")` for French.
+#' e.g., `options(SciViews_lang = "fr")` for French.
#' @param show.signif.stars If `TRUE`, add the significance stars to the table.
#' The default is `getOption("show.signif.stars")`
-#' @param ... Additional arguments passed to [tabularise::equation()]
+#' @param ... Additional arguments passed to [equatiomatic::equation()]
#' @param kind The kind of table to produce: "tt" for tinytable, or "ft" for
#' flextable (default).
-#' @param env The environment where to evaluate lazyeval expressions (unused for
-#' now).
#'
#' @return A **flextable** object that you can print in different formats (HTML,
#' LaTeX, Word, PowerPoint) or rearrange with the \{flextable\} functions.
@@ -173,11 +164,10 @@ tabularise_default.lm <- function(data, ..., kind = "ft", env = parent.frame())
#' @examples
#' iris_lm <- lm(data = iris, Petal.Length ~ Sepal.Length)
#' tabularise::tabularise$tidy(iris_lm)
-tabularise_tidy.lm <- function(data, header = TRUE, title = NULL,
+tabularise_tidy.lm <- function(data, header = TRUE, title = header,
equation = header, auto.labs = TRUE, origdata = NULL, labs = NULL,
- conf.int = FALSE, conf.level = 0.95, lang = getOption("data.io_lang", "en"),
- show.signif.stars = getOption("show.signif.stars", TRUE), ..., kind = "ft",
- env = parent.frame()) {
+ conf.int = FALSE, conf.level = 0.95, lang = getOption("SciViews_lang", "en"),
+ show.signif.stars = getOption("show.signif.stars", TRUE), ..., kind = "ft") {
# If title is not provided, determine if we have to use TRUE or FALSE
if (missing(title)) {
@@ -187,81 +177,15 @@ tabularise_tidy.lm <- function(data, header = TRUE, title = NULL,
title <- FALSE
}
- # Choose the language
- info_lang <- .infos_lang.lm(lang = lang)
-
- # Extract labels off data or origdata
- if (isTRUE(auto.labs)) {
- labs <- tabularise:::.labels2(x = data, origdata = origdata, labs = labs)
- } else {
- labs <- tabularise:::.labels2(x = NULL, labs = labs)
- }
-
- # Turn an object into a tidy tibble
- data_t <- as.data.frame(broom::tidy(x = data, conf.int = conf.int,
- conf.level = conf.level))
- rownames(data_t) <- data_t$term
+ df_list <- .extract_infos_lm(
+ data, type = "tidy", conf.int = conf.int, conf.level = 0.95,
+ show.signif.stars = show.signif.stars, lang = lang, auto.labs = auto.labs,
+ origdata = origdata, labs = labs, equation = equation, title = title,
+ colnames = colnames_lm, footer = FALSE, ...)
- if (isTRUE(conf.int)) {
- data_t <- data_t[, c("term", "estimate", "conf.low", "conf.high",
- "std.error", "statistic", "p.value")]
- }
- # Use flextable
- if (isTRUE(show.signif.stars)) {
- ft <- flextable(data_t, col_keys = c(names(data_t), "signif"))
- } else {
- ft <- flextable(data_t)
- }
- ft <- colformat_sci(ft)
- ft <- colformat_sci(ft, j = "p.value", lod = 2e-16)
-
- # Rename headers labels
- ft <- .header_labels(ft, info_lang = info_lang)
-
- # Headers
- if (isTRUE(equation)) {
- if (!is.null(labs)) {
- equa <- equation(data, swap_var_names = labs, ...)
- } else {
- equa <- equation(data, auto.labs = FALSE, ...)
- }
-
- ft <- .add_header(ft, data = data, info_lang = info_lang, header = header,
- title = title, equation = equa)
- } else {
- equa <- NULL
- ft <- .add_header(ft, data = data, info_lang = info_lang, header = header,
- title = title, equation = equation)
- }
-
- if (isTRUE(auto.labs) && any(data_t$term %in% "(Intercept)")) {
- ft <- mk_par(ft, i = "(Intercept)", j = 1, part = "body",
- value = as_paragraph(info_lang[["(Intercept)"]]))
- }
-
- if (!is.null(labs)) {
- labs_red <- labs[names(labs) %in% data_t$term]
-
- for (i in seq_along(labs_red))
- ft <- mk_par(ft, i = names(labs_red)[i], j = 1,
- value = para_md(labs_red[i]), part = "body")
- }
-
- if (isTRUE(equation) && !is.null(equa)) {
- params <- .params_equa(equa)
- if (length(params) == length(data_t$term))
- ft <- mk_par(ft, j = "term", value = para_md(params), part = "body")
- }
-
- # Add information on the p.value
- if (ncol_keys(ft) > ncol(data_t))
- ft <- .add_signif_stars(ft, j = "signif")
-
- ft <- autofit(ft, part = c("header", "body"))
- if (isTRUE(show.signif.stars))
- ft <- width(ft, j = "signif", width = 0.4)
- ft
+ # formatted table
+ format_table(df_list, kind = kind, header = header)
}
#' Glance version of the lm object into a flextable object
@@ -271,12 +195,24 @@ tabularise_tidy.lm <- function(data, header = TRUE, title = NULL,
#' object.
#'
#' @param data An **lm** object
-#' @param header If `TRUE` (by default), add a header to the table
-#' @param title If `TRUE`, add a title to the table header. Default to the same
-#' value than header, except outside of a chunk where it is `FALSE` if a table
-#' caption is detected (`tbl-cap` YAML entry).
-#' @param equation If `TRUE` (by default), add a equation to the table header.
-#' The equation can also be passed in the form of a character string (LaTeX).
+#' @param header Logical. If `TRUE` (`TRUE`by default), a header is added to
+#' the table. The header includes both the title and the equation (if
+#' applicable). If set to `FALSE`, neither the title nor the equation will be
+#' displayed in the table header, even if the `title` or `equation` parameters
+#' are provided.
+#' @param title If `TRUE` (by default) , add a title to the table header.
+#' Default to the same value than header, except outside of a chunk where it is
+#' `FALSE` if a table caption is detected (`tbl-cap` YAML entry).
+#' @param equation Logical or character. Controls whether an equation is added
+#' to the table header and how parameters are used. Accepted values are:
+#' - `TRUE`(by default): The equation is generated and added to the table
+#' header. Its parameters are also used in the "Term" column.
+#' - `FALSE`: No equation is generated or displayed, and its
+#' parameters are not used in the "Term" column.
+#' - `NA`: The equation is generated but not displayed in the table header.
+#' Its parameters are used in the "Term" column.
+#' - Character string: A custom equation is provided directly and added to
+#' the table header.
#' @param auto.labs If `TRUE` (by default), use labels (and units) automatically
#' from data or `origdata=`.
#' @param origdata The original data set this model was fitted to. By default it
@@ -284,12 +220,10 @@ tabularise_tidy.lm <- function(data, header = TRUE, title = NULL,
#' @param labs Labels to change the names of elements in the `term` column of
#' the table. By default it is `NULL` and nothing is changed.
#' @param lang The natural language to use. The default value can be set with,
-#' e.g., `options(data.io_lang = "fr")` for French.
-#' @param ... Additional arguments passed to [tabularise::equation()]
+#' e.g., `options(SciViews_lang = "fr")` for French.
+#' @param ... Additional arguments passed to [equatiomatic::equation()]
#' @param kind The kind of table to produce: "tt" for tinytable, or "ft" for
#' flextable (default).
-#' @param env The environment where to evaluate lazyeval expressions (unused for
-#' now).
#'
#' @return A **flextable** object that you can print in different form or
#' rearrange with the \{flextable\} functions.
@@ -299,10 +233,9 @@ tabularise_tidy.lm <- function(data, header = TRUE, title = NULL,
#' @examples
#' iris_lm <- lm(data = iris, Petal.Length ~ Sepal.Length)
#' tabularise::tabularise$glance(iris_lm)
-tabularise_glance.lm <- function(data, header = TRUE, title = NULL,
- equation = TRUE, auto.labs = TRUE, origdata = NULL, labs = NULL,
- lang = getOption("data.io_lang", "en"), ..., kind = "ft",
- env = parent.frame()) {
+tabularise_glance.lm <- function(data, header = TRUE, title = header,
+ equation = header, auto.labs = TRUE, origdata = NULL, labs = NULL,
+ lang = getOption("SciViews_lang", "en"), ..., kind = "ft") {
# If title is not provided, determine if we have to use TRUE or FALSE
if (missing(title)) {
@@ -312,66 +245,56 @@ tabularise_glance.lm <- function(data, header = TRUE, title = NULL,
title <- FALSE
}
- # Choose the language
- info_lang <- .infos_lang.lm(lang = lang)
-
- # Extract labels of data or origdata
- if (isTRUE(auto.labs)) {
- labs <- tabularise:::.labels2(x = data, origdata = origdata, labs = labs)
- } else {
- labs <- tabularise:::.labels2(x = NULL, labs = labs)
- }
-
- # Turn an object into a tidy tibble
- data_t <- as.data.frame(broom::glance(x = data))
- rownames(data_t) <- data_t$term
-
- # Use flextable
- ft <- flextable(data_t)
- ft <- colformat_sci(ft)
- #ft <- colformat_sci(ft, j = "p.value", lod = 2e-16)
-
- # Rename headers labels
- ft <- .header_labels(ft, info_lang = info_lang)
-
- # Headers
- if (isTRUE(equation)) {
- if (!is.null(labs)) {
- equa <- equation(data, swap_var_names = labs, ...)
- } else {
- equa <- equation(data, auto.labs = FALSE, ...)
- }
-
- ft <- .add_header(ft, data = data, info_lang = info_lang, header = header,
- equation = equa)
- } else {
- equa <- NULL
- ft <- .add_header(ft, data = data, info_lang = info_lang, header = header,
- equation = equation)
- }
-
- if (isTRUE(auto.labs) && any(data_t$term %in% "(Intercept)"))
- ft <- mk_par(ft, i = "(Intercept)", j = 1, part = "body",
- value = as_paragraph(info_lang[["(Intercept)"]]))
-
- if (!is.null(labs)) {
- labs_red <- labs[names(labs) %in% data_t$term]
-
- for (i in seq_along(labs_red))
- ft <- mk_par(ft, i = names(labs_red)[i], j = 1,
- value = para_md(labs_red[i]), part = "body")
- }
+ df_list <- .extract_infos_lm(
+ data, type = "glance", conf.int = FALSE, conf.level = 0.95,
+ show.signif.stars = FALSE, lang = lang, auto.labs = auto.labs,
+ origdata = origdata, labs = labs, equation = equation, title = title,
+ colnames = colnames_lm, footer = FALSE, ...)
- autofit(ft, part = c("header", "body"))
+ # formatted table
+ format_table(df_list, kind = kind, header = header)
}
#' Create a rich-formatted table using the table of coefficients of the summary.lm object
#'
-#' @param data A **summary.lm** object
-#' @param ... Additional arguments passed to [tabularise_tidy.lm()]
+#' @param data An **summary.lm** object
+#' @param header Logical. If `TRUE` (`TRUE`by default), a header is added to
+#' the table. The header includes both the title and the equation (if
+#' applicable). If set to `FALSE`, neither the title nor the equation will be
+#' displayed in the table header, even if the `title` or `equation` parameters
+#' are provided.
+#' @param title If `TRUE` (by default) , add a title to the table header.
+#' Default to the same value than header, except outside of a chunk where it is
+#' `FALSE` if a table caption is detected (`tbl-cap` YAML entry).
+#' @param equation Logical or character. Controls whether an equation is added
+#' to the table header and how parameters are used. Accepted values are:
+#' - `TRUE`(by default): The equation is generated and added to the table
+#' header. Its parameters are also used in the "Term" column.
+#' - `FALSE`: No equation is generated or displayed, and its
+#' parameters are not used in the "Term" column.
+#' - `NA`: The equation is generated but not displayed in the table header.
+#' Its parameters are used in the "Term" column.
+#' - Character string: A custom equation is provided directly and added to
+#' the table header.
+#' @param footer If `TRUE` (by default, it is FALSE), add a footer to the table.
+#' @param auto.labs If `TRUE` (by default), use labels (and units) automatically
+#' from data or `origdata=`.
+#' @param origdata The original data set this model was fitted to. By default it
+#' is `NULL` and no label is used.
+#' @param labs Labels to change the names of elements in the `term` column of
+#' the table. By default it is `NULL` and nothing is changed.
+#' @param conf.int If `TRUE`, add the confidence interval. The default is
+#' `FALSE`.
+#' @param conf.level The confidence level to use for the confidence interval if
+#' `conf.int = TRUE`. The default is 0.95.
+#' @param lang The natural language to use. The default value can be set with,
+#' e.g., `options(SciViews_lang = "fr")` for French.
+#' @param show.signif.stars If `TRUE`, add the significance stars to the table.
+#' The default is `getOption("show.signif.stars")`
+#' @param ... Additional arguments
#' @param kind The kind of table to produce: "tt" for tinytable, or "ft" for
#' flextable (default).
-#' @param env The environment where to evaluate the model.
+#' #' @param footer If `FALSE` (by default), add a footer to the table.
#'
#' @return A **flextable** object you can print in different formats (HTML,
#' LaTeX, Word, PowerPoint) or rearrange with the \{flextable\} functions.
@@ -384,25 +307,35 @@ tabularise_glance.lm <- function(data, header = TRUE, title = NULL,
#' iris_lm <- lm(data = iris, Petal.Length ~ Sepal.Length)
#' iris_lm_sum <- summary(iris_lm)
#' tabularise::tabularise$coef(iris_lm_sum)
-tabularise_coef.summary.lm <- function(data, ..., kind = "ft",
- env = parent.frame()) {
+tabularise_coef.summary.lm <- function(data, header = TRUE, title = header,
+ equation = header, footer = FALSE, auto.labs = TRUE, origdata = NULL,
+ labs = NULL, conf.int = FALSE, conf.level = 0.95,
+ lang = getOption("SciViews_lang", "en"),
+ show.signif.stars = getOption("show.signif.stars", TRUE), ..., kind = "ft") {
+
+ # If title is not provided, determine if we have to use TRUE or FALSE
+ if (missing(title)) {
+ title <- header # Default to same as header, but...
+ # if a caption is defined in the chunk, it defauts to FALSE
+ if (!is.null(knitr::opts_current$get('tbl-cap')))
+ title <- FALSE
+ }
- lm_original <- data$call
- data <- eval(lm_original, envir = env)
+ df_list <- .extract_infos_lm(
+ data, type = "tidy", conf.int = conf.int, conf.level = conf.level,
+ show.signif.stars = show.signif.stars, lang = lang, auto.labs = auto.labs,
+ origdata = origdata, labs = labs, equation = equation, title = title,
+ colnames = colnames_lm, footer = footer, ...)
- tabularise_tidy.lm(data = data, ..., kind = kind, env = env)
+ # formatted table
+ format_table(df_list, kind = kind, header = header)
}
#' Create a rich-formatted table from an summary.lm object
#'
#' @param data A **summary.lm** object
-#' @param footer If `TRUE` (by default), add a footer to the table
-#' @param lang The natural language to use. The default value can be set with,
-#' e.g., `options(data.io_lang = "fr")` for French.
#' @param ... Additional arguments passed to [tabularise_coef.summary.lm()]
-#' @param kind The kind of table to produce: "tt" for tinytable, or "ft" for
-#' flextable (default).
-#' @param env The environment where to evaluate the model.
+#' @param footer If `TRUE` (by default), add a footer to the table.
#'
#' @return A **flextable** object you can print in different formats (HTML,
#' LaTeX, Word, PowerPoint) or rearrange with the \{flextable\} functions.
@@ -415,129 +348,273 @@ tabularise_coef.summary.lm <- function(data, ..., kind = "ft",
#' iris_lm <- lm(data = iris, Petal.Length ~ Sepal.Length)
#' iris_lm_sum <- summary(iris_lm)
#' tabularise::tabularise(iris_lm_sum)
-tabularise_default.summary.lm <- function(data, footer = TRUE,
- lang = getOption("data.io_lang", "en"), ..., kind = "ft",
- env = parent.frame()) {
- ft <- tabularise_coef.summary.lm(data = data, lang = lang, ..., env = env)
-
- if (isTRUE(footer)) {
- info_lang <- .infos_lang.lm(lang = lang)
-
- digits <- max(3L, getOption("digits") - 3L)
- footer <- info_lang[["footer"]]
- vals <- c(
- paste0(footer[["resid.range"]], " [",
- format(signif(min(data$residuals, na.rm = TRUE), digits)), ", ",
- format(signif(max(data$residuals, na.rm = TRUE), digits)), "] "),
- paste(footer[["resid.std.err"]],
- format(signif(data$sigma, digits)), footer[["on"]],
- max(data$df), footer[["df2"]]),
- paste(footer[["R2"]], format(signif(data$r.squared, digits)), " - ",
- footer[["adj.R2"]], format(signif(data$adj.r.squared, digits))),
- paste(footer[["f.stat"]], format(signif(data$fstatistic[1L], digits)),
- footer[["on"]], format(signif(data$fstatistic[2L], digits)),
- footer[["and"]], format(signif(data$fstatistic[3L], digits)),
- footer[["df"]], " - ", footer[["p"]],
- format.pval(pf(data$fstatistic[1L], data$fstatistic[2L],
- data$fstatistic[3L], lower.tail = FALSE)))
- # TODO: nicely format this last p value!
- )
- ft <- add_footer_lines(ft, top = FALSE, values = para_md(vals))
- ft <- align(ft, i = seq_len(length(vals)) + 1 , align = "left",
- part = "footer")
- }
+tabularise_default.summary.lm <- function(data, ..., footer = TRUE) {
+ tabularise_coef.summary.lm(data = data, ..., footer = footer)
+}
+
- autofit(ft, part = c("header", "body"))
+# A list of internals functions
+colnames_lm <- c(
+ term = "Term",
+ estimate = "Estimate",
+ conf.low = "Lower bound (CI)",
+ conf.high = "Upper bound (CI)",
+ std.error = "Standard Error",
+ t.value = "t value",
+ sigma = "RSE",
+ r.squared = "R^2^",
+ adj.r.squared = "Adj.R^2^",
+ AIC = "AIC",
+ BIC = "BIC",
+ deviance = "Deviance",
+ logLik = "Log-likelihood",
+ statistic = "*t* value",
+ p.value = "*p* value",
+ df = "Model df",
+ df.residual = "Residuals df",
+ nobs = "N",
+ signif = "",
+ "(Intercept)" = "Intercept")
+
+.trads <- gettext(term = "Term",
+ estimate = "Estimate",
+ conf.low = "Lower bound (CI)",
+ conf.high = "Upper bound (CI)",
+ std.error = "Standard Error",
+ t.value = "t value",
+ sigma = "RSE",
+ r.squared = "R^2^",
+ adj.r.squared = "Adj.R^2^",
+ AIC = "AIC",
+ BIC = "BIC",
+ deviance = "Deviance",
+ logLik = "Log-likelihood",
+ statistic = "*t* value",
+ p.value = "*p* value",
+ df = "Model df",
+ df.residual = "Residuals df",
+ nobs = "N",
+ header = "Linear model",
+ "(Intercept)" = "Intercept", lang = "fr")
+
+# See utils.R for internal functions used by various .extract_infos_***
+
+.extract_footer_lm <- function(data, lang) {
+ digits <- max(3L, getOption("digits") - 3L)
+ domain <- "R-modelit"
+ res <- paste(gettextf("Residuals range: [%.*g, %.*g]",
+ digits, min(data$residuals, na.rm = TRUE),
+ digits, max(data$residuals, na.rm = TRUE),
+ domain = domain, lang = lang),
+ gettextf("Residuals standard error: %.*g on %.*g degrees of freedom",
+ digits, data$sigma, digits, max(data$df),
+ domain = domain, lang = lang),
+ gettextf("Multiple *R*^2^: %.*g - adjusted *R*^2^: %.*g",
+ digits, data$r.squared, digits, data$adj.r.squared,
+ domain = domain, lang = lang),
+ gettextf("*F*-statistic: %.*g on %.*g and %.*g df - *p* value: %s",
+ digits, data$fstatistic[1L],
+ digits, data$fstatistic[2L],
+ digits, data$fstatistic[3L],
+ format.pval(pf(data$fstatistic[1L], data$fstatistic[2L],
+ data$fstatistic[3L], lower.tail = FALSE)),
+ domain = domain, lang = lang),
+ sep = "\n")
+ res
}
-# Choose the lang and the infos_lang
-.infos_lang.lm <- function(lang) {
+.extract_infos_lm <- function(data, type = "coef",
+ conf.int = TRUE, conf.level = 0.95, show.signif.stars = getOption("show.signif.stars", TRUE),
+ lang = "en", auto.labs = TRUE, origdata = NULL , labs = NULL, equation = TRUE,
+ title = TRUE, colnames = colnames_lm , footer = FALSE, ...) {
+
+ if (!inherits(data, c("lm", "summary.lm")))
+ stop(".extract_infos_lm() can apply only lm and summary.lm object.")
+
+ type <- match.arg(type, choices = c("coef", "glance", "tidy"))
+
+ if (inherits(data, "summary.lm") && type == "coef") {
+ message(".extract_infos_lm() cannot apply type = 'coef' to a summary.lm object. Use type = 'tidy' instead to extract a detailed coefficient table.")
+ type <- "tidy"
+ }
+
+ df <- switch(type,
+ coef = {
+ df <- coef(data)
+ data.frame(term = names(df), estimate = df)},
+ glance = {
+ df <- as.data.frame(broom::glance(x = data))
+ rownames(df) <- df$term
+ df},
+ tidy = {
+ df <- as.data.frame(broom::tidy(x = data, conf.int = conf.int,
+ conf.level = conf.level))
+ rownames(df) <- df$term
+
+ if (isTRUE(conf.int)) {
+ df <- df[, c("term", "estimate", "conf.low", "conf.high",
+ "std.error", "statistic", "p.value")]
+ }
+ if (isTRUE(show.signif.stars)) {
+ df$signif <- .pvalue_format(df$p.value)
+ }
+ df}
+ )
+
+
+ if (isTRUE(show.signif.stars)) {
+ psignif <- "0 <= '***' < 0.001 < '**' < 0.01 < '*' < 0.05"
+ } else {
+ psignif <- NULL
+ }
+
lang <- tolower(lang)
+ cols <- .extract_colnames(df, labs = colnames_lm, lang = lang)
- if (lang != "fr") lang <- "en" # Only en or fr for now
+ data_obj <- attr(data, "object")
+
+ if (is.null(data_obj)) {
+ labels <- .extract_labels(df = df, data = data, auto.labs = auto.labs,
+ origdata = origdata, labs = labs)
+
+ equa <- .extract_equation(data, equation = equation, labs = labels)
- if (lang == "fr") {
- info_lang <- infos_fr.lm
} else {
- info_lang <- infos_en.lm
+ labels <- .extract_labels(df = df, data = data_obj, auto.labs = auto.labs,
+ origdata = origdata, labs = labs)
+
+ equa <- .extract_equation(data_obj, equation = equation, labs = labels)
}
- info_lang
-}
+ if ((isTRUE(equation) || is.na(equation)) && !is.null(equa)) {
+ terms <- .params_equa(equa)
+ } else {
+ terms <- .extract_terms(df, labs = labels, lang = lang)
+ }
-infos_en.lm <- list(
- labs = c(
- term = "Term",
- estimate = "Estimate",
- conf.low = "Lower bound (CI)",
- conf.high = "Upper bound (CI)",
- std.error = "Standard Error",
- t.value = "t value",
- sigma = "RSE",
- r.squared = "R^2^",
- adj.r.squared = "Adj.R^2^",
- AIC = "AIC",
- BIC = "BIC",
- deviance = "Deviance",
- logLik = "Log-likelihood",
- statistic = "*t* value",
- p.value = "*p* value",
- df = "Model df",
- df.residual = "Residuals df",
- nobs = "N",
- "(Intercept)" = "Intercept"),
- "(Intercept)" = "Intercept",
- "summary" = "Model summary",
- "header" = "Linear model",
- footer = c(
- "resid.range" = "Residuals range:",
- "resid.std.err" = "Residuals standard error:",
- "on" = "on",
- "and" = "and",
- "df" = "df",
- "df2" = "degrees of freedom",
- "R2" = "Multiple *R*^2^:",
- "adj.R2" = "adjusted *R*^2^:",
- "f.stat" = "*F*-statistic:",
- "p" = "*p* value:"
- )
-)
-
-infos_fr.lm <- list(
- labs = c(
- term = "Terme",
- estimate = "Valeur estim\u00e9e",
- conf.low = "Limite basse (IC)",
- conf.high = "Limite haute (IC)",
- std.error = "Ecart type",
- t.value = "Valeur de *t*",
- p.value = "Valeur de *p*",
- sigma = "RSE",
- r.squared = "R^2^",
- adj.r.squared = "R^2^ ajust\u00e9",
- AIC = "AIC",
- BIC = "BIC",
- statistic = " Valeur de *t*",
- deviance = "D\u00e9viance",
- logLik = "Log-vraisemblance",
- df = "Ddl mod\u00e8le",
- df.residual = "Ddl r\u00e9sidus",
- nobs = "N",
- "(Intercept)" = "Ordonn\u00e9e \u00e0 l'origine"
- ),
- "(Intercept)" = "Ordonn\u00e9e \u00e0 l'origine",
- "summary" = "R\u00e9sum\u00e9 du mod\u00e8le",
- "header" = "Mod\u00e8le lin\u00e9aire",
- footer = c(
- "resid.range" = "Etendue des r\u00e9sidus :",
- "resid.std.err" = "Ecart type des r\u00e9sidus :",
- "on" = "pour",
- "and" = "et",
- "df" = "ddl",
- "df2" = "degr\u00e9s de libert\u00e9",
- "R2" = "*R*^2^ multiple :",
- "adj.R2" = "*R*^2^ ajust\u00e9 :",
- "f.stat" = "Statistique *F* :",
- "p" = "valeur de *p* :"
+ if (is.na(equation)) {
+ equa <- NULL
+ }
+
+ title <- .extract_title(title, lang = lang, default = "Linear model")
+
+ if (isTRUE(footer)) {
+ footer <- .extract_footer_lm(data, lang = lang)
+ } else {
+ footer <- NULL
+ }
+
+ list(
+ df = df,
+ title = title,
+ cols = cols,
+ equa = equa,
+ terms = terms,
+ psignif = psignif,
+ footer = footer
)
-)
+}
+
+
+# # TODO: Migrate this translation system into the 'svBase' package
+#
+# # This function creates a translation handler that caches translations
+# # for different languages and object types (e.g., "lm", "nls", etc.).
+# # It avoids re-evaluating translation expressions by storing results
+# # in a cache (.trad), indexed by a key combining language and type.
+# .make_translation <- function() {
+# .trad <- list() # Internal cache for translations
+#
+# translation_fun <- structure(function(expr, lang = NULL, type = "lm", clear_cache = FALSE) {
+# # Clear the cache if requested
+# if (isTRUE(clear_cache)) {
+# .trad <<- list()
+# if (missing(expr))
+# return()
+# }
+#
+# # Try to extract language from the expression if not explicitly provided
+# if (is.null(lang)) {
+# lang <- substitute(expr)[["lang"]]
+# if (is.null(lang))
+# stop("lang is not defined")
+# }
+#
+# # Create a cache key based on language and type
+# slot <- paste(lang, type[[1]], sep = "-")
+# res <- .trad[[slot]]
+#
+# # If translation is not cached, evaluate and store it
+# if (is.null(res)) {
+# message("Language ", lang, " not found in cache")
+# res <- eval(expr)
+# .trad2 <- .trad
+# .trad2[[slot]] <- res
+# .trad <<- .trad2 # Super assignment to update cache
+# }
+#
+# res # Return the cached or newly evaluated translation
+# }, class = c("function", "subsettable_type"))
+#
+# translation_fun
+# }
+#
+# # Create the translation handler
+# .translation <- .make_translation()
+#
+# # Add translations for 'lm' objects in French and English
+# .translation$lm(gettext(
+# term = "Term",
+# estimate = "Estimate",
+# conf.low = "Lower bound (CI)",
+# conf.high = "Upper bound (CI)",
+# std.error = "Standard Error",
+# t.value = "t value",
+# sigma = "RSE",
+# r.squared = "R^2^",
+# adj.r.squared = "Adj.R^2^",
+# AIC = "AIC",
+# BIC = "BIC",
+# deviance = "Deviance",
+# logLik = "Log-likelihood",
+# statistic = "*t* value",
+# p.value = "*p* value",
+# df = "Model df",
+# df.residual = "Residuals df",
+# nobs = "N",
+# "(Intercept)" = "Intercept",
+# lang = "fr"
+# ))
+#
+# .translation$lm(gettext(
+# term = "Term",
+# estimate = "Estimate",
+# conf.low = "Lower bound (CI)",
+# conf.high = "Upper bound (CI)",
+# std.error = "Standard Error",
+# t.value = "t value",
+# sigma = "RSE",
+# r.squared = "R^2^",
+# adj.r.squared = "Adj.R^2^",
+# AIC = "AIC",
+# BIC = "BIC",
+# deviance = "Deviance",
+# logLik = "Log-likelihood",
+# statistic = "*t* value",
+# p.value = "*p* value",
+# df = "Model df",
+# df.residual = "Residuals df",
+# nobs = "N",
+# "(Intercept)" = "Intercept",
+# lang = "en"
+# ))
+#
+# # Optional: Clear the cache
+# #.translation(clear_cache = TRUE)
+#
+# # Access the internal translation cache
+# environment(.translation)$.trad -> s
+#
+# # View cached translations for French 'lm' objects
+# s$`fr-lm`
+# s
diff --git a/R/tabularise.nls.R b/R/tabularise.nls.R
index 38b6941..8b7e3df 100644
--- a/R/tabularise.nls.R
+++ b/R/tabularise.nls.R
@@ -5,24 +5,29 @@
#' of [print.summary.nls()] but richly formatted. The [tabularise_coef()]
#' function offers more customization options for this object.
#'
-#' @param data A **summary.nls** object.
-#' @param header If `TRUE` (by default), add a header to the table
+#' @param data An **nls** object.
+#' @param header If `TRUE` (by default), add a title to the table.
#' @param title If `TRUE`, add a title to the table header. Default to the same
#' value than header, except outside of a chunk where it is `FALSE` if a table
#' caption is detected (`tbl-cap` YAML entry).
#' @param equation Add equation of the model to the table. If `TRUE`,
#' [equation()] is used. The equation can also be passed in the form of a
-#' character string (LaTeX equation).
+#' character string (LaTeX).
+#' @param auto.labs If `TRUE` (by default), use labels (and units) automatically
+#' from data or `origdata=`.
+#' @param origdata The original data set this model was fitted to. By default it
+#' is `NULL` and no label is used (only the name of the variables).
+#' @param labs Labels to change the names of elements in the `term` column of
+#' the table. By default it is `NULL` and nothing is changed.
+#' @param lang The language to use. The default value can be set with, e.g.,
+#' `options(SciViews_lang = "fr")` for French.
#' @param footer If `TRUE` (by default), add a footer to the table.
-#' @param lang The language to use. The default value can be set with, e.g.
-#' `options(data.io_lang = "fr")` for French.
-#' @param show.signif.stars If `TRUE` (by default), add the significance stars
-#' to the table.
-#' @param ... Additional arguments (Not used).
+#' @param show.signif.stars If `TRUE`, add the significance stars to the table.
+#' The default is `getOption("show.signif.stars")`
+#' @param ... Not used
#' @param kind The kind of table to produce: "tt" for tinytable, or "ft" for
#' flextable (default).
-#' @param env The environment where to evaluate lazyeval expressions (unused for
-#' now).
+#'
#' @importFrom tabularise tabularise_default colformat_sci
#' @importFrom rlang .data
#' @method tabularise_default summary.nls
@@ -43,10 +48,20 @@
#'
#' tabularise::tabularise(chick1_logis_sum)
#' tabularise::tabularise(chick1_logis_sum, footer = FALSE)
-tabularise_default.summary.nls <- function(data, header = TRUE, title = NULL,
- equation = header, footer = TRUE, lang = getOption("data.io_lang", "en"),
- show.signif.stars = getOption("show.signif.stars", TRUE), ..., kind = "ft",
- env = parent.frame()) {
+#'
+#' growth <- data.io::read("urchin_growth", package = "data.io")
+#' growth_logis <- nls(data = growth, diameter ~ SSlogis(age, Asym, xmid, scal))
+#' chart::chart(growth_logis)
+#' tabularise::tabularise(summary(growth_logis)) # No labels
+#' tabularise::tabularise(summary(growth_logis), origdata = growth) # with labels
+#' tabularise::tabularise(summary(growth_logis), origdata = growth,
+#' equation = FALSE, show.signif.stars = FALSE)
+#'
+tabularise_default.summary.nls <- function(data, header = TRUE, title = header,
+ equation = header, auto.labs = TRUE, origdata = NULL, labs = NULL,
+ lang = getOption("SciViews_lang", "en"), footer = TRUE,
+ show.signif.stars = getOption("show.signif.stars", TRUE), ...,
+ kind = "ft") {
# If title is not provided, determine if we have to use TRUE or FALSE
if (missing(title)) {
@@ -56,45 +71,14 @@ tabularise_default.summary.nls <- function(data, header = TRUE, title = NULL,
title <- FALSE
}
- ft <- tabularise_coef.summary.nls(data, header = header, title = title,
- equation = equation, lang = lang, show.signif.stars = show.signif.stars,
- kind = kind, env = env)
-
- # Choose the language
- lang <- tolower(lang)
+ df_list <- .extract_infos_nls(
+ data, type = "coef", show.signif.stars = show.signif.stars, lang = lang,
+ auto.labs = auto.labs, origdata = origdata, labs = labs, equation = equation,
+ title = title, colnames = colnames_nls, footer = footer)
+ # print(df_list) # use only for development
- if (lang != "fr") lang <- "en" # Only en or fr for now
-
- if (lang == "fr") {
- info_lang <- infos_fr.nls
- } else {
- info_lang <- infos_en.nls
- }
-
- if (isTRUE(footer)) {
- footer <- info_lang[["footer"]]
-
- # Use the same rule of print.summary.nls
- digs <- max(3L, getOption("digits") - 3L)
-
- val <- paste(footer[["rse"]], ":", format(signif(data$sigma,
- digits = digs)), footer[["on"]], data$df[2], footer["df"])
-
- conv <- data$convInfo
- if (isTRUE(conv$isConv)) {
- convinfo <- c(
- paste(footer[["nbc"]], ":", conv$finIter),
- paste(footer[["ctol"]], ":", format(conv$finTol,
- digits = digs)))
- val <- c(val, convinfo)
- } else {
- val <- c(val, footer[["stop"]])
- }
- ft <- add_footer_lines(ft, top = FALSE, values = val)
- ft <- align(ft, i = seq_len(length(val)) + 1 , align = "left",
- part = "footer")
- }
- ft
+ # formatted table
+ format_table(df_list, kind = kind, header = header)
}
#' Create a rich-formatted table using the table of coefficients of the summary.nls object
@@ -103,23 +87,28 @@ tabularise_default.summary.nls <- function(data, header = TRUE, title = NULL,
#' This function extracts and formats the table of coefficients from a
#' **summary.nls** object, similar to [stats::coef()], but in flextable object.
#'
-#' @param data A **summary.nls** object.
+#' @param data An **nls** object.
#' @param header If `TRUE` (by default), add a title to the table.
#' @param title If `TRUE`, add a title to the table header. Default to the same
#' value than header, except outside of a chunk where it is `FALSE` if a table
#' caption is detected (`tbl-cap` YAML entry).
#' @param equation Add equation of the model to the table. If `TRUE`,
#' [equation()] is used. The equation can also be passed in the form of a
-#' character string (LaTeX equation).
+#' character string (LaTeX).
+#' @param auto.labs If `TRUE` (by default), use labels (and units) automatically
+#' from data or `origdata=`.
+#' @param origdata The original data set this model was fitted to. By default it
+#' is `NULL` and no label is used (only the name of the variables).
+#' @param labs Labels to change the names of elements in the `term` column of
+#' the table. By default it is `NULL` and nothing is changed.
#' @param lang The language to use. The default value can be set with, e.g.,
-#' `options(data.io_lang = "fr")` for French.
-#' @param show.signif.stars If `TRUE` (by default), add the significance stars
-#' to the table.
-#' @param ... Additional arguments passed to [equation()]
+#' `options(SciViews_lang = "fr")` for French.
+#' @param footer If `FALSE` (by default), add a footer to the table.
+#' @param show.signif.stars If `TRUE`, add the significance stars to the table.
+#' The default is `getOption("show.signif.stars")`
+#' @param ... Not used
#' @param kind The kind of table to produce: "tt" for tinytable, or "ft" for
#' flextable (default).
-#' @param env The environment where to evaluate lazyeval expressions (unused for
-#' now).
#'
#' @return A **flextable** object that you can print in different forms or
#' rearrange with the \{flextable\} functions.
@@ -136,64 +125,28 @@ tabularise_default.summary.nls <- function(data, header = TRUE, title = NULL,
#'
#' tabularise::tabularise$coef(chick1_logis_sum)
#' tabularise::tabularise$coef(chick1_logis_sum, header = FALSE, equation = TRUE)
-tabularise_coef.summary.nls <- function(data, header = TRUE, title = NULL,
- equation = header, lang = getOption("data.io_lang", "en"),
- show.signif.stars = getOption("show.signif.stars", TRUE), ..., kind = "ft",
- env = parent.frame()) {
+tabularise_coef.summary.nls <- function(data, header = TRUE, title = header,
+ equation = header, auto.labs = TRUE, origdata = NULL, labs = NULL,
+ lang = getOption("SciViews_lang", "en"), footer = FALSE,
+ show.signif.stars = getOption("show.signif.stars", TRUE), ...,
+ kind = "ft") {
# If title is not provided, determine if we have to use TRUE or FALSE
if (missing(title)) {
title <- header # Default to same as header, but...
- # if a caption is defined in the chunk, it defauts to FALSE
+ # if a caption is defined in the chunk, it defaults to FALSE
if (!is.null(knitr::opts_current$get('tbl-cap')))
title <- FALSE
}
- # Extract the coef and rework it to obtain a data.frame
- co <- as.data.frame(coef(data))
- res <- cbind(term = rownames(co), co)
- names(res) <- c("term", "estimate", "std.error", "statistic", "p.value")
-
- # Choose the language
- lang <- tolower(lang)
-
- if (lang != "fr")
- lang <- "en" # Only en or fr for now
-
- if (lang == "fr") {
- info_lang <- infos_fr.nls
- } else {
- info_lang <- infos_en.nls
- }
-
- # Use flextable
- if (isTRUE(show.signif.stars)) {
- ft <- flextable(res, col_keys = c(names(res), "signif"))
- } else {
- ft <- flextable(res)
- }
- ft <- colformat_sci(ft)
- ft <- colformat_sci(ft, j = "p.value", lod = 2e-16)
-
- # Change labels
- ft <- header_labels(ft, lang = lang)
-
- # Add information on the p.value
- if (ncol_keys(ft) > ncol(res))
- ft <- add_signif_stars(ft, j = "signif")
+ df_list <- .extract_infos_nls(
+ data, type = "coef", show.signif.stars = show.signif.stars, lang = lang,
+ auto.labs = auto.labs, origdata = origdata, labs = labs, equation = equation,
+ title = title, colnames = colnames_nls, footer = footer)
+ # print(df_list) # use only for development
- # Add headers
- ft <- add_header_nls(ft, data = data, header = header, title = title,
- equation = equation, lang = lang, ...)
-
- ft <- autofit(ft, part = c("header", "body"))
- if (isTRUE(show.signif.stars))
- ft <- width(ft, j = "signif", width = 0.4)
-
- if (isTRUE(equation) | is.character(equation))
- ft <- italic(ft, j = "term",part = "body")
-
- ft
+ # formatted table
+ format_table(df_list, kind = kind, header = header)
}
#' Create a rich-formatted table from a nls object
@@ -209,15 +162,19 @@ tabularise_coef.summary.nls <- function(data, header = TRUE, title = NULL,
#' caption is detected (`tbl-cap` YAML entry).
#' @param equation Add equation of the model to the table. If `TRUE`,
#' [equation()] is used. The equation can also be passed in the form of a
-#' character string (LaTeX equation).
-#' @param footer If `TRUE` (by default), add a footer to the table.
+#' character string (LaTeX).
+#' @param auto.labs If `TRUE` (by default), use labels (and units) automatically
+#' from data or `origdata=`.
+#' @param origdata The original data set this model was fitted to. By default it
+#' is `NULL` and no label is used (only the name of the variables).
+#' @param labs Labels to change the names of elements in the `term` column of
+#' the table. By default it is `NULL` and nothing is changed.
#' @param lang The language to use. The default value can be set with, e.g.,
-#' `options(data.io_lang = "fr")` for French.
-#' @param ... Additional arguments. Not used.
+#' `options(SciViews_lang = "fr")` for French.
+#' @param footer If `TRUE` (by default, it is TRUE), add a footer to the table.
+#' @param ... Not used
#' @param kind The kind of table to produce: "tt" for tinytable, or "ft" for
#' flextable (default).
-#' @param env The environment where to evaluate lazyeval expressions (unused for
-#' now).
#'
#' @return A **flextable** object that you can print in different forms or
#' rearrange with the \{flextable\} functions.
@@ -232,9 +189,9 @@ tabularise_coef.summary.nls <- function(data, header = TRUE, title = NULL,
#' chick1_logis <- nls(data = chick1, weight ~ SSlogis(Time, Asym, xmid, scal))
#'
#' tabularise::tabularise(chick1_logis)
-tabularise_default.nls <- function(data, header = TRUE, title = NULL,
- equation = header, footer = TRUE, lang = getOption("data.io_lang", "en"),
- ..., kind = "ft", env = parent.frame()) {
+tabularise_default.nls <- function(data, header = TRUE, title = header,
+ equation = header, auto.labs = TRUE, origdata = NULL, labs = NULL,
+ lang = getOption("SciViews_lang", "en"), footer = TRUE, ..., kind = "ft") {
# If title is not provided, determine if we have to use TRUE or FALSE
if (missing(title)) {
@@ -244,47 +201,14 @@ tabularise_default.nls <- function(data, header = TRUE, title = NULL,
title <- FALSE
}
- ft <- tabularise_coef.nls(data, header = header, title = title,
- equation = equation, lang = lang, kind = kind, env = env)
-
- # Choose the language
- lang <- tolower(lang)
-
- if (lang != "fr")
- lang <- "en" # Only en or fr for now
-
- if (lang == "fr") {
- info_lang <- infos_fr.nls
- } else {
- info_lang <- infos_en.nls
- }
-
- # Add footer
- if (isTRUE(footer)) {
- footer <- info_lang[["footer"]]
-
- # Use the same rule of print.summary.nls
- digs <- max(3L, getOption("digits") - 3L)
-
- val <- paste(footer[["rss"]], ":", format(signif(data$m$deviance(),
- digits = digs)))
-
- conv <- data$convInfo
- if (isTRUE(conv$isConv)) {
- convinfo <- c(
- paste(footer[["nbc"]], ":", conv$finIter),
- paste(footer[["ctol"]], ":", format(conv$finTol,
- digits = digs)))
- val <- c(val, convinfo)
- } else {
- val <- c(val, footer[["stop"]])
- }
-
- ft <- add_footer_lines(ft, top = FALSE, values = val)
- ft <- align(ft, align = "left", part = "footer")
- }
+ df_list <- .extract_infos_nls(
+ data, type = "coef", show.signif.stars = FALSE, lang = lang,
+ auto.labs = auto.labs, origdata = origdata, labs = labs, equation = equation,
+ title = title, colnames = colnames_nls, footer = footer)
+ # print(df_list) # use only for development
- autofit(ft, part = c("header", "body"))
+ # formatted table
+ format_table(df_list, kind = kind, header = header)
}
#' Create a rich-formatted table using the coefficients of the nls object
@@ -298,14 +222,21 @@ tabularise_default.nls <- function(data, header = TRUE, title = NULL,
#' @param title If `TRUE`, add a title to the table header. Default to the same
#' value than header, except outside of a chunk where it is `FALSE` if a table
#' caption is detected (`tbl-cap` YAML entry).
-#' @param equation If `TRUE` (by default), add the equation of the model
+#' @param equation Add equation of the model to the table. If `TRUE`,
+#' [equation()] is used. The equation can also be passed in the form of a
+#' character string (LaTeX).
+#' @param auto.labs If `TRUE` (by default), use labels (and units) automatically
+#' from data or `origdata=`.
+#' @param origdata The original data set this model was fitted to. By default it
+#' is `NULL` and no label is used (only the name of the variables).
+#' @param labs Labels to change the names of elements in the `term` column of
+#' the table. By default it is `NULL` and nothing is changed.
#' @param lang The language to use. The default value can be set with, e.g.,
-#' `options(data.io_lang = "fr")` for French.
-#' @param ... Additional arguments.
+#' `options(SciViews_lang = "fr")` for French.
+#' @param footer If `TRUE` (by default, it is TRUE), add a footer to the table.
+#' @param ... Not used
#' @param kind The kind of table to produce: "tt" for tinytable, or "ft" for
#' flextable (default).
-#' @param env The environment where to evaluate lazyeval expressions (unused for
-#' now).
#'
#' @return A **flextable** object that you can print in different forms or
#' rearrange with the \{flextable\} functions.
@@ -320,9 +251,9 @@ tabularise_default.nls <- function(data, header = TRUE, title = NULL,
#' chick1_logis <- nls(data = chick1, weight ~ SSlogis(Time, Asym, xmid, scal))
#'
#' tabularise::tabularise$coef(chick1_logis)
-tabularise_coef.nls <- function(data, header = TRUE, title = NULL,
- equation = header, lang = getOption("data.io_lang", "en"), ..., kind = "ft",
- env = parent.frame()) {
+tabularise_coef.nls <- function(data, header = TRUE, title = header,
+ equation = header, auto.labs = TRUE, origdata = NULL, labs = NULL,
+ lang = getOption("SciViews_lang", "en"), footer = TRUE, ..., kind = "ft") {
# If title is not provided, determine if we have to use TRUE or FALSE
if (missing(title)) {
@@ -332,28 +263,14 @@ tabularise_coef.nls <- function(data, header = TRUE, title = NULL,
title <- FALSE
}
- # Choose the language
- lang <- tolower(lang)
-
- if (lang != "fr")
- lang <- "en" # Only en or fr for now
+ df_list <- .extract_infos_nls(
+ data, type = "coef", show.signif.stars = FALSE, lang = lang,
+ auto.labs = auto.labs, origdata = origdata, labs = labs, equation = equation,
+ title = title, colnames = colnames_nls, footer = footer)
+ # print(df_list) # use only for development
- if (lang == "fr") {
- info_lang <- infos_fr.nls
- } else {
- info_lang <- infos_en.nls
- }
-
- co <- data.frame(rbind(coef(data)))
-
- ft <- flextable(co) |>
- colformat_sci()
-
- # Add headers
- ft <- add_header_nls(ft, data = data, header = header, title = title,
- equation = equation, lang = lang)
-
- autofit(ft, part = c("header", "body"))
+ # formatted table
+ format_table(df_list, kind = kind, header = header)
}
#' Tidy version of the nls object into a flextable object
@@ -364,12 +281,28 @@ tabularise_coef.nls <- function(data, header = TRUE, title = NULL,
#' formatted as an (almost) publication-ready form (good for informal reports,
#' notebooks, etc).
#'
-#' @param data A **nls** object
-#' @param ... arguments of [tabularise_coef.summary.nls()]
+#' @param data An **nls** object.
+#' @param header If `TRUE` (by default), add a title to the table.
+#' @param title If `TRUE`, add a title to the table header. Default to the same
+#' value than header, except outside of a chunk where it is `FALSE` if a table
+#' caption is detected (`tbl-cap` YAML entry).
+#' @param equation Add equation of the model to the table. If `TRUE`,
+#' [equation()] is used. The equation can also be passed in the form of a
+#' character string (LaTeX).
+#' @param auto.labs If `TRUE` (by default), use labels (and units) automatically
+#' from data or `origdata=`.
+#' @param origdata The original data set this model was fitted to. By default it
+#' is `NULL` and no label is used (only the name of the variables).
+#' @param labs Labels to change the names of elements in the `term` column of
+#' the table. By default it is `NULL` and nothing is changed.
+#' @param lang The language to use. The default value can be set with, e.g.,
+#' `options(SciViews_lang = "fr")` for French.
+#' @param show.signif.stars If `TRUE`, add the significance stars to the table.
+#' The default is `getOption("show.signif.stars")`
+#' @param ... Not used
#' @param kind The kind of table to produce: "tt" for tinytable, or "ft" for
#' flextable (default).
-#' @param env The environment where to evaluate lazyeval expressions (unused for
-#' now).
+#'
#' @seealso [tabularise::tabularise()], [tabularise::tabularise_tidy()],
#' [tabularise_coef.summary.nls()]
#' @return A **flextable** object that you can print in different forms or
@@ -387,9 +320,28 @@ tabularise_coef.nls <- function(data, header = TRUE, title = NULL,
#'
#' tabularise::tabularise$tidy(chick1_logis)
#' tabularise::tabularise$tidy(chick1_logis, lang = "fr")
-tabularise_tidy.nls <- function(data, ..., kind = "ft", env = parent.frame()) {
- data <- summary(data)
- tabularise_coef.summary.nls(data, ..., kind = kind, env = env)
+tabularise_tidy.nls <- function(data, header = TRUE, title = header,
+ equation = header, auto.labs = TRUE, origdata = NULL, labs = NULL,
+ lang = getOption("SciViews_lang", "en"),
+ show.signif.stars = getOption("show.signif.stars", TRUE), ...,
+ kind = "ft") {
+
+ # If title is not provided, determine if we have to use TRUE or FALSE
+ if (missing(title)) {
+ title <- header # Default to same as header, but...
+ # if a caption is defined in the chunk, it defauts to FALSE
+ if (!is.null(knitr::opts_current$get('tbl-cap')))
+ title <- FALSE
+ }
+
+ df_list <- .extract_infos_nls(
+ data, type = "tidy", show.signif.stars = show.signif.stars, lang = lang,
+ auto.labs = auto.labs, origdata = origdata, labs = labs, equation = equation,
+ title = title, colnames = colnames_nls, footer = FALSE)
+ # print(df_list) # use only for development
+
+ # formatted table
+ format_table(df_list, kind = kind, header = header)
}
#' Glance version of the nls object into a flextable object
@@ -407,13 +359,17 @@ tabularise_tidy.nls <- function(data, ..., kind = "ft", env = parent.frame()) {
#' @param equation Add equation of the model to the table. If `TRUE`,
#' [equation()] is used. The equation can also be passed in the form of a
#' character string (LaTeX).
+#' @param auto.labs If `TRUE` (by default), use labels (and units) automatically
+#' from data or `origdata=`.
+#' @param origdata The original data set this model was fitted to. By default it
+#' is `NULL` and no label is used (only the name of the variables).
+#' @param labs Labels to change the names of elements in the `term` column of
+#' the table. By default it is `NULL` and nothing is changed.
#' @param lang The language to use. The default value can be set with, e.g.,
-#' `options(data.io_lang = "fr")` for French.
-#' @param ... Additional arguments passed to [equation()]
+#' `options(SciViews_lang = "fr")` for French.
+#' @param ... Not used
#' @param kind The kind of table to produce: "tt" for tinytable, or "ft" for
#' flextable (default).
-#' @param env The environment where to evaluate lazyeval expressions (unused for
-#' now).
#'
#' @seealso [tabularise::tabularise_glance()], [tabularise_coef.summary.nls()]
#' @return A **flextable** object that you can print in different forms or
@@ -431,9 +387,9 @@ tabularise_tidy.nls <- function(data, ..., kind = "ft", env = parent.frame()) {
#'
#' tabularise::tabularise$glance(chick1_logis)
#' tabularise::tabularise$glance(chick1_logis, lang = "fr")
-tabularise_glance.nls <- function(data, header = TRUE, title = NULL,
- equation = header, lang = getOption("data.io_lang", "en"), ..., kind = "ft",
- env = parent.frame()) {
+tabularise_glance.nls <- function(data, header = TRUE, title = header,
+ equation = header, auto.labs = TRUE, origdata = NULL,
+ labs = NULL, lang = getOption("SciViews_lang", "en"), ..., kind = "ft") {
# If title is not provided, determine if we have to use TRUE or FALSE
if (missing(title)) {
@@ -443,37 +399,14 @@ tabularise_glance.nls <- function(data, header = TRUE, title = NULL,
title <- FALSE
}
- # Choose the language
- lang <- tolower(lang)
-
- if (lang != "fr")
- lang <- "en" # Only en or fr for now
-
- if (lang == "fr") {
- info_lang <- infos_fr.nls
- } else {
- info_lang <- infos_en.nls
- }
-
- res <- summary(data)
-
- res1 <- data.frame(
- sigma = res$sigma, finTol = res$convInfo$finTol,
- logLik = as.numeric(stats::logLik(data)), AIC = stats::AIC(data),
- BIC = stats::BIC(data), deviance = stats::deviance(data),
- df.residual = stats::df.residual(data), nobs = stats::nobs(data))
-
- ft <- flextable(res1) |>
- colformat_sci()
-
- # Add labels
- ft <- header_labels(ft, lang = lang)
-
- # Add headers
- ft <- add_header_nls(ft, data = data, header = header,
- title = title, equation = equation, lang = lang)
+ df_list <- .extract_infos_nls(
+ data, type = "glance", show.signif.stars = FALSE, lang = lang,
+ auto.labs = auto.labs, origdata = origdata, labs = labs, equation = equation,
+ title = title, colnames = colnames_nls, footer = FALSE)
+ # print(df_list) # use only for development
- autofit(ft)
+ # formatted table
+ format_table(df_list, kind = kind, header = header)
}
#' Get a LaTeX equation from an nls or the summary of a nls models
@@ -492,6 +425,7 @@ tabularise_glance.nls <- function(data, header = TRUE, title = NULL,
#' @param fix_signs Logical, defaults to `TRUE`. If disabled, coefficient
#' estimates that are negative are preceded with a `+` (e.g. `5(x) + -3(z)`).
#' If enabled, the `+ -` is replaced with a `-` (e.g. `5(x) - 3(z)`).
+#' @param swap_var_names A named character vector as `c(old_var_name = "new name")`
#' @param var_names A named character vector as `c(old_var_name = "new name")`
#' @param op_latex The LaTeX product operator character to use in fancy
#' scientific notation, either `\\cdot` (by default), or `\\times`.
@@ -502,7 +436,7 @@ tabularise_glance.nls <- function(data, header = TRUE, title = NULL,
#' @method equation nls
#'
#' @examples
-#' equation <- tabularise::equation
+#' equation <- equatiomatic::equation
#' chick1 <- ChickWeight[ChickWeight$Chick == 1, ]
#' chick1_nls <- nls(data = chick1, weight ~ SSlogis(Time, Asym, xmid, scal))
#' summary(chick1_nls)
@@ -517,15 +451,16 @@ tabularise_glance.nls <- function(data, header = TRUE, title = NULL,
#' equation(chick1_nls2)
#' equation(summary(chick1_nls2))
#'
-#' equation(summary(chick1_nls2), var_names = c(
+#' equation(summary(chick1_nls2), swap_var_names = c(
#' weight = "Body weight [gm]",
#' Time = "Number of days"))
equation.nls <- function(object, ital_vars = FALSE, use_coefs = FALSE,
-coef_digits = 2L, fix_signs = TRUE, var_names = NULL,
+coef_digits = 2L, fix_signs = TRUE, swap_var_names = NULL, var_names = swap_var_names,
op_latex = c("\\cdot", "\\times"), ...) {
x <- object
- if (!class(x) %in% c("nls", "summary.nls"))
- stop("x must be an nls or summary.nls object")
+ if (!inherits(x, "nls") && !inherits(x, "summary.nls")) {
+ stop("`x` must be an object of class 'nls' or 'summary.nls'.")
+ }
res <- try(stats::formula(x), silent = TRUE)
@@ -644,16 +579,18 @@ op_latex = c("\\cdot", "\\times"), ...) {
for (i in 1:length(vals))
SSequation <- gsub(names(vals)[i], vals[i], SSequation)
- if (!is.null(var_names)) {
- if (!is.character(var_names))
+ if (!is.null(swap_var_names)) {
+ if (!is.character(swap_var_names))
stop("var_names is not character vector")
- if (is.null(names(var_names)))
+ if (is.null(names(swap_var_names)))
stop("var_names must be named character vector")
- if (any(names(var_names) %in% ""))
+ if (any(names(swap_var_names) %in% ""))
stop("all elements must be named")
+ swap_var_names <- gsub(" " , " \\\\\\\\ ", swap_var_names)
+
for (i in 1:length(var_names))
- SSequation <- gsub(names(var_names)[i], var_names[i], SSequation)
+ SSequation <- gsub(names(swap_var_names)[i], swap_var_names[i], SSequation)
}
# Possibly fix signs
@@ -670,219 +607,206 @@ op_latex = c("\\cdot", "\\times"), ...) {
#' @export
#' @method equation summary.nls
equation.summary.nls <- function(object, ital_vars = FALSE, use_coefs = FALSE,
-coef_digits = 2L, fix_signs = TRUE, var_names = NULL,
-op_latex = c("\\cdot", "\\times"), ...) {
+ coef_digits = 2L, fix_signs = TRUE, swap_var_names = NULL,
+ op_latex = c("\\cdot", "\\times"), ...) {
# Same as equation.nls()
equation.nls(object, ital_vars = ital_vars, use_coefs = use_coefs,
- coef_digits = coef_digits, fix_signs = fix_signs, var_names = var_names,
- op_latex = op_latex)
+ coef_digits = coef_digits, fix_signs = fix_signs,
+ swap_var_names = swap_var_names, op_latex = op_latex)
}
-infos_en.nls <- list(
- labs = c(
- term = "Term",
- estimate = "Estimate",
- std.error = "Standard Error",
- statistic = "*t*~obs.~ value",
- p.value = "*p* value",
- sigma = "Relative standard error",
- finTol = "Convergence tolerance",
- logLik = "Log-Likelihood",
- AIC = "AIC",
- BIC = "BIC",
- deviance = "Deviance",
- df.residual = "df",
- nobs = "N"),
- SS = c(
- SSasymp = "Nonlinear least squares asymptotic regression model (von Bertalanffy)",
- SSAsympOff = "Nonlinear least squares asymptotic regression model (von Bertalanffy)",
- SSasympOrig = "Nonlinear least squares asymptotic regression model through the origin (von Bertalanffy)",
- SSbiexp = "Nonlinear least squares biexponential model",
- SSfol = "Nonlinear least squares first-order compartment model",
- SSfpl = "Nonlinear least squares four-parameter logistic model",
- SSgompertz = "Nonlinear least squares Gompertz model",
- SSlogis = "Nonlinear least squares logistic model",
- SSmicmen = "Nonlinear least squares Michaelis-Menten model",
- SSweibull = "Nonlinear least squares Weibull model"
- ),
- footer = c(
- rss = "Residual sum-of-squares",
- rse = "Residual standard error",
- on = "on",
- df = "degrees of freedom",
- nbc = "Number of iterations to convergence",
- ctol = "Achieved convergence tolerance",
- stop = "The model does not converge")
-)
-infos_fr.nls <- list(
- labs = c(
- term = "Terme",
- estimate = "Valeur estim\u00e9e",
- std.error = "Ecart type",
- statistic = "Valeur de *t*~obs.~",
- p.value = "Valeur de *p*",
- sigma = "Ecart type relatif",
- AIC = "AIC",
- df.residual = "Ddl",
- nobs = "N",
- statistic = "Valeur de *t*~obs.~",
- sigma = "Ecart type des r\u00e9sidus",
- finTol = "Tol\u00e9rance de convergence",
- logLik = "Log-vraisemblance",
- AIC = "AIC",
- BIC = "BIC",
- deviance = "D\u00e9viance",
- df.residual = "Ddl",
- nobs = "N"
- ),
- SS = c(
- SSasymp = "Mod\u00e8le non lin\u00e9aire de r\u00e9gression asymptotique (von Bertalanffy)",
- SSAsympOff = "Mod\u00e8le non lin\u00e9aire de r\u00e9gression asymptotique (von Bertalanffy)",
- SSasympOrig = "Mod\u00e8le non lin\u00e9aire de r\u00e9gression asymptotique forc\u00e9e \u00e0 l'origine (von Bertalanffy)",
- SSbiexp = "Mod\u00e8le non lin\u00e9aire biexponentiel",
- SSfol = "Mod\u00e8le non lin\u00e9aire \u00e0 compartiments du premier ordre",
- SSfpl = "Mod\u00e8le non lin\u00e9aire logistique \u00e0 quatre param\u00e8tres",
- SSgompertz = "Mod\u00e8le non lin\u00e9aire de Gompertz",
- SSlogis = "Mod\u00e8le non lin\u00e9aire logistique",
- SSmicmen = "Mod\u00e8le non lin\u00e9aire de Michaelis-Menten",
- SSweibull = "Mod\u00e8le non lin\u00e9aire de Weibull"
- ),
- footer = c(
- rss = "Somme des carr\u00e9s des r\u00e9sidus",
- rse = "Ecart type des r\u00e9sidus",
- on = "pour",
- df = "degr\u00e9s de libert\u00e9",
- nbc = "Nombre d'it\u00e9rations pour converger",
- ctol = "Tol\u00e9rance atteinte \u00e0 la convergence",
- stop = "Le mod\u00e8le ne converge pas"
- )
+.trad <- gettext(
+ term = "Term",
+ estimate = "Estimate",
+ std.error = "Standard Error",
+ statistic = "*t*~obs.~ value",
+ p.value = "*p* value",
+ sigma = "Relative standard error",
+ finTol = "Convergence tolerance",
+ logLik = "Log-Likelihood",
+ AIC = "AIC",
+ BIC = "BIC",
+ deviance = "Deviance",
+ df.residual = "df",
+ nobs = "N",
+ SSasymp = "Nonlinear least squares asymptotic regression model (von Bertalanffy)",
+ SSAsympOff = "Nonlinear least squares asymptotic regression model (von Bertalanffy)",
+ SSasympOrig = "Nonlinear least squares asymptotic regression model through the origin (von Bertalanffy)",
+ SSbiexp = "Nonlinear least squares biexponential model",
+ SSfol = "Nonlinear least squares first-order compartment model",
+ SSfpl = "Nonlinear least squares four-parameter logistic model",
+ SSgompertz = "Nonlinear least squares Gompertz model",
+ SSlogis = "Nonlinear least squares logistic model",
+ SSmicmen = "Nonlinear least squares Michaelis-Menten model",
+ SSweibull = "Nonlinear least squares Weibull model")
+
+colnames_nls <- c(
+ term = "Term",
+ estimate = "Estimate",
+ std.error = "Standard Error",
+ statistic = "*t*~obs.~ value",
+ p.value = "*p* value",
+ sigma = "Relative standard error",
+ finTol = "Convergence tolerance",
+ logLik = "Log-Likelihood",
+ AIC = "AIC",
+ BIC = "BIC",
+ deviance = "Deviance",
+ df.residual = "df",
+ nobs = "N")
+
+model_nls <- c(
+ SSasymp = "Nonlinear least squares asymptotic regression model (von Bertalanffy)",
+ SSAsympOff = "Nonlinear least squares asymptotic regression model (von Bertalanffy)",
+ SSasympOrig = "Nonlinear least squares asymptotic regression model through the origin (von Bertalanffy)",
+ SSbiexp = "Nonlinear least squares biexponential model",
+ SSfol = "Nonlinear least squares first-order compartment model",
+ SSfpl = "Nonlinear least squares four-parameter logistic model",
+ SSgompertz = "Nonlinear least squares Gompertz model",
+ SSlogis = "Nonlinear least squares logistic model",
+ SSmicmen = "Nonlinear least squares Michaelis-Menten model",
+ SSweibull = "Nonlinear least squares Weibull model"
)
-# Internal function of flextable
-pvalue_format <- function(x){
- #x <- get(as.character(substitute(x)), inherits = TRUE)
- z <- cut(x, breaks = c(-Inf, 0.001, 0.01, 0.05, 0.1, Inf),
- labels = c("***", " **", " *", " .", " "))
- z <- as.character(z)
- z[is.na(x)] <- ""
- z
-}
-
-add_header_nls <- function(x, data,
- lang = lang, header = TRUE, title = NULL, equation = header, ...) {
+# Internal function for nls and summary.nls object
- if (!inherits(x, "flextable"))
- stop(sprintf("Function `%s` supports only flextable objects.",
- "add_header_nls()"))
+.extract_footer_nls <- function(data, lang) {
+ digits <- max(3L, getOption("digits") - 3L)
+ domain <- "R-modelit"
- # If title is not provided, determine if we have to use TRUE or FALSE
- if (missing(title)) {
- title <- header # Default to same as header, but...
- # if a caption is defined in the chunk, it defauts to FALSE
- if (!is.null(knitr::opts_current$get('tbl-cap')))
- title <- FALSE
+ if (inherits(data, "nls")) {
+ val <- gettextf("Residual sum-of-squares: %.*g",
+ digits, data$m$deviance(), domain = domain, lang = lang)
+ } else {
+ val <- gettextf("Residuals standard error: %.*g on %.*g degrees of freedom",
+ digits, data$sigma, digits, max(data$df), domain = domain, lang = lang)
}
- # Choose the language
- lang <- tolower(lang)
-
- if (lang != "fr")
- lang <- "en" # Only en or fr for now
-
- if (lang == "fr") {
- info_lang <- infos_fr.nls
+ conv <- data$convInfo
+ if (isTRUE(conv$isConv)) {
+ convinfo <- paste(
+ gettextf("Number of iterations to convergence: %.*g",
+ digits, conv$finIter, domain = domain, lang = lang),
+ gettextf("Achieved convergence tolerance: %.*g",
+ digits, conv$finTol, domain = domain, lang = lang),
+ sep = "\n")
+ val <- c(val, convinfo)
} else {
- info_lang <- infos_en.nls
+ val <- c(val, gettext("The model does not converge", lang = lang))
}
+ return(val)
+}
- ft <- x
-
- if (isTRUE(header)) {
-
- if (isTRUE(equation)) {
- ssequa <- equation(data, ...)
- ft <- add_header_lines(ft, values = as_paragraph(as_equation(ssequa)))
- ft <- align(ft, i = 1, align = "right", part = "header")
- } else if (is.character(equation)) {
- ft <- add_header_lines(ft, values = as_paragraph(as_equation(equation)))
- ft <- align(ft, i = 1, align = "right", part = "header")
- }
-
- if (isTRUE(title)) {
- ss <- info_lang[["SS"]]
- rhs <- as.character(rlang::f_rhs(formula(data)))[1]
- if (!is.na(ss[rhs])) {
- ft <- add_header_lines(ft, values = ss[rhs])
- ft <- align(ft, i = 1, align = "right", part = "header")
+.extract_infos_nls <- function(data, type = "coef",
+ show.signif.stars = getOption("show.signif.stars", TRUE), lang = "en",
+ colnames = colnames_nls, auto.labs = TRUE, origdata = NULL , labs = NULL,
+ equation = TRUE, title = TRUE, footer = TRUE, ...) {
+
+ if (!inherits(data, c("nls", "summary.nls")))
+ stop(".extract_infos_nls() can apply only nls and summary.nls object.")
+
+ type <- match.arg(type, choices = c("coef", "glance", "tidy"))
+
+ # Extract df
+ if (inherits(data, "nls")) {
+ df <- switch(type,
+ coef = as.data.frame(t(coef(data))),
+ glance = {
+ res <- summary(data)
+ res1 <- data.frame(
+ sigma = res$sigma, finTol = res$convInfo$finTol,
+ logLik = as.numeric(stats::logLik(data)), AIC = stats::AIC(data),
+ BIC = stats::BIC(data), deviance = stats::deviance(data),
+ df.residual = stats::df.residual(data), nobs = stats::nobs(data))
+ res1
+ },
+ tidy = {
+ res <- summary(data)
+ res1 <- coef(res)
+ df <- data.frame(term = rownames(res1), estimate = res1)
+ names(df) <- c("term", "estimate", "std.error", "statistic", "p.value")
+
+ if (isTRUE(show.signif.stars)) {
+ df$signif <- .pvalue_format(df$p.value)
+ }
+
+ df
}
- } else if (is.character(title)) {
- ft <- add_header_lines(ft,
- values = as_paragraph(title))
- ft <- align(ft, i = 1, align = "right", part = "header")
+ )
+ } else {
+ # Only for summary.nls oject
+ if (type == "glance") {
+ stop(".extract_infos_nls() cannot apply type = 'glance' to a summary.nls object.")
}
- }
+ res1 <- coef(data)
+ df <- data.frame(term = rownames(res1), estimate = res1)
+ names(df) <- c("term", "estimate", "std.error", "statistic", "p.value")
- h_nrow <- nrow_part(ft, part = "header")
+ if (isTRUE(show.signif.stars))
+ df$signif <- .pvalue_format(df$p.value)
- if (h_nrow > 2) {
- ft |>
- border_inner_h(border = officer::fp_border(width = 0), part = "header") |>
- hline(i = nrow_part(ft, "header") - 1,
- border = officer::fp_border(width = 1.5, color = "#666666"),
- part = "header") ->
- ft
+ df
}
- ft
-}
-
-# Internal function to change the labels (accept markdown)
-header_labels <- function(x, lang, ...) {
-
- if (!inherits(x, "flextable"))
- stop(sprintf("Function `%s` supports only flextable objects.",
- "header_labels()"))
+ if (isTRUE(show.signif.stars)) {
+ psignif <- "0 <= '***' < 0.001 < '**' < 0.01 < '*' < 0.05"
+ } else {
+ psignif <- NULL
+ }
- # Choose thev language
lang <- tolower(lang)
+ cols <- .extract_colnames(df, labs = colnames, lang = lang)
- if (lang != "fr")
- lang <- "en" # Only en or fr for now
+ data_obj <- attr(data, "object")
- if (lang == "fr") {
- info_lang <- infos_fr.nls
- } else {
- info_lang <- infos_en.nls
- }
+ if (is.null(data_obj)) {
+ labels <- .extract_labels(df = df, data = data, auto.labs = auto.labs,
+ origdata = origdata, labs = labs)
- ft <- x
+ equa <- .extract_equation(data, equation = equation, labs = labels,...)
- labels_auto <- info_lang[["labs"]]
- labels_red <- labels_auto[names(labels_auto) %in% ft$header$col_keys]
+ } else {
+ labels <- .extract_labels(df = df, data = data_obj, auto.labs = auto.labs,
+ origdata = origdata, labs = labs)
- for (i in seq_along(labels_red))
- ft <- mk_par(ft, i = 1, j = names(labels_red)[i],
- value = para_md(labels_red[i]), part = "header")
+ equa <- .extract_equation(data_obj, equation = equation, labs = labels,...)
+ }
- ft
-}
+ if (is.na(equation))
+ equa <- NULL
-# Internal function to add pvalue signif
-add_signif_stars <- function(x, i = NULL, j = NULL, part = "body",
-align = "right", ...) {
+ terms <- NULL
- if (!inherits(x, "flextable"))
- stop(sprintf("Function `%s` supports only flextable objects.",
- "header_labels()"))
+ # title
+ if (!isTRUE(title)) {
+ title <- NULL
+ } else {
+ rhs <- as.character(rlang::f_rhs(formula(data)))[1]
+ if (!is.na(model_nls[rhs])) {
+ title <- gettext(model_nls[rhs], lang = lang)
+ } else {
+ title <- NULL
+ }
+ }
- ft <- x
+ if (is.character(title))
+ title <- title
- ft <- mk_par(ft, i = i, j = j,
- value = as_paragraph(pvalue_format(.data$p.value)))
- ft <- add_footer_lines(ft,
- values = c("0 <= '***' < 0.001 < '**' < 0.01 < '*' < 0.05"))
- ft <- align(ft, i = 1, align = align, part = "footer")
+ # footer
+ if(isTRUE(footer)) {
+ footer <- .extract_footer_nls(data, lang = lang)
+ } else {
+ footer <- NULL
+ }
- ft
+ # List with all elements
+ list(
+ df = df,
+ title = title,
+ cols = cols,
+ equa = equa,
+ terms = terms,
+ psignif = psignif,
+ footer = footer)
}
diff --git a/R/utils.R b/R/utils.R
deleted file mode 100644
index 019f250..0000000
--- a/R/utils.R
+++ /dev/null
@@ -1,159 +0,0 @@
-# Internal functions of flextable
-.pvalue_format <- function(x) {
- #x <- get(as.character(substitute(x)), inherits = TRUE)
- z <- cut(x, breaks = c(-Inf, 0.001, 0.01, 0.05, 0.1, Inf),
- labels = c("***", " **", " *", " .", " "))
- z <- as.character(z)
- z[is.na(x)] <- ""
- z
-}
-
-# Add pvalue signif
-.add_signif_stars <- function(x, i = NULL, j = NULL, part = "body",
-align = "right", ...) {
-
- if (!inherits(x, "flextable")) {
- stop(sprintf("Function `%s` supports only flextable objects.",
- ".add_signif_stars()"))}
-
- ft <- mk_par(x, i = i, j = j,
- value = as_paragraph(.pvalue_format(.data$p.value)))
- ft <- add_footer_lines(ft,
- values = c("0 <= '***' < 0.001 < '**' < 0.01 < '*' < 0.05"))
- align(ft, i = 1, align = align, part = "footer")
-}
-
-# 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
-# }
-
-# Retrieve model parameters
-.params_equa <- function(x, intercept = "alpha", greek = "beta") {
- vals <- NULL
-
- if (intercept != greek && grepl(intercept, x)) {
- it <- paste0("\\\\", intercept)
- res <- regmatches(x, gregexpr(it, x))[[1]]
- vals <- paste0("$",res, "$")
- }
-
- if (grepl(greek, x)) {
- g <- paste0("\\\\", greek,"_\\{\\d*\\}")
- res <- regmatches(x, gregexpr(g, x))[[1]]
- res1 <- paste0("$",res, "$")
- vals <- c(vals, res1)
- }
-
- vals
-}
-
-# Change labels of header
-.header_labels <- function(x, info_lang, ...) {
-
- if (!inherits(x, "flextable")) {
- stop(sprintf("Function `%s` supports only flextable objects.",
- "header_labels_lm()")) }
-
- ft <- x
-
- hlabs <- info_lang[["labs"]]
- hlabs_red <- hlabs[names(hlabs) %in% ft$header$col_keys]
-
- for (i in seq_along(hlabs_red))
- ft <- mk_par(ft, i = 1, j = names(hlabs_red)[i],
- value = para_md(hlabs_red[i]), part = "header")
-
- ft
-}
-
-# Add header
-.add_header <- function(x, info_lang, header = TRUE, title = NULL, equation,
-...) {
-
- # If title is not provided, determine if we have to use TRUE or FALSE
- if (missing(title)) {
- title <- header # Default to same as header, but...
- # if a caption is defined in the chunk, it defauts to FALSE
- if (!is.null(knitr::opts_current$get('tbl-cap')))
- title <- FALSE
- }
-
- if (!inherits(x, "flextable")) {
- stop(sprintf("Function `%s` supports only flextable objects.",
- ".add_header()")) }
-
- ft <- x
-
- if (isTRUE(header)) {
- if (is.character(equation)) {
- ft <- add_header_lines(ft,
- values = as_paragraph(as_equation(equation)))
- ft <- align(ft, i = 1, align = "right", part = "header")
- }
-
- if (isTRUE(title)) {
- ft <- add_header_lines(ft, values = info_lang[["header"]])
- ft <- align(ft, i = 1, align = "right", part = "header")
- }
-
- if (is.character(title)) {
- ft <- add_header_lines(ft,
- values = as_paragraph(title))
- ft <- align(ft, i = 1, align = "right", part = "header")
- }
- }
-
- h_nrow <- nrow_part(ft, part = "header")
-
- if (h_nrow > 2) {
- ft |>
- border_inner_h(border = officer::fp_border(width = 0), part = "header") |>
- hline(i = nrow_part(ft, "header") - 1,
- border = officer::fp_border(width = 1.5, color = "#666666"),
- part = "header") ->
- ft
- }
-
- ft
-}
diff --git a/README.Rmd b/README.Rmd
index f2e59cd..db3c815 100644
--- a/README.Rmd
+++ b/README.Rmd
@@ -1,17 +1,10 @@
---
-title: "Statistical Models for 'SciViews::R' 
"
output: github_document
---
-
+
-
-
-[](https://github.com/SciViews/modelit/actions/workflows/R-CMD-check.yaml) [](https://codecov.io/gh/SciViews/modelit?branch=main) [](https://cran.r-project.org/package=modelit) [](https://sciviews.r-universe.dev/modelit) [](https://opensource.org/licenses/MIT) [](https://lifecycle.r-lib.org/articles/stages.html#experimental)
-
-
-
-```{r setup, include = FALSE}
+```{r setup, include=FALSE}
knitr::opts_chunk$set(collapse = TRUE, comment = "#>",
fig.path = "man/figures/README-", out.width = "80%")
library(modelit)
@@ -19,16 +12,27 @@ library(tabularise)
library(chart)
```
+# 'SciViews::R' - Statistical Models
+
+
+[](https://github.com/SciViews/modelit/actions/workflows/R-CMD-check.yaml)
+[](https://codecov.io/gh/SciViews/modelit?branch=main)
+[](https://cran.r-project.org/package=modelit)
+[](https://sciviews.r-universe.dev/modelit)
+[](https://opensource.org/licenses/MIT)
+[](https://lifecycle.r-lib.org/articles/stages.html#experimental)
+
+
The {modelit} package adds the statistical models to the SciViews::R dialect. It uses both the `fun$type(data = ...., formula)` approach and the enhanced formula allowing to specify arguments with `%arg=%` directly inside the formula. It also takes the variable labels into account in the outputs.
The {modelit} package provides methods (**lm**, **glm**; **nls** objects) for the `chart()` function in the {chart} package and the `tabularise()` function in the {tabularise} package.
## Installation
-{modelit} is not available from CRAN yet. You should install it from the [SciViews R-Universe](https://sciviews.r-universe.dev). {chart} is an alternate formula interface to {ggplot2}. {tabularise} produces publication-ready (rich-formatted) tabular output. The {equatags} and {equatiomatic} packages are optional, but they are useful to display equations, both inline in R Markdown/Quarto documents and in {tabularise} tables. {data.io} is useful too because it manages labels and units that {chart} uses. To install these six packages and their dependencies, run the following command in R:
+{modelit} is not available from CRAN yet. You should install it from the [SciViews R-Universe](https://sciviews.r-universe.dev). {chart} is an alternate formula interface to {ggplot2}. {tabularise} produces publication-ready (rich-formatted) tabular output. The {equatags} and {equatiomatic} packages are optional, but they are useful to display equations, both inline in R Markdown/Quarto documents and in {tabularise} tables. {svBase} is useful too because it manages labels and units that {chart} uses. To install these six packages and their dependencies, run the following command in R:
```{r, eval=FALSE}
-install.packages(c('modelit', 'chart', 'tabularise', 'equatags', 'equatiomatic', 'data.io'),
+install.packages(c('modelit', 'chart', 'tabularise', 'equatags', 'equatiomatic', 'svBase'),
repos = c('https://sciviews.r-universe.dev', 'https://cloud.r-project.org'))
```
diff --git a/README.md b/README.md
index 7992a0e..3fc39e8 100644
--- a/README.md
+++ b/README.md
@@ -1,13 +1,12 @@
-Statistical Models for ‘SciViews::R’
-
-================
-
+
+
+# ‘SciViews::R’ - Statistical Models
+
[](https://github.com/SciViews/modelit/actions/workflows/R-CMD-check.yaml)
-[](https://codecov.io/gh/SciViews/modelit?branch=main)
+[](https://codecov.io/gh/SciViews/modelit?branch=main)
[](https://cran.r-project.org/package=modelit)
[](https://sciviews.r-univ
MIT](https://img.shields.io/badge/License-MIT-yellow.svg)](https://opensource.org/licenses/MIT)
[](https://lifecycle.r-lib.org/articles/stages.html#experimental)
-
The {modelit} package adds the statistical models to the SciViews::R
@@ -37,12 +35,12 @@ alternate formula interface to {ggplot2}. {tabularise} produces
publication-ready (rich-formatted) tabular output. The {equatags} and
{equatiomatic} packages are optional, but they are useful to display
equations, both inline in R Markdown/Quarto documents and in
-{tabularise} tables. {data.io} is useful too because it manages labels
+{tabularise} tables. {svBase} is useful too because it manages labels
and units that {chart} uses. To install these six packages and their
dependencies, run the following command in R:
``` r
-install.packages(c('modelit', 'chart', 'tabularise', 'equatags', 'equatiomatic', 'data.io'),
+install.packages(c('modelit', 'chart', 'tabularise', 'equatags', 'equatiomatic', 'svBase'),
repos = c('https://sciviews.r-universe.dev', 'https://cloud.r-project.org'))
```
diff --git a/TODO.md b/TODO.md
index db4842f..6429df9 100644
--- a/TODO.md
+++ b/TODO.md
@@ -1,17 +1,32 @@
+---
+editor_options:
+ markdown:
+ wrap: sentence
+---
+
# modelit To Do list
-- Using labels with `equation.nls()`
+- 🔥 High Priority: Improve translation management across the package.
+ Currently, multiple calls to gettext() and gettextf() from {svMisc} are used.
+
+- Introduced the first version of tabularise\_\*\*\*() methods for objects such as lm, nls, and glm, initially designed to generate tables using the {flextable} package.
+ Future versions will support multiple output formats via {flextable}, {tinytable}, and {gt}.
+ To enable this flexibility, a unified internal object structure is being developed to store all relevant metadata (e.g., labels, units, formatting).
+ This structure will allow seamless conversion to different table formats using functions like as_flextable(), as_tinytable(), and as_gt().
-- Propose specific tables with `tabularise()` for **lm**, **nls**, **glm** objects, etc. with {tinytable} in addition to {flextable}
+- Implement tabularise\_\*\*\*() methods for enriched model objects: nls\_, lm\_, summary.lm\_, anova\_, etc.
+ These methods should leverage the metadata (e.g., labels, units) embedded in the enriched objects to produce consistent and informative tables.
-- `tabularise()` for **merMod** and **summary.merMod** objects (\< `lme4::glmer()`)
+- Complete the examples sections of the tabularise\_\*\*\*() functions for the following object types: lm, summary.lm, nls, summary.nls,...
-- `tabularise()` for **anova** and **aov** =\> rework and decide where to place these ({inferit}, {modelit}, elsewhere...?) + `car::Anova()`. Also, there is no proper `tabularise_default()` method for **aov** objects
+- Implement tabularise\_\*\*\*() methods for merMod and summary.merMod objects (e.g., from lme4::glmer()).
-- `chart()` for **lm** with categorical variables
+- Extend tabularise() support for anova and aov objects.
-- multiple comparisons
+ - Rework the current implementation and determine the appropriate package context ({inferit}, {modelit}, or another).
+ - Also consider integration with car::Anova().
+ - Note: there is currently no proper tabularise_default() method for aov objects.
-- train/test
+- Develop chart() method for lm objects with categorical predictors (e.g., visualizing factor effects).
-- Add various SS models
+- Add support for multiple comparisons.
diff --git a/inst/CITATION b/inst/CITATION
index 5be4aa1..2be61fc 100644
--- a/inst/CITATION
+++ b/inst/CITATION
@@ -1,24 +1,13 @@
-citHeader("To cite SciViews-R in publications use:")
-
-citEntry(
- entry = "Manual",
- title = "SciViews::R",
- author = personList(as.person("Philippe Grosjean"),
- as.person("Guyliann Engels")),
- organization = "UMONS",
- address = "MONS, Belgium",
- year = version$year,
- url = "https://sciviews.r-universe.dev/",
-
- textVersion =
- paste("Grosjean, Ph. & Engels, G. (", version$year, "). ",
- "SciViews::R. ",
- "UMONS, Mons, Belgium. ",
- "URL https://sciviews.r-universe.dev/.",
- sep = "")
+bibentry(
+ bibtype = "Misc",
+ header = "To cite SciViews::R in publications, please use",
+ author = c(person("Philippe", "Grosjean", role = c("aut", "cre"),
+ email = "phgrosjean@sciviews.org",
+ comment = c(ORCID = "0000-0002-2694-9471")),
+ person("Guyliann", "Engels", role = "aut",
+ email = "guyliann.engels@umons.ac.be",
+ comment = c(ORCID = "0000-0001-9514-1014"))),
+ title = "'data.trame': A better 'data.frame' for 'SciViews::R'",
+ year = "2025",
+ url = "https://sciviews.r-universe.dev/",
)
-
-citFooter("We have invested a lot of time and effort in creating SciViews-R,",
- "please cite it when using it together with R.",
- "See also", sQuote("citation()"),
- "for citing R.")
diff --git a/inst/WORDLIST b/inst/WORDLIST
index b56ad8f..644bd8d 100644
--- a/inst/WORDLIST
+++ b/inst/WORDLIST
@@ -6,12 +6,14 @@ Codecov
datalorax
dir
equatiomatic
+eval
flextable
ggplot
GitHub
glm
Gompertz
hexSticker
+io
lazyeval
Lifecycle
lightblue
@@ -22,6 +24,7 @@ modelr
mtcars
nls
ORCID
+param
Pinus
png
qqplot
@@ -33,6 +36,7 @@ resleverage
scalelocation
SciViews
showWarnings
+svBase
svMisc
tabularise
tadea
diff --git a/inst/po/en@quot/LC_MESSAGES/R-modelit.mo b/inst/po/en@quot/LC_MESSAGES/R-modelit.mo
new file mode 100644
index 0000000..576fc88
Binary files /dev/null and b/inst/po/en@quot/LC_MESSAGES/R-modelit.mo differ
diff --git a/inst/po/fr/LC_MESSAGES/R-modelit.mo b/inst/po/fr/LC_MESSAGES/R-modelit.mo
new file mode 100644
index 0000000..fcb7eb8
Binary files /dev/null and b/inst/po/fr/LC_MESSAGES/R-modelit.mo differ
diff --git a/man/anova.lm_.Rd b/man/anova.lm_.Rd
new file mode 100644
index 0000000..10e90c4
--- /dev/null
+++ b/man/anova.lm_.Rd
@@ -0,0 +1,44 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/lm_.R
+\name{anova.lm_}
+\alias{anova.lm_}
+\title{ANOVA Tables for Enhanced Linear Models (\code{lm_})}
+\usage{
+\method{anova}{lm_}(object, ...)
+}
+\arguments{
+\item{object}{An object of class \code{lm_}, typically returned by \code{\link[=lm_]{lm_()}}.}
+
+\item{...}{Additional arguments passed to \code{\link[stats:anova]{stats::anova()}}.}
+}
+\value{
+An object of class \code{anova_}, which inherits from \code{anova} and may include
+a \code{labels} component if available in the original model.
+}
+\description{
+\code{anova.lm_()} is a method for objects of class \code{lm_}, extending the standard
+\code{\link[stats:anova]{stats::anova()}} functionality.
+It returns an ANOVA table similar to the base version but includes additional
+metadata such as variable labels (if available), making the output more
+informative for interpretation and reporting.
+
+This method is part of the experimental \code{lm_()} modeling framework.
+}
+\examples{
+data(iris)
+
+# Add labels to variables
+attr(iris$Sepal.Length, "label") <- "Sepal Length (cm)"
+attr(iris$Petal.Length, "label") <- "Petal Length (cm)"
+
+# Fit model using lm_()
+model <- lm_(iris, Petal.Length ~ Sepal.Length + Species)
+
+# Get ANOVA table with labels
+anova_model <- anova(model)
+anova_model
+
+# Access labels
+anova_model$labels
+
+}
diff --git a/man/anova_.Rd b/man/anova_.Rd
new file mode 100644
index 0000000..40fdfe0
--- /dev/null
+++ b/man/anova_.Rd
@@ -0,0 +1,29 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/lm_.R
+\name{anova_}
+\alias{anova_}
+\title{ANOVA tables with the original object as an attribute}
+\usage{
+anova_(object, ...)
+}
+\arguments{
+\item{object}{An object for which anova or deviance tables should be computed.}
+
+\item{...}{Additional arguments passed to the \code{anova()} function.}
+}
+\value{
+An anova object with an additional \code{"object"} attribute containing
+the original input.
+}
+\description{
+This function attempts to compute anova or deviance tables using the
+standard \code{\link[stats:anova]{stats::anova()}} function. The original object is attached as an
+attribute to the result for reference.
+}
+\examples{
+is_lm <- lm(data = iris, Petal.Length ~ Sepal.Length)
+anova(is_lm)
+
+anova_(is_lm)
+attr(anova_(is_lm), "object")
+}
diff --git a/man/chart.lm.Rd b/man/chart.lm.Rd
index 7e6d1ef..8b155f6 100644
--- a/man/chart.lm.Rd
+++ b/man/chart.lm.Rd
@@ -13,7 +13,7 @@
title,
labels = "AUTO",
name = deparse(substitute(data)),
- lang = getOption("data.io_lang", "en"),
+ lang = getOption("SciViews_lang", "en"),
env = parent.frame()
)
@@ -27,7 +27,7 @@ autoplot.lm(
ylab,
...,
name = deparse(substitute(object)),
- lang = getOption("data.io_lang", "en"),
+ lang = getOption("SciViews_lang", "en"),
env = parent.frame()
)
}
diff --git a/man/chart.nls.Rd b/man/chart.nls.Rd
index bc418ab..57fad85 100644
--- a/man/chart.nls.Rd
+++ b/man/chart.nls.Rd
@@ -12,7 +12,7 @@
title,
labels = "AUTO",
name = deparse(substitute(data)),
- lang = getOption("data.io_lang", "en"),
+ lang = getOption("SciViews_lang", "en"),
env = parent.frame()
)
@@ -24,7 +24,7 @@ autoplot.nls(
ylab,
...,
name = deparse(substitute(object)),
- lang = getOption("data.io_lang", "en"),
+ lang = getOption("SciViews_lang", "en"),
env = parent.frame()
)
}
diff --git a/man/equation.nls.Rd b/man/equation.nls.Rd
index 95b6b0a..d50e6f8 100644
--- a/man/equation.nls.Rd
+++ b/man/equation.nls.Rd
@@ -11,7 +11,8 @@
use_coefs = FALSE,
coef_digits = 2L,
fix_signs = TRUE,
- var_names = NULL,
+ swap_var_names = NULL,
+ var_names = swap_var_names,
op_latex = c("\\\\cdot", "\\\\times"),
...
)
@@ -22,7 +23,7 @@
use_coefs = FALSE,
coef_digits = 2L,
fix_signs = TRUE,
- var_names = NULL,
+ swap_var_names = NULL,
op_latex = c("\\\\cdot", "\\\\times"),
...
)
@@ -44,6 +45,8 @@ round to when displaying model estimates with \code{use_coefs = TRUE}.}
estimates that are negative are preceded with a \code{+} (e.g. \code{5(x) + -3(z)}).
If enabled, the \verb{+ -} is replaced with a \code{-} (e.g. \code{5(x) - 3(z)}).}
+\item{swap_var_names}{A named character vector as \code{c(old_var_name = "new name")}}
+
\item{var_names}{A named character vector as \code{c(old_var_name = "new name")}}
\item{op_latex}{The LaTeX product operator character to use in fancy
@@ -59,7 +62,7 @@ Create the model equation of several self-starting nonlinear
models available in the stats package.
}
\examples{
-equation <- tabularise::equation
+equation <- equatiomatic::equation
chick1 <- ChickWeight[ChickWeight$Chick == 1, ]
chick1_nls <- nls(data = chick1, weight ~ SSlogis(Time, Asym, xmid, scal))
summary(chick1_nls)
@@ -74,7 +77,7 @@ summary(chick1_nls2)
equation(chick1_nls2)
equation(summary(chick1_nls2))
-equation(summary(chick1_nls2), var_names = c(
+equation(summary(chick1_nls2), swap_var_names = c(
weight = "Body weight [gm]",
Time = "Number of days"))
}
diff --git a/man/figures/README-unnamed-chunk-7-1.png b/man/figures/README-unnamed-chunk-7-1.png
index 7c4cfd5..689c6c3 100644
Binary files a/man/figures/README-unnamed-chunk-7-1.png and b/man/figures/README-unnamed-chunk-7-1.png differ
diff --git a/man/glm_.Rd b/man/glm_.Rd
new file mode 100644
index 0000000..30c991f
--- /dev/null
+++ b/man/glm_.Rd
@@ -0,0 +1,48 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/lm_.R
+\name{glm_}
+\alias{glm_}
+\title{Fitting Generalized Linear Models with Enhanced Output (Experimental)}
+\usage{
+glm_(data = (.), formula, ..., .data = data)
+}
+\arguments{
+\item{data}{A \code{data.frame} containing the variables in the model.}
+
+\item{formula}{An object of class \code{formula}: a symbolic description of the
+model to be fitted.}
+
+\item{...}{Additional arguments passed to \code{\link[stats:glm]{stats::glm()}}.}
+
+\item{.data}{an alias for the \code{data} argument}
+}
+\value{
+An object of class \code{glm_}, which inherits from \code{glm}, and includes
+additional components such as \code{labels}. If no additional attributes are
+added, a standard \code{glm} object is returned.
+}
+\description{
+\code{glm_()} is an \strong{experimental} wrapper around the base \code{\link[stats:glm]{stats::glm()}}
+function. It behaves similarly to \code{glm()}, but enriches the returned object
+with additional metadata. The order of the arguments differs from \code{glm()},
+and the function uses evaluation through \link[svBase:prepare_data_dot]{svBase::prepare_data_dot} and
+\link[svBase:prepare_data_dot]{svBase::recall_with_data_dot} to support the data-dot mechanism.
+}
+\examples{
+data(iris)
+
+# Add labels to variables
+attr(iris$Sepal.Length, "label") <- "Sepal Length (cm)"
+attr(iris$Petal.Length, "label") <- "Petal Length (cm)"
+
+# Fit the model using lm_()
+res <- glm_(iris, formula = Petal.Length ~ Sepal.Length + Species)
+
+res
+class(res)
+summary(res)
+
+# Access labels
+res$labels
+
+}
diff --git a/man/lm_.Rd b/man/lm_.Rd
new file mode 100644
index 0000000..0d0e27a
--- /dev/null
+++ b/man/lm_.Rd
@@ -0,0 +1,49 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/lm_.R
+\name{lm_}
+\alias{lm_}
+\title{Fitting Linear Models with Enhanced Output (Experimental)}
+\usage{
+lm_(data = (.), formula, ..., .data = data)
+}
+\arguments{
+\item{data}{A \code{data.frame} containing the variables in the model.}
+
+\item{formula}{An object of class \code{formula}: a symbolic description of the model to be fitted.}
+
+\item{...}{Additional arguments passed to \code{\link[stats:lm]{stats::lm()}}.}
+
+\item{.data}{an alias for the \code{data} argument}
+}
+\value{
+An object of class \code{lm_}, which inherits from \code{lm}, and includes additional
+components such as \code{labels}. If no additional attributes are added, a standard \code{lm} object is returned.
+}
+\description{
+\code{lm_()} is an \strong{experimental} wrapper around the base \code{\link[stats:lm]{stats::lm()}} function.
+It behaves similarly to \code{lm()}, but enriches the returned object with additional metadata.
+The order of the arguments differs from \code{lm()}, and the function uses evaluation
+through \link[svBase:prepare_data_dot]{svBase::prepare_data_dot} and \link[svBase:prepare_data_dot]{svBase::recall_with_data_dot} to support the data-dot mechanism.
+}
+\examples{
+data(iris)
+
+# Add labels to variables
+attr(iris$Sepal.Length, "label") <- "Sepal Length (cm)"
+attr(iris$Petal.Length, "label") <- "Petal Length (cm)"
+
+# Fit the model using lm_()
+res <- lm_(iris, formula = Petal.Length ~ Sepal.Length + Species)
+
+. <- iris
+res1 <- lm_(Petal.Length ~ Sepal.Length + Species)
+
+
+res
+class(res)
+summary(res)
+
+# Access labels
+res$labels
+
+}
diff --git a/man/modelit-package.Rd b/man/modelit-package.Rd
index 0bfa6c9..cdd8d2d 100644
--- a/man/modelit-package.Rd
+++ b/man/modelit-package.Rd
@@ -4,7 +4,7 @@
\name{modelit-package}
\alias{modelit}
\alias{modelit-package}
-\title{Statistical Models for 'SciViews::R'}
+\title{'SciViews::R' - Statistical Models}
\description{
The \{modelit\} package provides an extension to base R functions for model
fitting like \code{\link[=lm]{lm()}}, \code{\link[=glm]{glm()}} or \code{\link[=nls]{nls()}} with enhanced plots and utilitarian
diff --git a/man/nls_.Rd b/man/nls_.Rd
new file mode 100644
index 0000000..5cb857f
--- /dev/null
+++ b/man/nls_.Rd
@@ -0,0 +1,50 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/lm_.R
+\name{nls_}
+\alias{nls_}
+\title{Fitting Non Linear Models with Enhanced Output (Experimental)}
+\usage{
+nls_(data = (.), formula, model = TRUE, ..., .data = data)
+}
+\arguments{
+\item{data}{A \code{data.frame} containing the variables in the model.}
+
+\item{formula}{An object of class \code{formula}: a symbolic description of the
+model to be fitted.}
+
+\item{model}{logical. If true, the model frame is returned as part of the
+object. Default is FALSE.}
+
+\item{...}{Additional arguments passed to \code{\link[stats:nls]{stats::nls()}}.}
+
+\item{.data}{an alias for the \code{data} argument}
+}
+\value{
+An object of class \code{nls_}, which inherits from \code{nls}, and includes
+additional components such as \code{labels}. If no additional attributes are
+added, a standard \code{nls} object is returned.
+}
+\description{
+\code{nls_()} is an \strong{experimental} wrapper around the base \code{\link[stats:nls]{stats::nls()}}
+function. It behaves similarly to \code{glm()}, but enriches the returned object
+with additional metadata. The order of the arguments differs from \code{glm()},
+and the function uses evaluation through \code{\link[svBase:prepare_data_dot]{svBase::recall_with_data_dot()}} to support
+the data-dot mechanism.
+}
+\examples{
+chick1 <- ChickWeight[ChickWeight$Chick == 1, ]
+# Add labels to variables
+attr(chick1$weight, "label") <- "Body weight [gm]"
+attr(chick1$Time, "label") <- "Number of days"
+
+chick1_nls <- nls_(data = chick1, weight ~ SSlogis(Time, Asym, xmid, scal))
+
+
+chick1_nls
+class(chick1_nls)
+summary(chick1_nls)
+
+# Access labels
+chick1_nls
+
+}
diff --git a/man/summary.lm_.Rd b/man/summary.lm_.Rd
new file mode 100644
index 0000000..89d7f79
--- /dev/null
+++ b/man/summary.lm_.Rd
@@ -0,0 +1,45 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/lm_.R
+\name{summary.lm_}
+\alias{summary.lm_}
+\title{Summarizing Linear Model Fits with Enhanced Output}
+\usage{
+\method{summary}{lm_}(object, ...)
+}
+\arguments{
+\item{object}{An object of class \code{lm_}, typically returned by \code{\link[=lm_]{lm_()}}.}
+
+\item{...}{Additional arguments passed to \code{\link[stats:summary.lm]{stats::summary.lm()}}.}
+}
+\value{
+An object of class \code{summary.lm_}, which inherits from \code{summary.lm} and
+includes an optional \code{labels} component if available in the original model.
+}
+\description{
+\code{summary.lm_()} is a method for objects of class \code{lm_}, extending the standard
+\code{\link[=summary.lm]{summary.lm()}} functionality.
+It returns a summary object similar to \code{summary.lm}, but includes additional
+metadata such as variable labels (if available), making the output more
+informative for reporting and interpretation.
+
+This method is part of the experimental \code{lm_()} modeling framework.
+}
+\examples{
+data(iris)
+
+# Add labels to variables
+attr(iris$Sepal.Length, "label") <- "Sepal Length (cm)"
+attr(iris$Petal.Length, "label") <- "Petal Length (cm)"
+attr(iris$Species, "label") <- "Iris Species"
+
+# Fit model using lm_()
+model <- lm_(iris, formula = Petal.Length ~ Sepal.Length + Species)
+
+# Get summary with labels
+summary_model <- summary(model)
+summary_model
+
+# Access labels
+summary_model$labels
+
+}
diff --git a/man/summary_.Rd b/man/summary_.Rd
new file mode 100644
index 0000000..89753a1
--- /dev/null
+++ b/man/summary_.Rd
@@ -0,0 +1,31 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/lm_.R
+\name{summary_}
+\alias{summary_}
+\title{Object summaries with the original object as an attribute}
+\usage{
+summary_(object, ...)
+}
+\arguments{
+\item{object}{An object to be summarized.}
+
+\item{...}{Additional arguments passed to the \code{summary()} function.}
+}
+\value{
+A summary object with an additional \code{"object"} attribute containing
+the original input.
+}
+\description{
+This function attempts to summarize an object using the standard \code{\link[base:summary]{base::summary()}}
+function. The original object is attached as an attribute to the result for
+reference.
+}
+\examples{
+
+is_lm <- lm(data = iris, Petal.Length ~ Sepal.Length)
+summary(is_lm)
+
+summary_(is_lm)
+attr(summary_(is_lm), "object")
+
+}
diff --git a/man/tabularise_coef.glm.Rd b/man/tabularise_coef.glm.Rd
index 65d08c9..14d6c84 100644
--- a/man/tabularise_coef.glm.Rd
+++ b/man/tabularise_coef.glm.Rd
@@ -6,13 +6,14 @@
\usage{
\method{tabularise_coef}{glm}(
data,
- header = TRUE,
- title = NULL,
+ header = FALSE,
+ title = header,
equation = header,
auto.labs = TRUE,
origdata = NULL,
labs = NULL,
- lang = getOption("data.io_lang", "en"),
+ footer = FALSE,
+ lang = getOption("SciViews_lang", default = Sys.getenv("LANGUAGE", unset = "en")),
...,
kind = "ft",
env = parent.frame()
@@ -21,34 +22,49 @@
\arguments{
\item{data}{A \strong{glm} object}
-\item{header}{If \code{TRUE} (by default), add a header to the table}
+\item{header}{Logical. If \code{TRUE} (default), a header is added to the table.
+The header includes both the title and the equation (if applicable).
+If set to \code{FALSE}, neither the title nor the equation will be displayed in
+the table header, even if the \code{title} or \code{equation} parameters are provided.}
\item{title}{If \code{TRUE}, add a title to the table header. Default to the same
value than header, except outside of a chunk where it is \code{FALSE} if a table
caption is detected (\code{tbl-cap} YAML entry).}
-\item{equation}{If \code{TRUE} (by default), add an equation to the table header.
-The equation can also be passed in the form of a character string (LaTeX).}
+\item{equation}{Logical or character. Controls whether an equation is added
+to the table header and how parameters are used. Accepted values are:
+\itemize{
+\item \code{TRUE}: The equation is generated and added to the table header. Its
+parameters are also used in the "Term" column.
+\item \code{FALSE} (by default): No equation is generated or displayed, and its
+parameters are not used in the "Term" column.
+\item \code{NA}: The equation is generated but not displayed in the table header.
+Its parameters are used in the "Term" column.
+\item Character string: A custom equation is provided directly and added to
+the table header.
+}}
\item{auto.labs}{If \code{TRUE} (by default), use labels (and units) automatically
-from \verb{origdata=}.}
+from data or \verb{origdata=}.}
\item{origdata}{The original data set this model was fitted to. By default it
-is \code{NULL} and labels of the original data set are not used.}
+is \code{NULL} and no label is used.}
\item{labs}{Labels to change the names of elements in the \code{term} column of
-the table. By default, it is \code{NULL} and no change is performed.}
+the table. By default it is \code{NULL} and nothing is changed.}
+
+\item{footer}{If \code{TRUE} (\code{FALSE} by default), add a footer to the table.}
\item{lang}{The natural language to use. The default value can be set with,
-e.g., \code{options(data.io_lang = "fr")} for French.}
+e.g., \code{options(SciViews_lang = "fr")} for French.}
-\item{...}{Additional arguments (not used yet).}
+\item{...}{Additional arguments}
\item{kind}{The kind of table to produce: "tt" for tinytable, or "ft" for
flextable (default).}
-\item{env}{The environment where to evaluate lazyeval expressions (unused for
-now).}
+\item{env}{The environment where to evaluate formulas (you probably do not
+need to change the default).}
}
\value{
A \strong{flextable} object is returned. You can print it in different
@@ -62,4 +78,15 @@ to \code{\link[stats:coef]{stats::coef()}}, but in a rich-formatted \strong{flex
\examples{
iris_glm <- glm(data = iris, Petal.Length ~ Sepal.Length)
tabularise::tabularise$coef(iris_glm)
+
+# If the 'iris' dataset has labels and units, they can be used to enhance
+# the output table
+iris <- svBase::labelise(iris, self = FALSE, label = list(
+ Sepal.Length = "Length of the sepals",
+ Petal.Length = "Length of the petals",
+ Species = "Species"), units = c(rep("cm", 4), NA))
+
+iris_glm1 <- glm(data = iris, Petal.Length ~ Sepal.Length + Species)
+tabularise::tabularise$coef(iris_glm1)
+
}
diff --git a/man/tabularise_coef.lm.Rd b/man/tabularise_coef.lm.Rd
index 501c7f8..c1a5aa4 100644
--- a/man/tabularise_coef.lm.Rd
+++ b/man/tabularise_coef.lm.Rd
@@ -6,29 +6,42 @@
\usage{
\method{tabularise_coef}{lm}(
data,
- header = TRUE,
- title = NULL,
+ header = FALSE,
+ title = header,
equation = header,
auto.labs = TRUE,
origdata = NULL,
labs = NULL,
- lang = getOption("data.io_lang", "en"),
+ lang = getOption("SciViews_lang", default = Sys.getenv("LANGUAGE", unset = "en")),
...,
- kind = "ft",
- env = parent.frame()
+ kind = "ft"
)
}
\arguments{
\item{data}{An \strong{lm} object}
-\item{header}{If \code{TRUE} (by default), add a header to the table}
+\item{header}{Logical. If \code{TRUE} (\code{FALSE}by default), a header is added to
+the table. The header includes both the title and the equation (if
+applicable). If set to \code{FALSE}, neither the title nor the equation will be
+displayed in the table header, even if the \code{title} or \code{equation} parameters
+are provided.}
-\item{title}{If \code{TRUE}, add a title to the table header. Default to the same
-value than header, except outside of a chunk where it is \code{FALSE} if a table
-caption is detected (\code{tbl-cap} YAML entry).}
+\item{title}{If \code{TRUE} (\code{FALSE}by default) , add a title to the table header.
+Default to the same value than header, except outside of a chunk where it is
+\code{FALSE} if a table caption is detected (\code{tbl-cap} YAML entry).}
-\item{equation}{If \code{TRUE} (by default), add a equation to the table header.
-The equation can also be passed in the form of a character string.}
+\item{equation}{Logical or character. Controls whether an equation is added
+to the table header and how parameters are used. Accepted values are:
+\itemize{
+\item \code{TRUE}: The equation is generated and added to the table header. Its
+parameters are also used in the "Term" column.
+\item \code{FALSE} (by default): No equation is generated or displayed, and its
+parameters are not used in the "Term" column.
+\item \code{NA}: The equation is generated but not displayed in the table header.
+Its parameters are used in the "Term" column.
+\item Character string: A custom equation is provided directly and added to
+the table header.
+}}
\item{auto.labs}{If \code{TRUE} (by default), use labels (and units) automatically
from data or \verb{origdata=}.}
@@ -40,15 +53,12 @@ is \code{NULL} and no label is used.}
the table. By default it is \code{NULL} and nothing is changed.}
\item{lang}{The natural language to use. The default value can be set with,
-e.g., \code{options(data.io_lang = "fr")} for French.}
+e.g., \code{options(SciViews_lang = "fr")} for French.}
\item{...}{Additional arguments}
\item{kind}{The kind of table to produce: "tt" for tinytable, or "ft" for
flextable (default).}
-
-\item{env}{The environment where to evaluate lazyeval expressions (unused for
-now).}
}
\value{
A \strong{flextable} object that you can print in different formats
@@ -61,6 +71,25 @@ object, similar to \code{\link[stats:coef]{stats::coef()}}, but in a rich-format
\{flextable\}.
}
\examples{
+data(iris)
+# Fit a simple linear model: Petal.Length as a function of Sepal.Length
iris_lm <- lm(data = iris, Petal.Length ~ Sepal.Length)
tabularise::tabularise$coef(iris_lm)
+
+# If the 'iris' dataset has labels and units, they can be used to enhance
+# the output table
+iris <- svBase::labelise(iris, self = FALSE, label = list(
+ Sepal.Length = "Length of the sepals",
+ Petal.Length = "Length of the petals",
+ Species = "Species"), units = c(rep("cm", 4), NA))
+
+iris_lm1 <- lm(data = iris, Petal.Length ~ Sepal.Length + Species)
+tabularise::tabularise$coef(iris_lm1)
+
+# The same table but without showing the model equation
+tabularise::tabularise$coef(iris_lm, equation = FALSE)
+
+iris_lm2 <- lm(data = iris, Petal.Length ~ Sepal.Length * Species)
+tabularise::tabularise$coef(iris_lm2)
+
}
diff --git a/man/tabularise_coef.nls.Rd b/man/tabularise_coef.nls.Rd
index cde019f..9cedad6 100644
--- a/man/tabularise_coef.nls.Rd
+++ b/man/tabularise_coef.nls.Rd
@@ -7,12 +7,15 @@
\method{tabularise_coef}{nls}(
data,
header = TRUE,
- title = NULL,
+ title = header,
equation = header,
- lang = getOption("data.io_lang", "en"),
+ auto.labs = TRUE,
+ origdata = NULL,
+ labs = NULL,
+ lang = getOption("SciViews_lang", "en"),
+ footer = TRUE,
...,
- kind = "ft",
- env = parent.frame()
+ kind = "ft"
)
}
\arguments{
@@ -24,18 +27,28 @@
value than header, except outside of a chunk where it is \code{FALSE} if a table
caption is detected (\code{tbl-cap} YAML entry).}
-\item{equation}{If \code{TRUE} (by default), add the equation of the model}
+\item{equation}{Add equation of the model to the table. If \code{TRUE},
+\code{\link[=equation]{equation()}} is used. The equation can also be passed in the form of a
+character string (LaTeX).}
+
+\item{auto.labs}{If \code{TRUE} (by default), use labels (and units) automatically
+from data or \verb{origdata=}.}
+
+\item{origdata}{The original data set this model was fitted to. By default it
+is \code{NULL} and no label is used (only the name of the variables).}
+
+\item{labs}{Labels to change the names of elements in the \code{term} column of
+the table. By default it is \code{NULL} and nothing is changed.}
\item{lang}{The language to use. The default value can be set with, e.g.,
-\code{options(data.io_lang = "fr")} for French.}
+\code{options(SciViews_lang = "fr")} for French.}
-\item{...}{Additional arguments.}
+\item{footer}{If \code{TRUE} (by default, it is TRUE), add a footer to the table.}
+
+\item{...}{Not used}
\item{kind}{The kind of table to produce: "tt" for tinytable, or "ft" for
flextable (default).}
-
-\item{env}{The environment where to evaluate lazyeval expressions (unused for
-now).}
}
\value{
A \strong{flextable} object that you can print in different forms or
diff --git a/man/tabularise_coef.summary.glm.Rd b/man/tabularise_coef.summary.glm.Rd
index 5ee8ae3..d0fc6de 100644
--- a/man/tabularise_coef.summary.glm.Rd
+++ b/man/tabularise_coef.summary.glm.Rd
@@ -4,17 +4,55 @@
\alias{tabularise_coef.summary.glm}
\title{Create a rich-formatted table using the table of coefficients of the summary.glm object}
\usage{
-\method{tabularise_coef}{summary.glm}(data, ..., kind = "ft", env = parent.frame())
+\method{tabularise_coef}{summary.glm}(
+ data,
+ header = TRUE,
+ title = NULL,
+ equation = header,
+ auto.labs = TRUE,
+ origdata = NULL,
+ labs = NULL,
+ lang = getOption("SciViews_lang", default = Sys.getenv("LANGUAGE", unset = "en")),
+ show.signif.stars = getOption("show.signif.stars", TRUE),
+ ...,
+ kind = "ft",
+ env = parent.frame()
+)
}
\arguments{
\item{data}{A \strong{summary.glm} object}
-\item{...}{Additional arguments passed to \code{\link[=tabularise_tidy.glm]{tabularise_tidy.glm()}}}
+\item{header}{If \code{TRUE} (by default), add a header to the table}
+
+\item{title}{If \code{TRUE}, add a title to the table header. Default to the same
+value than header, except outside of a chunk where it is \code{FALSE} if a table
+caption is detected (\code{tbl-cap} YAML entry).}
+
+\item{equation}{If \code{TRUE} (by default), try to add a equation to the table
+header. The equation can also be passed in the form of a character string.}
+
+\item{auto.labs}{If \code{TRUE} (by default), use labels (and units) automatically
+from data or \verb{origdata=}.}
+
+\item{origdata}{The original data set this model was fitted to. By default it
+is \code{NULL} and no label is used.}
+
+\item{labs}{Labels to change the names of elements in the \code{term} column of
+the table. By default it is \code{NULL} and nothing is changed.}
+
+\item{lang}{The natural language to use. The default value can be set with,
+e.g., \code{options(SciViews_lang = "fr")} for French.}
+
+\item{show.signif.stars}{If \code{TRUE}, add the significance stars to the table.
+The default is \code{getOption("show.signif.stars")}}
+
+\item{...}{Additional arguments}
\item{kind}{The kind of table to produce: "tt" for tinytable, or "ft" for
flextable (default).}
-\item{env}{The environment where to evaluate the model.}
+\item{env}{The environment where to evaluate formulas (you probably do not
+need to change the default).}
}
\value{
A \strong{flextable} object that you can print in different formats
@@ -28,5 +66,5 @@ from the \code{\link[=summary]{summary()}} of a \strong{glm} object.
\examples{
iris_glm <- glm(data = iris, Petal.Length ~ Sepal.Length)
iris_glm_sum <- summary(iris_glm)
-tabularise::tabularise$coef(iris_glm_sum)
+tabularise::tabularise_coef(iris_glm_sum)
}
diff --git a/man/tabularise_coef.summary.lm.Rd b/man/tabularise_coef.summary.lm.Rd
index 8c4c2fa..69f5658 100644
--- a/man/tabularise_coef.summary.lm.Rd
+++ b/man/tabularise_coef.summary.lm.Rd
@@ -4,17 +4,77 @@
\alias{tabularise_coef.summary.lm}
\title{Create a rich-formatted table using the table of coefficients of the summary.lm object}
\usage{
-\method{tabularise_coef}{summary.lm}(data, ..., kind = "ft", env = parent.frame())
+\method{tabularise_coef}{summary.lm}(
+ data,
+ header = TRUE,
+ title = header,
+ equation = header,
+ footer = FALSE,
+ auto.labs = TRUE,
+ origdata = NULL,
+ labs = NULL,
+ conf.int = FALSE,
+ conf.level = 0.95,
+ lang = getOption("SciViews_lang", "en"),
+ show.signif.stars = getOption("show.signif.stars", TRUE),
+ ...,
+ kind = "ft"
+)
}
\arguments{
-\item{data}{A \strong{summary.lm} object}
+\item{data}{An \strong{summary.lm} object}
-\item{...}{Additional arguments passed to \code{\link[=tabularise_tidy.lm]{tabularise_tidy.lm()}}}
+\item{header}{Logical. If \code{TRUE} (\code{TRUE}by default), a header is added to
+the table. The header includes both the title and the equation (if
+applicable). If set to \code{FALSE}, neither the title nor the equation will be
+displayed in the table header, even if the \code{title} or \code{equation} parameters
+are provided.}
-\item{kind}{The kind of table to produce: "tt" for tinytable, or "ft" for
-flextable (default).}
+\item{title}{If \code{TRUE} (by default) , add a title to the table header.
+Default to the same value than header, except outside of a chunk where it is
+\code{FALSE} if a table caption is detected (\code{tbl-cap} YAML entry).}
+
+\item{equation}{Logical or character. Controls whether an equation is added
+to the table header and how parameters are used. Accepted values are:
+\itemize{
+\item \code{TRUE}(by default): The equation is generated and added to the table
+header. Its parameters are also used in the "Term" column.
+\item \code{FALSE}: No equation is generated or displayed, and its
+parameters are not used in the "Term" column.
+\item \code{NA}: The equation is generated but not displayed in the table header.
+Its parameters are used in the "Term" column.
+\item Character string: A custom equation is provided directly and added to
+the table header.
+}}
+
+\item{footer}{If \code{TRUE} (by default, it is FALSE), add a footer to the table.}
+
+\item{auto.labs}{If \code{TRUE} (by default), use labels (and units) automatically
+from data or \verb{origdata=}.}
+
+\item{origdata}{The original data set this model was fitted to. By default it
+is \code{NULL} and no label is used.}
+
+\item{labs}{Labels to change the names of elements in the \code{term} column of
+the table. By default it is \code{NULL} and nothing is changed.}
-\item{env}{The environment where to evaluate the model.}
+\item{conf.int}{If \code{TRUE}, add the confidence interval. The default is
+\code{FALSE}.}
+
+\item{conf.level}{The confidence level to use for the confidence interval if
+\code{conf.int = TRUE}. The default is 0.95.}
+
+\item{lang}{The natural language to use. The default value can be set with,
+e.g., \code{options(SciViews_lang = "fr")} for French.}
+
+\item{show.signif.stars}{If \code{TRUE}, add the significance stars to the table.
+The default is \code{getOption("show.signif.stars")}}
+
+\item{...}{Additional arguments}
+
+\item{kind}{The kind of table to produce: "tt" for tinytable, or "ft" for
+flextable (default).
+#' @param footer If \code{FALSE} (by default), add a footer to the table.}
}
\value{
A \strong{flextable} object you can print in different formats (HTML,
diff --git a/man/tabularise_coef.summary.nls.Rd b/man/tabularise_coef.summary.nls.Rd
index 2efe170..a6d0efb 100644
--- a/man/tabularise_coef.summary.nls.Rd
+++ b/man/tabularise_coef.summary.nls.Rd
@@ -7,17 +7,20 @@
\method{tabularise_coef}{summary.nls}(
data,
header = TRUE,
- title = NULL,
+ title = header,
equation = header,
- lang = getOption("data.io_lang", "en"),
+ auto.labs = TRUE,
+ origdata = NULL,
+ labs = NULL,
+ lang = getOption("SciViews_lang", "en"),
+ footer = FALSE,
show.signif.stars = getOption("show.signif.stars", TRUE),
...,
- kind = "ft",
- env = parent.frame()
+ kind = "ft"
)
}
\arguments{
-\item{data}{A \strong{summary.nls} object.}
+\item{data}{An \strong{nls} object.}
\item{header}{If \code{TRUE} (by default), add a title to the table.}
@@ -27,21 +30,29 @@ caption is detected (\code{tbl-cap} YAML entry).}
\item{equation}{Add equation of the model to the table. If \code{TRUE},
\code{\link[=equation]{equation()}} is used. The equation can also be passed in the form of a
-character string (LaTeX equation).}
+character string (LaTeX).}
+
+\item{auto.labs}{If \code{TRUE} (by default), use labels (and units) automatically
+from data or \verb{origdata=}.}
+
+\item{origdata}{The original data set this model was fitted to. By default it
+is \code{NULL} and no label is used (only the name of the variables).}
+
+\item{labs}{Labels to change the names of elements in the \code{term} column of
+the table. By default it is \code{NULL} and nothing is changed.}
\item{lang}{The language to use. The default value can be set with, e.g.,
-\code{options(data.io_lang = "fr")} for French.}
+\code{options(SciViews_lang = "fr")} for French.}
-\item{show.signif.stars}{If \code{TRUE} (by default), add the significance stars
-to the table.}
+\item{footer}{If \code{FALSE} (by default), add a footer to the table.}
-\item{...}{Additional arguments passed to \code{\link[=equation]{equation()}}}
+\item{show.signif.stars}{If \code{TRUE}, add the significance stars to the table.
+The default is \code{getOption("show.signif.stars")}}
+
+\item{...}{Not used}
\item{kind}{The kind of table to produce: "tt" for tinytable, or "ft" for
flextable (default).}
-
-\item{env}{The environment where to evaluate lazyeval expressions (unused for
-now).}
}
\value{
A \strong{flextable} object that you can print in different forms or
diff --git a/man/tabularise_default.anova.Rd b/man/tabularise_default.anova.Rd
index 62916a3..2ac69c1 100644
--- a/man/tabularise_default.anova.Rd
+++ b/man/tabularise_default.anova.Rd
@@ -11,11 +11,10 @@
auto.labs = TRUE,
origdata = NULL,
labs = NULL,
- lang = getOption("data.io_lang", "en"),
+ lang = getOption("SciViews_lang", "en"),
show.signif.stars = getOption("show.signif.stars", TRUE),
...,
- kind = "ft",
- env = parent.frame()
+ kind = "ft"
)
}
\arguments{
@@ -37,7 +36,7 @@ caption is detected (\code{tbl-cap} YAML entry).}
table. By default it is \code{NULL} and nothing is changed.}
\item{lang}{The natural language to use. The default value is set with,
-e.g., \code{options(data.io_lang = "fr")} for French.}
+e.g., \code{options(SciViews_lang = "fr")} for French.}
\item{show.signif.stars}{If \code{TRUE}, add the significance stars to the table.
The default is taken from \code{getOption("show.signif.stars")}.}
@@ -46,9 +45,6 @@ The default is taken from \code{getOption("show.signif.stars")}.}
\item{kind}{The kind of table to produce: "tt" for tinytable, or "ft" for
flextable (default).}
-
-\item{env}{The environment where to evaluate lazyeval expressions (not used
-for now)}
}
\value{
A \strong{flextable} object you can print in different form or rearrange
@@ -58,6 +54,24 @@ with the \{flextable\} functions.
Create a rich-formatted table from an anova object
}
\examples{
-iris_anova <- anova(lm(data = iris, Petal.Length ~ Species))
-tabularise::tabularise(iris_anova)
+is <- data.io::read("iris", package = "datasets")
+
+is_lm1 <- lm(data = is, petal_length ~ species)
+
+library(tabularise)
+
+anova(is_lm1) |> tabularise_default()
+# identical
+anova(is_lm1) |> tabularise()
+# Use labels
+anova(is_lm1) |> tabularise(origdata = is)
+
+# alternative with anova_() in {modelit} package
+anova_(is_lm1) |> tabularise()
+
+is_lm2 <- lm(data = is, petal_length ~ sepal_length + species)
+
+anova(is_lm1, is_lm2) |> tabularise(origdata = is)
+anova_(is_lm1, is_lm2) |> tabularise()
+
}
diff --git a/man/tabularise_default.aov.Rd b/man/tabularise_default.aov.Rd
new file mode 100644
index 0000000..2c71397
--- /dev/null
+++ b/man/tabularise_default.aov.Rd
@@ -0,0 +1,24 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/tabularise.anova.R
+\name{tabularise_default.aov}
+\alias{tabularise_default.aov}
+\title{Create a rich-formatted table from an aov object}
+\usage{
+\method{tabularise_default}{aov}(data, ...)
+}
+\arguments{
+\item{data}{An \strong{aov} object}
+
+\item{...}{Additional arguments passed to \code{\link[=tabularise_default.anova]{tabularise_default.anova()}}}
+}
+\value{
+\strong{flextable} object you can print in different form or rearrange
+with the \{flextable\} functions.
+}
+\description{
+Create a rich-formatted table from an aov object
+}
+\examples{
+iris_aov <- aov(data = iris, Petal.Length ~ Species)
+tabularise::tabularise$tidy(iris_aov)
+}
diff --git a/man/tabularise_default.glm.Rd b/man/tabularise_default.glm.Rd
index 2e9aede..fa13d4e 100644
--- a/man/tabularise_default.glm.Rd
+++ b/man/tabularise_default.glm.Rd
@@ -6,8 +6,14 @@
\usage{
\method{tabularise_default}{glm}(
data,
- footer = TRUE,
- lang = getOption("data.io_lang", "en"),
+ header = FALSE,
+ title = header,
+ equation = header,
+ auto.labs = TRUE,
+ origdata = NULL,
+ labs = NULL,
+ footer = FALSE,
+ lang = getOption("SciViews_lang", default = Sys.getenv("LANGUAGE", unset = "en")),
...,
kind = "ft",
env = parent.frame()
@@ -16,17 +22,49 @@
\arguments{
\item{data}{A \strong{glm} object}
-\item{footer}{If \code{TRUE} (by default), add a footer to the table}
+\item{header}{Logical. If \code{TRUE} (\code{FALSE} by default), a header is added to the table.
+The header includes both the title and the equation (if applicable).
+If set to \code{FALSE}, neither the title nor the equation will be displayed in
+the table header, even if the \code{title} or \code{equation} parameters are provided.}
+
+\item{title}{If \code{TRUE} (\code{FALSE} by default), add a title to the table header. Default to the same
+value than header, except outside of a chunk where it is \code{FALSE} if a table
+caption is detected (\code{tbl-cap} YAML entry).}
+
+\item{equation}{Logical or character. Controls whether an equation is added
+to the table header and how parameters are used. Accepted values are:
+\itemize{
+\item \code{TRUE}: The equation is generated and added to the table header. Its
+parameters are also used in the "Term" column.
+\item \code{FALSE} (by default): No equation is generated or displayed, and its
+parameters are not used in the "Term" column.
+\item \code{NA}: The equation is generated but not displayed in the table header.
+Its parameters are used in the "Term" column.
+\item Character string: A custom equation is provided directly and added to
+the table header.
+}}
+
+\item{auto.labs}{If \code{TRUE} (by default), use labels (and units) automatically
+from data or \verb{origdata=}.}
+
+\item{origdata}{The original data set this model was fitted to. By default it
+is \code{NULL} and no label is used.}
+
+\item{labs}{Labels to change the names of elements in the \code{term} column of
+the table. By default it is \code{NULL} and nothing is changed.}
+
+\item{footer}{If \code{TRUE} (\code{FALSE} by default), add a footer to the table}
\item{lang}{The natural language to use. The default value can be set with,
-e.g., \code{options(data.io_lang = "fr")} for French.}
+e.g., \code{options(SciViews_lang = "fr")} for French.}
-\item{...}{Additional arguments passed to \code{\link[=tabularise_coef.glm]{tabularise_coef.glm()}}}
+\item{...}{Additional arguments}
\item{kind}{The kind of table to produce: "tt" for tinytable, or "ft" for
flextable (default).}
-\item{env}{The environment where to evaluate the model.}
+\item{env}{The environment where to evaluate formulas (you probably do not
+need to change the default).}
}
\value{
A \strong{flextable} object is returned. You can print it in different
@@ -39,4 +77,7 @@ Create a rich-formatted table from a glm object
\examples{
iris_glm <- glm(data = iris, Petal.Length ~ Sepal.Length)
tabularise::tabularise(iris_glm)
+tabularise::tabularise(iris_glm, header = TRUE, footer = TRUE)
+tabularise::tabularise(iris_glm, header = TRUE, footer = FALSE)
+tabularise::tabularise(iris_glm, header = TRUE, equation = NA,footer = TRUE)
}
diff --git a/man/tabularise_default.lm.Rd b/man/tabularise_default.lm.Rd
index a291c73..1672e17 100644
--- a/man/tabularise_default.lm.Rd
+++ b/man/tabularise_default.lm.Rd
@@ -4,7 +4,7 @@
\alias{tabularise_default.lm}
\title{Create a rich-formatted table from an lm object}
\usage{
-\method{tabularise_default}{lm}(data, ..., kind = "ft", env = parent.frame())
+\method{tabularise_default}{lm}(data, ..., kind = "ft")
}
\arguments{
\item{data}{An \strong{lm} object}
@@ -13,8 +13,6 @@
\item{kind}{The kind of table to produce: "tt" for tinytable, or "ft" for
flextable (default).}
-
-\item{env}{The environment where to evaluate the model.}
}
\value{
A \strong{flextable} object that you can print in different formats (HTML,
diff --git a/man/tabularise_default.nls.Rd b/man/tabularise_default.nls.Rd
index fd093b3..6a1e3bb 100644
--- a/man/tabularise_default.nls.Rd
+++ b/man/tabularise_default.nls.Rd
@@ -7,13 +7,15 @@
\method{tabularise_default}{nls}(
data,
header = TRUE,
- title = NULL,
+ title = header,
equation = header,
+ auto.labs = TRUE,
+ origdata = NULL,
+ labs = NULL,
+ lang = getOption("SciViews_lang", "en"),
footer = TRUE,
- lang = getOption("data.io_lang", "en"),
...,
- kind = "ft",
- env = parent.frame()
+ kind = "ft"
)
}
\arguments{
@@ -27,20 +29,26 @@ caption is detected (\code{tbl-cap} YAML entry).}
\item{equation}{Add equation of the model to the table. If \code{TRUE},
\code{\link[=equation]{equation()}} is used. The equation can also be passed in the form of a
-character string (LaTeX equation).}
+character string (LaTeX).}
-\item{footer}{If \code{TRUE} (by default), add a footer to the table.}
+\item{auto.labs}{If \code{TRUE} (by default), use labels (and units) automatically
+from data or \verb{origdata=}.}
+
+\item{origdata}{The original data set this model was fitted to. By default it
+is \code{NULL} and no label is used (only the name of the variables).}
+
+\item{labs}{Labels to change the names of elements in the \code{term} column of
+the table. By default it is \code{NULL} and nothing is changed.}
\item{lang}{The language to use. The default value can be set with, e.g.,
-\code{options(data.io_lang = "fr")} for French.}
+\code{options(SciViews_lang = "fr")} for French.}
-\item{...}{Additional arguments. Not used.}
+\item{footer}{If \code{TRUE} (by default, it is TRUE), add a footer to the table.}
+
+\item{...}{Not used}
\item{kind}{The kind of table to produce: "tt" for tinytable, or "ft" for
flextable (default).}
-
-\item{env}{The environment where to evaluate lazyeval expressions (unused for
-now).}
}
\value{
A \strong{flextable} object that you can print in different forms or
diff --git a/man/tabularise_default.summary.glm.Rd b/man/tabularise_default.summary.glm.Rd
index 3a04d5e..5d7b019 100644
--- a/man/tabularise_default.summary.glm.Rd
+++ b/man/tabularise_default.summary.glm.Rd
@@ -6,8 +6,15 @@
\usage{
\method{tabularise_default}{summary.glm}(
data,
+ header = TRUE,
+ title = NULL,
+ equation = header,
+ auto.labs = TRUE,
+ origdata = NULL,
+ labs = NULL,
+ lang = getOption("SciViews_lang", default = Sys.getenv("LANGUAGE", unset = "en")),
+ show.signif.stars = getOption("show.signif.stars", TRUE),
footer = TRUE,
- lang = getOption("data.io_lang", "en"),
...,
kind = "ft",
env = parent.frame()
@@ -16,17 +23,39 @@
\arguments{
\item{data}{A \strong{summary.glm} object}
-\item{footer}{If \code{TRUE} (by default), add a footer to the table}
+\item{header}{If \code{TRUE} (by default), add a header to the table}
+
+\item{title}{If \code{TRUE}, add a title to the table header. Default to the same
+value than header, except outside of a chunk where it is \code{FALSE} if a table
+caption is detected (\code{tbl-cap} YAML entry).}
+
+\item{equation}{If \code{TRUE} (by default), try to add a equation to the table
+header. The equation can also be passed in the form of a character string.}
+
+\item{auto.labs}{If \code{TRUE} (by default), use labels (and units) automatically
+from data or \verb{origdata=}.}
+
+\item{origdata}{The original data set this model was fitted to. By default it
+is \code{NULL} and no label is used.}
+
+\item{labs}{Labels to change the names of elements in the \code{term} column of
+the table. By default it is \code{NULL} and nothing is changed.}
\item{lang}{The natural language to use. The default value can be set with,
-e.g., \code{options(data.io_lang = "fr")} for French.}
+e.g., \code{options(SciViews_lang = "fr")} for French.}
+
+\item{show.signif.stars}{If \code{TRUE}, add the significance stars to the table.
+The default is \code{getOption("show.signif.stars")}}
+
+\item{footer}{If \code{TRUE} (by default), add a footer to the table}
-\item{...}{Additional arguments passed to \code{\link[=tabularise_coef.summary.glm]{tabularise_coef.summary.glm()}}}
+\item{...}{Additional arguments}
\item{kind}{The kind of table to produce: "tt" for tinytable, or "ft" for
flextable (default).}
-\item{env}{The environment where to evaluate the model.}
+\item{env}{The environment where to evaluate formulas (you probably do not
+need to change the default).}
}
\value{
A \strong{flextable} object that you can print in different form or
diff --git a/man/tabularise_default.summary.lm.Rd b/man/tabularise_default.summary.lm.Rd
index 69d6720..8a0d8e7 100644
--- a/man/tabularise_default.summary.lm.Rd
+++ b/man/tabularise_default.summary.lm.Rd
@@ -4,29 +4,14 @@
\alias{tabularise_default.summary.lm}
\title{Create a rich-formatted table from an summary.lm object}
\usage{
-\method{tabularise_default}{summary.lm}(
- data,
- footer = TRUE,
- lang = getOption("data.io_lang", "en"),
- ...,
- kind = "ft",
- env = parent.frame()
-)
+\method{tabularise_default}{summary.lm}(data, ..., footer = TRUE)
}
\arguments{
\item{data}{A \strong{summary.lm} object}
-\item{footer}{If \code{TRUE} (by default), add a footer to the table}
-
-\item{lang}{The natural language to use. The default value can be set with,
-e.g., \code{options(data.io_lang = "fr")} for French.}
-
\item{...}{Additional arguments passed to \code{\link[=tabularise_coef.summary.lm]{tabularise_coef.summary.lm()}}}
-\item{kind}{The kind of table to produce: "tt" for tinytable, or "ft" for
-flextable (default).}
-
-\item{env}{The environment where to evaluate the model.}
+\item{footer}{If \code{TRUE} (by default), add a footer to the table.}
}
\value{
A \strong{flextable} object you can print in different formats (HTML,
diff --git a/man/tabularise_default.summary.nls.Rd b/man/tabularise_default.summary.nls.Rd
index 9bf2764..f46759a 100644
--- a/man/tabularise_default.summary.nls.Rd
+++ b/man/tabularise_default.summary.nls.Rd
@@ -7,20 +7,22 @@
\method{tabularise_default}{summary.nls}(
data,
header = TRUE,
- title = NULL,
+ title = header,
equation = header,
+ auto.labs = TRUE,
+ origdata = NULL,
+ labs = NULL,
+ lang = getOption("SciViews_lang", "en"),
footer = TRUE,
- lang = getOption("data.io_lang", "en"),
show.signif.stars = getOption("show.signif.stars", TRUE),
...,
- kind = "ft",
- env = parent.frame()
+ kind = "ft"
)
}
\arguments{
-\item{data}{A \strong{summary.nls} object.}
+\item{data}{An \strong{nls} object.}
-\item{header}{If \code{TRUE} (by default), add a header to the table}
+\item{header}{If \code{TRUE} (by default), add a title to the table.}
\item{title}{If \code{TRUE}, add a title to the table header. Default to the same
value than header, except outside of a chunk where it is \code{FALSE} if a table
@@ -28,23 +30,29 @@ caption is detected (\code{tbl-cap} YAML entry).}
\item{equation}{Add equation of the model to the table. If \code{TRUE},
\code{\link[=equation]{equation()}} is used. The equation can also be passed in the form of a
-character string (LaTeX equation).}
+character string (LaTeX).}
-\item{footer}{If \code{TRUE} (by default), add a footer to the table.}
+\item{auto.labs}{If \code{TRUE} (by default), use labels (and units) automatically
+from data or \verb{origdata=}.}
+
+\item{origdata}{The original data set this model was fitted to. By default it
+is \code{NULL} and no label is used (only the name of the variables).}
+
+\item{labs}{Labels to change the names of elements in the \code{term} column of
+the table. By default it is \code{NULL} and nothing is changed.}
+
+\item{lang}{The language to use. The default value can be set with, e.g.,
+\code{options(SciViews_lang = "fr")} for French.}
-\item{lang}{The language to use. The default value can be set with, e.g.
-\code{options(data.io_lang = "fr")} for French.}
+\item{footer}{If \code{TRUE} (by default), add a footer to the table.}
-\item{show.signif.stars}{If \code{TRUE} (by default), add the significance stars
-to the table.}
+\item{show.signif.stars}{If \code{TRUE}, add the significance stars to the table.
+The default is \code{getOption("show.signif.stars")}}
-\item{...}{Additional arguments (Not used).}
+\item{...}{Not used}
\item{kind}{The kind of table to produce: "tt" for tinytable, or "ft" for
flextable (default).}
-
-\item{env}{The environment where to evaluate lazyeval expressions (unused for
-now).}
}
\value{
A \strong{flextable} object that you can print in different forms or
@@ -65,6 +73,15 @@ chick1_logis_sum <- summary(chick1_logis)
tabularise::tabularise(chick1_logis_sum)
tabularise::tabularise(chick1_logis_sum, footer = FALSE)
+
+growth <- data.io::read("urchin_growth", package = "data.io")
+growth_logis <- nls(data = growth, diameter ~ SSlogis(age, Asym, xmid, scal))
+chart::chart(growth_logis)
+tabularise::tabularise(summary(growth_logis)) # No labels
+tabularise::tabularise(summary(growth_logis), origdata = growth) # with labels
+tabularise::tabularise(summary(growth_logis), origdata = growth,
+ equation = FALSE, show.signif.stars = FALSE)
+
}
\seealso{
\code{\link[tabularise:tabularise]{tabularise::tabularise()}}, \code{\link[tabularise:tabularise_tidy]{tabularise::tabularise_tidy()}},
diff --git a/man/tabularise_glance.glm.Rd b/man/tabularise_glance.glm.Rd
index 2f3b6c4..32cd139 100644
--- a/man/tabularise_glance.glm.Rd
+++ b/man/tabularise_glance.glm.Rd
@@ -7,12 +7,12 @@
\method{tabularise_glance}{glm}(
data,
header = TRUE,
- title = NULL,
- equation = TRUE,
+ title = header,
+ equation = header,
auto.labs = TRUE,
origdata = NULL,
labs = NULL,
- lang = getOption("data.io_lang", "en"),
+ lang = getOption("SciViews_lang", "en"),
...,
kind = "ft",
env = parent.frame()
@@ -21,34 +21,45 @@
\arguments{
\item{data}{A \strong{glm} object}
-\item{header}{If \code{TRUE} (by default), add an header to the table}
+\item{header}{Logical. If \code{TRUE} (\code{TRUE} by default), a header is added to the table.
+The header includes both the title and the equation (if applicable).
+If set to \code{FALSE}, neither the title nor the equation will be displayed in
+the table header, even if the \code{title} or \code{equation} parameters are provided.}
-\item{title}{If \code{TRUE}, add a title to the table header. Default to the same
+\item{title}{If \code{TRUE} (\code{TRUE} by default), add a title to the table header. Default to the same
value than header, except outside of a chunk where it is \code{FALSE} if a table
caption is detected (\code{tbl-cap} YAML entry).}
-\item{equation}{If \code{TRUE} (by default), add an equation to the table header.
-The equation can also be passed in the form of a character string (LaTeX).}
+\item{equation}{Logical or character. Controls whether an equation is added
+to the table header and how parameters are used. Accepted values are:
+\itemize{
+\item \code{TRUE} (default) : The equation is generated and added to the table
+header. Its parameters are also used in the "Term" column.
+\item \code{FALSE}: No equation is generated or displayed, and its parameters are
+not used in the "Term" column.
+\item Character string: A custom equation is provided directly and added to
+the table header.
+}}
\item{auto.labs}{If \code{TRUE} (by default), use labels (and units) automatically
-from \verb{origdata=}.}
+from data or \verb{origdata=}.}
\item{origdata}{The original data set this model was fitted to. By default it
-is \code{NULL} and original labels are not used.}
+is \code{NULL} and no label is used.}
\item{labs}{Labels to change the names of elements in the \code{term} column of
the table. By default it is \code{NULL} and nothing is changed.}
\item{lang}{The natural language to use. The default value can be set with,
-e.g., \code{options(data.io_lang = "fr")} for French.}
+e.g., \code{options(SciViews_lang = "fr")} for French.}
-\item{...}{Additional arguments passed to \code{\link[tabularise:equation]{tabularise::equation()}}}
+\item{...}{Additional arguments passed to \code{\link[equatiomatic:equation]{equatiomatic::equation()}}}
\item{kind}{The kind of table to produce: "tt" for tinytable, or "ft" for
flextable (default).}
-\item{env}{The environment where to evaluate lazyeval expressions (unused for
-now).}
+\item{env}{The environment where to evaluate formulas (you probably do not
+need to change the default).}
}
\value{
A \strong{flextable} object is produced that you can print in different
@@ -63,4 +74,7 @@ Word, PowerPoint), or rearranged later on.
\examples{
iris_glm <- glm(data = iris, Petal.Length ~ Sepal.Length)
tabularise::tabularise$glance(iris_glm)
+tabularise::tabularise$glance(iris_glm, equation = FALSE)
+tabularise::tabularise$glance(iris_glm, equation = "my personal equation")
+
}
diff --git a/man/tabularise_glance.lm.Rd b/man/tabularise_glance.lm.Rd
index bb4efe0..da68ef6 100644
--- a/man/tabularise_glance.lm.Rd
+++ b/man/tabularise_glance.lm.Rd
@@ -7,28 +7,41 @@
\method{tabularise_glance}{lm}(
data,
header = TRUE,
- title = NULL,
- equation = TRUE,
+ title = header,
+ equation = header,
auto.labs = TRUE,
origdata = NULL,
labs = NULL,
- lang = getOption("data.io_lang", "en"),
+ lang = getOption("SciViews_lang", "en"),
...,
- kind = "ft",
- env = parent.frame()
+ kind = "ft"
)
}
\arguments{
\item{data}{An \strong{lm} object}
-\item{header}{If \code{TRUE} (by default), add a header to the table}
+\item{header}{Logical. If \code{TRUE} (\code{TRUE}by default), a header is added to
+the table. The header includes both the title and the equation (if
+applicable). If set to \code{FALSE}, neither the title nor the equation will be
+displayed in the table header, even if the \code{title} or \code{equation} parameters
+are provided.}
-\item{title}{If \code{TRUE}, add a title to the table header. Default to the same
-value than header, except outside of a chunk where it is \code{FALSE} if a table
-caption is detected (\code{tbl-cap} YAML entry).}
+\item{title}{If \code{TRUE} (by default) , add a title to the table header.
+Default to the same value than header, except outside of a chunk where it is
+\code{FALSE} if a table caption is detected (\code{tbl-cap} YAML entry).}
-\item{equation}{If \code{TRUE} (by default), add a equation to the table header.
-The equation can also be passed in the form of a character string (LaTeX).}
+\item{equation}{Logical or character. Controls whether an equation is added
+to the table header and how parameters are used. Accepted values are:
+\itemize{
+\item \code{TRUE}(by default): The equation is generated and added to the table
+header. Its parameters are also used in the "Term" column.
+\item \code{FALSE}: No equation is generated or displayed, and its
+parameters are not used in the "Term" column.
+\item \code{NA}: The equation is generated but not displayed in the table header.
+Its parameters are used in the "Term" column.
+\item Character string: A custom equation is provided directly and added to
+the table header.
+}}
\item{auto.labs}{If \code{TRUE} (by default), use labels (and units) automatically
from data or \verb{origdata=}.}
@@ -40,15 +53,12 @@ is \code{NULL} and no label is used (only the name of the variables).}
the table. By default it is \code{NULL} and nothing is changed.}
\item{lang}{The natural language to use. The default value can be set with,
-e.g., \code{options(data.io_lang = "fr")} for French.}
+e.g., \code{options(SciViews_lang = "fr")} for French.}
-\item{...}{Additional arguments passed to \code{\link[tabularise:equation]{tabularise::equation()}}}
+\item{...}{Additional arguments passed to \code{\link[equatiomatic:equation]{equatiomatic::equation()}}}
\item{kind}{The kind of table to produce: "tt" for tinytable, or "ft" for
flextable (default).}
-
-\item{env}{The environment where to evaluate lazyeval expressions (unused for
-now).}
}
\value{
A \strong{flextable} object that you can print in different form or
diff --git a/man/tabularise_glance.nls.Rd b/man/tabularise_glance.nls.Rd
index 4751aad..0ce7604 100644
--- a/man/tabularise_glance.nls.Rd
+++ b/man/tabularise_glance.nls.Rd
@@ -7,12 +7,14 @@
\method{tabularise_glance}{nls}(
data,
header = TRUE,
- title = NULL,
+ title = header,
equation = header,
- lang = getOption("data.io_lang", "en"),
+ auto.labs = TRUE,
+ origdata = NULL,
+ labs = NULL,
+ lang = getOption("SciViews_lang", "en"),
...,
- kind = "ft",
- env = parent.frame()
+ kind = "ft"
)
}
\arguments{
@@ -28,16 +30,22 @@ caption is detected (\code{tbl-cap} YAML entry).}
\code{\link[=equation]{equation()}} is used. The equation can also be passed in the form of a
character string (LaTeX).}
+\item{auto.labs}{If \code{TRUE} (by default), use labels (and units) automatically
+from data or \verb{origdata=}.}
+
+\item{origdata}{The original data set this model was fitted to. By default it
+is \code{NULL} and no label is used (only the name of the variables).}
+
+\item{labs}{Labels to change the names of elements in the \code{term} column of
+the table. By default it is \code{NULL} and nothing is changed.}
+
\item{lang}{The language to use. The default value can be set with, e.g.,
-\code{options(data.io_lang = "fr")} for French.}
+\code{options(SciViews_lang = "fr")} for French.}
-\item{...}{Additional arguments passed to \code{\link[=equation]{equation()}}}
+\item{...}{Not used}
\item{kind}{The kind of table to produce: "tt" for tinytable, or "ft" for
flextable (default).}
-
-\item{env}{The environment where to evaluate lazyeval expressions (unused for
-now).}
}
\value{
A \strong{flextable} object that you can print in different forms or
diff --git a/man/tabularise_tidy.anova.Rd b/man/tabularise_tidy.anova.Rd
index 35cc174..3e6f199 100644
--- a/man/tabularise_tidy.anova.Rd
+++ b/man/tabularise_tidy.anova.Rd
@@ -4,51 +4,12 @@
\alias{tabularise_tidy.anova}
\title{Tidy version of the anova object into a flextable object}
\usage{
-\method{tabularise_tidy}{anova}(
- data,
- header = TRUE,
- title = header,
- auto.labs = TRUE,
- origdata = NULL,
- labs = NULL,
- lang = getOption("data.io_lang", "en"),
- show.signif.stars = getOption("show.signif.stars", TRUE),
- ...,
- kind = "ft",
- env = parent.frame()
-)
+\method{tabularise_tidy}{anova}(data, ...)
}
\arguments{
\item{data}{An \strong{anova} object}
-\item{header}{If \code{TRUE} (by default), add a header to the table}
-
-\item{title}{If \code{TRUE}, add a title to the table header. Default to the same
-value than header, except outside of a chunk where it is \code{FALSE} if a table
-caption is detected (\code{tbl-cap} YAML entry).}
-
-\item{auto.labs}{If \code{TRUE} (by default), use labels (and units) from
-\verb{origdata=}.}
-
-\item{origdata}{The original data set used for the ANOVA (used for changing
-the labels). By default, it is \code{NULL}.}
-
-\item{labs}{Labels to use to change the names of elements in the \code{term}
-column. By default, it is \code{NULL}.}
-
-\item{lang}{The natural language to use. The default value can be set with,
-e.g., \code{options(data.io_lang = "fr")} for French.}
-
-\item{show.signif.stars}{If \code{TRUE}, add the significance stars to the table.
-The default is taken from \code{getOption("show.signif.stars")}.}
-
-\item{...}{Additional arguments (not used for now)}
-
-\item{kind}{The kind of table to produce: "tt" for tinytable, or "ft" for
-flextable (default).}
-
-\item{env}{The environment where to evaluate lazyeval expressions (not used
-for now)}
+\item{...}{Additional arguments used \code{\link[=tabularise_default.anova]{tabularise_default.anova()}}}
}
\value{
A \strong{flextable} object you can print in different form or rearrange
@@ -58,6 +19,18 @@ with the \{flextable\} functions.
Tidy version of the anova object into a flextable object
}
\examples{
-iris_anova <- anova(lm(data = iris, Petal.Length ~ Species))
-tabularise::tabularise$tidy(iris_anova)
+is <- data.io::read("iris", package = "datasets")
+
+is_lm1 <- lm(data = is, petal_length ~ species)
+
+library(tabularise)
+
+anova(is_lm1) |> tabularise_tidy()
+# identical
+anova(is_lm1) |> tabularise$tidy()
+# Use labels
+anova(is_lm1) |> tabularise$tidy(origdata = is)
+
+# alternative with anova_() in {modelit} package
+anova_(is_lm1) |> tabularise$tidy()
}
diff --git a/man/tabularise_tidy.aov.Rd b/man/tabularise_tidy.aov.Rd
index 2b1f8b6..5ac49a9 100644
--- a/man/tabularise_tidy.aov.Rd
+++ b/man/tabularise_tidy.aov.Rd
@@ -4,17 +4,12 @@
\alias{tabularise_tidy.aov}
\title{Tidy version of the aov object into a flextable object}
\usage{
-\method{tabularise_tidy}{aov}(data, ..., kind = "ft", env = parent.frame())
+\method{tabularise_tidy}{aov}(data, ...)
}
\arguments{
-\item{data}{An \strong{anova} object}
+\item{data}{An \strong{aov} object}
-\item{...}{Additional arguments passed to \code{\link[=tabularise_tidy.anova]{tabularise_tidy.anova()}}}
-
-\item{kind}{The kind of table to produce: "tt" for tinytable, or "ft" for
-flextable (default).}
-
-\item{env}{The environment where to evaluate the object.}
+\item{...}{Additional arguments passed to \code{\link[=tabularise_default.anova]{tabularise_default.anova()}}}
}
\value{
\strong{flextable} object you can print in different form or rearrange
diff --git a/man/tabularise_tidy.glm.Rd b/man/tabularise_tidy.glm.Rd
index c5145b5..92aeeb0 100644
--- a/man/tabularise_tidy.glm.Rd
+++ b/man/tabularise_tidy.glm.Rd
@@ -14,7 +14,7 @@
labs = NULL,
conf.int = FALSE,
conf.level = 0.95,
- lang = getOption("data.io_lang", "en"),
+ lang = getOption("SciViews_lang", default = Sys.getenv("LANGUAGE", unset = "en")),
show.signif.stars = getOption("show.signif.stars", TRUE),
...,
kind = "ft",
@@ -24,20 +24,33 @@
\arguments{
\item{data}{A \strong{glm} object}
-\item{header}{If \code{TRUE} (by default), add a header to the table}
+\item{header}{Logical. If \code{TRUE} (\code{TRUE} by default), a header is added to the table.
+The header includes both the title and the equation (if applicable).
+If set to \code{FALSE}, neither the title nor the equation will be displayed in
+the table header, even if the \code{title} or \code{equation} parameters are provided.}
-\item{title}{If \code{TRUE}, add a title to the table header. Default to the same
+\item{title}{If \code{TRUE} (\code{TRUE} by default), add a title to the table header. Default to the same
value than header, except outside of a chunk where it is \code{FALSE} if a table
caption is detected (\code{tbl-cap} YAML entry).}
-\item{equation}{If \code{TRUE} (by default), add an equation to the table header.
-The equation can also be passed in the form of a character string (LaTeX).}
+\item{equation}{Logical or character. Controls whether an equation is added
+to the table header and how parameters are used. Accepted values are:
+\itemize{
+\item \code{TRUE} (default) : The equation is generated and added to the table
+header. Its parameters are also used in the "Term" column.
+\item \code{FALSE}: No equation is generated or displayed, and its parameters are
+not used in the "Term" column.
+\item \code{NA}: The equation is generated but not displayed in the table header.
+Its parameters are used in the "Term" column.
+\item Character string: A custom equation is provided directly and added to
+the table header.
+}}
\item{auto.labs}{If \code{TRUE} (by default), use labels (and units) automatically
-from \verb{origdata=}. `}
+from data or \verb{origdata=}.}
\item{origdata}{The original data set this model was fitted to. By default it
-is \code{NULL} and variables labels from this data set are not used.}
+is \code{NULL} and no label is used.}
\item{labs}{Labels to change the names of elements in the \code{term} column of
the table. By default it is \code{NULL} and nothing is changed.}
@@ -49,18 +62,18 @@ the table. By default it is \code{NULL} and nothing is changed.}
\code{conf.int = TRUE}. The default is 0.95.}
\item{lang}{The natural language to use. The default value can be set with,
-e.g., \code{options(data.io_lang = "fr")} for French.}
+e.g., \code{options(SciViews_lang = "fr")} for French.}
\item{show.signif.stars}{If \code{TRUE}, add the significance stars to the table.
-Its value is obtained from \code{getOption("show.signif.stars")}.}
+The default is \code{getOption("show.signif.stars")}}
-\item{...}{Additional arguments passed to \code{\link[tabularise:equation]{tabularise::equation()}}}
+\item{...}{Additional arguments}
\item{kind}{The kind of table to produce: "tt" for tinytable, or "ft" for
flextable (default).}
-\item{env}{The environment where to evaluate lazyeval expressions (unused for
-now).}
+\item{env}{The environment where to evaluate formulas (you probably do not
+need to change the default).}
}
\value{
A \strong{flextable} object is returned. You can print it in different
@@ -73,6 +86,15 @@ Turn the tidy of \strong{glm} object into a rich-formatted table with
Word, PowerPoint), or rearranged later on.
}
\examples{
+#' # If the 'iris' dataset has labels and units, they can be used to enhance
+# the output table
+iris <- svBase::labelise(iris, self = FALSE, label = list(
+ Sepal.Length = "Length of the sepals",
+ Petal.Length = "Length of the petals",
+ Species = "Species"), units = c(rep("cm", 4), NA))
iris_glm <- glm(data = iris, Petal.Length ~ Sepal.Length)
+
tabularise::tabularise$tidy(iris_glm)
+tabularise::tabularise$tidy(iris_glm, conf.int = TRUE)
+tabularise::tabularise$tidy(iris_glm, conf.int = TRUE, equation = NA)
}
diff --git a/man/tabularise_tidy.lm.Rd b/man/tabularise_tidy.lm.Rd
index 4d5484a..7e5285f 100644
--- a/man/tabularise_tidy.lm.Rd
+++ b/man/tabularise_tidy.lm.Rd
@@ -7,31 +7,44 @@
\method{tabularise_tidy}{lm}(
data,
header = TRUE,
- title = NULL,
+ title = header,
equation = header,
auto.labs = TRUE,
origdata = NULL,
labs = NULL,
conf.int = FALSE,
conf.level = 0.95,
- lang = getOption("data.io_lang", "en"),
+ lang = getOption("SciViews_lang", "en"),
show.signif.stars = getOption("show.signif.stars", TRUE),
...,
- kind = "ft",
- env = parent.frame()
+ kind = "ft"
)
}
\arguments{
\item{data}{An \strong{lm} object}
-\item{header}{If \code{TRUE} (by default), add an header to the table}
+\item{header}{Logical. If \code{TRUE} (\code{TRUE}by default), a header is added to
+the table. The header includes both the title and the equation (if
+applicable). If set to \code{FALSE}, neither the title nor the equation will be
+displayed in the table header, even if the \code{title} or \code{equation} parameters
+are provided.}
-\item{title}{If \code{TRUE}, add a title to the table header. Default to the same
-value than header, except outside of a chunk where it is \code{FALSE} if a table
-caption is detected (\code{tbl-cap} YAML entry).}
+\item{title}{If \code{TRUE} (by default) , add a title to the table header.
+Default to the same value than header, except outside of a chunk where it is
+\code{FALSE} if a table caption is detected (\code{tbl-cap} YAML entry).}
-\item{equation}{If \code{TRUE} (by default), add an equation to the table header.
-The equation can also be passed in the form of a character string (LaTeX).}
+\item{equation}{Logical or character. Controls whether an equation is added
+to the table header and how parameters are used. Accepted values are:
+\itemize{
+\item \code{TRUE}(by default): The equation is generated and added to the table
+header. Its parameters are also used in the "Term" column.
+\item \code{FALSE}: No equation is generated or displayed, and its
+parameters are not used in the "Term" column.
+\item \code{NA}: The equation is generated but not displayed in the table header.
+Its parameters are used in the "Term" column.
+\item Character string: A custom equation is provided directly and added to
+the table header.
+}}
\item{auto.labs}{If \code{TRUE} (by default), use labels (and units) automatically
from data or \verb{origdata=}.}
@@ -49,18 +62,15 @@ the table. By default it is \code{NULL} and no term is changed.}
\code{conf.int = TRUE}. The default is 0.95.}
\item{lang}{The natural language to use. The default value can be set with,
-e.g., \code{options(data.io_lang = "fr")} for French.}
+e.g., \code{options(SciViews_lang = "fr")} for French.}
\item{show.signif.stars}{If \code{TRUE}, add the significance stars to the table.
The default is \code{getOption("show.signif.stars")}}
-\item{...}{Additional arguments passed to \code{\link[tabularise:equation]{tabularise::equation()}}}
+\item{...}{Additional arguments passed to \code{\link[equatiomatic:equation]{equatiomatic::equation()}}}
\item{kind}{The kind of table to produce: "tt" for tinytable, or "ft" for
flextable (default).}
-
-\item{env}{The environment where to evaluate lazyeval expressions (unused for
-now).}
}
\value{
A \strong{flextable} object that you can print in different formats (HTML,
diff --git a/man/tabularise_tidy.nls.Rd b/man/tabularise_tidy.nls.Rd
index b19a9ae..170b264 100644
--- a/man/tabularise_tidy.nls.Rd
+++ b/man/tabularise_tidy.nls.Rd
@@ -4,18 +4,52 @@
\alias{tabularise_tidy.nls}
\title{Tidy version of the nls object into a flextable object}
\usage{
-\method{tabularise_tidy}{nls}(data, ..., kind = "ft", env = parent.frame())
+\method{tabularise_tidy}{nls}(
+ data,
+ header = TRUE,
+ title = header,
+ equation = header,
+ auto.labs = TRUE,
+ origdata = NULL,
+ labs = NULL,
+ lang = getOption("SciViews_lang", "en"),
+ show.signif.stars = getOption("show.signif.stars", TRUE),
+ ...,
+ kind = "ft"
+)
}
\arguments{
-\item{data}{A \strong{nls} object}
+\item{data}{An \strong{nls} object.}
-\item{...}{arguments of \code{\link[=tabularise_coef.summary.nls]{tabularise_coef.summary.nls()}}}
+\item{header}{If \code{TRUE} (by default), add a title to the table.}
+
+\item{title}{If \code{TRUE}, add a title to the table header. Default to the same
+value than header, except outside of a chunk where it is \code{FALSE} if a table
+caption is detected (\code{tbl-cap} YAML entry).}
+
+\item{equation}{Add equation of the model to the table. If \code{TRUE},
+\code{\link[=equation]{equation()}} is used. The equation can also be passed in the form of a
+character string (LaTeX).}
+
+\item{auto.labs}{If \code{TRUE} (by default), use labels (and units) automatically
+from data or \verb{origdata=}.}
+
+\item{origdata}{The original data set this model was fitted to. By default it
+is \code{NULL} and no label is used (only the name of the variables).}
+
+\item{labs}{Labels to change the names of elements in the \code{term} column of
+the table. By default it is \code{NULL} and nothing is changed.}
+
+\item{lang}{The language to use. The default value can be set with, e.g.,
+\code{options(SciViews_lang = "fr")} for French.}
+
+\item{show.signif.stars}{If \code{TRUE}, add the significance stars to the table.
+The default is \code{getOption("show.signif.stars")}}
+
+\item{...}{Not used}
\item{kind}{The kind of table to produce: "tt" for tinytable, or "ft" for
flextable (default).}
-
-\item{env}{The environment where to evaluate lazyeval expressions (unused for
-now).}
}
\value{
A \strong{flextable} object that you can print in different forms or
diff --git a/modelit.Rproj b/modelit.Rproj
index a4dc148..2a1a166 100644
--- a/modelit.Rproj
+++ b/modelit.Rproj
@@ -1,4 +1,5 @@
Version: 1.0
+ProjectId: 820bdb37-4760-4e6e-8ea0-a09ee1f2e817
RestoreWorkspace: No
SaveWorkspace: No
diff --git a/po/R-fr.mo b/po/R-fr.mo
new file mode 100644
index 0000000..c0677b1
Binary files /dev/null and b/po/R-fr.mo differ
diff --git a/po/R-fr.po b/po/R-fr.po
new file mode 100644
index 0000000..0c46ac5
--- /dev/null
+++ b/po/R-fr.po
@@ -0,0 +1,427 @@
+msgid ""
+msgstr ""
+"Project-Id-Version: modelit 1.4.7\n"
+"POT-Creation-Date: 2025-08-20 09:35\n"
+"PO-Revision-Date: 2025-08-19 15:04+0200\n"
+"Last-Translator: \n"
+"Language-Team: \n"
+"Language: fr\n"
+"MIME-Version: 1.0\n"
+"Content-Type: text/plain; charset=UTF-8\n"
+"Content-Transfer-Encoding: 8bit\n"
+"X-Generator: Poedit 3.6\n"
+
+msgid "Can only transform a model with 2 variables for now."
+msgstr "Pour l’instant, on ne peut transformer qu’un modèle à 2 variables."
+
+msgid ""
+"Can only make of function from a model involving numeric variables for now."
+msgstr ""
+"On ne peut créer une fonction qu'à partir d'un modèle impliquant des "
+"variables numériques pour le moment."
+
+msgid "You cannot use one-sided formula, like ~x."
+msgstr "Vous ne pouvez pas utiliser une formule unilatérale, comme ~x."
+
+msgid "Impossible to plot in 2D a model with more than 2 variables"
+msgstr ""
+"Impossible de représenter en 2D un modèle contenant plus de deux variables."
+
+msgid "Can only plot a model involving numeric variables for now."
+msgstr ""
+"Impossible de tracer un modèle impliquant des variables non numériques pour "
+"le moment."
+
+msgid "Independent variable '"
+msgstr "Variable indépendante"
+
+msgid ""
+"' must appear untransformed in the model's formula, or you must supply the "
+"original dataset in origdata=."
+msgstr ""
+"La variable doit apparaître non transformée dans la formule du modèle, ou "
+"vous devez fournir le jeu de données original via origdata=."
+
+msgid ""
+"Unrecognized type, must be 'model', 'resfitted', 'qqplot', 'scalelocation', "
+"'cooksd', 'resleverage', 'cookleverage', 'reshist', or 'resautocor'"
+msgstr ""
+"Type non reconnu, il doit être 'model', 'resfitted', 'qqplot', "
+"'scalelocation', 'cooksd', 'resleverage', 'cookleverage', 'reshist' ou "
+"'resautocor'"
+
+msgid ""
+"Unrecognized type, must be 'model', 'resfitted', 'qqplot',\n"
+" 'scalelocation' or 'reshist'"
+msgstr ""
+"Type non reconnu, il doit être 'model', 'resfitted', 'qqplot', "
+"'scalelocation', 'cooksd', 'resleverage', 'cookleverage', 'reshist' ou "
+"'resautocor'"
+
+msgid ""
+"The type= argument must provide a model_spec object or its name in a "
+"character string."
+msgstr ""
+"L'argument type= doit fournir un objet model_spec ou son nom sous forme de "
+"chaîne de caractères."
+
+msgid "`data` must be a `data.frame`."
+msgstr "`data` doit être un`data.frame`."
+
+msgid "Unable to summarize the object."
+msgstr "Impossible de calculer le résumé de l'objet."
+
+msgid "Unable to compute ANOVA for the object."
+msgstr "Impossible de calculer l'ANOVA pour l'objet."
+
+msgid "You must give either 'h=' or 'v='."
+msgstr "Il faut fournir 'h=' ou 'v=‘."
+
+msgid "Type III analysis of variance with Satterthwaite's method"
+msgstr "Analyse de la variance de type III avec m\\u00e9thode Sattertwaite"
+
+msgid "Analysis of deviance"
+msgstr "Analyse de la déviance"
+
+msgid "Analysis of variance"
+msgstr "Analyse de la variance"
+
+msgid "Type II analysis of variance"
+msgstr "Analyse de la variance de type II"
+
+msgid "Type III analysis of variance"
+msgstr "Analyse de la variance de type III"
+
+msgid "Type II analysis of deviance table"
+msgstr "Analyse de la déviance de type II"
+
+msgid "Type III analysis of deviance table"
+msgstr "Analyse de la déviance de type III"
+
+msgid "Response:"
+msgstr "Réponse :"
+
+msgid "Model:"
+msgstr "Modèle :"
+
+msgid "Model"
+msgstr "Modèle"
+
+msgid "link:"
+msgstr "Lien :"
+
+msgid "Terms added sequentially (first to last)"
+msgstr "Termes ajoutés séquentiellement (du premier au dernier)"
+
+msgid "Term"
+msgstr "Terme"
+
+msgid "Df"
+msgstr "Ddl"
+
+msgid "Residuals Df"
+msgstr "Ddl des résidus"
+
+msgid "Residual sum of squares"
+msgstr "Somme des carrés des résidus"
+
+msgid "Sum of squares"
+msgstr "Somme des carrés"
+
+msgid "Mean squares"
+msgstr "Carrés moyens"
+
+msgid "*p* value"
+msgstr "Valeur de *p*"
+
+msgid "Num. Df"
+msgstr "Ddl. Num."
+
+msgid "Denom. Df"
+msgstr "Ddl dénom."
+
+msgid "Deviance"
+msgstr "Déviance"
+
+msgid "Residual deviance"
+msgstr "Déviance résiduelle"
+
+msgid "*F*~obs.~ value"
+msgstr "Valeur de *F*~obs.~"
+
+msgid "$\\chi2_{obs.}$"
+msgstr "$\\chi2_{obs.}$"
+
+msgid "None"
+msgstr "Aucun"
+
+msgid "Residuals"
+msgstr "Résidus"
+
+msgid "Number of parameters"
+msgstr "Nombre de paramètres"
+
+msgid ".extract_infos_anova() can apply only anova object."
+msgstr ".extract_infos_anova() ne s’applique qu’au objet anova."
+
+msgid "Estimate"
+msgstr "Valeur estimée"
+
+msgid "Lower bound (CI)"
+msgstr "Limite basse (IC)"
+
+msgid "Upper bound (CI)"
+msgstr "Limite haute (IC)"
+
+msgid "Standard Error"
+msgstr "Ecart type"
+
+msgid "*t* value"
+msgstr "Valeur de *t*"
+
+msgid "Sigma"
+msgstr "Sigma"
+
+msgid "R^2^"
+msgstr "R^2^"
+
+msgid "Adj.R^2^"
+msgstr "R^2^ ajustée"
+
+msgid "AIC"
+msgstr "AIC"
+
+msgid "BIC"
+msgstr "BIC"
+
+msgid "*z* value"
+msgstr "Valeur de *z*"
+
+msgid "Log-Likelihood"
+msgstr "Log-vraisemblance"
+
+msgid "Total deviance"
+msgstr "Déviance totale"
+
+msgid "Total df"
+msgstr "Ddl totaux"
+
+msgid "Num. df"
+msgstr "Ddl modèle"
+
+msgid "Residuals df"
+msgstr "Ddl résidus"
+
+msgid "N"
+msgstr "N"
+
+msgid "Intercept"
+msgstr "Ordonnée à l’origine"
+
+msgid "Generalized Linear Model"
+msgstr "Modèle linéaire généralisé"
+
+msgid "fr"
+msgstr "Fr"
+
+msgid "(Dispersion parameter for %s: %.*g)"
+msgstr "(Paramètre de dispersion pour une %s: %.*g)"
+
+msgid "Total deviance: %.*g on %.*g degrees of freedom"
+msgstr "Déviance totale : %.*g pour %.*g degrés de liberté"
+
+msgid "Residual deviance: %.*g on %.*g degrees of freedom"
+msgstr "Déviance résiduelle : %.*g pour %.*g degrés de liberté"
+
+msgid "AIC: %.*g - Number of Fisher Scoring iterations: %.*g"
+msgstr ""
+"AIC: %.*g - Nombre d’itérations de la fonction de score de Fisher : %.*g"
+
+msgid "Degrees of Freedom: %.*g Total (i.e. no model); %.*g Residual"
+msgstr "Degrés de liberté : %.*g Totaux (i.e., hors modèle) ; %.*g Résidus"
+
+msgid "Total deviance: %.*g"
+msgstr "Déviance totale : %.*g"
+
+msgid "Residual deviance: %.*g AIC: %.*g"
+msgstr "Déviance résiduelle %.*g AIC : %.*g"
+
+msgid ".extract_infos_glm() can apply only glm and summary.glm object."
+msgstr ".extract_infos_nls() ne s’applique qu’au objet glm et summary.glm."
+
+msgid ""
+".extract_infos_glm() can only apply type = 'coef' to a summary.glm\n"
+" object."
+msgstr ""
+"extract_infos_nls() ne peut appliquer type=‘chef’ à un objet summary.nls."
+
+msgid "t value"
+msgstr "Valeur de *t*"
+
+msgid "RSE"
+msgstr "RSE"
+
+msgid "Log-likelihood"
+msgstr "Log-vraisemblance"
+
+msgid "Model df"
+msgstr "Ddl modèle"
+
+msgid "Linear model"
+msgstr "Modèle linéaire"
+
+msgid "Residuals range: [%.*g, %.*g]"
+msgstr "Etendue des résidus : [%.*g, %.*g]"
+
+msgid "Residuals standard error: %.*g on %.*g degrees of freedom"
+msgstr "Ecart type des résidus : %.*g pour %.*g degrés de liberté"
+
+msgid "Multiple *R*^2^: %.*g - adjusted *R*^2^: %.*g"
+msgstr "*R*^2^ multiple : %.*g - *R*^2^ ajusté : %.*g"
+
+msgid "*F*-statistic: %.*g on %.*g and %.*g df - *p* value: %s"
+msgstr "Statistique *F* : %.*g sur %.*g et %.*g ddl - valeur de *p* : %s"
+
+msgid ".extract_infos_lm() can apply only lm and summary.lm object."
+msgstr ".extract_infos_nls() ne s’applique qu’au objet lm et summary.lm."
+
+msgid ""
+".extract_infos_lm() cannot apply type = 'coef' to a summary.lm\n"
+" object. Use type = 'tidy' instead to extract a detailed "
+"coefficient table."
+msgstr ""
+".extract_infos_lm() ne peut appliquer type ='coef' à summary.lm\n"
+" type = 'tidy' est employé pour extraire le tableau des coefficients."
+
+#, fuzzy
+msgid "`x` must be an object of class 'nls' or 'summary.nls'."
+msgstr "x doit être un objet nls ou summary.nls"
+
+msgid "An error occurred when trying to extract the formula from 'x'"
+msgstr "Une erreur s’est produit lors de l’essais d’extraire la formule de 'x'"
+
+msgid "The formula is not a Self-Starting nls formula"
+msgstr "La formule n'est pas une formule Self-Starting nls"
+
+msgid "The %s is not available."
+msgstr "Le %s n'est pas disponible."
+
+msgid "var_names is not character vector"
+msgstr "var_names n’est pas une vecteur de caractère"
+
+msgid "var_names must be named character vector"
+msgstr "var_names doit être un vecteur de caractère nommé"
+
+msgid "all elements must be named"
+msgstr "Tous les éléments doivent être nommé."
+
+msgid "*t*~obs.~ value"
+msgstr "Valeur de *t*~obs.~"
+
+msgid "Relative standard error"
+msgstr "Ecart type des résidus"
+
+msgid "Convergence tolerance"
+msgstr "Tolérance de convergence"
+
+msgid "df"
+msgstr "Degrés de liberté"
+
+msgid "Nonlinear least squares asymptotic regression model (von Bertalanffy)"
+msgstr "Modèle non linéaire de régression asymptotique (von Bertalanffy)"
+
+msgid "Nonlinear least squares asymptotic regression model (von Bertalanffy)"
+msgstr "Modèle non linéaire de régression asymptotique (von Bertalanffy)"
+
+msgid ""
+"Nonlinear least squares asymptotic regression model through the origin (von "
+"Bertalanffy)"
+msgstr ""
+"Modèle non linéaire de régression asymptotique forcée à l'origine (von "
+"Bertalanffy)"
+
+msgid "Nonlinear least squares biexponential model"
+msgstr "Modèle non linéaire biexponentiel"
+
+msgid "Nonlinear least squares first-order compartment model"
+msgstr "Modèle non linéaire à compartiments du premier ordre"
+
+msgid "Nonlinear least squares four-parameter logistic model"
+msgstr "Modèle non linéaire logistique à quatre paramètres"
+
+msgid "Nonlinear least squares Gompertz model"
+msgstr "Modèle non linéaire de Gompertz"
+
+msgid "Nonlinear least squares logistic model"
+msgstr "Modèle non linéaire logistique"
+
+msgid "Nonlinear least squares Michaelis-Menten model"
+msgstr "Modèle non linéaire de Michaelis-Menten"
+
+msgid "Nonlinear least squares Weibull model"
+msgstr "Modèle non linéaire de Weibull"
+
+msgid "Residual sum-of-squares: %.*g"
+msgstr "Somme des carrés des résidus : %.*g"
+
+msgid "Number of iterations to convergence: %.*g"
+msgstr "Nombre d'itérations pour converger : %.*g"
+
+msgid "Achieved convergence tolerance: %.*g"
+msgstr "Tolérance atteinte à la convergence : %.*g"
+
+msgid "The model does not converge"
+msgstr "Le modèle ne converge pas"
+
+msgid ".extract_infos_nls() can apply only nls and summary.nls object."
+msgstr ".extract_infos_nls() ne s’applique qu’au objet nls et summary.nls."
+
+msgid ""
+".extract_infos_nls() cannot apply type = 'glance' to a summary.nls\n"
+" object."
+msgstr ""
+"extract_infos_nls() ne peut appliquer type=‘lance’ à un objet summary.nls."
+
+msgid "Package 'data.io' is required but not installed."
+msgstr "Le package “data.io” est requis mais n'est pas installé."
+
+msgid "labs is not character vector"
+msgstr "L’argument labs n’est pas un vecteur de caractères"
+
+msgid "labs must be named character vector"
+msgstr "l’argument ‘labs’ doit être un vecteur de caractères nommé"
+
+msgid "all element must be named"
+msgstr "tous les éléments doivent être nommés"
+
+msgid "The following terms are missing in 'labs' for the interaction '%s': %s"
+msgstr ""
+"Les termes suivants sont manquant dans 'labs' pour les interactions %s’: %s"
+
+msgid ","
+msgstr ","
+
+msgid "The 'equation' argument must be TRUE, FALSE, NA, or a character string."
+msgstr ""
+"L’argument 'equation' doit être TRUE, FALSE, NA, ou une chaine de caractère."
+
+msgid "Not implemented yet"
+msgstr "Ce n'est pas encore implémenté"
+
+msgid "Function `%s` supports only flextable objects."
+msgstr "La fonction `%s` supporte uniquement des objets flextable."
+
+msgid ".add_signif_stars()"
+msgstr ".add_signif_stars()"
+
+msgid ".add_header2()"
+msgstr ".add_header2()"
+
+msgid ".add_colnames()"
+msgstr ".add_colnames()"
+
+#~ msgid "header_labels_lm()"
+#~ msgstr "header_labels_lm()"
+
+#~ msgid ".add_header()"
+#~ msgstr ".add_header()"
diff --git a/po/R-modelit.pot b/po/R-modelit.pot
new file mode 100644
index 0000000..6ccdc58
--- /dev/null
+++ b/po/R-modelit.pot
@@ -0,0 +1,377 @@
+msgid ""
+msgstr ""
+"Project-Id-Version: modelit 1.4.8\n"
+"POT-Creation-Date: 2025-08-20 09:35\n"
+"PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n"
+"Last-Translator: FULL NAME \n"
+"Language-Team: LANGUAGE \n"
+"Language: \n"
+"MIME-Version: 1.0\n"
+"Content-Type: text/plain; charset=CHARSET\n"
+"Content-Transfer-Encoding: 8bit\n"
+
+msgid "Can only transform a model with 2 variables for now."
+msgstr ""
+
+msgid "Can only make of function from a model involving numeric variables for now."
+msgstr ""
+
+msgid "You cannot use one-sided formula, like ~x."
+msgstr ""
+
+msgid "Impossible to plot in 2D a model with more than 2 variables"
+msgstr ""
+
+msgid "Can only plot a model involving numeric variables for now."
+msgstr ""
+
+msgid "Independent variable '"
+msgstr ""
+
+msgid "' must appear untransformed in the model's formula, or you must supply the original dataset in origdata=."
+msgstr ""
+
+msgid "Unrecognized type, must be 'model', 'resfitted', 'qqplot', 'scalelocation', 'cooksd', 'resleverage', 'cookleverage', 'reshist', or 'resautocor'"
+msgstr ""
+
+msgid "Unrecognized type, must be 'model', 'resfitted', 'qqplot',\n 'scalelocation' or 'reshist'"
+msgstr ""
+
+msgid "The type= argument must provide a model_spec object or its name in a character string."
+msgstr ""
+
+msgid "`data` must be a `data.frame`."
+msgstr ""
+
+msgid "Unable to summarize the object."
+msgstr ""
+
+msgid "Unable to compute ANOVA for the object."
+msgstr ""
+
+msgid "You must give either 'h=' or 'v='."
+msgstr ""
+
+msgid "Type III analysis of variance with Satterthwaite's method"
+msgstr ""
+
+msgid "Analysis of deviance"
+msgstr ""
+
+msgid "Analysis of variance"
+msgstr ""
+
+msgid "Type II analysis of variance"
+msgstr ""
+
+msgid "Type III analysis of variance"
+msgstr ""
+
+msgid "Type II analysis of deviance table"
+msgstr ""
+
+msgid "Type III analysis of deviance table"
+msgstr ""
+
+msgid "Response:"
+msgstr ""
+
+msgid "Model:"
+msgstr ""
+
+msgid "Model"
+msgstr ""
+
+msgid "link:"
+msgstr ""
+
+msgid "Terms added sequentially (first to last)"
+msgstr ""
+
+msgid "Term"
+msgstr ""
+
+msgid "Df"
+msgstr ""
+
+msgid "Residuals Df"
+msgstr ""
+
+msgid "Residual sum of squares"
+msgstr ""
+
+msgid "Sum of squares"
+msgstr ""
+
+msgid "Mean squares"
+msgstr ""
+
+msgid "*p* value"
+msgstr ""
+
+msgid "Num. Df"
+msgstr ""
+
+msgid "Denom. Df"
+msgstr ""
+
+msgid "Deviance"
+msgstr ""
+
+msgid "Residual deviance"
+msgstr ""
+
+msgid "*F*~obs.~ value"
+msgstr ""
+
+msgid "$\\chi2_{obs.}$"
+msgstr ""
+
+msgid "None"
+msgstr ""
+
+msgid "Residuals"
+msgstr ""
+
+msgid "Number of parameters"
+msgstr ""
+
+msgid ".extract_infos_anova() can apply only anova object."
+msgstr ""
+
+msgid "Estimate"
+msgstr ""
+
+msgid "Lower bound (CI)"
+msgstr ""
+
+msgid "Upper bound (CI)"
+msgstr ""
+
+msgid "Standard Error"
+msgstr ""
+
+msgid "*t* value"
+msgstr ""
+
+msgid "Sigma"
+msgstr ""
+
+msgid "R^2^"
+msgstr ""
+
+msgid "Adj.R^2^"
+msgstr ""
+
+msgid "AIC"
+msgstr ""
+
+msgid "BIC"
+msgstr ""
+
+msgid "*z* value"
+msgstr ""
+
+msgid "Log-Likelihood"
+msgstr ""
+
+msgid "Total deviance"
+msgstr ""
+
+msgid "Total df"
+msgstr ""
+
+msgid "Num. df"
+msgstr ""
+
+msgid "Residuals df"
+msgstr ""
+
+msgid "N"
+msgstr ""
+
+msgid "Intercept"
+msgstr ""
+
+msgid "Generalized Linear Model"
+msgstr ""
+
+msgid "fr"
+msgstr ""
+
+msgid "(Dispersion parameter for %s: %.*g)"
+msgstr ""
+
+msgid "Total deviance: %.*g on %.*g degrees of freedom"
+msgstr ""
+
+msgid "Residual deviance: %.*g on %.*g degrees of freedom"
+msgstr ""
+
+msgid "AIC: %.*g - Number of Fisher Scoring iterations: %.*g"
+msgstr ""
+
+msgid "Degrees of Freedom: %.*g Total (i.e. no model); %.*g Residual"
+msgstr ""
+
+msgid "Total deviance: %.*g"
+msgstr ""
+
+msgid "Residual deviance: %.*g AIC: %.*g"
+msgstr ""
+
+msgid ".extract_infos_glm() can apply only glm and summary.glm object."
+msgstr ""
+
+msgid ".extract_infos_glm() can only apply type = 'coef' to a summary.glm\n object."
+msgstr ""
+
+msgid "t value"
+msgstr ""
+
+msgid "RSE"
+msgstr ""
+
+msgid "Log-likelihood"
+msgstr ""
+
+msgid "Model df"
+msgstr ""
+
+msgid "Linear model"
+msgstr ""
+
+msgid "Residuals range: [%.*g, %.*g]"
+msgstr ""
+
+msgid "Residuals standard error: %.*g on %.*g degrees of freedom"
+msgstr ""
+
+msgid "Multiple *R*^2^: %.*g - adjusted *R*^2^: %.*g"
+msgstr ""
+
+msgid "*F*-statistic: %.*g on %.*g and %.*g df - *p* value: %s"
+msgstr ""
+
+msgid ".extract_infos_lm() can apply only lm and summary.lm object."
+msgstr ""
+
+msgid ".extract_infos_lm() cannot apply type = 'coef' to a summary.lm\n object. Use type = 'tidy' instead to extract a detailed coefficient table."
+msgstr ""
+
+msgid "`x` must be an object of class 'nls' or 'summary.nls'."
+msgstr ""
+
+msgid "An error occurred when trying to extract the formula from 'x'"
+msgstr ""
+
+msgid "The formula is not a Self-Starting nls formula"
+msgstr ""
+
+msgid "The %s is not available."
+msgstr ""
+
+msgid "var_names is not character vector"
+msgstr ""
+
+msgid "var_names must be named character vector"
+msgstr ""
+
+msgid "all elements must be named"
+msgstr ""
+
+msgid "*t*~obs.~ value"
+msgstr ""
+
+msgid "Relative standard error"
+msgstr ""
+
+msgid "Convergence tolerance"
+msgstr ""
+
+msgid "df"
+msgstr ""
+
+msgid "Nonlinear least squares asymptotic regression model (von Bertalanffy)"
+msgstr ""
+
+msgid "Nonlinear least squares asymptotic regression model (von Bertalanffy)"
+msgstr ""
+
+msgid "Nonlinear least squares asymptotic regression model through the origin (von Bertalanffy)"
+msgstr ""
+
+msgid "Nonlinear least squares biexponential model"
+msgstr ""
+
+msgid "Nonlinear least squares first-order compartment model"
+msgstr ""
+
+msgid "Nonlinear least squares four-parameter logistic model"
+msgstr ""
+
+msgid "Nonlinear least squares Gompertz model"
+msgstr ""
+
+msgid "Nonlinear least squares logistic model"
+msgstr ""
+
+msgid "Nonlinear least squares Michaelis-Menten model"
+msgstr ""
+
+msgid "Nonlinear least squares Weibull model"
+msgstr ""
+
+msgid "Residual sum-of-squares: %.*g"
+msgstr ""
+
+msgid "Number of iterations to convergence: %.*g"
+msgstr ""
+
+msgid "Achieved convergence tolerance: %.*g"
+msgstr ""
+
+msgid "The model does not converge"
+msgstr ""
+
+msgid ".extract_infos_nls() can apply only nls and summary.nls object."
+msgstr ""
+
+msgid ".extract_infos_nls() cannot apply type = 'glance' to a summary.nls\n object."
+msgstr ""
+
+msgid "Package 'data.io' is required but not installed."
+msgstr ""
+
+msgid "labs is not character vector"
+msgstr ""
+
+msgid "labs must be named character vector"
+msgstr ""
+
+msgid "all element must be named"
+msgstr ""
+
+msgid "The following terms are missing in 'labs' for the interaction '%s': %s"
+msgstr ""
+
+msgid ","
+msgstr ""
+
+msgid "The 'equation' argument must be TRUE, FALSE, NA, or a character string."
+msgstr ""
+
+msgid "Not implemented yet"
+msgstr ""
+
+msgid "Function `%s` supports only flextable objects."
+msgstr ""
+
+msgid ".add_signif_stars()"
+msgstr ""
+
+msgid ".add_header2()"
+msgstr ""
+
+msgid ".add_colnames()"
+msgstr ""
diff --git a/tests/testthat/test-.extract_infos_lm.R b/tests/testthat/test-.extract_infos_lm.R
new file mode 100644
index 0000000..ed28ee9
--- /dev/null
+++ b/tests/testthat/test-.extract_infos_lm.R
@@ -0,0 +1,156 @@
+
+data(mtcars)
+mod <- lm(mpg ~ wt + hp, data = mtcars)
+mod1 <- lm(mpg ~ wt + hp + 0, data = mtcars)
+mod3 <- lm(petal_length ~ sepal_length , data = data.io::read("iris", package = "datasets"))
+
+test_that("output is a list contains all expected named elements", {
+ # Verifies that the returned list
+ expect_type(.extract_infos_lm(mod), "list")
+})
+
+test_that("output contains all expected named elements of the list", {
+ # Verifies that the returned list includes all expected components
+ res <- .extract_infos_lm(mod, type = "tidy")
+ expect_true(all(c("df", "title", "cols", "equa", "terms", "psignif", "footer") %in% names(res)))
+})
+
+# df ----------------------------------------------------------------------
+
+test_that("invalid type throws an error", {
+ # Ensures an error is thrown for an unsupported type
+ expect_error(.extract_infos_lm(mod, type = "unknown"))
+})
+
+test_that("type = 'coef' returns expected columns in df", {
+ # Checks that the 'coef' type returns a data frame with 'term' and 'estimate'
+ res <- .extract_infos_lm(mod, type = "coef")
+ expect_equal(colnames(res$df), c("term", "estimate"))
+})
+
+test_that("type = 'glance' returns a one-row data frame", {
+ # Checks that the 'glance' type returns a summary with one row
+ res <- .extract_infos_lm(mod, type = "glance")
+ expect_true("df" %in% names(res))
+ expect_equal(nrow(res$df), 1)
+})
+
+test_that("type = 'tidy' returns expected columns with conf.int = TRUE", {
+ # Checks that confidence intervals are included when conf.int = TRUE
+ res <- .extract_infos_lm(mod, type = "tidy", conf.int = TRUE)
+ expect_true(all(c("term", "estimate", "conf.low", "conf.high", "std.error",
+ "statistic", "p.value") %in% colnames(res$df)))
+})
+
+test_that("type = 'tidy' without conf.int omits CI columns", {
+ # Ensures confidence interval columns are not present when conf.int = FALSE
+ res <- .extract_infos_lm(mod, type = "tidy", conf.int = FALSE)
+ expect_false("conf.low" %in% colnames(res$df))
+})
+
+test_that("signif.stars = TRUE adds 'signif' column", {
+ # Checks that significance stars are added when enabled
+ res <- .extract_infos_lm(mod, type = "tidy", show.signif.stars = TRUE)
+ expect_true("signif" %in% colnames(res$df))
+})
+
+test_that("signif.stars = FALSE omits 'signif' column in df", {
+ # Ensures 'signif' column is not added when disabled
+ res <- .extract_infos_lm(mod, type = "tidy", show.signif.stars = FALSE)
+ expect_false("signif" %in% colnames(res$df))
+})
+
+
+# title -------------------------------------------------------------------
+
+test_that("x$title is NULL when title = FALSE/TRUE/chr", {
+ res <- .extract_infos_lm(mod, type = "tidy", title = FALSE)
+ expect_null(res$title)
+
+ res <- .extract_infos_lm(mod, type = "tidy", title = TRUE)
+ expect_equal(res$title, "Linear model")
+ #res <- .extract_infos_lm(mod, type = "tidy", title = TRUE, lang = "fr")
+ #expect_equal(res$title, "Modèle linéaire")
+
+ res <- .extract_infos_lm(mod, type = "tidy", title = "blablabla")
+ expect_type(res$title, "character")
+ expect_equal(res$title, "blablabla")
+})
+
+
+# cols --------------------------------------------------------------------
+
+test_that("x$cols is a named character vector", {
+ res <- .extract_infos_lm(mod, type = "tidy")
+
+ # Check that 'cols' exists and is a character vector
+ expect_true("cols" %in% names(res))
+ expect_type(res$cols, "character")
+
+ # Check that it has names
+ expect_true(any(nzchar(names(res$cols)))) # names are not empty
+})
+
+# equation ----------------------------------------------------------------
+
+test_that("x$equa is an equation ", {
+ res <- .extract_infos_lm(mod, type = "coef")
+
+ # Check that 'equa' exists and is a character vector
+ expect_true("equa" %in% names(res))
+ expect_true(all(class(res$equa) == c("equation", "character")))
+
+ res <- .extract_infos_lm(mod, type = "coef", equation = "tada")
+ expect_type(res$equa, "character")
+})
+
+
+# terms -------------------------------------------------------------------
+test_that("res$terms is a character vector with or without names depending on
+ equation argument", {
+ res <- .extract_infos_lm(mod, equation = TRUE)
+ expect_type(res$terms, "character")
+ # .params_equation returns an unnamed character vector
+ expect_null(names(res$terms))
+
+ # .params_equation returns a vector of the same length as the number of rows in df
+ expect_true(length(res$terms) == nrow(res$df))
+
+ res <- .extract_infos_lm(mod, equation = FALSE)
+ expect_type(res$terms, "character")
+ expect_true(any(nzchar(names(res$terms))))
+
+ res <- .extract_infos_lm(mod1, equation = FALSE)
+ expect_null(res$terms)
+
+ res <- .extract_infos_lm(mod3, equation = FALSE)
+ expect_true(length(res$terms) == nrow(res$df))
+ expect_true(any(nzchar(names(res$terms))))
+})
+
+# psignif -----------------------------------------------------------------
+
+test_that("x$signif is an equation ", {
+ res <- .extract_infos_lm(mod, show.signif.stars = FALSE)
+ expect_null(res$psignif)
+
+ res <- .extract_infos_lm(mod, show.signif.stars = TRUE)
+ expect_type(res$psignif, "character")
+})
+
+# footer ------------------------------------------------------------------
+
+test_that("x$footer is NULL when footer = FALSE", {
+ # Checks that footer is NULL when not requested
+ res <- .extract_infos_lm(mod, type = "tidy", footer = FALSE)
+ expect_null(res$footer)
+
+ # footer is generated when footer = TRUE and a summary.lm object
+ res <- .extract_infos_lm(summary(mod), type = "tidy", footer = TRUE)
+ expect_true(!is.null(res$footer))
+
+ # footer is not generated when footer = TRUE and a lm object
+ expect_error(extract_infos_lm(mod, type = "tidy", footer = TRUE))
+ })
+
+
diff --git a/tests/testthat/test-general.R b/tests/testthat/test-general.R
index 8849056..7613874 100644
--- a/tests/testthat/test-general.R
+++ b/tests/testthat/test-general.R
@@ -1,3 +1,7 @@
-test_that("multiplication works", {
- expect_equal(2 * 2, 4)
+test_that("Update .po and .mo files", {
+ # Update .po and .mo files (only test in the source package, not R CMD check)
+ if (file.exists("../../DESCRIPTION")) {# This is the source of the package
+ cat("\nCompiling .po files...\n")
+ res <- try(tools::update_pkg_po("../.."), silent = TRUE)
+ }
})
diff --git a/vignettes/modelit.R b/vignettes/modelit.R
index 19d1ff8..bdf6023 100644
--- a/vignettes/modelit.R
+++ b/vignettes/modelit.R
@@ -3,12 +3,14 @@ knitr::opts_chunk$set(collapse = TRUE, comment = "#>", fig.align = 'center',
fig.width = 7, fig.height = 5, out.width = "100%")
library(modelit)
library(tabularise)
+library(equatiomatic)
library(chart)
library(dplyr)
## -----------------------------------------------------------------------------
library(modelit)
library(tabularise)
+library(equatiomatic)
library(chart)
library(dplyr)
@@ -17,7 +19,7 @@ data("Loblolly", package = "datasets")
# convert feet to meters
Loblolly$height <- round(Loblolly$height * 0.3048, 2)
# Add labels and units
-Loblolly <- data.io::labelise(Loblolly,
+Loblolly <- svBase::labelise(Loblolly,
label = list(height = "Heigth", age = "Age", Seed = "Seed"),
units = list(height = "m", age = "years"))
diff --git a/vignettes/modelit.Rmd b/vignettes/modelit.Rmd
index 2f1e86b..573f79d 100644
--- a/vignettes/modelit.Rmd
+++ b/vignettes/modelit.Rmd
@@ -1,5 +1,5 @@
---
-title: "Statistical Models for 'SciViews::R'"
+title: "'SciViews::R' - Statistical Models"
author: "Philippe Grosjean & Guyliann Engels"
date: "`r Sys.Date()`"
output:
@@ -8,7 +8,7 @@ output:
toc_depth: 3
fig_caption: yes
vignette: >
- %\VignetteIndexEntry{Statistical Models for 'SciViews::R'}
+ %\VignetteIndexEntry{'SciViews::R' - Statistical Models}
%\VignetteEngine{knitr::rmarkdown}
%\VignetteEncoding{UTF-8}
---
@@ -18,6 +18,7 @@ knitr::opts_chunk$set(collapse = TRUE, comment = "#>", fig.align = 'center',
fig.width = 7, fig.height = 5, out.width = "100%")
library(modelit)
library(tabularise)
+library(equatiomatic)
library(chart)
library(dplyr)
```
@@ -31,6 +32,7 @@ Load the required packages for this example.
```{r}
library(modelit)
library(tabularise)
+library(equatiomatic)
library(chart)
library(dplyr)
```
@@ -42,7 +44,7 @@ data("Loblolly", package = "datasets")
# convert feet to meters
Loblolly$height <- round(Loblolly$height * 0.3048, 2)
# Add labels and units
-Loblolly <- data.io::labelise(Loblolly,
+Loblolly <- svBase::labelise(Loblolly,
label = list(height = "Heigth", age = "Age", Seed = "Seed"),
units = list(height = "m", age = "years"))