diff --git a/R/fdata-selection.R b/R/fdata-selection.R new file mode 100644 index 000000000..bcd76f56c --- /dev/null +++ b/R/fdata-selection.R @@ -0,0 +1,108 @@ +##' Select feature variables to be retained. +##' +##' @title Select feature variables of interest +##' +##' @param object An \code{MSnSet}, \code{MSnExp} or \code{OnDiskMSnExp}. +##' +##' @param graphics A \code{logical} (default is \code{TRUE}) +##' indicating whether a shiny application should be used if +##' available. Otherwise, a text menu is used. Ignored if \code{k} +##' is not missing. +##' +##' @param fcol A \code{numeric}, \code{logical} or \code{character} of +##' valid feature variables to be passed directly. +##' +##' @return For \code{selectFeatureData}: updated object containing only +##' selected feature variables. +##' +##' @author Laurent Gatto +##' +##' @examples +##' +##' library("pRolocdata") +##' data(hyperLOPIT2015) +##' ## 5 first feature variables +##' x <- selectFeatureData(hyperLOPIT2015, fcol = 1:5) +##' fvarLabels(x) +##' \dontrun{ +##' ## select via GUI +##' x <- selectFeatureData(hyperLOPIT2015) +##' fvarLabels(x) +##' } +##' +##' ## Subset the feature data of an OnDiskMSnExp object to the minimal +##' ## required columns +##' f <- system.file("microtofq/MM14.mzML", package = "msdata") +##' od <- readMSData(f, mode = "onDisk") +##' +##' ## what columns do we have? +##' fvarLabels(od) +##' +##' ## Reduce the feature data data.frame to the required columns only +##' od <- selectFeatureData(od, fcol = requiredFvarLabels(class(od))) +##' fvarLabels(od) +selectFeatureData <- function(object, + graphics = TRUE, + fcol) { + if (missing(fcol)) { + if (graphics) { + if (!requireNamespace("shiny", quietly = TRUE)) { + warning("The shiny package is required to use the graphical interface.") + fcol <- .selectTextFeatureData(object) + } else + fcol <- .selectShinyFeatureData(object) + } else fcol <- .selectTextFeatureData(object) + } + fData(object) <- fData(object)[, fcol, drop = FALSE] + if (validObject(object)) + object +} + + +.selectTextFeatureData <- function(object) + select.list(fvarLabels(object), multiple=TRUE) + + +.selectShinyFeatureData <- function(object) { + sel <- fv <- fvarLabels(object) + on.exit(return(sel)) + ui <- shiny::fluidPage( + title = 'Examples of DataTables', + shiny::sidebarLayout( + shiny::sidebarPanel( + shiny::actionButton("stop", "Stop app"), + shiny::checkboxGroupInput('vars', 'Feature variables', + as.list(fv), selected = sel)), + shiny::mainPanel(shiny::dataTableOutput('fd')))) + server <- function(input, output) { + shiny::observeEvent(input$stop, { + shiny::stopApp(returnValue = sel) + }) + output$fd <- shiny::renderDataTable({ + sel <<- input$vars + fData(object)[, input$vars, drop = FALSE] + }) + } + app <- list(ui=ui, server=server) + shiny::runApp(app) +} + +#' @rdname selectFeatureData +#' +#' @description `requiredFvarLabels` returns a `character` vector with the +#' required feature data variable names (`fvarLabels`, i.e. the column +#' names in the `fData` `data.frame`) for the specified object. +#' +#' @param x `character(1)` specifying the class name for which the required +#' feature data variable names should be returned. +#' +#' @return For `requiredFvarLabels`: `character` with the required feature +#' variable names. +#' +#' @md +requiredFvarLabels <- function(x = c("OnDiskMSnExp", "MSnExp", "MSnSet")) { + x <- match.arg(x) + if (x == "OnDiskMSnExp") + .MSnExpReqFvarLabels + else character() +} diff --git a/tests/testthat/test_fdata-selection.R b/tests/testthat/test_fdata-selection.R new file mode 100644 index 000000000..5202fb562 --- /dev/null +++ b/tests/testthat/test_fdata-selection.R @@ -0,0 +1,82 @@ +context("fdata-selection") + +test_that("Feature variable selection", { + data(hyperLOPIT2015, package = "pRolocdata") + fv <- fvarLabels(hyperLOPIT2015) + i <- sort(sample(length(fv), 10)) + k <- fv[i] + l <- logical(length(fv)) + l[i] <- TRUE + expect_equal(selectFeatureData(hyperLOPIT2015, fcol = i), + selectFeatureData(hyperLOPIT2015, fcol = k)) + expect_equal(selectFeatureData(hyperLOPIT2015, fcol = i), + selectFeatureData(hyperLOPIT2015, fcol = l)) +}) + +test_that("selectFeatureData,OnDiskMSnExp works", { + on_disk <- tmt_erwinia_on_disk + fvars <- c("fileIdx", "spIdx", "acquisitionNum", "retentionTime", "msLevel", + "precursorScanNum", "centroided") + res <- selectFeatureData(on_disk, fcol = fvars) + expect_equal(fvarLabels(res), fvars) + expect_true(validObject(res)) + sp_full <- on_disk[[3]] + sp_red <- res[[3]] + expect_equal(mz(sp_full), mz(sp_red)) + expect_equal(intensity(sp_full), intensity(sp_red)) + expect_equal(rtime(sp_full), rtime(sp_red)) + expect_equal(acquisitionNum(sp_full), acquisitionNum(sp_red)) + expect_equal(msLevel(sp_full), msLevel(sp_red)) + expect_equal(centroided(sp_full), centroided(sp_red)) + expect_equal(precScanNum(sp_full), precScanNum(sp_red)) + ## Stuff that is no longer set. + expect_true(is.na(tic(sp_red))) + expect_true(!is.na(tic(sp_full))) + expect_true(is.na(polarity(sp_red))) + expect_true(!is.na(polarity(sp_full))) + + ## And for MS1 data + on_disk <- microtofq_on_disk + res <- selectFeatureData(on_disk, fcol = fvars) + expect_equal(fvarLabels(res), fvars) + expect_true(validObject(res)) + sp_full <- on_disk[[3]] + sp_red <- res[[3]] + expect_equal(mz(sp_full), mz(sp_red)) + expect_equal(intensity(sp_full), intensity(sp_red)) + expect_equal(rtime(sp_full), rtime(sp_red)) + expect_equal(acquisitionNum(sp_full), acquisitionNum(sp_red)) + expect_equal(msLevel(sp_full), msLevel(sp_red)) + expect_equal(centroided(sp_full), centroided(sp_red)) + ## Stuff that is no longer set. + expect_true(is.na(tic(sp_red))) + expect_true(!is.na(tic(sp_full))) + expect_true(is.na(polarity(sp_red))) + expect_true(!is.na(polarity(sp_full))) + sp_full <- on_disk[[2]] + sp_red <- res[[2]] + expect_equal(mz(sp_full), mz(sp_red)) + expect_equal(intensity(sp_full), intensity(sp_red)) + expect_equal(rtime(sp_full), rtime(sp_red)) + expect_equal(acquisitionNum(sp_full), acquisitionNum(sp_red)) + expect_equal(msLevel(sp_full), msLevel(sp_red)) + expect_equal(centroided(sp_full), centroided(sp_red)) + ## Stuff that is no longer set. + expect_true(is.na(tic(sp_red))) + expect_true(!is.na(tic(sp_full))) + expect_true(is.na(polarity(sp_red))) + expect_true(!is.na(polarity(sp_full))) +}) + +test_that("selectFeatureData,MSnExp works", { + in_mem <- tmt_erwinia_in_mem_ms1 + ## fData is currently a single column data.frame... +}) + +test_that("requiredFvarLabels works", { + expect_error(requiredFvarLabels(x = "other")) + res <- requiredFvarLabels("OnDiskMSnExp") + expect_equal(res, MSnbase:::.MSnExpReqFvarLabels) + expect_equal(requiredFvarLabels("MSnExp"), character()) + expect_equal(requiredFvarLabels("MSnSet"), character()) +})