tests/testthat/test-tab_afun_cfun.R

In rtables: Reporting Tables

context("Analysis functions (afun)")

test_that(".spl_context contains information about the column split", {
    ## Duplication hack -> This would need to use  split_cols_by_multivar(...)
    # Workaround for #690
    DM_tmp <- DM %>% 
        mutate(method = factor("Mean")) 
    
    DM_tmp <- rbind(DM_tmp, DM_tmp %>% 
                        mutate(method = factor("SD")))
    
    analysis_fun_fin <- function(x, .spl_context, labelstr = "", ...) {
        
        # Very smart internal checks for name reconstruction from path
        stopifnot(length(.spl_context$cur_col_id[[1]]) == 1L)
        stopifnot(.spl_context$cur_col_id[[1]] %in% names(.spl_context))
        
        if (any(.spl_context$cur_col_split_val[[2]] == "SD")) {
            res <- list("SOMETHING" = sd(x))
        } else if (any(.spl_context$cur_col_split_val[[2]] == "Mean")) {
            res <- list("SOMETHING" = mean(x))
        }
            
        in_rows(.list = res)
    }
    
    lyt <- basic_table() %>% 
        split_rows_by("STRATA1") %>%
        split_cols_by(var = "method") %>%
        split_cols_by("SEX", split_fun = drop_split_levels) %>%
        analyze(vars = "BMRKR1", afun = analysis_fun_fin, format = "xx.xxx")
    
    expect_silent(tbl <- lyt %>% build_table(DM_tmp))
    
    DM_B_F <- DM %>% filter(SEX == "F", STRATA1 == "B")
    expect_equal(tbl[4, 1, drop = TRUE], mean(DM_B_F$BMRKR1))
    expect_equal(tbl[4, 3, drop = TRUE], sd(DM_B_F$BMRKR1))
})

test_that(".spl_context and afun extra parameters contain information about combo counts", {
    ## Fix for https://github.com/insightsengineering/rtables/issues/517
    combodf <- tribble(
        ~valname, ~label, ~levelcombo, ~exargs,
        "all_X", "All Drug X", c("A: Drug X", "C: Combination"), list(),
        "all_pt", "All Patients", c("A: Drug X", "B: Placebo", "C: Combination"), list()
    )
    
    n_wrapper_alt_df <- function(alt_counts_df) {
        function(x, 
                 .spl_context, 
                 .N_col, 
                 .alt_df_row, 
                 .alt_df, 
                 .all_col_exprs, 
                 .all_col_counts, 
                 ...) { 
            
            cur_col <- paste0(.spl_context$cur_col_split_val[[1]], collapse = ".")
            
            # Checks on new .spl_context content
            expect_equal(.spl_context$cur_col_id[[1]], cur_col)
            stopifnot(cur_col %in% names(.spl_context))
            if (.spl_context$cur_col_split[[1]][1] != "All Patients 2") {
                stopifnot(all(.spl_context$cur_col_split[[1]] == c("ARM", "COUNTRY")))
            }
            
            if (grepl("all_X", .spl_context$cur_col_id[[1]]) ||
                .spl_context$cur_col_id[[1]] == "All Patients 2") {
                in_rows("n" = .N_col, .formats = "xx")
            } else {
                # Needed to find the names of columns we need that are not the current one
                AC_colname <- vapply(c("A: Drug X", "C: Combination"),
                                     function(nmi) {
                                         paste0(c(nmi, 
                                                  .spl_context$cur_col_split_val[[1]][2]),
                                                collapse = ".")
                                     }, FUN.VALUE = character(1))
                # Use of cexpr
                alt_df1c <- .alt_df_row %>% 
                    filter(eval(.all_col_exprs[[AC_colname[1]]]))
                alt_df2c <- .alt_df_row %>% 
                    filter(eval(.all_col_exprs[[AC_colname[2]]]))
                
                # Normal execution - no use of cexpr
                alt_df1 <- .alt_df_row %>% 
                    filter(ARM == "A: Drug X",
                           COUNTRY == .spl_context$cur_col_split_val[[1]][2])
                alt_df2 <- .alt_df_row %>% 
                    filter(ARM == "C: Combination",
                           COUNTRY == .spl_context$cur_col_split_val[[1]][2])
                
                # Super manual extraction
                alt_df1b <- alt_counts_df %>% 
                    filter(ARM == "A: Drug X",
                           COUNTRY == .spl_context$cur_col_split_val[[1]][2],
                           SEX == .spl_context$value[3])
                alt_df2b <- alt_counts_df %>% 
                    filter(ARM == "C: Combination",
                           COUNTRY == .spl_context$cur_col_split_val[[1]][2],
                           SEX == .spl_context$value[3])
                
                # All strata is add_overall_level -> filter not needed
                if (.spl_context$value[[2]] != "All Strata") {
                alt_df1b <- alt_df1b %>% 
                    filter(STRATA1 == .spl_context$value[[2]])
                alt_df2b <- alt_df2b %>% 
                    filter(STRATA1 == .spl_context$value[[2]])
                }
                
                # This would break the tests if no match
                expect_equal(nrow(alt_df1), nrow(alt_df1b))
                expect_equal(nrow(alt_df1), nrow(alt_df1c))
                expect_equal(nrow(alt_df2), nrow(alt_df2b))
                expect_equal(nrow(alt_df2), nrow(alt_df2c))
                
                # General info
                expect_equal(.all_col_counts[[.spl_context$cur_col_id[[1]]]], .N_col)
                expect_equal(.all_col_exprs[[.spl_context$cur_col_id[[1]]]],
                              .spl_context$cur_col_expr[[3]])
                expect_silent(filtering <- eval(.spl_context$cur_col_expr[[1]], .alt_df_row))
                expect_equal(.alt_df_row[filtering, ], .alt_df) # Main check for col-filter
                
                # Fin needed output 
                in_rows("n" = c(nrow(alt_df1c), 
                                nrow(alt_df2c)), 
                        .formats = "xx - xx")
            }
        }
    }
    
    lyt <- basic_table(show_colcounts = TRUE) %>% 
        split_cols_by("ARM", split_fun = add_combo_levels(combodf, first = TRUE)) %>%
        split_cols_by("COUNTRY", split_fun = keep_split_levels(c("CHN", "USA"))) %>%
        split_rows_by("STRATA1", split_fun = add_overall_level("All Strata")) %>%
        split_rows_by("SEX", split_fun = keep_split_levels(c("F", "M"))) %>%
        add_overall_col("All Patients 2") %>% 
        analyze(vars = "BMRKR1", afun = n_wrapper_alt_df(ex_adsl))
    
    # NB: If you add keep_levels = c("all_X") to add_combo_levels the other 
    #     column expressions are missing -> Expected!
    expect_error(lyt %>% build_table(DM), 
                  regexp = "Layout contains afun\\/cfun functions that have optional*")
    
    tbl <- lyt %>% build_table(DM, alt_counts_df = ex_adsl)
    
    expect_silent(cbind_rtables(tbl, tbl))
    expect_silent(rbind(tbl, tbl))
    
    spl_ctx_cnt <- lapply(seq(8, nrow(tbl), 5), function(x) tbl[x, 2, drop = TRUE])
    
    nrow_manual <- lapply(sort(unique(ex_adsl$STRATA1)), function(x) {
        tmp_strata <- ex_adsl %>% filter(STRATA1 == x, SEX == "F", COUNTRY == "USA")
        sapply(list(tmp_strata %>% filter(ARM == "A: Drug X"),
                 tmp_strata %>% filter(ARM == "C: Combination")), nrow)
    })
    
    expect_identical(nrow_manual, spl_ctx_cnt)
})

test_that("Error localization for missing split variable when done in alt_count_df", {
    # Error we want to happen
    afun_tmp <- function(x, .alt_df_row, ...) mean(x)
    lyt_col <- basic_table() %>% split_cols_by("ARMCD") %>% analyze("BMRKR1", afun = afun_tmp)
    lyt_row <- basic_table() %>% split_rows_by("ARMCD") %>% analyze("BMRKR1", afun = afun_tmp)
    expect_error(lyt_col %>% build_table(ex_adsl, alt_counts_df = DM))
    expect_error(lyt_row %>% build_table(ex_adsl, alt_counts_df = DM), 
                 regexp = paste0("Following error encountered in splitting ",
                 "alt_counts_df:  variable\\(s\\) \\[ARMCD\\] ",
                 "not present in data. \\(VarLevelSplit\\)"))
    
    # What if it is not asked by the function?
    afun_tmp <- function(x, ...) mean(x)
    lyt_col <- basic_table() %>% 
        split_cols_by("ARMCD") %>% 
        analyze("BMRKR1", afun = afun_tmp)
    lyt_row <- basic_table() %>% 
        split_rows_by("STRATA1", split_fun = keep_split_levels("A")) %>% 
        split_rows_by("ARMCD") %>% 
        analyze("BMRKR1", afun = afun_tmp)
    
    # Error on the columns should happen because it is used for counts on column space
    expect_error(lyt_col %>% build_table(ex_adsl, alt_counts_df = DM), 
                 "alt_counts_df appears incompatible with column-split structure*")
    expect_silent(lyt_col %>% build_table(ex_adsl)) # it is specific of alt_counts_df
    expect_silent(lyt_row %>% build_table(ex_adsl, alt_counts_df = DM))
})

test_that("Error localization for missmatch split variable when done in alt_count_df", {
    afun_tmp <- function(x, .alt_df_row, .spl_context,...) {
        # Important check that order is aligned even if source levels are not
        check_val <- unique(.alt_df_row$ARMCD)
        # This is something mysterious happening in splits for which if the values are all
        # NAs in the split column, the dataspl has the nrow of the data in NA rows. xxx ToFix
        check_val <- check_val[!is.na(check_val)] 
        stopifnot(as.character(check_val) == .spl_context$value[2])
        mean(x)
    }
    lyt_row <- basic_table() %>% split_rows_by("ARMCD") %>% analyze("BMRKR1", afun = afun_tmp)
    
    # Mismatch in the number of splits (NA is 0)
    DM_tmp <- DM %>% mutate("ARMCD" = NA_character_)
    expect_error(lyt_row %>% build_table(ex_adsl, alt_counts_df = DM_tmp), 
                 regexp = paste0("alt_counts_df split variable\\(s\\) \\[ARMCD\\] *"))
    
    # Mismatch of levels
    armcd_col <- factor(sample(c("arm A", "arm B", "arm C"), nrow(DM), replace = TRUE))
    DM_tmp <- DM %>% mutate("ARMCD" = armcd_col)
    expect_error(lyt_row %>% build_table(ex_adsl, alt_counts_df = DM_tmp), 
                 regexp = paste0("alt_counts_df split variable\\(s\\) \\[ARMCD\\] *"))
    
    # Mix mismatch of levels
    armcd_col <- factor(sample(c("arm A", "ARM B", "ARM C"), nrow(DM), replace = TRUE))
    DM_tmp <- DM %>% mutate("ARMCD" = armcd_col)
    expect_error(lyt_row %>% build_table(ex_adsl, alt_counts_df = DM_tmp), 
                 regexp = paste0("alt_counts_df split variable\\(s\\) \\[ARMCD\\] *"))
    
    # Mismatch in the number of levels 
    armcd_col2 <- factor(sample(levels(ex_adsl$ARMCD)[c(1, 2)], nrow(DM), replace = TRUE))
    DM_tmp <- DM %>% mutate("ARMCD" = armcd_col2)
    expect_error(lyt_row %>% build_table(ex_adsl, alt_counts_df = DM_tmp), 
                 regexp = paste0("alt_counts_df split variable\\(s\\) \\[ARMCD\\] *"))
    
    # Another order -> should work? yes, split is valid
    levels(armcd_col) <- levels(ex_adsl$ARMCD)[c(1, 3, 2)]
    DM_tmp <- DM %>% mutate("ARMCD" = armcd_col)
    expect_silent(lyt_row %>% build_table(ex_adsl, alt_counts_df = DM_tmp))
    
    # Mix mismatch of levels but covering them all -> valid split
    armcd_col <- factor(sample(c("arm A", levels(ex_adsl$ARMCD)), nrow(DM), replace = TRUE))
    DM_tmp <- DM %>% mutate("ARMCD" = armcd_col)
    expect_silent(lyt_row %>% build_table(ex_adsl, alt_counts_df = DM_tmp))
    
    # Values are all NA, but the levels are correct
    DM_tmp$ARMCD <- factor(NA, levels = levels(ex_adsl$ARMCD))
    expect_error(lyt_row %>% build_table(ex_adsl, alt_counts_df = DM_tmp), 
                 regexp = paste0("alt_counts_df split variable\\(s\\) \\[ARMCD\\] *"))
    
    DM_tmp$ARMCD <- factor(NA, levels = levels(ex_adsl$ARMCD))
    DM_tmp$ARMCD[seq_along(levels(ex_adsl$ARMCD))] <- levels(ex_adsl$ARMCD) 
    expect_silent(lyt_row %>% build_table(ex_adsl, alt_counts_df = DM_tmp))
})

context("Content functions (cfun)")

test_that(".alt_df_row appears in cfun but not in afun.", {
    # Adding STRATA2 col to DM for alt_counts_df col split
    alt_tmp <- DM %>% left_join(ex_adsl %>% 
                                    mutate(ID = paste0("S", seq_len(nrow(ex_adsl)))) %>% 
                                    select(ID, STRATA2))
    
    afun_tmp <- function(x, ...) rcell(mean(x), label = "MeAn", format = "xx.x")
    cfun_tmp <- function(x, labelstr, 
                         .alt_df_row, 
                         .alt_df, 
                         .N_col, 
                         .spl_context,
                         .all_col_exprs,
                         .all_col_counts,
                         ...) {
        if (!missing(.alt_df_row)) {
            # .alt_df_row is only row-splitted matter
            stopifnot(nrow(alt_tmp %>% filter(STRATA1 == "A")) == nrow(.alt_df_row))
            
            # Filtered column number of elements correspond to .N_col
            stopifnot(nrow(alt_tmp %>% 
                               filter(eval(.spl_context$cur_col_expr[[1]]))) == .N_col)
        } else {
            # Checking cur_col_n is the same as .N_col for root and length(x) for split
            stopifnot(identical(.spl_context$cur_col_n, c(.N_col, length(x))))
        }
        
        # Checking internal names for all column counts correspond to .spl_context
        stopifnot(all(names(.all_col_counts) %in% colnames(.spl_context)))
        
        # Checking that current col id and col counts agree with .N_col
        stopifnot(.all_col_counts[.spl_context$cur_col_id[1]] == .N_col)
        
        # Checking col expression
        stopifnot(identical(.all_col_exprs[.spl_context$cur_col_id[1]][[1]],
                            .spl_context$cur_col_expr[[1]])) # Uses the root one
        
        in_rows(c(length(x), length(x) / .N_col), 
                .names = labelstr, 
                .formats = c("xx (xx.xx)"))
    }
    
    lyt <- basic_table(show_colcounts = TRUE) %>% 
        split_cols_by("SEX", split_fun = keep_split_levels(c("F", "U"))) %>% 
        split_cols_by("STRATA2", split_fun = keep_split_levels("S1")) %>% 
        split_rows_by("STRATA1", split_fun = keep_split_levels("A")) %>% 
        summarize_row_groups(var = "BMRKR1", cfun = cfun_tmp) %>%
        split_rows_by("ARMCD") %>% 
        analyze("BMRKR1", afun = afun_tmp)
    
    expect_error(lyt %>% build_table(ex_adsl), 
                 "Layout contains afun/cfun functions that have optional*")
    expect_error(lyt %>% build_table(ex_adsl, alt_counts_df = DM),
                 "alt_counts_df appears incompatible with column-split*")
    expect_silent(lyt %>% build_table(ex_adsl, alt_counts_df = alt_tmp))
})