diff --git a/DESCRIPTION b/DESCRIPTION index 57009cabca..2515323a41 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: insight Title: Easy Access to Model Information for Various Model Objects -Version: 0.99.0.1 +Version: 0.99.0.2 Authors@R: c(person(given = "Daniel", family = "Lüdecke", diff --git a/NEWS.md b/NEWS.md index aee8e13636..d21a939efa 100644 --- a/NEWS.md +++ b/NEWS.md @@ -23,6 +23,9 @@ * The function to calculate the corrections for likelihood-values when the response-variable is transformed is now exported as `get_likelihood_adjustment()`. +* `export_table()` can now split tables into more than three tables when + `table_width` is used (formerly, the maximum number of split tables was three). + ## Bug fix * `clean_parameters()` now uses the correct labels for the random effects diff --git a/R/export_table.R b/R/export_table.R index c3baebd3ef..0b76e5ddad 100644 --- a/R/export_table.R +++ b/R/export_table.R @@ -44,9 +44,10 @@ #' @param table_width Numeric, or `"auto"`, indicating the width of the complete #' table. If `table_width = "auto"` and the table is wider than the current #' width (i.e. line length) of the console (or any other source for textual -#' output, like markdown files), the table is split into two parts. Else, +#' output, like markdown files), the table is split into multiple parts. Else, #' if `table_width` is numeric and table rows are larger than `table_width`, -#' the table is split into two parts. +#' the table is split into multiple parts. For each new table, the first +#' column is repeated for better orientation. #' @param ... Currently not used. #' @inheritParams format_value #' @inheritParams get_data @@ -118,7 +119,7 @@ export_table <- function(x, align = NULL, by = NULL, zap_small = FALSE, - table_width = NULL, + table_width = "auto", verbose = TRUE, ...) { # check args @@ -545,12 +546,8 @@ print.insight_table <- function(x, ...) { } - # we can split very wide table into maximum three parts - # this is currently hardcoded, not flexible, so we cannot allow - # more than three parts of one wide table - final2 <- NULL - final3 <- NULL - + # we can split very wide tables + final_extra <- NULL # check if user requested automatic width-adjustment of tables, or if a # given width is required @@ -569,38 +566,35 @@ print.insight_table <- function(x, ...) { # width of first table row of complete table. Currently, "final" is still # a matrix, so we need to paste the columns of the first row into a string - row_width <- nchar(paste0(final[1, ], collapse = sep), type = "width") + row_width <- nchar(paste(final[1, ], collapse = sep), type = "width") # possibly first split - all table columns longer than "line_width" # (i.e. first table row) go into a second string if (row_width > line_width) { - i <- 1 - # determine how many columns fit into the first line - while (nchar(paste0(final[1, 1:i], collapse = sep), type = "width") < line_width) { - i <- i + 1 - } - # copy first column, and all columns that did not fit into the first line - # into the second table matrix - if (i > 2 && i < ncol(final)) { - final2 <- final[, c(1, i:ncol(final))] - final <- final[, 1:(i - 1)] + final_extra <- list(final) + e <- 1 + while (nchar(paste(utils::tail(final_extra, 1)[[1]][1, ], collapse = sep), type = "width") > line_width && e <= length(final_extra)) { # nolint + .final_temp <- final_extra[[e]] + + i <- 1 + # determine how many columns fit into the first line + while (nchar(paste(.final_temp[1, 1:i], collapse = sep), type = "width") < line_width) { + i <- i + 1 + } + # copy first column, and all columns that did not fit into the first line + # into the second table matrix + if (i < ncol(.final_temp)) { + final_extra[[e]] <- .final_temp[, 1:(i - 1), drop = FALSE] + final_extra[[e + 1]] <- .final_temp[, c(1, i:ncol(.final_temp)), drop = FALSE] + } + e <- e + 1 } - } - - # width of first table row of remaing second table part - row_width <- nchar(paste0(final2[1, ], collapse = sep), type = "width") - # possibly second split - all table columns longer than "line_width" - # (i.e. first table row) go into a third string - we repeat the same - # procedure as above - if (row_width > line_width) { - i <- 1 - while (nchar(paste0(final2[1, 1:i], collapse = sep), type = "width") < line_width) { - i <- i + 1 - } - if (i > 2 && i < ncol(final2)) { - final3 <- final2[, c(1, i:ncol(final2))] - final2 <- final2[, 1:(i - 1)] + final <- final_extra[[1]] + if (length(final_extra) > 1) { + final_extra <- final_extra[-1] + } else { + final_extra <- NULL } } } @@ -608,17 +602,14 @@ print.insight_table <- function(x, ...) { # Transform table matrix into a string value that can be printed rows <- .table_parts(NULL, final, header, sep, cross, empty_line) - # if we have over-lengthy tables that are split into two parts, - # print second table here - if (!is.null(final2)) { - rows <- .table_parts(paste0(rows, "\n"), final2, header, sep, cross, empty_line) + # if we have over-lengthy tables that are split into parts, + # print extra table here + if (!is.null(final_extra)) { + for (fex in final_extra) { + rows <- .table_parts(paste0(rows, "\n"), fex, header, sep, cross, empty_line) + } } - # if we have over-lengthy tables that are split into two parts, - # print second table here - if (!is.null(final3)) { - rows <- .table_parts(paste0(rows, "\n"), final3, header, sep, cross, empty_line) - } # if caption is available, add a row with a headline if (!is.null(caption) && caption[1] != "") { @@ -666,7 +657,7 @@ print.insight_table <- function(x, ...) { for (row in seq_len(nrow(final))) { # create a string for each row, where cells from original matrix are # separated by the separator char - final_row <- paste0(final[row, ], collapse = sep) + final_row <- paste(final[row, ], collapse = sep) # check if we have an empty row, and if so, fill with an # "empty line separator", if requested by user if (!is.null(empty_line) && !any(nzchar(trim_ws(final[row, ])))) { @@ -677,7 +668,7 @@ print.insight_table <- function(x, ...) { # the empty line, which is just empty cells with separator char, # will now be replaced by the "empty line char", so we have a # clean separator line - paste0(rep_len(empty_line, nchar(final_row, type = "width")), collapse = ""), + paste(rep_len(empty_line, nchar(final_row, type = "width")), collapse = ""), cross, sep, final_row, is_last_row = row == nrow(final) ) @@ -691,7 +682,7 @@ print.insight_table <- function(x, ...) { # check whether user wants to have a "cross" char where vertical and # horizontal lines (from header line) cross. header_line <- .insert_cross( - paste0(rep_len(header, nchar(final_row, type = "width")), collapse = ""), + paste(rep_len(header, nchar(final_row, type = "width")), collapse = ""), cross, sep, final_row, is_last_row = row == nrow(final) ) diff --git a/man/export_table.Rd b/man/export_table.Rd index d4ed149c0a..0982e0a34a 100644 --- a/man/export_table.Rd +++ b/man/export_table.Rd @@ -25,7 +25,7 @@ export_table( align = NULL, by = NULL, zap_small = FALSE, - table_width = NULL, + table_width = "auto", verbose = TRUE, ... ) @@ -111,9 +111,10 @@ places than \code{digits} are printed in scientific notation.} \item{table_width}{Numeric, or \code{"auto"}, indicating the width of the complete table. If \code{table_width = "auto"} and the table is wider than the current width (i.e. line length) of the console (or any other source for textual -output, like markdown files), the table is split into two parts. Else, +output, like markdown files), the table is split into multiple parts. Else, if \code{table_width} is numeric and table rows are larger than \code{table_width}, -the table is split into two parts.} +the table is split into multiple parts. For each new table, the first +column is repeated for better orientation.} \item{verbose}{Toggle messages and warnings.} diff --git a/tests/testthat/_snaps/windows/export_table.md b/tests/testthat/_snaps/windows/export_table.md new file mode 100644 index 0000000000..bd88d1e2ee --- /dev/null +++ b/tests/testthat/_snaps/windows/export_table.md @@ -0,0 +1,95 @@ +# export_table, table_width + + Code + print(out, table_width = 50) + Output + # Comparison of Model Performance Indices + + Name | Model | Chi2(24) | p (Chi2) + ------------------------------------- + model1 | lavaan | 85.306 | < .001 + model2 | lavaan | 85.306 | < .001 + + Name | Baseline(36) | p (Baseline) | GFI + -------------------------------------------- + model1 | 918.852 | < .001 | 0.943 + model2 | 918.852 | < .001 | 0.943 + + Name | AGFI | NFI | NNFI | CFI | RMSEA + ---------------------------------------------- + model1 | 0.894 | 0.907 | 0.896 | 0.931 | 0.092 + model2 | 0.894 | 0.907 | 0.896 | 0.931 | 0.092 + + Name | RMSEA CI | p (RMSEA) | RMR | SRMR + ------------------------------------------------- + model1 | [0.07, 0.11] | < .001 | 0.082 | 0.065 + model2 | [0.07, 0.11] | < .001 | 0.082 | 0.065 + + Name | RFI | PNFI | IFI | RNI + -------------------------------------- + model1 | 0.861 | 0.605 | 0.931 | 0.931 + model2 | 0.861 | 0.605 | 0.931 | 0.931 + + Name | Loglikelihood | AIC (weights) + --------------------------------------- + model1 | -3737.745 | 7517.5 (0.500) + model2 | -3737.745 | 7517.5 (0.500) + + Name | BIC (weights) | BIC_adjusted + -------------------------------------- + model1 | 7595.3 (0.500) | 7528.739 + model2 | 7595.3 (0.500) | 7528.739 + +--- + + Code + print(tab, table_width = 80) + Output + Parameter | lm1 | lm2 + ------------------------------------------------------------------------------ + (Intercept) | 5.01 (4.86, 5.15) | 3.68 ( 3.47, 3.89) + Species [versicolor] | 0.93 (0.73, 1.13) | -1.60 (-1.98, -1.22) + Species [virginica] | 1.58 (1.38, 1.79) | -2.12 (-2.66, -1.58) + Petal Length | | 0.90 ( 0.78, 1.03) + Species [versicolor] × Petal Length | | + Species [virginica] × Petal Length | | + Petal Width | | + ------------------------------------------------------------------------------ + Observations | 150 | 150 + + Parameter | lm3 + ---------------------------------------------------------- + (Intercept) | 4.21 ( 3.41, 5.02) + Species [versicolor] | -1.81 (-2.99, -0.62) + Species [virginica] | -3.15 (-4.41, -1.90) + Petal Length | 0.54 ( 0.00, 1.09) + Species [versicolor] × Petal Length | 0.29 (-0.30, 0.87) + Species [virginica] × Petal Length | 0.45 (-0.12, 1.03) + Petal Width | + ---------------------------------------------------------- + Observations | 150 + + Parameter | lm4 + ---------------------------------------------------------- + (Intercept) | 4.21 ( 3.41, 5.02) + Species [versicolor] | -1.80 (-2.99, -0.62) + Species [virginica] | -3.19 (-4.50, -1.88) + Petal Length | 0.54 (-0.02, 1.09) + Species [versicolor] × Petal Length | 0.28 (-0.30, 0.87) + Species [virginica] × Petal Length | 0.45 (-0.12, 1.03) + Petal Width | 0.03 (-0.28, 0.34) + ---------------------------------------------------------- + Observations | 150 + + Parameter | lm5 | lm6 + --------------------------------------------------------------------------------- + (Intercept) | 4.21 ( 3.41, 5.02) | 4.21 ( 3.41, 5.02) + Species [versicolor] | -1.80 (-2.99, -0.62) | -1.80 (-2.99, -0.62) + Species [virginica] | -3.19 (-4.50, -1.88) | -3.19 (-4.50, -1.88) + Petal Length | 0.54 (-0.02, 1.09) | 0.54 (-0.02, 1.09) + Species [versicolor] × Petal Length | 0.28 (-0.30, 0.87) | 0.28 (-0.30, 0.87) + Species [virginica] × Petal Length | 0.45 (-0.12, 1.03) | 0.45 (-0.12, 1.03) + Petal Width | 0.03 (-0.28, 0.34) | 0.03 (-0.28, 0.34) + --------------------------------------------------------------------------------- + Observations | 150 | 150 + diff --git a/tests/testthat/test-export_table.R b/tests/testthat/test-export_table.R index 54cb72f1e0..61cd119daa 100644 --- a/tests/testthat/test-export_table.R +++ b/tests/testthat/test-export_table.R @@ -100,3 +100,30 @@ test_that("export_table", { ignore_attr = TRUE ) }) + + +test_that("export_table, table_width", { + skip_on_cran() + skip_if_not_installed("lavaan") + skip_if_not_installed("performance") + skip_if_not_installed("parameters") + + data(HolzingerSwineford1939, package = "lavaan") + structure <- " visual =~ x1 + x2 + x3 + textual =~ x4 + x5 + x6 + speed =~ x7 + x8 + x9 " + model1 <- lavaan::cfa(structure, data = HolzingerSwineford1939) + model2 <- lavaan::cfa(structure, data = HolzingerSwineford1939) + + out <- performance::compare_performance(model1, model2) + expect_snapshot(print(out, table_width = 50), variant = "windows") + + data(iris) + lm1 <- lm(Sepal.Length ~ Species, data = iris) + lm2 <- lm(Sepal.Length ~ Species + Petal.Length, data = iris) + lm3 <- lm(Sepal.Length ~ Species * Petal.Length, data = iris) + lm6 <- lm5 <- lm4 <- lm(Sepal.Length ~ Species * Petal.Length + Petal.Width, data = iris) + + tab <- parameters::compare_parameters(lm1, lm2, lm3, lm4, lm5, lm6) + expect_snapshot(print(tab, table_width = 80), variant = "windows") +})