Skip to content

Commit

Permalink
712 - {shinytest2} for tm_missing_data (#727)
Browse files Browse the repository at this point in the history 
Part of
#712

---------

Signed-off-by: kartikeya kirar <kirar.kartikeya1@gmail.com>
Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com>
Co-authored-by: Marcin <133694481+m7pr@users.noreply.github.com>
Co-authored-by: André Veríssimo <211358+averissimo@users.noreply.github.com>
Co-authored-by: m7pr <marcin.kosinski.mk1@roche.com>
  • Loading branch information
@kartikeyakirar @github-actions
@m7pr @averissimo
5 people authored Apr 19, 2024
1 parent eefb1b8 commit f6267a9
Show file tree
Hide file tree
Showing 2 changed files with 180 additions and 3 deletions.
18 changes: 15 additions & 3 deletions R/tm_missing_data.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -730,7 +730,11 @@ srv_missing_data <- function(id, data, reporter, filter_panel_api, dataname, par
values = c("grey90", c(getOption("ggplot2.discrete.colour")[2], "#ff2951ff")[1]),
labels = c("Present", "Missing")
) +
scale_y_continuous(labels = scales::percent_format(), breaks = seq(0, 1, by = 0.1), expand = c(0, 0)) +
scale_y_continuous(
labels = scales::percent_format(),
breaks = seq(0, 1, by = 0.1),
expand = c(0, 0)
) +
geom_text(
aes(label = ifelse(isna == TRUE, sprintf("%d [%.02f%%]", n, n_pct), ""), y = 1),
hjust = 1,
Expand Down Expand Up @@ -803,7 +807,11 @@ srv_missing_data <- function(id, data, reporter, filter_panel_api, dataname, par
fill = ~isna
) +
geom_bar(alpha = 1, stat = "identity", position = "fill") +
scale_y_continuous(labels = scales::percent_format(), breaks = seq(0, 1, by = 0.1), expand = c(0, 0)) +
scale_y_continuous(
labels = scales::percent_format(),
breaks = seq(0, 1, by = 0.1),
expand = c(0, 0)
) +
scale_fill_manual(
name = "",
values = c("grey90", c(getOption("ggplot2.discrete.colour")[2], "#ff2951ff")[1]),
Expand Down Expand Up @@ -972,7 +980,11 @@ srv_missing_data <- function(id, data, reporter, filter_panel_api, dataname, par
dplyr::distinct() %>%
ggplot(aes(x = id, y = n)) +
geom_bar(stat = "identity", fill = c(getOption("ggplot2.discrete.colour")[2], "#ff2951ff")[1]) +
geom_text(aes(label = n), position = position_dodge(width = 0.9), vjust = -0.25) +
geom_text(
aes(label = n),
position = position_dodge(width = 0.9),
vjust = -0.25
) +
ylim(c(0, max(data_combination_plot_cutoff$n) * 1.5)) +
labs1 +
ggthemes1 +
Expand Down
165 changes: 165 additions & 0 deletions tests/testthat/test-shinytest2-tm_misssing_data.R
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,165 @@
app_driver_tm_missing_data <- function() {
data <- within(simple_teal_data(), {
require(nestcolor)

add_nas <- function(x) {
x[sample(seq_along(x), floor(length(x) * runif(1, .05, .17)))] <- NA
x
}

iris[] <- lapply(iris, add_nas)
mtcars[] <- lapply(mtcars, add_nas)
mtcars[["cyl"]] <- as.factor(mtcars[["cyl"]])
mtcars[["gear"]] <- as.factor(mtcars[["gear"]])
})

init_teal_app_driver(
data = data,
modules = tm_missing_data(
label = "Missing data",
plot_height = c(600, 400, 5000),
plot_width = NULL,
parent_dataname = "",
ggtheme = "gray",
ggplot2_args = list(
"Combinations Hist" = teal.widgets::ggplot2_args(
labs = list(subtitle = "Plot produced by Missing Data Module", caption = NULL)
),
"Combinations Main" = teal.widgets::ggplot2_args(labs = list(title = NULL))
),
pre_output = NULL,
post_output = NULL
),
timeout = 3000,
seed = 1
)
}

test_that("e2e - tm_missing_data: Initializes without errors", {
skip_if_too_deep(5)
app_driver <- app_driver_tm_missing_data()

app_driver$expect_no_shiny_error()

testthat::expect_equal(
app_driver$get_text("#teal-main_ui-root-active_tab > li.active > a"),
"Missing data"
)

encoding_dataset <- app_driver$get_text(
app_driver$active_module_element("dataset_encodings .help-block")
)

testthat::expect_match(encoding_dataset, "Datasets.*iris.*mtcars", all = FALSE)


app_driver$stop()
})

test_that("e2e - tm_missing_data: Default settings and visibility of the summary graph", {
skip_if_too_deep(5)
app_driver <- app_driver_tm_missing_data()
# default summary tab
testthat::expect_equal(
app_driver$get_active_module_input("iris-summary_type"),
"Summary"
)

testthat::expect_setequal(
app_driver$get_active_module_input("iris-variables_select"),
c("Petal.Length", "Sepal.Length", "Petal.Width", "Species", "Sepal.Width")
)

app_driver$click(selector = app_driver$active_module_element("iris-filter_na"))
app_driver$expect_no_validation_error()

app_driver$click(selector = app_driver$active_module_element("iris-any_na"))
app_driver$expect_no_validation_error()

testthat::expect_true(
app_driver$is_visible(
app_driver$active_module_element("iris-summary_plot-plot_out_main")
)
)

app_driver$stop()
})

test_that("e2e - tm_missing_data: Check default settings and visibility of the combinations graph and encodings", {
skip_if_too_deep(5)
app_driver <- app_driver_tm_missing_data()

app_driver$expect_no_shiny_error()

# combination graph

app_driver$set_active_module_input("iris-summary_type", "Combinations")
app_driver$expect_no_validation_error()
testthat::expect_true(
app_driver$is_visible(
app_driver$active_module_element("iris-combination_plot-plot_out_main")
)
)

# combination encoding

testthat::expect_true(
app_driver$is_visible(
app_driver$active_module_element("iris-cutoff")
)
)

testthat::expect_equal(app_driver$get_active_module_input("iris-combination_cutoff"), 2L)
app_driver$set_active_module_input("iris-combination_cutoff", 10L)
app_driver$expect_no_validation_error()

app_driver$stop()
})

test_that("e2e - tm_missing_data: Validate functionality and UI response for 'By Variable Levels'", {
skip_if_too_deep(5)
app_driver <- app_driver_tm_missing_data()
# By variable levels
app_driver$set_active_module_input("iris-summary_type", "By Variable Levels")
app_driver$expect_no_validation_error()


testthat::expect_equal(
app_driver$get_active_module_input("iris-group_by_var"),
"Species"
)
testthat::expect_setequal(
app_driver$get_active_module_input("iris-group_by_vals"),
c("NA", "setosa", "versicolor", "virginica")
)

app_driver$set_active_module_input("iris-group_by_vals", c("versicolor", "virginica"))
app_driver$expect_no_validation_error()

testthat::expect_equal(
app_driver$get_active_module_input("iris-count_type"),
"counts"
)
app_driver$set_active_module_input("iris-count_type", "proportions")
testthat::expect_true(app_driver$is_visible(app_driver$active_module_element("iris-levels_table")))

app_driver$stop()
})

test_that("e2e - tm_missing_data: Validate 'By Variable Levels' table values", {
skip_if_too_deep(5)
app_driver <- app_driver_tm_missing_data()

app_driver$set_active_module_input("iris-summary_type", "By Variable Levels")
levels_table <- app_driver$active_module_element("iris-levels_table") %>%
app_driver$get_html_rvest() %>%
rvest::html_table(fill = TRUE) %>%
.[[1]]

testthat::expect_setequal(
levels_table$Variable,
c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")
)

app_driver$stop()
})

0 comments on commit f6267a9

Please sign in to comment.