From 1248e6b4429dc4dfc011fb9ed27900c7cae68106 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Fri, 18 Oct 2024 14:08:45 +0200 Subject: [PATCH 1/3] Don't create filter panel for non-filtered objects --- R/FilteredData-utils.R | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/R/FilteredData-utils.R b/R/FilteredData-utils.R index 6f2e272a3..7772701be 100644 --- a/R/FilteredData-utils.R +++ b/R/FilteredData-utils.R @@ -29,7 +29,10 @@ init_filtered_data <- function(x, join_keys = teal.data::join_keys(), code, chec "init_filtered_data(check = 'No longer supported')" ) } - FilteredData$new(x, join_keys = join_keys) + FilteredData$new( + Filter(function(obj) inherits(obj, c("data.frame", "MultiAssayExperiment")), x), + join_keys = join_keys + ) } #' Evaluate expression with meaningful message From 242b0630cf4f9ad8b8a6a6d04803b88ae069e074 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Tue, 22 Oct 2024 07:38:14 +0200 Subject: [PATCH 2/3] test --- tests/testthat/test-init_filtered_data.R | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-init_filtered_data.R b/tests/testthat/test-init_filtered_data.R index 9f5910158..7bf2eb7c5 100644 --- a/tests/testthat/test-init_filtered_data.R +++ b/tests/testthat/test-init_filtered_data.R @@ -3,16 +3,30 @@ testthat::test_that("init_filtered_data accepts a list of `data.frame` objects", }) -testthat::test_that("init_filtered_data.default asserts x has unique names", { +testthat::test_that("init_filtered_data asserts x has unique names", { testthat::expect_error( init_filtered_data(list("iris" = iris, "iris" = iris)), regexp = "Assertion on 'x' failed: Must have unique names, but element 2 is duplicated." ) }) -testthat::test_that("init_filtered_data.default asserts join_keys is `join_keys`", { +testthat::test_that("init_filtered_data asserts join_keys is `join_keys`", { testthat::expect_error( init_filtered_data(list("iris" = iris), join_keys = "test"), regexp = "Assertion on 'join_keys' failed: Must inherit from class 'join_keys', but has class 'character'." ) }) + +testthat::test_that("init_filtered_data ignores datasets if they are of different class than data.frame and MAE", { + testthat::skip_if_not_installed("MultiAssayExperiment") + utils::data(miniACC, package = "MultiAssayExperiment") + fd <- init_filtered_data( + list( + a = character(), + b = structure(data.frame(), class = "not data.frame"), + c = data.frame(), + d = miniACC + ) + ) + testthat::expect_identical(fd$datanames(), c("c", "d")) +}) From 82f4cc9930bf8322b5d571b24a99a37f05cb59eb Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Wed, 23 Oct 2024 08:23:06 +0200 Subject: [PATCH 3/3] remove DefaultFilteredDataset class --- NEWS.md | 4 + R/FilteredData.R | 6 +- R/FilteredDataset-utils.R | 6 +- R/FilteredDatasetDefault.R | 124 --------- man/DefaultFilteredDataset.Rd | 254 ------------------- tests/testthat/test-DefaultFilteredDataset.R | 68 ----- tests/testthat/test-FilteredData.R | 29 --- 7 files changed, 7 insertions(+), 484 deletions(-) delete mode 100644 R/FilteredDatasetDefault.R delete mode 100644 man/DefaultFilteredDataset.Rd delete mode 100644 tests/testthat/test-DefaultFilteredDataset.R diff --git a/NEWS.md b/NEWS.md index b493de05e..a68cced1c 100644 --- a/NEWS.md +++ b/NEWS.md @@ -8,6 +8,10 @@ * Fix error while creating the filter choices when the data has a factor with a level containing an empty string (""). +### Miscellaneous + +* `DefaultFilteredDataset` has been removed and filter panel no longer displays entries for non-filterable datasets. + ### Breaking changes * `ui_add` and `srv_add` no longer exist as adding new filters is a part of `ui_active` and `srv_active`. diff --git a/R/FilteredData.R b/R/FilteredData.R index 9b56ee937..35f827cb7 100644 --- a/R/FilteredData.R +++ b/R/FilteredData.R @@ -377,15 +377,13 @@ FilteredData <- R6::R6Class( # nolint #' format = function(show_all = FALSE, trim_lines = TRUE) { datasets <- lapply(self$datanames(), private$get_filtered_dataset) - ind <- vapply(datasets, inherits, logical(1L), what = "DefaultFilteredDataset") - states <- do.call(c, lapply(datasets[!ind], function(ds) ds$get_filter_state())) + states <- do.call(c, lapply(datasets, function(ds) ds$get_filter_state())) states_fmt <- format(states, show_all = show_all, trim_lines = trim_lines) - holders_fmt <- vapply(datasets[ind], format, character(1L), show_all = show_all, trim_lines = trim_lines) sprintf( "%s:\n%s", class(self)[1], - paste(c(states_fmt, holders_fmt), collapse = "\n") + paste(states_fmt, collapse = "\n") ) }, diff --git a/R/FilteredDataset-utils.R b/R/FilteredDataset-utils.R index 2f0e419d6..b3bace23e 100644 --- a/R/FilteredDataset-utils.R +++ b/R/FilteredDataset-utils.R @@ -141,9 +141,5 @@ init_filtered_dataset.default <- function(dataset, parent, # ignored join_keys, # ignored label = attr(dataset, "label", exact = TRUE)) { - DefaultFilteredDataset$new( - dataset = dataset, - dataname = dataname, - label = label - ) + NULL } diff --git a/R/FilteredDatasetDefault.R b/R/FilteredDatasetDefault.R deleted file mode 100644 index aefbb8d71..000000000 --- a/R/FilteredDatasetDefault.R +++ /dev/null @@ -1,124 +0,0 @@ -# DefaultFilteredDataset ---- - -#' @name DefaultFilteredDataset -#' @docType class -#' @title `DefaultFilteredDataset` `R6` class -#' -#' @description Stores any object as inert entity. Filtering is not supported. -#' -#' @examples -#' # use non-exported function from teal.slice -#' DefaultFilteredDataset <- getFromNamespace("DefaultFilteredDataset", "teal.slice") -#' -#' library(shiny) -#' -#' ds <- DefaultFilteredDataset$new(letters, "letters") -#' isolate(ds$get_filter_state()) -#' isolate(ds$get_call()) -#' -#' @keywords internal -#' -DefaultFilteredDataset <- R6::R6Class( # nolint - classname = "DefaultFilteredDataset", - inherit = FilteredDataset, - - # public methods ---- - public = list( - - #' @description - #' Initializes this `DefaultFilteredDataset` object. - #' - #' @param dataset - #' any type of object; will not be filtered. - #' @param dataname (`character(1)`) - #' syntactically valid name given to the dataset. - #' @param label (`character(1)`) - #' label to describe the dataset. - #' - #' @return Object of class `DefaultFilteredDataset`, invisibly. - #' - initialize = function(dataset, dataname, label = character(0)) { - super$initialize(dataset = dataset, dataname = dataname, label = label) - }, - - #' @description - #' Returns a formatted string representing this `DefaultFilteredDataset` object. - #' - #' @param show_all (`logical(1)`) for method consistency, ignored. - #' @param trim_lines (`logical(1)`) flag specifying whether to trim lines if class names are too long. - #' - #' @return The formatted string. - #' - format = function(show_all, trim_lines = FALSE) { - class_string <- toString(class(private$dataset)) - if (trim_lines) { - trim_position <- 37L - class_string <- strtrim(class_string, trim_position) - substr(class_string, 35L, 37L) <- "..." - } - sprintf(" - unfiltered dataset:\t\"%s\": %s", private$dataname, class_string) - }, - - #' @param sid (`character(1)`) for method consistency, ignored. - #' @return `NULL`, invisibly. - get_call = function(sid) { - invisible(NULL) - }, - #' @return `NULL`, invisibly. - get_filter_state = function() { - invisible(NULL) - }, - #' @param state (`teal_slices`) for method consistency, ignored. - #' @return `NULL`, invisibly. - set_filter_state = function(state) { - if (length(state) != 0L) { - warning("DefaultFilterState cannot set state") - } - invisible(NULL) - }, - #' @param force (`logical(1)`) for method consistency, ignored. - #' @return `NULL`, invisibly. - clear_filter_states = function(force) { - invisible(NULL) - }, - - #' @description - #' Creates row for filter overview in the form of \cr - #' `dataname` - unsupported data class - #' @return A `data.frame`. - get_filter_overview = function() { - data.frame(dataname = private$dataname, obs = NA, obs_filtered = NA) - }, - - # shiny modules ---- - - #' @description - #' Overwrites parent method. - #' @details - #' Blank UI module that would list active filter states for this dataset. - #' @param id (`character(1)`) - #' `shiny` module instance id. - #' @param allow_add (ignored) - #' @return An empty `div`. - ui_active = function(id, allow_add) { - ns <- NS(id) - tags$div() - }, - - #' @description - #' Overwrites parent method. - #' @details - #' Blank UI module that would list active filter states for this dataset. - #' @param id (`character(1)`) - #' `shiny` module instance id. - #' @return An empty `div`. - ui_add = function(id) { - ns <- NS(id) - tags$div() - } - ), - private = list( - # private methods ---- - # private fields ---- - ) -) diff --git a/man/DefaultFilteredDataset.Rd b/man/DefaultFilteredDataset.Rd deleted file mode 100644 index e6bfbed0d..000000000 --- a/man/DefaultFilteredDataset.Rd +++ /dev/null @@ -1,254 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/FilteredDatasetDefault.R -\docType{class} -\name{DefaultFilteredDataset} -\alias{DefaultFilteredDataset} -\title{\code{DefaultFilteredDataset} \code{R6} class} -\description{ -Stores any object as inert entity. Filtering is not supported. -} -\examples{ -# use non-exported function from teal.slice -DefaultFilteredDataset <- getFromNamespace("DefaultFilteredDataset", "teal.slice") - -library(shiny) - -ds <- DefaultFilteredDataset$new(letters, "letters") -isolate(ds$get_filter_state()) -isolate(ds$get_call()) - -} -\keyword{internal} -\section{Super class}{ -\code{\link[teal.slice:FilteredDataset]{teal.slice::FilteredDataset}} -> \code{DefaultFilteredDataset} -} -\section{Methods}{ -\subsection{Public methods}{ -\itemize{ -\item \href{#method-DefaultFilteredDataset-new}{\code{DefaultFilteredDataset$new()}} -\item \href{#method-DefaultFilteredDataset-format}{\code{DefaultFilteredDataset$format()}} -\item \href{#method-DefaultFilteredDataset-get_call}{\code{DefaultFilteredDataset$get_call()}} -\item \href{#method-DefaultFilteredDataset-get_filter_state}{\code{DefaultFilteredDataset$get_filter_state()}} -\item \href{#method-DefaultFilteredDataset-set_filter_state}{\code{DefaultFilteredDataset$set_filter_state()}} -\item \href{#method-DefaultFilteredDataset-clear_filter_states}{\code{DefaultFilteredDataset$clear_filter_states()}} -\item \href{#method-DefaultFilteredDataset-get_filter_overview}{\code{DefaultFilteredDataset$get_filter_overview()}} -\item \href{#method-DefaultFilteredDataset-ui_active}{\code{DefaultFilteredDataset$ui_active()}} -\item \href{#method-DefaultFilteredDataset-ui_add}{\code{DefaultFilteredDataset$ui_add()}} -\item \href{#method-DefaultFilteredDataset-clone}{\code{DefaultFilteredDataset$clone()}} -} -} -\if{html}{\out{ -
Inherited methods - -
-}} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-DefaultFilteredDataset-new}{}}} -\subsection{Method \code{new()}}{ -Initializes this \code{DefaultFilteredDataset} object. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{DefaultFilteredDataset$new(dataset, dataname, label = character(0))}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{dataset}}{any type of object; will not be filtered.} - -\item{\code{dataname}}{(\code{character(1)}) -syntactically valid name given to the dataset.} - -\item{\code{label}}{(\code{character(1)}) -label to describe the dataset.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -Object of class \code{DefaultFilteredDataset}, invisibly. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-DefaultFilteredDataset-format}{}}} -\subsection{Method \code{format()}}{ -Returns a formatted string representing this \code{DefaultFilteredDataset} object. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{DefaultFilteredDataset$format(show_all, trim_lines = FALSE)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{show_all}}{(\code{logical(1)}) for method consistency, ignored.} - -\item{\code{trim_lines}}{(\code{logical(1)}) flag specifying whether to trim lines if class names are too long.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -The formatted string. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-DefaultFilteredDataset-get_call}{}}} -\subsection{Method \code{get_call()}}{ -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{DefaultFilteredDataset$get_call(sid)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{sid}}{(\code{character(1)}) for method consistency, ignored.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -\code{NULL}, invisibly. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-DefaultFilteredDataset-get_filter_state}{}}} -\subsection{Method \code{get_filter_state()}}{ -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{DefaultFilteredDataset$get_filter_state()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{NULL}, invisibly. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-DefaultFilteredDataset-set_filter_state}{}}} -\subsection{Method \code{set_filter_state()}}{ -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{DefaultFilteredDataset$set_filter_state(state)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{state}}{(\code{teal_slices}) for method consistency, ignored.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -\code{NULL}, invisibly. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-DefaultFilteredDataset-clear_filter_states}{}}} -\subsection{Method \code{clear_filter_states()}}{ -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{DefaultFilteredDataset$clear_filter_states(force)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{force}}{(\code{logical(1)}) for method consistency, ignored.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -\code{NULL}, invisibly. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-DefaultFilteredDataset-get_filter_overview}{}}} -\subsection{Method \code{get_filter_overview()}}{ -Creates row for filter overview in the form of \cr -\code{dataname} - unsupported data class -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{DefaultFilteredDataset$get_filter_overview()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -A \code{data.frame}. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-DefaultFilteredDataset-ui_active}{}}} -\subsection{Method \code{ui_active()}}{ -Overwrites parent method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{DefaultFilteredDataset$ui_active(id, allow_add)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{id}}{(\code{character(1)}) -\code{shiny} module instance id.} - -\item{\code{allow_add}}{(ignored)} -} -\if{html}{\out{
}} -} -\subsection{Details}{ -Blank UI module that would list active filter states for this dataset. -} - -\subsection{Returns}{ -An empty \code{div}. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-DefaultFilteredDataset-ui_add}{}}} -\subsection{Method \code{ui_add()}}{ -Overwrites parent method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{DefaultFilteredDataset$ui_add(id)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{id}}{(\code{character(1)}) -\code{shiny} module instance id.} -} -\if{html}{\out{
}} -} -\subsection{Details}{ -Blank UI module that would list active filter states for this dataset. -} - -\subsection{Returns}{ -An empty \code{div}. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-DefaultFilteredDataset-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{DefaultFilteredDataset$clone(deep = FALSE)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deep}}{Whether to make a deep clone.} -} -\if{html}{\out{
}} -} -} -} diff --git a/tests/testthat/test-DefaultFilteredDataset.R b/tests/testthat/test-DefaultFilteredDataset.R deleted file mode 100644 index 8c53b6776..000000000 --- a/tests/testthat/test-DefaultFilteredDataset.R +++ /dev/null @@ -1,68 +0,0 @@ -# initialize ---- -testthat::test_that("constructor accepts all types of datasets", { - testthat::expect_no_error(FilteredData$new(list("logical" = c(TRUE, FALSE)))) - testthat::expect_no_error(FilteredData$new(list("integer" = 1:10))) - testthat::expect_no_error(FilteredData$new(list("numeric" = 1:10 * 1))) - testthat::expect_no_error(FilteredData$new(list("character" = letters))) - testthat::expect_no_error(FilteredData$new(list("factor" = as.factor(letters)))) - testthat::expect_no_error(FilteredData$new(list("list" = as.list(letters)))) - testthat::expect_no_error(FilteredData$new(list("function" = function() letters))) - testthat::expect_no_error(FilteredData$new(list("array" = array(1:27, dim = c(3, 3, 3))))) -}) - -# format ---- -testthat::test_that("format dispalys object name and class", { - fds <- DefaultFilteredDataset$new(letters, "character") - testthat::expect_identical( - fds$format(), - " - unfiltered dataset:\t\"character\": character" - ) -}) - -testthat::test_that("format trims very long class names to 40 characters if trim_lines = TRUE", { - classes <- c("someclass1", "someclass2", "someclass3", "someclass4", "somanyclasses") - fds <- DefaultFilteredDataset$new(structure(letters, class = classes), "character") - testthat::expect_identical( - nchar(fds$format(trim_lines = FALSE)), - nchar(paste0(" - unfiltered dataset:\t\"character\": ")) + nchar(toString(classes)) - ) - - testthat::expect_identical( - nchar(fds$format(trim_lines = TRUE)), - nchar(paste0(" - unfiltered dataset:\t\"character\": ")) + 37L - ) -}) - -# get_call ---- -testthat::test_that("get_call returns NULL", { - fds <- DefaultFilteredDataset$new(letters, "character") - testthat::expect_null(fds$get_call()) -}) -# get_filter_state ---- -testthat::test_that("get_filter_state returns NULL", { - fds <- DefaultFilteredDataset$new(letters, "character") - testthat::expect_null(fds$get_filter_state()) -}) -# set_filter_state ---- -testthat::test_that("set_filter_state returns NULL, raises warning if `state` is not empty", { - fds <- DefaultFilteredDataset$new(letters, "character") - tss0 <- teal_slices() - tss1 <- teal_slices(teal_slice("letters", "letter")) - testthat::expect_null(fds$set_filter_state(tss0)) - testthat::expect_null( - testthat::expect_warning(fds$set_filter_state(tss1), "cannot set state") - ) -}) -# clear_filter_states ---- -testthat::test_that("clear_filter_state returns NULL", { - fds <- DefaultFilteredDataset$new(letters, "character") - testthat::expect_null(fds$clear_filter_states()) -}) -# get_filter_overview ---- -testthat::test_that("get_filter_overview returns NULL", { - fds <- DefaultFilteredDataset$new(letters, "character") - testthat::expect_identical( - fds$get_filter_overview(), - data.frame(dataname = "character", obs = NA, obs_filtered = NA) - ) -}) diff --git a/tests/testthat/test-FilteredData.R b/tests/testthat/test-FilteredData.R index caa7baf21..a28bf43ea 100644 --- a/tests/testthat/test-FilteredData.R +++ b/tests/testthat/test-FilteredData.R @@ -339,35 +339,6 @@ testthat::test_that("format returns properly formatted string representing `teal ) }) -testthat::test_that("format lists unfiltered datasets at the end of the output", { - datasets <- FilteredData$new(list(iris = iris, letters = letters, mtcars = mtcars)) - - fs <- teal_slices( - teal_slice( - dataname = "iris", varname = "Species", - choices = c("setosa", "versicolor", "virginica"), multiple = TRUE, selected = c("setosa", "versicolor"), - keep_na = FALSE - ), - teal_slice( - dataname = "mtcars", varname = "cyl", - choices = c("4", "6", "8"), multiple = TRUE, selected = c("4", "6"), - keep_na = FALSE, keep_inf = FALSE - ), - count_type = "none", - include_varnames = list(mtcars = "cyl"), - exclude_varnames = list(iris = c("Petal.Length", "Petal.Width")) - ) - - datasets$set_filter_state(fs) - - state_fmt <- shiny::isolate(format(datasets$get_filter_state())) - - testthat::expect_identical( - shiny::isolate(datasets$format()), - paste0("FilteredData:\n", state_fmt, "\n - unfiltered dataset:\t\"letters\": character") - ) -}) - # remove_filter_state ---- testthat::test_that("remove_filter_state removes states specified by `teal_slices", { datasets <- FilteredData$new(list(iris = iris, mtcars = mtcars))