From c95828cfe7f76fa0c4dba5dc61919cfcfd19164c Mon Sep 17 00:00:00 2001 From: Ger Inberg Date: Thu, 6 Feb 2025 13:05:48 +0100 Subject: [PATCH] updates --- .github/workflows/R-CMD-check.yaml | 6 +- CRAN-SUBMISSION | 6 +- DESCRIPTION | 1 + NEWS.md | 5 + R/dataPlotPanel.R | 313 +++++++++++---------- R/metaDataPanel.R | 4 +- R/shinyApp.R | 291 +++++++++++++++++++ inst/shiny/ResultsExplorer/data/mock.zip | Bin 18836 -> 19650 bytes inst/shiny/ResultsExplorer/dataPlotPanel.R | 178 ++++++++---- inst/shiny/ResultsExplorer/global.R | 2 +- inst/shiny/ResultsExplorer/ui.R | 8 +- inst/shiny/ResultsExplorer/utils.R | 6 +- man/dataPlotPanel.Rd | 2 +- man/metaDataPanel.Rd | 2 +- tests/testthat/helper-ableToRun.R | 10 + tests/testthat/test-ShinyApp.R | 35 +++ 16 files changed, 650 insertions(+), 219 deletions(-) create mode 100644 R/shinyApp.R create mode 100644 tests/testthat/helper-ableToRun.R create mode 100644 tests/testthat/test-ShinyApp.R diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index 403f22c..6dcf277 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -18,11 +18,9 @@ jobs: fail-fast: false matrix: config: - - {os: macos-13, r: 'release'} + - {os: macOS-latest, r: 'release'} - {os: windows-latest, r: 'release'} - - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} - - {os: ubuntu-latest, r: 'release'} - - {os: ubuntu-latest, r: 'oldrel-1'} + - {os: ubuntu-latest, r: 'release'} env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} diff --git a/CRAN-SUBMISSION b/CRAN-SUBMISSION index 07984e6..6c037f7 100644 --- a/CRAN-SUBMISSION +++ b/CRAN-SUBMISSION @@ -1,3 +1,3 @@ -Version: 1.0.10 -Date: 2024-11-22 12:14:07 UTC -SHA: 79e20aa7cada9614032930f494936f1431d04efd +Version: 1.1.1 +Date: 2025-02-06 10:46:22 UTC +SHA: 074c44dfb7ece3f7d4a4373c2b17a6b6be288367 diff --git a/DESCRIPTION b/DESCRIPTION index 6652991..dd8c394 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -90,6 +90,7 @@ Collate: 'obscureCounts.R' 'runBenchmark.R' 'shiny.R' + 'shinyApp.R' 'summariseChecks.R' 'utils-pipe.R' 'utils.R' diff --git a/NEWS.md b/NEWS.md index e239e24..479ebe4 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,10 @@ # DrugExposureDiagnostics (development version) +# DrugExposureDiagnostics 1.1.1 +* Update shiny app: fix NA in boxplots and add dropdown drugs-missing +* CDMConnector v2 changes +* Add shiny modules + # DrugExposureDiagnostics 1.1.0 * Add params to executeChecks so it will write results to disk, no need to separately call writeResultToDisk diff --git a/R/dataPlotPanel.R b/R/dataPlotPanel.R index 3465b5c..1fcc893 100644 --- a/R/dataPlotPanel.R +++ b/R/dataPlotPanel.R @@ -76,36 +76,36 @@ dataPlotPanel <- R6::R6Class( # update ingredients when db changes observeEvent(input[["dbPicker"]], - { - databases <- input$dbPicker - if (!is.null(databases)) { - ingredients <- private$getIngredients(databases) - shinyWidgets::updatePickerInput( - session = session, - inputId = shiny::NS(private$.namespace, "ingredientPicker"), - choices = ingredients, - selected = ingredients - ) - } - }, - ignoreNULL = FALSE, - ignoreInit = TRUE + { + databases <- input$dbPicker + if (!is.null(databases)) { + ingredients <- private$getIngredients(databases) + shinyWidgets::updatePickerInput( + session = session, + inputId = shiny::NS(private$.namespace, "ingredientPicker"), + choices = ingredients, + selected = ingredients + ) + } + }, + ignoreNULL = FALSE, + ignoreInit = TRUE ) observeEvent(input[["plotDbPicker"]], - { - databases <- input$plotDbPicker - if (!is.null(databases)) { - ingredients <- private$getIngredients(databases) - shinyWidgets::updatePickerInput( - session = session, - inputId = shiny::NS(private$.namespace, "plotIngredientPicker"), - choices = ingredients, - selected = ingredients - ) - } - }, - ignoreNULL = FALSE, - ignoreInit = TRUE + { + databases <- input$plotDbPicker + if (!is.null(databases)) { + ingredients <- private$getIngredients(databases) + shinyWidgets::updatePickerInput( + session = session, + inputId = shiny::NS(private$.namespace, "plotIngredientPicker"), + choices = ingredients, + selected = ingredients + ) + } + }, + ignoreNULL = FALSE, + ignoreInit = TRUE ) output$tableDescription <- renderUI({ @@ -125,7 +125,7 @@ dataPlotPanel <- R6::R6Class( }) output$ingredientPickerUI <- renderUI({ - shinyWidgets::pickerInput( + shinyWidgets::pickerInput( inputId = shiny::NS(private$.namespace, "ingredientPicker"), label = "ingredients", choices = private$.ingredients, @@ -150,8 +150,8 @@ dataPlotPanel <- R6::R6Class( data <- getData() if (!is.null(data) && nrow(data) > 0) { shinyWidgets::downloadBttn(shiny::NS(private$.namespace, "downloadButton"), - size = "xs", - label = "Download" + size = "xs", + label = "Download" ) } }) @@ -255,7 +255,6 @@ dataPlotPanel <- R6::R6Class( ggplot2::labs(x = xLabel) } }, - addBoxPlotTheme = function(plot, fontSize = 16) { plot + ggplot2::theme( @@ -271,25 +270,24 @@ dataPlotPanel <- R6::R6Class( createBoxChart = function(data) { if (!is.null(data) && nrow(data) > 0) { private$addBoxPlotTheme(data %>% - ggplot2::ggplot(ggplot2::aes(x = ingredient, ymin = y0, lower = y25, middle = y50, upper = y75, ymax = y100)) + - ggplot2::geom_boxplot(stat = "identity") + - ggplot2::facet_wrap(. ~ database_id) + - ggplot2::ggtitle(private$.description)) + ggplot2::ggplot(ggplot2::aes(x = ingredient, ymin = y0, lower = y25, middle = y50, upper = y75, ymax = y100)) + + ggplot2::geom_boxplot(stat = "identity") + + ggplot2::facet_wrap(. ~ database_id) + + ggplot2::ggtitle(private$.description)) } }, - createDoseChart = function(data, colour = "database_id", x = "group_level", facet = "strata_name") { result <- NULL if (!is.null(data) && nrow(data) > 0) { result <- private$addBoxPlotTheme(data %>% - dplyr::filter(estimate_name != "count_missing") %>% - dplyr::filter(estimate_name != "percentage_missing") %>% - dplyr::filter(variable_name == "daily_dose") %>% - dplyr::mutate(estimate_value = as.integer(estimate_value)) %>% - private$plotCharacteristics( - facet = facet, - colour = colour - )) + dplyr::filter(estimate_name != "count_missing") %>% + dplyr::filter(estimate_name != "percentage_missing") %>% + dplyr::filter(variable_name == "daily_dose") %>% + dplyr::mutate(estimate_value = as.integer(estimate_value)) %>% + private$plotCharacteristics( + facet = facet, + colour = colour + )) } return(result) }, @@ -409,33 +407,43 @@ dataPlotPanel <- R6::R6Class( do.call(paste, ingredients) }, # Copied from CohortCharacteristics. The new version of this function doesn't work with dose data - plotCharacteristics = function (data, x = "variable_name", facet = NULL, - colour = NULL, colourName = NULL, .options = list()) { + plotCharacteristics = function(data, x = "variable_name", facet = NULL, + colour = NULL, colourName = NULL, .options = list()) { result <- NULL if (nrow(data) > 0) { xAxis <- x yAxis <- "estimate_value" vertical_x <- FALSE - nVariableNames <- length(dplyr::pull(dplyr::distinct(dplyr::select(data, - "variable_name")))) + nVariableNames <- length(dplyr::pull(dplyr::distinct(dplyr::select( + data, + "variable_name" + )))) if (nVariableNames != 1) { - emptyPlot("Only one variable name can be plotted at a time.", - "Please filter variable_name column in results before passing to plotCharacteristics()") + emptyPlot( + "Only one variable name can be plotted at a time.", + "Please filter variable_name column in results before passing to plotCharacteristics()" + ) } data <- dplyr::mutate(data, estimate_type = dplyr::if_else(.data$estimate_type == - "integer", "numeric", .data$estimate_type)) - estimateType <- dplyr::pull(dplyr::distinct(dplyr::select(data, - "estimate_type"))) + "integer", "numeric", .data$estimate_type)) + estimateType <- dplyr::pull(dplyr::distinct(dplyr::select( + data, + "estimate_type" + ))) nEstimateTypes <- length(estimateType) if (nEstimateTypes != 1) { - private$emptyPlot("Only one estimate type can be plotted at a time.", - "Please filter estimate_type column in results before passing to plotCharacteristics()") + private$emptyPlot( + "Only one estimate type can be plotted at a time.", + "Please filter estimate_type column in results before passing to plotCharacteristics()" + ) } if (!estimateType %in% c("numeric", "percentage")) { private$emptyPlot(paste0(estimateType, " not currently supported by plotCharacteristics()")) } - gg <- private$plotfunction(data, xAxis, yAxis, facetVarX = NULL, facetVarY = NULL, - colorVars = colour, vertical_x, facet = facet, .options = .options) + gg <- private$plotfunction(data, xAxis, yAxis, + facetVarX = NULL, facetVarY = NULL, + colorVars = colour, vertical_x, facet = facet, .options = .options + ) gg <- gg + ggplot2::theme_bw() if (estimateType == "numeric") { var <- unique(data$variable_name) @@ -457,8 +465,7 @@ dataPlotPanel <- R6::R6Class( gg <- gg + ggplot2::theme_bw() + ggplot2::theme(legend.position = "top") if (!is.null(colourName)) { gg <- gg + ggplot2::labs(color = colourName, fill = colourName) - } - else { + } else { gg <- gg + ggplot2::labs(color = "", fill = "") } result <- gg @@ -483,8 +490,8 @@ dataPlotPanel <- R6::R6Class( checkmate::assertVector(facetVarY, add = errorMessage, null.ok = TRUE) if (nrow(data) == 0) { return(ggplot2::ggplot() + - ggplot2::theme_void() + - ggplot2::labs(title = "Empty Data Provided", subtitle = "No data available for plotting.")) + ggplot2::theme_void() + + ggplot2::labs(title = "Empty Data Provided", subtitle = "No data available for plotting.")) } if (!all(c("q25", "median", "q75", "min", "max") %in% data$estimate_name)) { return( @@ -496,7 +503,7 @@ dataPlotPanel <- R6::R6Class( ) ) } - data <- data |> + data <- data %>% dplyr::mutate(color_combined = private$construct_color_variable(data, colorVars)) if (is.null(facetVarX)) { data$overall <- "overall" @@ -506,47 +513,47 @@ dataPlotPanel <- R6::R6Class( data$overall <- "overall" facetVarY <- "overall" } - data <- data |> + data <- data %>% dplyr::mutate( facet_combined_x = private$construct_variable(data, facetVarX), facet_combined_y = private$construct_variable(data, facetVarY) ) if (!is.null(facet)) { - data <- data |> + data <- data %>% tidyr::unite("facet_var", - c(dplyr::all_of(.env$facet)), - remove = FALSE, sep = "; " + c(dplyr::all_of(.env$facet)), + remove = FALSE, sep = "; " ) } checkmate::assertTRUE(any(xAxis == "estimate_value", yAxis == "estimate_value"), add = errorMessage) checkmate::reportAssertions(collection = errorMessage) - df_dates <- data |> dplyr::filter(.data$estimate_type == "date") - df_non_dates <- data |> dplyr::filter(!(.data$estimate_type %in% c("date", "logical"))) + df_dates <- data %>% dplyr::filter(.data$estimate_type == "date") + df_non_dates <- data %>% dplyr::filter(!(.data$estimate_type %in% c("date", "logical"))) # Start constructing the plot if (nrow(df_non_dates) > 0) { - df_non_dates <- df_non_dates |> - dplyr::filter(.data$estimate_name %in% c("q25", "median", "q75", "min", "max")) |> + df_non_dates <- df_non_dates %>% + dplyr::filter(.data$estimate_name %in% c("q25", "median", "q75", "min", "max")) %>% dplyr::mutate( estimate_value = as.numeric(.data$estimate_value), estimate_type = "numeric" ) - non_numeric_cols <- df_non_dates |> + non_numeric_cols <- df_non_dates %>% dplyr::select(-c( "estimate_value", "estimate_name", if ("facet_combined_x" %in% names(df_non_dates)) "facet_combined_x" else NULL, if ("facet_combined_y" %in% names(df_non_dates)) "facet_combined_y" else NULL, if ("color_combined" %in% names(df_non_dates)) "color_combined" else NULL - )) |> - dplyr::summarise(dplyr::across(dplyr::everything(), ~ dplyr::n_distinct(.) > 1)) |> - dplyr::select(dplyr::where(~.)) |> + )) %>% + dplyr::summarise(dplyr::across(dplyr::everything(), ~ dplyr::n_distinct(.) > 1)) %>% + dplyr::select(dplyr::where(~.)) %>% names() - df_non_dates_wide <- df_non_dates |> + df_non_dates_wide <- df_non_dates %>% tidyr::pivot_wider( id_cols = dplyr::all_of(colnames( - df_non_dates |> + df_non_dates %>% dplyr::select(-c("estimate_name", "estimate_value")) )), names_from = "estimate_name", @@ -555,32 +562,32 @@ dataPlotPanel <- R6::R6Class( if (length(non_numeric_cols) > 0) { - df_non_dates_wide$group_identifier <- interaction(df_non_dates_wide |> - dplyr::select(dplyr::all_of(non_numeric_cols))) + df_non_dates_wide$group_identifier <- interaction(df_non_dates_wide %>% + dplyr::select(dplyr::all_of(non_numeric_cols))) } else { df_non_dates_wide$group_identifier <- "overall" } } if (nrow(df_dates) > 0) { - df_dates <- df_dates |> - dplyr::filter(.data$estimate_name %in% c("q25", "median", "q75", "min", "max")) |> + df_dates <- df_dates %>% + dplyr::filter(.data$estimate_name %in% c("q25", "median", "q75", "min", "max")) %>% dplyr::mutate(estimate_value = as.Date(.data$estimate_value)) - df_dates_wide <- df_dates |> + df_dates_wide <- df_dates %>% tidyr::pivot_wider( - id_cols = dplyr::all_of(colnames(df_dates |> - dplyr::select(-c( - "estimate_name", - "estimate_value" - )))), + id_cols = dplyr::all_of(colnames(df_dates %>% + dplyr::select(-c( + "estimate_name", + "estimate_value" + )))), names_from = "estimate_name", values_from = "estimate_value" ) if (length(non_numeric_cols) > 0) { - df_dates_wide$group_identifier <- interaction(df_dates_wide |> - dplyr::select( - dplyr::all_of(non_numeric_cols) - )) + df_dates_wide$group_identifier <- interaction(df_dates_wide %>% + dplyr::select( + dplyr::all_of(non_numeric_cols) + )) } else { df_dates_wide$group_identifier <- "overall" } @@ -589,7 +596,7 @@ dataPlotPanel <- R6::R6Class( # Check if the dataframe has rows to plot if (nrow(df_non_dates) > 0) { xcol <- ifelse(xAxis == "estimate_value", yAxis, xAxis) - p_non_dates <- df_non_dates_wide |> ggplot2::ggplot( + p_non_dates <- df_non_dates_wide %>% ggplot2::ggplot( ggplot2::aes(x = .data[[xcol]]) ) @@ -626,7 +633,7 @@ dataPlotPanel <- R6::R6Class( if (nrow(df_dates) > 0) { xcol <- ifelse(xAxis == "estimate_value", yAxis, xAxis) - p_dates <- df_dates_wide |> ggplot2::ggplot( + p_dates <- df_dates_wide %>% ggplot2::ggplot( ggplot2::aes(x = .data[[xcol]]) ) + ggplot2::labs( @@ -669,65 +676,65 @@ dataPlotPanel <- R6::R6Class( if (suppressWarnings(!is.null(data$facet_combined_x) || !is.null(data$facet_combined_y))) { if (!is.null(p_dates)) { - facet_x_exists <- "facet_combined_x" %in% names(df_dates) - facet_y_exists <- "facet_combined_y" %in% names(df_dates) - - # Construct the faceting formula based on the existence of the variables - facet_formula <- paste0( - ifelse(facet_y_exists, "facet_combined_y", "."), - " ~ ", - ifelse(facet_x_exists, "facet_combined_x", ".") - ) + facet_x_exists <- "facet_combined_x" %in% names(df_dates) + facet_y_exists <- "facet_combined_y" %in% names(df_dates) + + # Construct the faceting formula based on the existence of the variables + facet_formula <- paste0( + ifelse(facet_y_exists, "facet_combined_y", "."), + " ~ ", + ifelse(facet_x_exists, "facet_combined_x", ".") + ) - p_dates <- p_dates + - ggplot2::facet_grid(rows = facet_formula, scales = "free") - if (vertical_x) { - p_dates <- p_dates + ggplot2::theme(axis.text.x = ggplot2::element_text( - angle = 90, - hjust = 1, - vjust = 0.5 - )) - } + p_dates <- p_dates + + ggplot2::facet_grid(rows = facet_formula, scales = "free") + if (vertical_x) { + p_dates <- p_dates + ggplot2::theme(axis.text.x = ggplot2::element_text( + angle = 90, + hjust = 1, + vjust = 0.5 + )) } - if (!is.null(p_non_dates)) { - facet_x_exists <- "facet_combined_x" %in% names(df_non_dates) - facet_y_exists <- "facet_combined_y" %in% names(df_non_dates) - - # Construct the faceting formula based on the existence of the variables - facet_formula <- paste0( - ifelse(facet_y_exists, "facet_combined_y", "."), - " ~ ", - ifelse(facet_x_exists, "facet_combined_x", ".") - ) + } + if (!is.null(p_non_dates)) { + facet_x_exists <- "facet_combined_x" %in% names(df_non_dates) + facet_y_exists <- "facet_combined_y" %in% names(df_non_dates) + + # Construct the faceting formula based on the existence of the variables + facet_formula <- paste0( + ifelse(facet_y_exists, "facet_combined_y", "."), + " ~ ", + ifelse(facet_x_exists, "facet_combined_x", ".") + ) - p_non_dates <- p_non_dates + - ggplot2::facet_grid(rows = facet_formula, scales = "free") - if (vertical_x) { - p_non_dates <- p_non_dates + ggplot2::theme( - axis.text.x = - ggplot2::element_text( - angle = 90, - hjust = 1, - vjust = 0.5 - ) - ) - } + p_non_dates <- p_non_dates + + ggplot2::facet_grid(rows = facet_formula, scales = "free") + if (vertical_x) { + p_non_dates <- p_non_dates + ggplot2::theme( + axis.text.x = + ggplot2::element_text( + angle = 90, + hjust = 1, + vjust = 0.5 + ) + ) } + } - p <- if (!is.null(p_dates) && !is.null(p_non_dates)) { - ggpubr::ggarrange(p_dates, p_non_dates, nrow = 2) - } else if (!is.null(p_dates)) { - p_dates - } else if (!is.null(p_non_dates)) { - p_non_dates - } else { - ggplot2::ggplot() + - ggplot2::theme_void() + - ggplot2::labs( - title = "No Data Provided", - subtitle = "Boxplot needs to have min max q25 q75 in estimate_name" - ) - } + p <- if (!is.null(p_dates) && !is.null(p_non_dates)) { + ggpubr::ggarrange(p_dates, p_non_dates, nrow = 2) + } else if (!is.null(p_dates)) { + p_dates + } else if (!is.null(p_non_dates)) { + p_non_dates + } else { + ggplot2::ggplot() + + ggplot2::theme_void() + + ggplot2::labs( + title = "No Data Provided", + subtitle = "Boxplot needs to have min max q25 q75 in estimate_name" + ) + } } else { if (!is.null(p_dates) || !is.null(p_non_dates)) { if (!is.null(p_dates) && is.null(p_non_dates)) { @@ -781,8 +788,8 @@ dataPlotPanel <- R6::R6Class( } p <- p + ggplot2::facet_wrap(ggplot2::vars(.data$facet_var), - ncol = facetNcols, - scales = facetScales + ncol = facetNcols, + scales = facetScales ) } return(p) @@ -796,7 +803,7 @@ dataPlotPanel <- R6::R6Class( valid_vars <- facet_vars[unique_val_vars] if (length(valid_vars) > 1) { - return(as.factor(interaction(data |> dplyr::select(dplyr::all_of(valid_vars)), sep = "."))) + return(as.factor(interaction(data %>% dplyr::select(dplyr::all_of(valid_vars)), sep = "."))) } else if (length(valid_vars) == 1) { return(as.factor(data[[valid_vars]])) } @@ -870,9 +877,9 @@ dataPlotPanel <- R6::R6Class( #' @return (`tabItem`) uiBody = function() { filterRow <- shiny::fluidRow( - shiny::column(width = 3, shiny::uiOutput(shiny::NS(private$.namespace,"dbPickerUI"))), - shiny::column(width = 3, shiny::uiOutput(shiny::NS(private$.namespace,"ingredientPickerUI"))), - shiny::column(width = 3, shiny::uiOutput(shiny::NS(private$.namespace,"columnPickerUI"))) + shiny::column(width = 3, shiny::uiOutput(shiny::NS(private$.namespace, "dbPickerUI"))), + shiny::column(width = 3, shiny::uiOutput(shiny::NS(private$.namespace, "ingredientPickerUI"))), + shiny::column(width = 3, shiny::uiOutput(shiny::NS(private$.namespace, "columnPickerUI"))) ) topNCol <- shiny::tagList() diff --git a/R/metaDataPanel.R b/R/metaDataPanel.R index b9f5cc3..ec85084 100644 --- a/R/metaDataPanel.R +++ b/R/metaDataPanel.R @@ -69,8 +69,8 @@ metaDataPanel <- R6::R6Class( data <- getData() if (!is.null(data) && nrow(data) > 0) { shinyWidgets::downloadBttn(shiny::NS(private$.namespace, "downloadButton"), - size = "xs", - label = "Download" + size = "xs", + label = "Download" ) } }) diff --git a/R/shinyApp.R b/R/shinyApp.R new file mode 100644 index 0000000..4d0590e --- /dev/null +++ b/R/shinyApp.R @@ -0,0 +1,291 @@ +# Copyright 2024 DARWIN EU® +# +# This file is part of DrugExposureDiagnostics +# +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. + +#' @title ShinyApp +#' +#' @description +#' R6 ShinyApp class. +#' +#' @noRd +ShinyApp <- R6::R6Class( + classname = "ShinyApp", + inherit = ShinyModule, + public = list( + + #' @description + #' Initializer method + #' + #' @param resultList (`list`) List containing the output of the checks + #' @param database_id (`character`) + #' + #' @return (`invisible(self)`) + initialize = function(resultList, database_id) { + super$initialize() + private$.resultList <- resultList + private$.database_id <- database_id + lapply(names(private$.resultList), FUN = function(name) { + private$.resultList[[name]] <- dplyr::bind_cols( + database_id = database_id, + private$.resultList[[name]] + ) + }) + if (nrow(private$.resultList$conceptSummary) > 0) { + ingredientConceptsColumnsToHide <- c( + "concept_code", "valid_start_date", "valid_end_date", + "invalid_reason", "amount_value", "amount_unit_concept_id", "numerator_value", + "numerator_unit_concept_id", "numerator_unit", "denominator_value", + "denominator_unit_concept_id", "denominator_unit", "box_size", "amount_unit" + ) + ingredientConceptColumnsSelected <- colnames(private$.resultList$conceptSummary) + ingredientConceptColumnsSelected <- setdiff(ingredientConceptColumnsSelected, ingredientConceptsColumnsToHide) + private$.ingredientConceptsTab <- dataPlotPanel$new( + data = private$.resultList$conceptSummary, + id = "ingredientConcepts", + title = "Ingredient concepts", + description = "Ingredient concepts", + plotPercentage = FALSE, + byConcept = FALSE, + downloadFilename = "IngredientConcepts.csv", + selectedColumns = ingredientConceptColumnsSelected + ) + private$.ingredientConceptsTab$parentNamespace <- self$namespace + } + if (nrow(private$.resultList$drugRoutesOverall) > 0) { + private$.drugRoutesTab <- dataPlotPanel$new( + data = private$.resultList$drugRoutesOverall, + dataByConcept = private$.resultList$drugRoutesByConcept, + id = "drugRoutes", + title = "Drug routes", + description = "Drug routes", + plotPercentage = FALSE, + byConcept = TRUE, + downloadFilename = "DrugRoutes.csv" + ) + private$.drugRoutesTab$parentNamespace <- self$namespace + } + if (nrow(private$.resultList$drugTypesOverall) > 0) { + private$.drugTypesTab <- dataPlotPanel$new( + data = private$.resultList$drugTypesOverall, + dataByConcept = private$.resultList$drugTypesByConcept, + id = "drugTypes", + title = "Drug types", + description = "Drug types", + plotPercentage = FALSE, + byConcept = TRUE, + downloadFilename = "DrugTypes.csv" + ) + private$.drugTypesTab$parentNamespace <- self$namespace + } + if (nrow(private$.resultList$drugSourceConceptsOverall) > 0) { + private$.drugSourceConceptsTab <- dataPlotPanel$new( + data = private$.resultList$drugSourceConceptsOverall, + id = "drugSourceConcepts", + title = "Drug source concepts", + description = "Drug source concepts", + plotPercentage = FALSE, + byConcept = FALSE, + downloadFilename = "DrugSourceConcepts.csv" + ) + private$.drugSourceConceptsTab$parentNamespace <- self$namespace + } + if (nrow(private$.resultList$drugExposureDurationOverall) > 0) { + private$.drugExposureDurationTab <- dataPlotPanel$new( + data = private$.resultList$drugExposureDurationOverall, + dataByConcept = private$.resultList$drugExposureDurationByConcept, + id = "drugExposureDuration", + title = "Drug exposure duration", + description = "Drug exposure duration", + plotPercentage = FALSE, + byConcept = TRUE, + downloadFilename = "DrugExposureDuration.csv" + ) + private$.drugExposureDurationTab$parentNamespace <- self$namespace + } + if (nrow(private$.resultList$missingValuesOverall) > 0) { + private$.drugVariablesMissingTab <- dataPlotPanel$new( + data = private$.resultList$missingValuesOverall, + dataByConcept = private$.resultList$missingValuesByConcept, + id = "drugVariablesMissing", + title = "Drug variables missing", + description = "Drug variables missing", + plotPercentage = TRUE, + byConcept = TRUE, + downloadFilename = "DrugVariablesMissing.csv" + ) + private$.drugVariablesMissingTab$parentNamespace <- self$namespace + } + if (nrow(private$.resultList$drugDaysSupply) > 0) { + private$.drugDaysSupplyTab <- dataPlotPanel$new( + data = private$.resultList$drugDaysSupply, + dataByConcept = private$.resultList$drugDaysSupplyByConcept, + id = "drugDaysSupply", + title = "Drug days supply", + description = "Drug days supply", + plotPercentage = FALSE, + byConcept = TRUE, + downloadFilename = "DrugDaysSupply.csv" + ) + private$.drugDaysSupplyTab$parentNamespace <- self$namespace + } + if (nrow(private$.resultList$drugQuantity) > 0) { + private$.drugQuantityTab <- dataPlotPanel$new( + data = private$.resultList$drugQuantity, + dataByConcept = private$.resultList$drugQuantityByConcept, + id = "drugQuantity", + title = "Drug quantity", + description = "Drug quantity", + plotPercentage = FALSE, + byConcept = TRUE, + downloadFilename = "DrugQuantity.csv" + ) + private$.drugQuantityTab$parentNamespace <- self$namespace + } + if (nrow(private$.resultList$drugSig) > 0) { + private$.drugSigTab <- dataPlotPanel$new( + data = private$.resultList$drugSig, + dataByConcept = private$.resultList$drugSigByConcept, + id = "drugSig", + title = "Drug sig", + description = "Drug sig", + plotPercentage = FALSE, + byConcept = TRUE, + downloadFilename = "DrugSig.csv" + ) + private$.drugSigTab$parentNamespace <- self$namespace + } + if (nrow(private$.resultList$drugVerbatimEndDate) > 0) { + private$.drugVerbatimEndDateTab <- dataPlotPanel$new( + data = private$.resultList$drugVerbatimEndDate, + dataByConcept = private$.resultList$drugVerbatimEndDateByConcept, + id = "drugVerbatimEndDate", + title = "Drug verbatim end date", + description = "Drug verbatim end date", + plotPercentage = FALSE, + byConcept = TRUE, + downloadFilename = "DrugVerbatimEndDate.csv" + ) + private$.drugVerbatimEndDateTab$parentNamespace <- self$namespace + } + if (nrow(private$.resultList$drugDose) > 0) { + private$.drugDailyDoseTab <- dataPlotPanel$new( + data = private$.resultList$drugDose, + id = "drugDailyDose", + title = "Drug daily dose", + description = "Drug daily dose", + plotPercentage = FALSE, + byConcept = FALSE, + downloadFilename = "DrugDailyDose.csv" + ) + private$.drugDailyDoseTab$parentNamespace <- self$namespace + } + # metadata + if (nrow(private$.resultList$metadata) > 0) { + private$.metaDataTab <- metaDataPanel$new( + data = private$.resultList$metadata, + id = "metaData", + title = "Metadata", + description = "Metadata", + downloadFilename = "metaData.csv" + ) + private$.metaDataTab$parentNamespace <- self$namespace + } + return(invisible(self)) + } + ), + + ## Private ---- + private = list( + ### Fields ---- + .resultList = NULL, + .database_id = NULL, + .ingredientConceptsTab = NULL, + .drugRoutesTab = NULL, + .drugTypesTab = NULL, + .drugSourceConceptsTab = NULL, + .drugExposureDurationTab = NULL, + .drugVariablesMissingTab = NULL, + .drugDaysSupplyTab = NULL, + .drugQuantityTab = NULL, + .drugSigTab = NULL, + .drugVerbatimEndDateTab = NULL, + .drugDailyDoseTab = NULL, + .metaDataTab = NULL, + + ### Methods ---- + .UI = function() { + allTabsList <- list(widths = c(2, 10)) + if (!is.null(private$.ingredientConceptsTab)) { + allTabsList[[length(allTabsList) + 1]] <- private$.ingredientConceptsTab$uiBody() + } + if (!is.null(private$.drugRoutesTab)) { + allTabsList[[length(allTabsList) + 1]] <- private$.drugRoutesTab$uiBody() + } + if (!is.null(private$.drugTypesTab)) { + allTabsList[[length(allTabsList) + 1]] <- private$.drugTypesTab$uiBody() + } + if (!is.null(private$.drugSourceConceptsTab)) { + allTabsList[[length(allTabsList) + 1]] <- private$.drugSourceConceptsTab$uiBody() + } + if (!is.null(private$.drugExposureDurationTab)) { + allTabsList[[length(allTabsList) + 1]] <- private$.drugExposureDurationTab$uiBody() + } + if (!is.null(private$.drugVariablesMissingTab)) { + allTabsList[[length(allTabsList) + 1]] <- private$.drugVariablesMissingTab$uiBody() + } + if (!is.null(private$.drugDaysSupplyTab)) { + allTabsList[[length(allTabsList) + 1]] <- private$.drugDaysSupplyTab$uiBody() + } + if (!is.null(private$.drugQuantityTab)) { + allTabsList[[length(allTabsList) + 1]] <- private$.drugQuantityTab$uiBody() + } + if (!is.null(private$.drugSigTab)) { + allTabsList[[length(allTabsList) + 1]] <- private$.drugSigTab$uiBody() + } + if (!is.null(private$.drugVerbatimEndDateTab)) { + allTabsList[[length(allTabsList) + 1]] <- private$.drugVerbatimEndDateTab$uiBody() + } + if (!is.null(private$.drugDailyDoseTab)) { + allTabsList[[length(allTabsList) + 1]] <- private$.drugDailyDoseTab$uiBody() + } + if (!is.null(private$.metaDataTab)) { + allTabsList[[length(allTabsList) + 1]] <- private$.metaDataTab$uiBody() + } + shiny::fluidPage( + theme = bslib::bs_theme(version = "5", bootswatch = "spacelab"), + shinyjs::useShinyjs(), + shiny::titlePanel( + title = shiny::h2("Drug Exposure Diagnostics Dashboard", align = "center"), + windowTitle = "Drug Exposure Diagnostics Dashboard" + ), + do.call(navlistPanel, allTabsList) + ) + }, + .server = function(input, output, session) { + private$.ingredientConceptsTab$server(input, output, session) + private$.drugRoutesTab$server(input, output, session) + private$.drugTypesTab$server(input, output, session) + private$.drugSourceConceptsTab$server(input, output, session) + private$.drugExposureDurationTab$server(input, output, session) + private$.drugVariablesMissingTab$server(input, output, session) + private$.drugDaysSupplyTab$server(input, output, session) + private$.drugQuantityTab$server(input, output, session) + private$.drugSigTab$server(input, output, session) + private$.drugVerbatimEndDateTab$server(input, output, session) + private$.drugDailyDoseTab$server(input, output, session) + private$.metaDataTab$server(input, output, session) + } + ) +) diff --git a/inst/shiny/ResultsExplorer/data/mock.zip b/inst/shiny/ResultsExplorer/data/mock.zip index ca0e4ddc5c1a42d4f396fea8c287a987ffd13321..3e77578a7b957f3c131e24918df0b88cf0207afe 100644 GIT binary patch delta 1924 zcmbO-neos}M!o=VW)=|!5V+ft7deqnN^`QLSvm*@NSURVR&X;gvV3J^U;rzEDCS_` zfG7@B;ejbG0V6(Au7RR01@@!*@qCF&Swe{y}%d61UGlPpfN=Bogf=Rv{6I{BDzr|4Pn9(F*S(j zIk7SpxCs}f^&q0mGJ*)T3uUb!qW5Lp5$0}IfU13}V2u!6t84^O`&hXgWLnMKg@*7lu%`jT5QfnrU~1pNyh8>&ZSQT| z&U;Tyag}=Bt9(9SXD7R8ZqQB7qxa<4GaepD4Vv=f|NrwFwfQ-%5^}2JYeUZU=him} z%Bvpt;ft5;f3sqKko@6CF4Nt4IJ>S3{ZmRT;I>!(INA2-L1kN(hYhJ4aspmhTD|zh z@a6j@6HnFsyJk2GNm{$jdOum^)#7+%7OAQySN0`ZFfL6!r*OWSr#W7M&)}oxI$z-( z#xjL>bAo#>&Q<-fu;xzuvJ*2ue317(w=M5U{XO9iGk$*1-Fo$!*59Q)qJh_Rro`#3 z-Wv8R_~tXUGw<5+-q-dTxy_t3BkKC@tYX#xZ*~svGe3X6fCd*L=^+QCJTM?-fB_jF z@9XI79~_|%4pF^$%rNDK1}Y?3YKnb~R$%)i`BbulsZUYSQ9vx>IJ3ew_sJVItRmJl zDaA+3ikLDZeA3M6rv&s;r||`){Qa!Je#6zF_1&*!+Hq$&HLsW(Y%thlW^8U|>|?@D6SR`OEH?0 zXKQ?bq?mq9E0}2K&&pdw=OWpg9A3@9{#GHGD* zCO5iiPtLO9o4m!s0-T+IGV+u8Exi!39hRO5nJ<>^2$?J^H-yY(D}RJcptT=D=8&}; zLgs`k-(*)CbA;@C8*hZHq^%c1rp?w9A@k4H10j=X=Y){CW#@>Hv9q^9$gH%thR8I! zDNN>Ya7M^f0Xg7sIOvd%5RG^AN0@Zc(FGw><-j*N$jKBTyUNJ}A*<-@4wI2~0VQ?h zOaLk~U|>n(MO6kON)S-QDS!+@Bt%G_K^P>VKH1P&SO!-)1dU|*$=%LU%w`%4li#UA z642y}&X&w=S`3rzGz=h)c6701ny)?iy_NLj_1aPhUp;W)W4fd}Ini1TEDkp@*j0*Y zsovy#S4ipwryyXgGG!P5)rw7C;J`ZBN>2(JAa0gS28NS;+#odvP^~3Xj`3tiPw~lC zhN`eYlb3ejo#ociO}-KU5Z)4jA8NxV-1Aj1P?wY z5p%HO307>Adpsl%8jgENao#qE+40a!0Om~I z2n8vmqlickqF1pJvAz%y@t{)e!5&1KgY+QcBVg|)JKgp#T zG!&d3aka5a)yvLtE!(@`{==hx-4PAWvFF~c5B}|a2L%}^#It273E3ll7pJrSF35U= zeVm>SVxaX<52th>rO|037_1nE&NjkMeX7lAvhzc3mWnuZ*c@yF+S!eWtk$WCk1@j9 zq66wSs`f%u0sAwW19L3)-?|K#fx%H&^LX$um;*x@%}fCm<9Us`*_F5g=0`jSW^y^3B;haM8T7ysc zyWu^aC 0) { data %>% - ggplot(aes_string(x = x, y = y, fill = fill)) + + ggplot(aes(x = count, y = variable, fill = ingredient, text = paste0(variable, ": ", count))) + geom_bar(stat = "identity", position = position_dodge()) + theme( axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5), @@ -170,6 +199,7 @@ dataPlotPanelServer <- function(id, data, dataByConcept, downloadFilename, descr if (!is.null(topN)) { result <- data %>% group_by(database_id, ingredient_id) %>% + mutate(count = replace(count, is.na(count), 0)) %>% slice_max(order_by = count, n = topN, with_ties = TRUE) %>% dplyr::ungroup() %>% dplyr::mutate(variable = factor(variable, levels = unique(variable[order(count, decreasing = F)]))) @@ -187,11 +217,11 @@ dataPlotPanelServer <- function(id, data, dataByConcept, downloadFilename, descr } else if (id == "drugDaysSupply") { data %>% dplyr::rename( - y0 = minimum_drug_exposure_days_supply, + y0 = q05_drug_exposure_days_supply, y25 = q25_drug_exposure_days_supply, y50 = median_drug_exposure_days_supply, y75 = q75_drug_exposure_days_supply, - y100 = maximum_drug_exposure_days_supply + y100 = q95_drug_exposure_days_supply ) %>% createBoxChart() } else if (id == "drugRoutes") { @@ -242,21 +272,21 @@ dataPlotPanelServer <- function(id, data, dataByConcept, downloadFilename, descr } else if (id == "drugExposureDuration") { data %>% dplyr::rename( - y0 = minimum_drug_exposure_days, + y0 = q05_drug_exposure_days, y25 = q25_drug_exposure_days, y50 = median_drug_exposure_days, y75 = q75_drug_exposure_days, - y100 = maximum_drug_exposure_days + y100 = q95_drug_exposure_days ) %>% createBoxChart() } else if (id == "drugQuantity") { data %>% dplyr::rename( - y0 = minimum_drug_exposure_quantity, + y0 = q05_drug_exposure_quantity, y25 = q25_drug_exposure_quantity, y50 = median_drug_exposure_quantity, y75 = q75_drug_exposure_quantity, - y100 = maximum_drug_exposure_quantity + y100 = q95_drug_exposure_quantity ) %>% createBoxChart() } @@ -304,6 +334,16 @@ dataPlotPanelServer <- function(id, data, dataByConcept, downloadFilename, descr } }) + getTabData <- reactive({ + data <- getData() + if (!is.null(data) && id == "drugVariablesMissing") { + variables <- input$variablesPicker + data <- data %>% + dplyr::filter(variable %in% variables) + } + return(data) + }) + observeEvent(input[["ingredientPicker"]], { if (id == referenceTabId) { @@ -423,8 +463,23 @@ dataPlotPanelServer <- function(id, data, dataByConcept, downloadFilename, descr ) }) + output$variablesPickerUI <- renderUI({ + if (id == "drugVariablesMissing") { + data <- getData() + choices <- unique(data$variable) + pickerInput( + inputId = ns("variablesPicker"), + label = "Variables", + choices = choices, + options = list(`actions-box` = TRUE), + multiple = T, + selected = choices + ) + } + }) + output$downloadButtonUI <- renderUI({ - data <- getData() + data <- getTabData() if (!is.null(data) && nrow(data) > 0) { downloadBttn(ns("downloadButton"), size = "xs", @@ -434,9 +489,9 @@ dataPlotPanelServer <- function(id, data, dataByConcept, downloadFilename, descr }) output$mainTable <- DT::renderDataTable({ - validate(need(ncol(getData()) > 1, "No input data")) + validate(need(ncol(getTabData()) > 1, "No input data")) - DT::datatable(getData(), rownames = FALSE) + DT::datatable(getTabData(), rownames = FALSE) }) output$downloadButton <- downloadHandler( @@ -444,7 +499,7 @@ dataPlotPanelServer <- function(id, data, dataByConcept, downloadFilename, descr downloadFilename }, content = function(file) { - write.csv(getData(), file, row.names = FALSE) + write.csv(getTabData(), file, row.names = FALSE) } ) @@ -473,7 +528,20 @@ dataPlotPanelServer <- function(id, data, dataByConcept, downloadFilename, descr selected = ingredients ) }) - + output$plotVariablesPickerUI <- renderUI({ + if (id == "drugVariablesMissing") { + data <- getPlotData() + choices <- unique(data$variable) + pickerInput( + inputId = ns("plotVariablesPicker"), + label = "Variables", + choices = choices, + options = list(`actions-box` = TRUE), + multiple = T, + selected = choices + ) + } + }) getPlotData <- reactive({ result <- NULL @@ -488,18 +556,32 @@ dataPlotPanelServer <- function(id, data, dataByConcept, downloadFilename, descr result }) + getPlotTabData <- reactive({ + data <- getPlotData() + if (!is.null(data) && id == "drugVariablesMissing") { + variables <- input$plotVariablesPicker + data <- data %>% + dplyr::filter(variable %in% variables) + } + return(data) + }) + output$plotUI <- renderUI({ result <- NULL # Boxplots and ggplotly do not work together, so we output ggplot for these if (id %in% ggplotModules) { result <- plotOutput(ns("plot"), height = "700px") output$plot <- renderPlot({ - createChart(getPlotData(), input$top_n) + createChart(getPlotTabData(), input$top_n) }) } else { result <- plotlyOutput(ns("plot"), height = "700px") output$plot <- renderPlotly({ - createChart(getPlotData(), input$top_n, input$perc) + plotData <- getPlotTabData() + if (!is.null(plotData) && nrow(plotData) > 0) { + plot <- createChart(plotData, input$top_n, input$perc) + ggplotly(plot, tooltip = c("text")) + } }) } result diff --git a/inst/shiny/ResultsExplorer/global.R b/inst/shiny/ResultsExplorer/global.R index ae11ac5..3d2b1e5 100644 --- a/inst/shiny/ResultsExplorer/global.R +++ b/inst/shiny/ResultsExplorer/global.R @@ -107,7 +107,7 @@ if (exists("drugverbatimenddate")) { } drugDailyDose <- data.frame() -if (exists("drugdose")) { +if (exists("drugdose") && nrow(ingredientConcepts) > 0) { drugDailyDose <- formatResult(drugdose) %>% dplyr::filter(!is.na(strata_level)) %>% dplyr::mutate(result_id = as.integer(result_id)) diff --git a/inst/shiny/ResultsExplorer/ui.R b/inst/shiny/ResultsExplorer/ui.R index a7bed89..3c5b895 100644 --- a/inst/shiny/ResultsExplorer/ui.R +++ b/inst/shiny/ResultsExplorer/ui.R @@ -1,11 +1,11 @@ # User interface definition -allTabsList <- list( - dataPlotPanelViewer("ingredientConcepts", "Ingredient concepts", byConcept = FALSE), - widths = c(2, 10) -) +allTabsList <- list(widths = c(2, 10)) # add tabs depending on if the data is available +if (nrow(ingredientConcepts) > 0) { + allTabsList[[length(allTabsList) + 1]] <- dataPlotPanelViewer("ingredientConcepts", "Ingredient concepts", byConcept = FALSE) +} if (nrow(drugRoutes) > 0) { allTabsList[[length(allTabsList) + 1]] <- dataPlotPanelViewer("drugRoutes", "Drug routes") } diff --git a/inst/shiny/ResultsExplorer/utils.R b/inst/shiny/ResultsExplorer/utils.R index fae01db..db819bc 100644 --- a/inst/shiny/ResultsExplorer/utils.R +++ b/inst/shiny/ResultsExplorer/utils.R @@ -30,8 +30,10 @@ loadFile <- function(file, folder, overwrite, i) { )) } else if (grepl("drugDose", file)) { data <- data %>% - dplyr::mutate(result_id = i, - estimate_value = as.character(estimate_value)) + dplyr::mutate( + result_id = i, + estimate_value = as.character(estimate_value) + ) } else if (grepl("drugSourceConceptsOverall", file)) { data <- data %>% dplyr::mutate(drug_source_value = as.character(.data$drug_source_value)) diff --git a/man/dataPlotPanel.Rd b/man/dataPlotPanel.Rd index 2c4c92b..e33a285 100644 --- a/man/dataPlotPanel.Rd +++ b/man/dataPlotPanel.Rd @@ -10,7 +10,7 @@ Class to view the data and plot view of a DrugExposureDiagnostics check. } \section{Super class}{ -\code{DrugExposureDiagnostics::ShinyModule} -> \code{dataPlotPanel} +\code{\link[DrugExposureDiagnostics:ShinyModule]{DrugExposureDiagnostics::ShinyModule}} -> \code{dataPlotPanel} } \section{Methods}{ \subsection{Public methods}{ diff --git a/man/metaDataPanel.Rd b/man/metaDataPanel.Rd index f16b484..b3c20c1 100644 --- a/man/metaDataPanel.Rd +++ b/man/metaDataPanel.Rd @@ -10,7 +10,7 @@ Class to view the metadata of a DrugExposureDiagnostics execution. } \section{Super class}{ -\code{DrugExposureDiagnostics::ShinyModule} -> \code{metaDataPanel} +\code{\link[DrugExposureDiagnostics:ShinyModule]{DrugExposureDiagnostics::ShinyModule}} -> \code{metaDataPanel} } \section{Methods}{ \subsection{Public methods}{ diff --git a/tests/testthat/helper-ableToRun.R b/tests/testthat/helper-ableToRun.R new file mode 100644 index 0000000..f35462c --- /dev/null +++ b/tests/testthat/helper-ableToRun.R @@ -0,0 +1,10 @@ +ableToRun <- function() { + list( + shiny = all( + require("shiny", quietly = TRUE, mask.ok = TRUE, character.only = TRUE), + require("ggplot2", quietly = TRUE, mask.ok = TRUE, character.only = TRUE), + require("plotly", quietly = TRUE, mask.ok = TRUE, character.only = TRUE), + require("dplyr", quietly = TRUE, mask.ok = TRUE, character.only = TRUE) + ) + ) +} diff --git a/tests/testthat/test-ShinyApp.R b/tests/testthat/test-ShinyApp.R new file mode 100644 index 0000000..7ba81c5 --- /dev/null +++ b/tests/testthat/test-ShinyApp.R @@ -0,0 +1,35 @@ +library(testthat) +library(shiny) +library(R6) + +test_that("ShinyApp", { + skip_if_not(ableToRun()$shiny) + + cdm <- mockDrugExposure() + resultList <- DrugExposureDiagnostics::executeChecks( + cdm = cdm, + ingredients = 1125315, + checks = c("missing", "exposureDuration", "type", "route", "sourceConcept", "daysSupply", "verbatimEndDate", "dose", "sig", "quantity"), + minCellCount = 5, + earliestStartDate = "2000-01-01" + ) + + app <- DrugExposureDiagnostics:::ShinyApp$new( + resultList = resultList, + database_id = "Eunomia" + ) + + # Fields + expect_false(is.null(app$namespace)) + expect_false(is.null(app$moduleId)) + expect_equal(app$moduleName, "ShinyApp") + expect_false(is.null(app$instanceId)) + + # UI + expect_s3_class(app$UI(), "shiny.tag.list") + + # Server + testServer(app = app$server, { + expect_true(is.character(session$token)) + }) +})