R/iSEE-main.R

Defines functions .fill_se_dimnames .create_persistent_objects .define_reservoir .setup_initial_state .prepare_SE .initialize_server iSEE

Documented in iSEE

#' iSEE: interactive SummarizedExperiment Explorer
#'
#' Interactive and reproducible visualization of data contained in a
#' \linkS4class{SummarizedExperiment} object, using a Shiny interface.
#'
#' @param se A \linkS4class{SummarizedExperiment} object, ideally with named assays.
#' If missing, an app is launched with a landing page generated by the \code{landingPage} argument.
#' @param initial A list of \linkS4class{Panel} objects specifying the initial state of the app.
#' The order of panels determines the sequence in which they are laid out in the interface.
#' Defaults to one instance of each panel class available from \pkg{iSEE}.
#' @param extra A list of additional \linkS4class{Panel} objects that might be added after the app has started.
#' Defaults to one instance of each panel class available from \pkg{iSEE}.
#' @param landingPage A function that renders a landing page when \code{iSEE} is started without any specified \code{se}.
#' Ignored if \code{se} is supplied.
#' @param colormap An \linkS4class{ExperimentColorMap} object that defines custom colormaps to apply to individual \code{assays}, \code{colData} and \code{rowData} covariates.
#' @param tour A data.frame with the content of the interactive tour to be displayed after starting up the app.
#' Ignored if \code{se} is not supplied.
#' @param appTitle A string indicating the title to be displayed in the app.
#' If not provided, the app displays the version info of \code{\link{iSEE}}.
#' @param runLocal A logical indicating whether the app is to be run locally or remotely on a server, which determines how documentation will be accessed.
#' @param voice A logical indicating whether the voice recognition should be enabled.
#' @param bugs Set to \code{TRUE} to enable the bugs Easter egg.
#' Alternatively, a named numeric vector control the respective number of each bug type (e.g., \code{c(bugs=3L, spiders=1L)}).
#' @param saveState A function that accepts a single argument containing the current application state and saves it to some appropriate location.
#' @param ... Further arguments to pass to \code{\link{shinyApp}}.
#'
#' @details
#' Configuring the initial state of the app is as easy as passing a list of \linkS4class{Panel} objects to \code{initial}.
#' Each element represents one panel and is typicall constructed with a command like \code{\link{ReducedDimensionPlot}()}.
#' Panels are filled from left to right in a row-wise manner depending on the available width.
#' Each panel can be easily customized by modifying the parameters in each object.
#'
#' The \code{extra} argument should specify \linkS4class{Panel} classes that might not be shown during initialization
#' but can be added interactively by the user after the app has started.
#' The first instance of each new class in \code{extra} will be used as a template when the user adds a new panel of that class.
#' Note that \code{initial} will automatically be appended to \code{extra} to form the final set of available panels,
#' so it is not strictly necessary to re-specify instances of those initial panels in \code{extra}.
#' (unless we want the parameters of newly created panels to be different from those at initialization).
#'
#' @section Setting up a tour:
#' The \code{tour} argument allows users to specify a custom tour to walk their audience through various panels.
#' This is useful for describing different aspects of the dataset and highlighting interesting points in an interactive manner.
#' 
#' We use the format expected by the \code{rintrojs} package - see \url{https://github.com/carlganz/rintrojs#usage} for more information.
#' There should be two columns, \code{element} and \code{intro}, with the former describing the element to highlight and the latter providing some descriptive text. 
#' The \code{\link{defaultTour}} also provides the default tour that is used in the Examples below.
#'
#' @section Creating a landing page:
#' If \code{se} is not supplied, a landing page is generated that allows users to upload their own RDS file to initialize the app.
#' By default, the maximum request size for file uploads defaults to 5MB
#' (\url{https://shiny.rstudio.com/reference/shiny/0.14/shiny-options.html}).
#' To raise the limit (e.g., 50MB), run \code{options(shiny.maxRequestSize=50*1024^2)}.
#' 
#' The \code{landingPage} argument can be used to alter the landing page, see \code{\link{createLandingPage}} for more details.
#' This is useful for creating front-ends that can retrieve \linkS4class{SummarizedExperiment}s from a database on demand for interactive visualization.
#'
#' @section Saving application state:
#' If users want to record the application state, they can download an RDS file containing a list with the entries:
#' \itemize{
#' \item \code{memory}, a list of \linkS4class{Panel} objects containing the current state of the application.
#' This can be directly re-used as the \code{initial} argument in a subsequent \code{\link{iSEE}} call.
#' \item \code{se}, the \linkS4class{SummarizedExperiment} object of interest.
#' This is optional and may not be present in the list, depending on the user specifications.
#' \item \code{colormap}, the \linkS4class{ExperimentColorMap} object being used.
#' This is optional and may not be present in the list, depending on the user specifications.
#' }
#' 
#' We can also provide a custom function in \code{saveState} that accepts a single argument containing this list.
#' This is most useful when \code{\link{iSEE}} is deployed in an enterprise environment where sessions can be saved in a persistent location;
#' combined with a suitable \code{landingPage} specification, this allows users to easily reload sessions of interest.
#' The idea is very similar to Shiny bookmarks but is more customizable and can be used in conjunction with URL-based bookmarking.
#'
#' @return A Shiny app object is returned for interactive data exploration of \code{se},
#' either by simply printing the object or by explicitly running it with \code{\link{runApp}}.
#'
#' @references
#' Rue-Albrecht K, Marini F, Soneson C, Lun ATL.
#' iSEE: Interactive SummarizedExperiment Explorer
#' \emph{F1000Research} 7.
#'
#' Javascript code for \code{bugs} was based on \url{https://github.com/Auz/Bug}.
#'
#' @examples
#' library(scRNAseq)
#'
#' # Example data ----
#' sce <- ReprocessedAllenData(assays="tophat_counts")
#' class(sce)
#'
#' library(scater)
#' sce <- logNormCounts(sce, exprs_values="tophat_counts")
#'
#' sce <- runPCA(sce, ncomponents=4)
#' sce <- runTSNE(sce)
#' rowData(sce)$ave_count <- rowMeans(assay(sce, "tophat_counts"))
#' rowData(sce)$n_cells <- rowSums(assay(sce, "tophat_counts") > 0)
#' sce
#'
#' # launch the app itself ----
#'
#' app <- iSEE(sce)
#' if (interactive()) {
#'   shiny::runApp(app, port=1234)
#' }
#'
#' @export
#' @importFrom shinydashboard dashboardBody dashboardHeader dashboardPage
#' dashboardSidebar menuItem tabBox valueBox valueBoxOutput dropdownMenu 
#' notificationItem
#' @importFrom utils packageVersion
#' @importFrom shinyjs useShinyjs
#' @importFrom rintrojs introjsUI
#' @importFrom shiny reactiveValues uiOutput actionButton shinyApp
#' HTML icon tags includeCSS isolate showNotification onStop
iSEE <- function(se,
    initial=NULL,
    extra=NULL,
    colormap=ExperimentColorMap(),
    landingPage=createLandingPage(),
    tour=NULL,
    appTitle=NULL,
    runLocal=TRUE,
    voice=FALSE,
    bugs=FALSE,
    saveState=NULL,
    ...)
{
    # Save the original name of the input object for renaming in the tracker
    if (has_se <- !missing(se)) {
        se_name <- deparse(substitute(se))
    } else {
        se_name <- "se"
    }
    ecm_name <- deparse(substitute(colormap))

    if (is.null(initial) || is.null(extra)) {
        all_defaults <- list(
            ReducedDimensionPlot(), 
            RowDataTable(), 
            FeatureAssayPlot(), 
            ColumnDataPlot(),
            RowDataPlot(), 
            SampleAssayPlot(), 
            ColumnDataTable(), 
            ComplexHeatmapPlot()
        )

        if (is.null(initial)) {
            initial <- all_defaults
        }
        if (is.null(extra)) {
            extra <- all_defaults
        }
    }

    #######################################################################
    ## UI definition. ----
    #######################################################################

    iSEE_ui <- dashboardPage(
        dashboardHeader(
            title = ifelse(is.null(appTitle),
                   paste0("iSEE - interactive SummarizedExperiment Explorer v", packageVersion("iSEE")),
                   appTitle),
            titleWidth = 750,
            dropdownMenu(type = "tasks",
                icon = icon("object-group fa-1g"),
                badgeStatus = NULL,
                headerText = "Organization",
                notificationItem(
                    text = actionButton(
                        .generalOrganizePanels,
                        label="Organize panels",
                        icon = icon("object-ungroup"),
                        style=.actionbutton_biocstyle
                    ),
                    icon = icon(""), status = "primary"
                ),
                notificationItem(
                    text=actionButton(
                        .generalLinkGraph,
                        label="Examine panel chart",
                        icon=icon("chain"),
                        style=.actionbutton_biocstyle
                    ),
                    icon=icon(""), status="primary"
                )
            ),

            dropdownMenu(type = "tasks",
                icon = icon("download fa-1g"),
                badgeStatus = NULL,
                headerText = "Export",

                notificationItem(
                    text=actionButton(
                        .generalExportOutput,
                        label="Download panel output",
                        icon=icon("download"),
                        style=.actionbutton_biocstyle
                    ),
                    icon=icon(""), status="primary"
                ),
                notificationItem(
                    text=actionButton(
                        .generalTrackedCode,
                        label="Extract the R code",
                        icon=icon("magic"),
                        style=.actionbutton_biocstyle
                    ),
                    icon=icon(""), status="primary"
                ),
                notificationItem(
                    text=actionButton(
                        .generalPanelSettings,
                        label="Display panel settings",
                        icon=icon("clipboard"),
                        style=.actionbutton_biocstyle
                    ),
                    icon=icon(""), status="primary"
                )
            ), # end of dropdownMenu

            dropdownMenu(type="tasks",
                icon=icon("question-circle fa-1g"),
                badgeStatus=NULL,
                headerText="Documentation",
                notificationItem(
                    text=actionButton(
                        .generalTourSteps,
                        "Click me for a quick tour",
                        icon("hand-o-right"),
                        style=.actionbutton_biocstyle
                    ),
                    icon=icon(""), # tricking it to not have additional icon
                    status="primary"
                ),
                notificationItem(
                    text=actionButton(
                        .generalVignetteOpen,
                        label="Open the vignette",
                        icon=icon("book"),
                        style=.actionbutton_biocstyle,
                        onclick=ifelse(runLocal, "",
                            # Use web vignette, with varying paths depending on whether we're release or devel.
                            sprintf("window.open('http://bioconductor.org/packages/%s/bioc/vignettes/iSEE/inst/doc/basic.html', '_blank')",
                                ifelse(unlist(packageVersion("iSEE"))[2] %% 2L==0L, "release", "devel")
                            )
                        )
                    ),
                    icon=icon(""), status="primary"
                )
            ),

            dropdownMenu(type="tasks",
                icon=icon("info fa-1g"),
                badgeStatus=NULL,
                headerText="Additional information",
                notificationItem(
                    text=actionButton(
                        .generalSessionInfo,
                        label="About this session",
                        icon=icon("window-maximize"),
                        style=.actionbutton_biocstyle
                    ),
                    icon=icon(""), status="primary"
                ),
                notificationItem(
                    text=actionButton(
                        .generalCitationInfo,
                        label="About iSEE",
                        icon=icon("heart"),
                        style=.actionbutton_biocstyle
                    ),
                    icon=icon(""), status="primary"
                )
            ) # end of dropdownMenu
        ), # end of dashboardHeader

        dashboardSidebar(disable=TRUE),

        dashboardBody(
            includeCSS(system.file(package="iSEE", "www", "iSEE.css")),
            useShinyjs(),
            prepareSpeechRecognition(voice),
            .prepareBugsEasterEgg(bugs),
            introjsUI(), # must be included in UI

            # for error message handling
            tags$head(
                tags$style(id="iSEE-styles",
                    HTML(".shiny-output-error-validation {
    font-size: 15px;
    color: forestgreen;
    text-align: center;
}
")
                )
            ),

            uiOutput("allPanels")
        ), # end of dashboardBody
        skin="black"
    ) # end of dashboardPage

    #######################################################################
    ## Server definition. ----
    #######################################################################

    #nocov start
    iSEE_server <- function(input, output, session) {
        rObjects <- reactiveValues(rerender=1L, rerendered=1L, modified=list())

        if (!has_se) {
            FUN <- function(SE, INITIAL, TOUR=NULL) {
                if (is.null(INITIAL)) {
                    INITIAL <- initial
                } 
                .initialize_server(SE, initial=INITIAL, extra=extra, colormap=colormap,
                    tour=TOUR, runLocal=runLocal, se_name=se_name, ecm_name=ecm_name, saveState=saveState,
                    input=input, output=output, session=session, rObjects=rObjects)
                rObjects$rerendered <- .increment_counter(isolate(rObjects$rerendered))
            }
            landingPage(FUN, input=input, output=output, session=session)
        } else {
            .initialize_server(se, initial=initial, extra=extra, colormap=colormap,
                tour=tour, runLocal=runLocal, se_name=se_name, ecm_name=ecm_name, saveState=saveState,
                input=input, output=output, session=session, rObjects=rObjects)
        }
    } # end of iSEE_server
    #nocov end

    #######################################################################
    # Launching the app.
    #######################################################################

    shinyApp(ui=function(request) iSEE_ui, server=iSEE_server, 

        # Turning off validity checks in the classes for speed,
        # given that we should internally guarantee correctness anyway.
        onStart=function() {
            # nocov start
            old <- iSEEOptions$get(".check.validity")
            iSEEOptions$set(.check.validity=FALSE)
            onStop(function() iSEEOptions$set(.check.validity=old))
            # nocov end
        },

        # Enable bookmarking to be turned off, if so desired.
        ...)
}

#' Server-side initialization of the app
#'
#' This function defines the bulk of the server function used in \code{\link{shinyApp}}.
#' We roll it out into a separate function so that it can be run either immediately on the \code{\link{iSEE}} call
#' or upon user interaction with the landing page.
#'
#' @inheritParams iSEE
#' @param se_name String containing the variable name of the SummarizedExperiment object.
#' @param ecm_name String containing the variable name of the ExperimentColorMap object.
#' @param input,output,session The typical Shiny objects to be used in various reactive expressions.
#' @param rObjects A list of reactive variables used throughout the app.
#'
#' @return
#' Observers and reactive expressions for all app elements are defined.
#'
#' @author Aaron Lun
#'
#' @rdname INTERNAL_initialize_server
#' @importFrom shiny showNotification tagList HTML strong br code insertUI
.initialize_server <- function(se, initial, extra, colormap,
    tour, runLocal, se_name, ecm_name, saveState, 
    input, output, session, rObjects)
{
    # nocov start
    if (grepl("[[:digit:]]+-12-06", Sys.Date())) {
        showNotification(ui=HTML(paste0(
            "<p style='font-size:500%; text-align:center;'>&#x1F382;</p>",
            "<p style='font-size:200%; text-align:center;'>Happy Birthday <code>iSEE</code>!</p>", collapse = "")),
            type="default", duration = NULL)
    }

    dn_out <- .fill_se_dimnames(se)
    se <- dn_out$se
    mod_commands <- dn_out$commands

    # Display an error notifications if colormap is not compatible with se
    # Display one warning notification for each incompatibility issue
    errors <- checkColormapCompatibility(colormap, se)
    if (!is.null(errors)){
        colormap <- ExperimentColorMap()
        # Show unknown number of errors first, as they may be pushed out of screen
        for (i in seq_along(errors)) {
            ui_msg <- tagList(strong("Compatibility error:"), errors[i], ".")
            showNotification(ui=ui_msg, type="error", duration=10)
        }
        # Show overall warning last, so that it is visible at the bottom of the screen
        ui_msg <- tagList(
            strong("Invalid colormap:"), br(),
            "Reverting to default", code("ExperimentColorMap()"), "."
        )
        showNotification(ui=ui_msg, type="warning", duration=10)
    }

    # Preparing app state variables.
    se <- .prepare_SE(se, colormap, c(initial, extra))

    init_out <- .setup_initial_state(se, initial)
    memory <- init_out$memory
    counter <- init_out$counter

    res_out <- .define_reservoir(se, extra, memory, counter)
    reservoir <- res_out$reservoir
    counter <- res_out$counter

    # Validating the multiple selection sources to avoid invalid app state
    # downstream. We also clean out the selection sources in the reservoir,
    # given that there is no guarantee that the panel is still present. 
    all_names <- vapply(memory, .getEncodedName, "")
    multi_sources <- .get_selection_sources(memory, all_names)

    for (x in seq_along(memory)) {
        if (!memory[[x]][[.selectRowSource]] %in% multi_sources$row) {
            memory[[x]][[.selectRowSource]] <- .noSelection
        }
        if (!memory[[x]][[.selectColSource]] %in% multi_sources$column) {
            memory[[x]][[.selectColSource]] <- .noSelection
        }
    }

    for (r in seq_along(reservoir)) {
        reservoir[[r]][[.selectRowSource]] <- .noSelection
        reservoir[[r]][[.selectColSource]] <- .noSelection
    }

    pObjects <- .create_persistent_objects(memory, reservoir, counter)

    # Adding CSS classes for all boxes.
    class.def <- .define_box_statuses(c(memory, reservoir))
    insertUI("#iSEE-styles", where="beforeEnd", HTML(class.def), immediate=TRUE)

    # Evaluating certain plots to fill the coordinate list, if there are any
    # multiple selections. This is done in topological order so that all
    # dependencies between panels are satisfied, allowing downstream observers
    # to render any panel in a valid state.

    eval_order <- .establish_eval_order(pObjects$selection_links)
    eval_extra <- .has_child(pObjects$aesthetics_links)
    eval_order <- union(eval_order, eval_extra)

    for (panel_name in eval_order) {
        p.out <- .generateOutput(pObjects$memory[[panel_name]], se,
            all_memory=pObjects$memory, all_contents=pObjects$contents)
        pObjects$contents[[panel_name]] <- p.out$contents
    }

    # Observer set-up.
    .create_general_observers(se, runLocal=runLocal, se_name=se_name, ecm_name=ecm_name, 
        mod_commands=mod_commands, saveState=saveState, 
        input=input, session=session, pObjects=pObjects, rObjects=rObjects)

    .create_tour_observer(se, memory=pObjects$memory, tour=tour, input=input, session=session)

    .create_organization_observers(se=se, input=input, output=output, session=session,
        pObjects=pObjects, rObjects=rObjects)

    .create_child_propagation_observer(se, session=session, pObjects=pObjects, rObjects=rObjects)

    for (idx in seq_along(pObjects$memory)) {
        instance <- pObjects$memory[[idx]]
        .createObservers(instance, se=se, input=input,
            session=session, pObjects=pObjects, rObjects=rObjects)
        .renderOutput(instance, se=se,
            output=output, pObjects=pObjects, rObjects=rObjects)
    }

   .create_voice_observers(input, output, session, se, pObjects, rObjects)

   .create_general_output(se, input, output, session, pObjects, rObjects)

   invisible(NULL)
   # nocov end
}

#' Prepare the SummarizedExperiment
#'
#' Stores useful information in the \linkS4class{SummarizedExperiment}'s metadata by calling \code{\link{.cacheCommonInfo}}.
#' Also stuffs the \linkS4class{ExperimentColorMap} in there.
#'
#' @param se A SummarizedExperiment object containing the current dataset.
#' @param colormap An ExperimentColorMap object.
#' @param available A list of all available \linkS4class{Panel} objects that might be used in the app.
#'
#' @return A modified \code{se} with extra information in its \code{\link{metadata}}.
#'
#' @author Aaron Lun
#'
#' @rdname INTERNAL_prepare_SE
#' @importFrom S4Vectors metadata metadata<-
.prepare_SE <- function(se, colormap, available) {
    se <- .set_colormap(se, colormap)
    for (entry in available) {
        se <- .cacheCommonInfo(entry, se)
    }
    se
}

#' Set up the initial app state
#'
#' Set up the initial memory of the application by calling \code{\link{.refineParameters}} and removing invalid panels;
#' also filling in the \code{PanelId} slot for each panel that does not have it set to a positive integer.
#'
#' @param se A \linkS4class{SummarizedExperiment} object after running \code{\link{.prepare_SE}}.
#' @param initial A list of \linkS4class{Panel} objects representing the requested initial state of the application.
#'
#' @return
#' A list containing \code{memory}, a list of \linkS4class{Panel}s that is ready for use as the initial state;
#' and \code{counter}, an integer vector of the current ID counter for each Panel class.
#'
#' @author Aaron Lun
#'
#' @rdname INTERNAL_setup_initial_state
.setup_initial_state <- function(se, initial) {
    # Refining the initial panels.
    for (idx in seq_along(initial)) {
        initial[idx] <- list(.refineParameters(initial[[idx]], se))
    }
    memory <- initial[!vapply(initial, is.null, TRUE)]

    # Assigning names and IDs to each panel.
    all_modes <- vapply(memory, .encodedName, "")
    all_ids <- vapply(memory, "[[", i=.organizationId, 0L)
    by_mode <- split(all_ids, all_modes)
    counter <- vapply(by_mode, function(x) max(c(0L, x), na.rm=TRUE), 0L)

    for (idx in seq_along(memory)) {
        instance <- memory[[idx]]
        curid <- instance[[.organizationId]]
        if (is.na(curid)) {
            nm <- .encodedName(instance)
            curid <- counter[nm] + 1L
            memory[[idx]][[.organizationId]] <- curid
            counter[nm] <- curid
        }
    }

    all_names <- vapply(memory, .getEncodedName, "")
    if (dup <- anyDuplicated(all_names)) {
        stop("panels of same class with duplicated IDs '", all_names[dup], "'")
    }
    names(memory) <- all_names

    list(memory=memory, counter=counter)
}

#' Define the reservoir of available Panels
#'
#' Define a reservoir of available \linkS4class{Panel} classes that can be added interactively by the user.
#'
#' @param se A \linkS4class{SummarizedExperiment} object after running \code{\link{.prepare_SE}}.
#' @param extra A list of \linkS4class{Panel} instances representing the classes that can be added.
#' @param memory A list of \linkS4class{Panel} instances representing the initial app state,
#' generated by \code{\link{.setup_initial_state}}.
#' @param counter An integer vector of the ID counter for each Panel class,
#' generated by \code{\link{.setup_initial_state}}.
#'
#' @author Aaron Lun
#'
#' @return
#' A list containing \code{reservoir}, a list of Panels with one representative instance of each class that can be added;
#' and \code{counter}, an updated version of the input \code{counter} with entries added for new classes in \code{extra}.
#'
#' @rdname INTERNAL_define_reservoir
.define_reservoir <- function(se, extra, memory, counter) {
    # Adding a reservoir of extra panel classes.
    for (idx in seq_along(extra)) {
        extra[idx] <- list(.refineParameters(extra[[idx]], se))
    }
    extra <- extra[!vapply(extra, is.null, TRUE)]

    extra_enc <- vapply(extra, .encodedName, "")
    leftovers <- setdiff(extra_enc, names(counter))
    empty <- integer(length(leftovers))
    names(empty) <- leftovers
    counter <- c(counter, empty)

    reservoir <- c(extra, memory)
    res_names <- c(extra_enc, vapply(memory, .encodedName, ""))
    res_nondup <- !duplicated(res_names)
    reservoir <- reservoir[res_nondup]
    names(reservoir) <- res_names[res_nondup]

    list(reservoir=reservoir, counter=counter)
}

#' Create persistent objects
#'
#' Create global persistent objects in an environment that provides pass-by-reference behavior throughout the application.
#'
#' @param memory A list of \linkS4class{Panel}s produced by \code{\link{.setup_initial_state}}.
#' @param reservoir A list of \linkS4class{Panel}s produced by \code{\link{.define_reservoir}}.
#' @param counter An integer vector produced by \code{\link{.define_reservoir}}.
#'
#' @return
#' An environment containing several global variables for use throughout the application.
#'
#' @details
#' The following objects are created:
#' \itemize{
#' \item \code{memory}, a list of Panels representing the current state of the application at any point in time.
#' This may be modified by observers throughout the lifetime of the app.
#' \item \code{reservoir}, a list of Panels representing the available classes that can be added interactively by the user.
#' This should not change throughout the lifetime of the app.
#' \item \code{counter}, an integer vector specifying the largest ID for each class.
#' This will be incremented every time a user adds an instance of that class.
#' \item \code{commands}, a list of lists of character vectors.
#' Each internal list corresponds to a Panel and contains the R commands necessary to produce its output.
#' \item \code{cached}, a list of the panel-specific outputs of \code{\link{.generateOutput}}.
#' This is filled by the observer in \code{\link{.create_child_propagation_observer}}
#' and used by \code{\link{.retrieveOutput}}, usually in \code{\link{.renderOutput}}'s rendering expression.
#' \item \code{contents}, a list of panel-specific contents.
#' This is filled by \code{\link{.create_child_propagation_observer}} and is pulled out by each panel's children.
#' Values are used to cross-reference with that panel's multiple selection structure to determine which points were selected.
#' \item \code{varname}, a list of strings indicating which variable in a panel's \code{commands} represents that panel's \code{contents}.
#' This is used within \code{\link{.track_it_all}} to ensure that the reported code makes sense.
#' \item \code{selection_links}, a \link{graph} containing the links between panels due to transmitted multiple selections.
#' This is constructed by \code{\link{.spawn_multi_selection_graph}} and can be modified by \code{\link{.choose_new_parent}}.
#' \item \code{aesthetics_links}, a \link{graph} containing the links between panels due to transmitted single selections.
#' This is constructed by \code{\link{.spawn_single_selection_graph}} and can be modified by \code{\link{.choose_new_parent}}.
#' \item \code{dynamic_multi_selections}, a list containing the panels participating in the dynamic multiple selection scheme.
#' This is constructed by \code{\link{.spawn_dynamic_multi_selection_list}}.
#' \item \code{dynamic_single_selections}, a list containing the panels participating in the dynamic single selection scheme.
#' This is constructed by \code{\link{.spawn_dynamic_single_selection_list}}.
#' }
#'
#' @author Aaron Lun
#' @rdname INTERNAL_create_persistent_objects
.create_persistent_objects <- function(memory, reservoir, counter) {
    pObjects <- new.env()
    pObjects$memory <- memory
    pObjects$reservoir <- reservoir
    pObjects$counter <- counter

    pObjects$commands <- list()
    pObjects$cached <- list()
    pObjects$contents <- list()
    pObjects$varname <- list()

    pObjects$aesthetics_links <- .spawn_single_selection_graph(memory)
    pObjects$selection_links <- .spawn_multi_selection_graph(memory)

    pObjects$dynamic_multi_selections <- .spawn_dynamic_multi_selection_list(memory)
    pObjects$dynamic_single_selections <- .spawn_dynamic_single_selection_list(memory)

    pObjects[[.voiceActivePanel]] <- NA_character_

    pObjects
}

#' Fill SummarizedExperiment dimnames
#'
#' Fill the dimension names of the SummarizedExperiment object,
#' as the app assumes that rows and columns are named for setting up the UI.
#'
#' @param se The \linkS4class{SummarizedExperiment} object.
#'
#' @return A list of length 2 containing \code{se}, the dimnamed SummarizedExperiment object,
#' and \code{commands}, a character vector of R commands required to create names.
#'
#' @author Aaron Lun
#'
#' @rdname INTERNAL_fill_se_dimnames
.fill_se_dimnames <- function(se) {
    cmds <- character(0)
    if (is.null(rownames(se))) {
        cmds <- c(cmds, "rownames(se) <- seq_len(nrow(se));")
    } 
    if (is.null(colnames(se))) {
        cmds <- c(cmds, "colnames(se) <- seq_len(ncol(se));")
    }
    env <- new.env()
    env$se <- se
    eval(parse(text=cmds), envir=env)
    list(se=env$se, commands=cmds)
}

Try the iSEE package in your browser

Any scripts or data that you put into this service are public.

iSEE documentation built on Feb. 3, 2021, 2:01 a.m.