diff --git a/R/1.0_module_data_summary.R b/R/1.0_module_data_summary.R index 48675020f5..2796fa731d 100644 --- a/R/1.0_module_data_summary.R +++ b/R/1.0_module_data_summary.R @@ -140,8 +140,17 @@ get_filter_overview <- function(teal_data) { simplify = FALSE ) - rows <- lapply( + child_parent <- sapply( datanames, + function(i) teal.data::parent(joinkeys, i), + USE.NAMES = TRUE, + simplify = FALSE + ) + ordered_datanames <- topological_sort(child_parent) + ordered_datanames <- intersect(ordered_datanames, datanames) + + rows <- lapply( + ordered_datanames, function(dataname) { parent <- teal.data::parent(joinkeys, dataname) @@ -149,7 +158,6 @@ get_filter_overview <- function(teal_data) { # - Obs and Subjects # - Obs only # - Subjects only - # todo: summary table should be ordered by topological order # todo (for later): summary table should be displayed in a way that child datasets # are indented under their parent dataset to form a tree structure subject_keys <- if (length(parent) > 0) { @@ -260,3 +268,17 @@ get_object_filter_overview_MultiAssayExperiment <- function(filtered_data, # nol experiment_info <- cbind(experiment_obs_info[, c("dataname", "obs", "obs_filtered")], experiment_subjects_info) rbind(mae_info, experiment_info) } + + +#' @inherit teal.data::topological_sort description details params title +#' @examples +#' # use non-exported function from teal.slice +#' topological_sort <- getFromNamespace("topological_sort", "teal.slice") +#' +#' topological_sort(list(A = c(), B = c("A"), C = c("B"), D = c("A"))) +#' topological_sort(list(D = c("A"), A = c(), B = c("A"), C = c("B"))) +#' topological_sort(list(D = c("A"), B = c("A"), C = c("B"), A = c())) +#' @keywords internal +topological_sort <- function(graph) { + utils::getFromNamespace("topological_sort", ns = "teal.data")(graph) +} diff --git a/man/topological_sort.Rd b/man/topological_sort.Rd new file mode 100644 index 0000000000..db5e4132fa --- /dev/null +++ b/man/topological_sort.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/1.0_module_data_summary.R +\name{topological_sort} +\alias{topological_sort} +\title{Topological graph sort} +\usage{ +topological_sort(graph) +} +\arguments{ +\item{graph}{(\verb{named list}) with node vector elements} +} +\description{ +Graph is a \code{list} which for each node contains a vector of child nodes +in the returned list, parents appear before their children. +} +\details{ +Implementation of \code{Kahn} algorithm with a modification to maintain the order of input elements. +} +\examples{ +# use non-exported function from teal.slice +topological_sort <- getFromNamespace("topological_sort", "teal.slice") + +topological_sort(list(A = c(), B = c("A"), C = c("B"), D = c("A"))) +topological_sort(list(D = c("A"), A = c(), B = c("A"), C = c("B"))) +topological_sort(list(D = c("A"), B = c("A"), C = c("B"), A = c())) +} +\keyword{internal} diff --git a/tests/testthat/test-shinytest2-data_summary.R b/tests/testthat/test-shinytest2-data_summary.R index aa9618fd79..aba320bf64 100644 --- a/tests/testthat/test-shinytest2-data_summary.R +++ b/tests/testthat/test-shinytest2-data_summary.R @@ -36,6 +36,30 @@ testthat::test_that("e2e: data summary is displayed with 2 columns data without app$stop() }) +testthat::test_that("e2e: data summary displays datasets by topological_sort of join_keys", { + skip_if_too_deep(5) + + data <- teal.data::teal_data(mtcars1 = mtcars, mtcars2 = data.frame(am = c(0, 1), test = c("a", "b"))) + + teal.data::join_keys(data) <- teal.data::join_keys( + teal.data::join_key("mtcars2", "mtcars1", keys = c("am")) + ) + + app <- TealAppDriver$new( + data = data, + modules = example_module() + ) + + testthat::expect_identical( + testthat::expect_identical( + as.data.frame(app$get_active_data_summary_table())[["Data Name"]], + c("mtcars2", "mtcars1") + ) + ) + + app$stop() +}) + testthat::test_that("e2e: data summary is displayed with 3 columns for data with join keys", { skip_if_too_deep(5) @@ -53,9 +77,9 @@ testthat::test_that("e2e: data summary is displayed with 3 columns for data with testthat::expect_identical( as.data.frame(app$get_active_data_summary_table()), data.frame( - `Data Name` = c("mtcars1", "mtcars2"), - Obs = c("32/32", "2/2"), - Subjects = c("2/2", "2/2"), + `Data Name` = c("mtcars2", "mtcars1"), + Obs = c("2/2", "32/32"), + Subjects = c("", "2/2"), check.names = FALSE ) ) @@ -97,10 +121,10 @@ testthat::test_that( data.frame( `Data Name` = c( "CO2", "iris", "miniACC", "- RNASeq2GeneNorm", "- gistict", "- RPPAArray", "- Mutations", "- miRNASeqGene", - "mtcars1", "mtcars2", "factors" + "mtcars2", "mtcars1", "factors" ), - Obs = c("84/84", "150/150", "", "198/198", "198/198", "33/33", "97/97", "471/471", "32/32", "2/2", ""), - Subjects = c("", "", "92/92", "79/79", "90/90", "46/46", "90/90", "80/80", "2/2", "2/2", ""), + Obs = c("84/84", "150/150", "", "198/198", "198/198", "33/33", "97/97", "471/471", "2/2", "32/32", ""), + Subjects = c("", "", "92/92", "79/79", "90/90", "46/46", "90/90", "80/80", "", "2/2", ""), check.names = FALSE ) ) @@ -108,3 +132,21 @@ testthat::test_that( app$stop() } ) + +testthat::test_that("e2e: data summary displays datasets by datanames() order if no join_keys", { + skip_if_too_deep(5) + + data <- teal.data::teal_data(mtcars1 = mtcars, mtcars2 = data.frame(am = c(0, 1), test = c("a", "b"))) + + app <- TealAppDriver$new( + data = data, + modules = example_module() + ) + + testthat::expect_identical( + as.data.frame(app$get_active_data_summary_table())[["Data Name"]], + c("mtcars1", "mtcars2") + ) + + app$stop() +})