Add missing files

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()
+}

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())
+})