diff --git a/DESCRIPTION b/DESCRIPTION index b804cc9..12c8275 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -44,8 +44,6 @@ Suggests: remotes, rmarkdown, testthat (>= 3.0.0) -Remotes: - github::microbiome/iSEEtree URL: https://github.com/RiboRings/miaDash BugReports: https://github.com/RiboRings/miaDash/issues Roxygen: list(markdown = TRUE) diff --git a/NEWS b/NEWS index 5d97d88..a23d0b5 100644 --- a/NEWS +++ b/NEWS @@ -5,4 +5,5 @@ Changes in version 0.1.0 Changes in version 0.2.0 * Added manipulate functionality * Added estimate functionality -* Added panel layout customisation \ No newline at end of file +* Added panel layout customisation +* Added unit testing diff --git a/R/landing_page.R b/R/landing_page.R index 0b549f5..8e18f28 100644 --- a/R/landing_page.R +++ b/R/landing_page.R @@ -18,10 +18,8 @@ #' @importFrom shinyjs disable #' @importFrom utils data .landing_page <- function(FUN, input, output, session) { - - mia_datasets <- data(package = "mia") - mia_datasets <- mia_datasets$results[-c(2, 5), "Item"] - data(list = mia_datasets, package = "mia") + + mia_datasets <- .import_datasets(-c(2, 5)) # nocov start output$allPanels <- renderUI({ @@ -30,7 +28,7 @@ fluidRow(column(4, wellPanel(id = "import.panel", - titlePanel("Import"), + titlePanel("Import"), tabsetPanel(id = "format", @@ -60,159 +58,157 @@ fileInput(inputId = "rowdata", label = "rowData:", accept = ".csv") - ), + ), - tabPanel(title = "Foreign", value = "foreign", + tabPanel(title = "Foreign", value = "foreign", - radioButtons(inputId = "ftype", - label = "Type:", choices = list("biom", "QZA", - "MetaPhlAn")), + radioButtons(inputId = "ftype", + label = "Type:", choices = list("biom", "QZA", + "MetaPhlAn")), - fileInput(inputId = "main.file", - label = "Main file:", accept = c(".biom", - ".QZA", ".txt")), + fileInput(inputId = "main.file", + label = "Main file:", accept = c(".biom", + ".QZA", ".txt")), - conditionalPanel( - condition = "input.ftype == 'biom'", + conditionalPanel( + condition = "input.ftype == 'biom'", - checkboxInput(inputId = "rm.tax.pref", - label = "Remove taxa prefixes"), + checkboxInput(inputId = "rm.tax.pref", + label = "Remove taxa prefixes"), - checkboxInput(inputId = "rank.from.pref", - label = "Derive taxa from prefixes") - ), + checkboxInput(inputId = "rank.from.pref", + label = "Derive taxa from prefixes") + ), - conditionalPanel( - condition = "input.ftype == 'MetaPhlAn'", + conditionalPanel( + condition = "input.ftype == 'MetaPhlAn'", - fileInput(inputId = "col.data", label = "colData:", - accept = ".tsv"), + fileInput(inputId = "col.data", label = "colData:", + accept = ".tsv"), - fileInput(inputId = "tree.file", label = "Tree:", - accept = ".tree") - ) + fileInput(inputId = "tree.file", label = "Tree:", + accept = ".tree") + ) - ) + ) - ), + ), - actionButton("import", "Upload", class = "btn-success", - style = .actionbutton_biocstyle) + actionButton("import", "Upload", class = "btn-success", + style = .actionbutton_biocstyle) - )), + )), column(4, wellPanel(id = "manipulate.panel", - titlePanel("Manipulate"), + titlePanel("Manipulate"), - tabsetPanel(id = "manipulate", + tabsetPanel(id = "manipulate", - tabPanel(title = "Subset", value = "subset", + tabPanel(title = "Subset", value = "subset", - radioButtons(inputId = "subkeep", label = "Keep:", - choices = c("prevalent", "rare"), inline = TRUE), + radioButtons(inputId = "subkeep", label = "Keep:", + choices = c("prevalent", "rare"), inline = TRUE), - selectInput(inputId = "subassay", label = "Assay:", - choices = NULL), + selectInput(inputId = "subassay", label = "Assay:", + choices = NULL), - sliderInput(inputId = "prevalence", value = 0, - label = "Prevalence threshold:", step = 0.01, - min = 0, max = 1), + sliderInput(inputId = "prevalence", value = 0, + label = "Prevalence threshold:", step = 0.01, + min = 0, max = 1), - numericInput(inputId = "detection", value = 0, - label = "Detection threshold:", min = 0, step = 1) + numericInput(inputId = "detection", value = 0, + label = "Detection threshold:", min = 0, step = 1) - ), + ), - tabPanel(title = "Agglomerate", value = "agglomerate", + tabPanel(title = "Agglomerate", value = "agglomerate", - selectInput(inputId = "taxrank", label = "Taxonomic rank:", - choices = NULL) + selectInput(inputId = "taxrank", + label = "Taxonomic rank:", choices = NULL) - ), + ), - tabPanel(title = "Transform", value = "transform", + tabPanel(title = "Transform", value = "transform", - selectInput(inputId = "assay.type", label = "Assay:", - choices = NULL), + selectInput(inputId = "assay.type", label = "Assay:", + choices = NULL), - selectInput(inputId = "trans.method", label = "Method:", - choices = c("relabundance", "clr", "standardize")), + selectInput(inputId = "trans.method", label = "Method:", + choices = c("relabundance", "clr", "standardize")), - checkboxInput(inputId = "pseudocount", - label = "Pseudocount"), + checkboxInput(inputId = "pseudocount", + label = "Pseudocount"), - textInput(inputId = "assay.name", label = "Name:"), + textInput(inputId = "assay.name", label = "Name:"), - radioButtons(inputId = "margin", label = "Margin:", - choices = c("samples", "features"), inline = TRUE) + radioButtons(inputId = "margin", label = "Margin:", + choices = c("samples", "features"), inline = TRUE) - )), + )), - actionButton("apply", "Apply", class = "btn-success", - style = .actionbutton_biocstyle) + actionButton("apply", "Apply", class = "btn-success", + style = .actionbutton_biocstyle) )), column(4, wellPanel(id = "estimate.panel", - titlePanel("Estimate"), + titlePanel("Estimate"), - tabsetPanel(id = "estimate", + tabsetPanel(id = "estimate", - tabPanel(title = "Alpha", value = "alpha", + tabPanel(title = "Alpha", value = "alpha", - selectInput(inputId = "alpha.assay", label = "Assay:", - choices = NULL), + selectInput(inputId = "alpha.assay", label = "Assay:", + choices = NULL), - selectInput(inputId = "alpha.index", label = "Metric:", - choices = c("coverage", "shannon", "faith"), - multiple = TRUE), + selectInput(inputId = "alpha.index", label = "Metric:", + choices = c("coverage", "shannon", "faith"), + multiple = TRUE), - textInput(inputId = "alpha.name", label = "Name:") + textInput(inputId = "alpha.name", label = "Name:") - ), + ), - tabPanel(title = "Beta", value = "beta", + tabPanel(title = "Beta", value = "beta", - radioButtons(inputId = "bmethod", label = "Method:", - choices = c("MDS", "NMDS", "PCA", "RDA"), inline = TRUE), + radioButtons(inputId = "bmethod", label = "Method:", + choices = c("MDS", "NMDS", "PCA", "RDA"), + inline = TRUE), - - selectInput(inputId = "beta.assay", label = "Assay:", - choices = NULL), + selectInput(inputId = "beta.assay", label = "Assay:", + choices = NULL), - conditionalPanel( - condition = "input.bmethod != 'PCA'", + conditionalPanel( + condition = "input.bmethod != 'PCA'", - selectInput(inputId = "beta.index", label = "Metric:", - choices = c("euclidean", "bray", "jaccard", "unifrac")), - ), + selectInput(inputId = "beta.index", label = "Metric:", + choices = c("euclidean", "bray", "jaccard", "unifrac")), + ), - conditionalPanel( - condition = "input.bmethod == 'RDA'", + conditionalPanel( + condition = "input.bmethod == 'RDA'", - textInput(inputId = "rda.formula", label = "Formula:", - placeholder = "data ~ var1 + var2 * var3"), - ), + textInput(inputId = "rda.formula", label = "Formula:", + placeholder = "data ~ var1 + var2 * var3"), + ), - numericInput(inputId = "ncomponents", value = 5, - label = "Number of components:", min = 1, step = 1), + numericInput(inputId = "ncomponents", value = 5, + label = "Number of components:", min = 1, step = 1), - textInput(inputId = "beta.name", label = "Name:") + textInput(inputId = "beta.name", label = "Name:") - ) + ) - ), + ), - actionButton("compute", "Compute", class = "btn-success", - style = .actionbutton_biocstyle) + actionButton("compute", "Compute", class = "btn-success", + style = .actionbutton_biocstyle) ))), - fluidRow( - - column(4, wellPanel(id = "visualise.panel", + fluidRow(column(4, wellPanel(id = "visualise.panel", titlePanel("Visualise"), @@ -223,19 +219,19 @@ actionButton("launch", "Launch iSEE", class = "btn-success", style = .actionbutton_biocstyle) - )), + )), - column(8, wellPanel(id = "output.panel", + column(8, wellPanel(id = "output.panel", - titlePanel("Output"), + titlePanel("Output"), - verbatimTextOutput(outputId = "object"), + verbatimTextOutput(outputId = "object"), - downloadButton(outputId = "download", label = "Download", - style = .actionbutton_biocstyle) + downloadButton(outputId = "download", label = "Download", + style = .actionbutton_biocstyle) - ))) - ) + )) + )) }) ## Disable navbar buttons that are not linked to any observer yet diff --git a/R/miaDash.R b/R/miaDash.R index 9c26d58..e57ed22 100644 --- a/R/miaDash.R +++ b/R/miaDash.R @@ -44,6 +44,7 @@ miaDash <- function() { #' @importFrom SingleCellExperiment reducedDims .launch_isee <- function(FUN, initial, session, rObjects) { + # nocov start tse <- rObjects$tse initial <- lapply(initial, function(x) eval(parse(text = paste0(x, "()")))) @@ -68,4 +69,5 @@ miaDash <- function() { enable("iSEE_INTERNAL_citation_info") # citation info invisible(NULL) + # nocov end } \ No newline at end of file diff --git a/R/observers.R b/R/observers.R index 27f306b..814dd9b 100644 --- a/R/observers.R +++ b/R/observers.R @@ -22,6 +22,7 @@ #' @importFrom TreeSummarizedExperiment TreeSummarizedExperiment .create_import_observers <- function(input, rObjects) { + # nocov start observeEvent(input$import, { if( input$format == "dataset" ){ @@ -100,6 +101,7 @@ } }, ignoreInit = TRUE, ignoreNULL = FALSE) + # nocov end invisible(NULL) } @@ -111,6 +113,7 @@ #' transformAssay .create_manipulate_observers <- function(input, rObjects) { + # nocov start observeEvent(input$apply, { if( input$manipulate == "subset" ){ @@ -172,6 +175,7 @@ } }, ignoreInit = TRUE, ignoreNULL = TRUE) + # nocov end invisible(NULL) } @@ -185,6 +189,7 @@ #' @importFrom vegan vegdist .create_estimate_observers <- function(input, rObjects) { + # nocov start observeEvent(input$compute, { if( input$estimate == "alpha" ){ @@ -269,6 +274,7 @@ } }, ignoreInit = TRUE, ignoreNULL = TRUE) + # nocov end invisible(NULL) } @@ -280,6 +286,7 @@ #' @importFrom rintrojs introjs .update_observers <- function(input, session, rObjects){ + # nocov start observe({ if( isS4(rObjects$tse) ){ @@ -311,6 +318,7 @@ introjs(session, options = list(steps = .landing_page_tour)) }, ignoreInit = TRUE) + # nocov end invisible(NULL) } diff --git a/R/outputs.R b/R/outputs.R index ab83a9e..e0fc58a 100644 --- a/R/outputs.R +++ b/R/outputs.R @@ -16,9 +16,11 @@ #' @importFrom shiny renderPrint .render_overview <- function(output, rObjects) { + # nocov start output$object <- renderPrint({ rObjects$tse }) + # nocov end invisible(NULL) } @@ -27,10 +29,12 @@ #' @importFrom shiny downloadHandler .render_download <- function(output, rObjects) { + # nocov start output$download <- downloadHandler( filename = function() paste0("se-", Sys.Date(), ".rds"), content = function(file) saveRDS(rObjects$tse, file) ) + # nocov end invisible(NULL) } \ No newline at end of file diff --git a/R/utils.R b/R/utils.R index b142570..4aed336 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,12 +1,21 @@ -default_panels <- c("RowDataTable", "ColumnDataTable", "RowTreePlot", - "AbundancePlot", "AbundanceDensityPlot", "ReducedDimensionPlot", - "ComplexHeatmapPlot") - -other_panels <- c("LoadingPlot", "ColumnTreePlot", "RDAPlot", "ColumnDataPlot", - "RowDataPlot") +#' Utilities +#' +#' Helper functions and constants to support the app functionality. +#' +#' @name utils +#' @keywords internal -.actionbutton_biocstyle <- "color: #ffffff; background-color: #0092AC; border-color: #2e6da4" +#' @rdname utils +.import_datasets <- function(selection) { + + mia_datasets <- data(package = "mia") + mia_datasets <- mia_datasets$results[selection, "Item"] + data(list = mia_datasets, package = "mia") + + return(mia_datasets) +} +#' @rdname utils #' @importFrom shiny showModal modalDialog .print_message <- function(...){ @@ -17,6 +26,7 @@ other_panels <- c("LoadingPlot", "ColumnTreePlot", "RDAPlot", "ColumnDataPlot", } +#' @rdname utils #' @importFrom SummarizedExperiment colData .check_formula <- function(form, se){ @@ -27,6 +37,7 @@ other_panels <- c("LoadingPlot", "ColumnTreePlot", "RDAPlot", "ColumnDataPlot", return(cond) } +#' @rdname utils #' @importFrom S4Vectors isEmpty #' @importFrom methods is .check_panel <- function(se, panel_list, panel_class, panel_fun, wtext) { @@ -40,4 +51,16 @@ other_panels <- c("LoadingPlot", "ColumnTreePlot", "RDAPlot", "ColumnDataPlot", } return(panel_list) -} \ No newline at end of file +} + +#' @rdname utils +default_panels <- c("RowDataTable", "ColumnDataTable", "RowTreePlot", + "AbundancePlot", "AbundanceDensityPlot", "ReducedDimensionPlot", + "ComplexHeatmapPlot") + +#' @rdname utils +other_panels <- c("LoadingPlot", "ColumnTreePlot", "RDAPlot", "ColumnDataPlot", + "RowDataPlot") + +#' @rdname utils +.actionbutton_biocstyle <- "color: #ffffff; background-color: #0092AC; border-color: #2e6da4" diff --git a/man/utils.Rd b/man/utils.Rd new file mode 100644 index 0000000..57575d5 --- /dev/null +++ b/man/utils.Rd @@ -0,0 +1,40 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\docType{data} +\name{utils} +\alias{utils} +\alias{.import_datasets} +\alias{.print_message} +\alias{.check_formula} +\alias{.check_panel} +\alias{default_panels} +\alias{other_panels} +\alias{.actionbutton_biocstyle} +\title{Utilities} +\format{ +An object of class \code{character} of length 7. + +An object of class \code{character} of length 5. + +An object of class \code{character} of length 1. +} +\usage{ +.import_datasets(selection) + +.print_message(...) + +.check_formula(form, se) + +.check_panel(se, panel_list, panel_class, panel_fun, wtext) + +default_panels + +other_panels + +.actionbutton_biocstyle +} +\description{ +Helper functions and constants to support the app functionality. +} +\keyword{datasets} +\keyword{internal} diff --git a/tests/testthat.R b/tests/testthat.R new file mode 100644 index 0000000..ed3bf8e --- /dev/null +++ b/tests/testthat.R @@ -0,0 +1,12 @@ +# This file is part of the standard setup for testthat. +# It is recommended that you do not modify it. +# +# Where should you do additional test configuration? +# Learn more about the roles of various files in: +# * https://r-pkgs.org/testing-design.html#sec-tests-files-overview +# * https://testthat.r-lib.org/articles/special-files.html + +library(testthat) +library(miaDash) + +test_check("miaDash") diff --git a/tests/testthat/test-observers.R b/tests/testthat/test-observers.R new file mode 100644 index 0000000..b8a4b14 --- /dev/null +++ b/tests/testthat/test-observers.R @@ -0,0 +1,22 @@ +test_that(".create_observers works", { + + input <- new.env() + rObjects <- new.env() + FUN <- function(SE, INITIAL) invisible(NULL) + + import_out <- .create_import_observers(input, rObjects) + expect_null(import_out) + + manipulate_out <- .create_manipulate_observers(input, rObjects) + expect_null(manipulate_out) + + estimate_out <- .create_estimate_observers(input, rObjects) + expect_null(estimate_out) + + update_out <- .update_observers(input, session = NULL, rObjects) + expect_null(update_out) + + launch_out <- .create_launch_observers(FUN, input, session = NULL, rObjects) + expect_null(launch_out) + +}) diff --git a/tests/testthat/test-outputs.R b/tests/testthat/test-outputs.R new file mode 100644 index 0000000..cfd4772 --- /dev/null +++ b/tests/testthat/test-outputs.R @@ -0,0 +1,13 @@ +test_that("outputs", { + + output <- new.env() + rObjects <- new.env() + + overview_out <- .render_overview(output, rObjects) + download_out <- .render_download(output, rObjects) + + expect_null(overview_out) + expect_null(download_out) + expect_named(output, c("object", "download")) + +}) diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R new file mode 100644 index 0000000..b87df3e --- /dev/null +++ b/tests/testthat/test-utils.R @@ -0,0 +1,12 @@ +test_that("utils", { + + data("Tengeler2020", package = "mia") + tse <- Tengeler2020 + + expect_equal(.import_datasets(c(1, 3)), c("GlobalPatterns", "Tengeler2020")) + + expect_true(.check_formula("data ~ patient_status + cohort", tse)) + expect_false(.check_formula("data ~ wrong_var + sample_name", tse)) + + expect_length(.check_panel(tse, c(RowDataTable()), "RowDataTable", rowData), 1) +}) diff --git a/vignettes/miaDash.Rmd b/vignettes/miaDash.Rmd index 6b0db6a..3ecd8e6 100644 --- a/vignettes/miaDash.Rmd +++ b/vignettes/miaDash.Rmd @@ -31,10 +31,21 @@ knitr::opts_chunk$set( # Introduction +The Microbiome Analysis Dashboard (miaDash) aims to make microbiome analysis +accessible to anyone, with or without programming skills. + ## Motivation ## Interface +The interface provides tools to: + +- import from datasets from several file types or practice with a ready-made + mia dataset +- manipulate objects as subsetting, agglomeration and transformation +- estimate alpha and beta diversity +- visualise different aspects with iSEEtree + # Tutorial ## Installation @@ -68,7 +79,8 @@ SCREENSHOT("screenshots/get_started.png", delay = 20) ## Citation -We hope that miaDash will be useful for your research. Please use the following information to cite the package and the overall approach. Thank you! +We hope that miaDash will be useful for your research. Please use the following +information to cite the package and the overall approach. Thank you! ```{r citation} ## Citation info