diff --git a/R/tt_as_df.R b/R/tt_as_df.R index df1727fe3..214d10ec3 100644 --- a/R/tt_as_df.R +++ b/R/tt_as_df.R @@ -99,8 +99,13 @@ as_result_df <- function(tt, spec = NULL, which_root_name = c("root", "rbind_root"), all = TRUE ) + + # Correcting maxlen for even number of paths (only multianalysis diff table names) maxlen <- max(lengths(df$path)) - + if (maxlen %% 2 != 0) { + maxlen <- maxlen + 1 + } + # Loop for metadata (path and details from make_row_df) metadf <- do.call( rbind.data.frame, @@ -174,6 +179,7 @@ as_result_df <- function(tt, spec = NULL, ret <- rbind(header_colnames_matrix, ret) } + # make_ard ----------------------------------------------------------------- # ARD part for one stat per row if (make_ard) { cinfo_df <- col_info(tt) @@ -238,11 +244,13 @@ as_result_df <- function(tt, spec = NULL, stat_name <- setNames(cell_stat_names[, col_i - min(only_col_indexes) + 1, drop = TRUE], NULL) stat <- setNames(ret_tmp[!col_label_rows, col_i, drop = TRUE], NULL) necessary_stat_lengths <- sapply(stat, length) + stat[sapply(stat, is.null)] <- NA # Truncating or adding NA if stat names has more or less elements than stats stat_name <- lapply(seq_along(stat_name), function(sn_i) { stat_name[[sn_i]][seq_len(necessary_stat_lengths[sn_i])] }) + stat_name[sapply(stat_name, function(x) length(x) == 0)] <- NA # unnesting stat_name and stat tmp_ret_by_col_i <- NULL @@ -322,7 +330,15 @@ as_result_df <- function(tt, spec = NULL, kids <- tree_children(ci_coltree) return(lapply(kids, .get_column_split_name)) } - sapply(pos_splits(tree_pos(ci_coltree)), spl_payload) + + lapply(pos_splits(tree_pos(ci_coltree)), function(x) { + pl <- spl_payload(x) + if (!is.null(pl)) { # it is null when all obs (1 column) + return(pl) + } else { + return(x@name) + } + }) } # Function that selects specific outputs from the result data frame @@ -378,6 +394,9 @@ do_label_row <- function(rdfrow, maxlen) { # Special cases with hidden labels if (length(pth) %% 2 == 1) { extra_nas_from_splits <- extra_nas_from_splits + 1 + } else { + pth <- c("", pth) + extra_nas_from_splits <- extra_nas_from_splits - 1 } c( @@ -415,15 +434,17 @@ do_content_row <- function(rdfrow, maxlen) { do_data_row <- function(rdfrow, maxlen) { pth <- rdfrow$path[[1]] pthlen <- length(pth) - ## odd means we have a multi-analsysis step in the path, we dont' want that in the result data frame + ## odd means we have a multi-analsysis step in the path, we do not want this in the result if (pthlen %% 2 == 1) { - pth <- pth[-1 * (pthlen - 2)] + # we remove the last element, as it is a fake split (tbl_name from analyse) + # pth <- pth[-1 * (pthlen - 2)] + pth <- c("", pth) } pthlen_new <- length(pth) - if (maxlen == 1) pthlen_new <- 3 + if (maxlen == 1) pthlen_new <- 3 # why? c( as.list(pth[seq_len(pthlen_new - 2)]), - replicate(maxlen - pthlen, list(NA_character_)), + replicate(ifelse((maxlen - pthlen_new) > 0, maxlen - pthlen_new, 0), list(NA_character_)), as.list(tail(pth, 2)), list( label_name = rdfrow$label, diff --git a/tests/testthat/test-result_data_frame.R b/tests/testthat/test-result_data_frame.R index 01889620d..5c23c7db3 100644 --- a/tests/testthat/test-result_data_frame.R +++ b/tests/testthat/test-result_data_frame.R @@ -239,6 +239,16 @@ test_that("as_result_df works fine with empty tables and no character(0) is allo ) }) +test_that("as_result_df works with only analyze tables (odd num of path elements)", { + tbl <- basic_table() %>% + analyze("cyl", table_names = "a") %>% + analyze("mpg") %>% + build_table(mtcars) + + expect_equal(as_result_df(tbl)$group1[[1]], "") + expect_equal(as_result_df(tbl, make_ard = TRUE)$group1[[1]], "") +}) + test_that("make_ard produces realistic ARD output with as_result_df", { # Testing fundamental getters/setters rc <- rcell(c(1, 2), stat_names = c("Rand1", "Rand2"))