diff --git a/R/iSEEindex.R b/R/iSEEindex.R index 6a3d95d..597b3d2 100644 --- a/R/iSEEindex.R +++ b/R/iSEEindex.R @@ -96,6 +96,7 @@ #' info on the versions of the `iSEEindex` and `iSEE` packages. #' @param body.header UI element to display \emph{above} the main landing page body. #' @param body.footer UI element to display \emph{below} the main landing page body. +#' @param already_se_object TODO #' #' @return An [iSEE::iSEE()] app with a custom landing page using a [BiocFileCache()] to cache a selection of data sets. #' @@ -107,17 +108,9 @@ #' @importFrom utils packageVersion #' #' @examples -#' ## -#' # BiocFileCache ---- -#' ## -#' -#' library(BiocFileCache) +#' library("BiocFileCache") #' bfc <- BiocFileCache(cache = tempdir()) #' -#' ## -#' # iSEEindex ---- -#' ## -#' #' dataset_fun <- function() { #' x <- yaml::read_yaml(system.file(package = "iSEEindex", "example.yaml")) #' x$datasets @@ -133,46 +126,18 @@ #' if (interactive()) { #' shiny::runApp(app, port = 1234) #' } -iSEEindex <- function(bfc, FUN.datasets, FUN.initial = NULL, default.add = TRUE, default.position = c("first", "last"), app.title = NULL, body.header = NULL, body.footer = NULL) { - stopifnot(is(bfc, "BiocFileCache")) - if (is.null(FUN.initial)) { - FUN.initial <- function() NULL - } - - if (is.null(app.title)) { - app.title <- sprintf("iSEEindex - v%s | powered by iSEE - v%s", - packageVersion("iSEEindex"), - packageVersion("iSEE")) - } - - iSEE( - landingPage=.landing_page(bfc, FUN.datasets, FUN.initial, default.add, default.position, body.header, body.footer), - appTitle = app.title - ) -} - -#' @examples -#' ## -#' # BiocFileCache ---- -#' ## #' -#' library(BiocFileCache) -#' bfc <- BiocFileCache(cache = tempdir()) -#' -#' ## -#' # iSEEindex ---- -#' ## +#' ## Alternatively, with the example based on using runr calls #' -#' dataset_fun <- function() { +#' dataset_fun_tonsils <- function() { #' x <- yaml::read_yaml( -#' system.file("tonsils_example", "tonsil_package.yml", package = "iSEEindex") +#' system.file("tonsils_example", "tonsil_package.yml", package = "iSEEindex") #' ) #' x$datasets #' } -#' -#' initial_fun <- function() { +#' initial_fun_tonsils <- function() { #' x <- yaml::read_yaml( -#' system.file("tonsils_example", "tonsil_package.yml", package = "iSEEindex") +#' system.file("tonsils_example", "tonsil_package.yml", package = "iSEEindex") #' ) #' x$initial #' } @@ -180,16 +145,13 @@ iSEEindex <- function(bfc, FUN.datasets, FUN.initial = NULL, default.add = TRUE, #' library("shiny") #' header_tonsils <- fluidRow( #' shinydashboard::box( -#' width = 12, -#' collapsible = TRUE, -#' collapsed = TRUE, +#' width = 12, collapsible = TRUE, collapsed = TRUE, #' title = "How to explore the Tonsil Atlas datasets", #' includeMarkdown( #' system.file("tonsils_example", "header_tonsils.md", package = "iSEEindex") #' ) #' ) #' ) -#' #' footer_tonsils <- fluidRow( #' shinydashboard::box( #' width = 12, @@ -199,46 +161,141 @@ iSEEindex <- function(bfc, FUN.datasets, FUN.initial = NULL, default.add = TRUE, #' ) #' ) #' -#' app <- iSEEindex_runr(bfc, dataset_fun, initial_fun, -#' default.add = TRUE, -#' default.position = "last", -#' app.title = "iSEE ❤️ Tonsil Data Atlas", -#' body.header = header_tonsils, -#' body.footer = footer_tonsils) +#' app_tonsils <- iSEEindex(bfc, +#' dataset_fun_tonsils, +#' initial_fun_tonsils, +#' default.add = TRUE, +#' default.position = "last", +#' app.title = "iSEE ❤️ Tonsil Data Atlas", +#' body.header = header_tonsils, +#' body.footer = footer_tonsils, +#' already_se_object = TRUE) #' #' if (interactive()) { -#' shiny::runApp(app, port = 1234) +#' shiny::runApp(app_tonsils, port = 5678) #' } -iSEEindex_runr <- function(bfc, - FUN.datasets, - FUN.initial = NULL, - default.add = TRUE, default.position = c("first", "last"), - app.title = NULL, - body.header = NULL, - body.footer = NULL) { - stopifnot(is(bfc, "BiocFileCache")) - if (is.null(FUN.initial)) { - FUN.initial <- function() NULL - } +iSEEindex <- function(bfc, + FUN.datasets, + FUN.initial = NULL, + default.add = TRUE, + default.position = c("first", "last"), + app.title = NULL, + body.header = NULL, + body.footer = NULL, + already_se_object = FALSE) { + stopifnot(is(bfc, "BiocFileCache")) + if (is.null(FUN.initial)) { + FUN.initial <- function() NULL + } - if (is.null(app.title)) { - app.title <- sprintf("iSEEindex - v%s", - packageVersion("iSEEindex")) - } else { - app.title <- app.title - } + if (is.null(app.title)) { + app.title <- sprintf("iSEEindex - v%s | powered by iSEE - v%s", + packageVersion("iSEEindex"), + packageVersion("iSEE")) + } - iSEE( - landingPage=.landing_page_runr(bfc, - FUN.datasets, - FUN.initial, - default.add, default.position, - body.header, - body.footer), - appTitle = app.title - ) + iSEE( + landingPage = .landing_page(bfc, + FUN.datasets, + FUN.initial, + default.add, + default.position, + body.header, + body.footer, + already_se_object = already_se_object + ), + appTitle = app.title + ) } +#### #' @examples +#### #' ## +#### #' ## +#### #' +#### #' library(BiocFileCache) +#### #' bfc <- BiocFileCache(cache = tempdir()) +#### #' +#### #' ## +#### #' ## +#### #' +#### #' dataset_fun <- function() { +#### #' x <- yaml::read_yaml( +#### #' system.file("tonsils_example", "tonsil_package.yml", package = "iSEEindex") +#### #' ) +#### #' x$datasets +#### #' } +#### #' +#### #' initial_fun <- function() { +#### #' x <- yaml::read_yaml( +#### #' system.file("tonsils_example", "tonsil_package.yml", package = "iSEEindex") +#### #' ) +#### #' x$initial +#### #' } +#### #' +#### #' library("shiny") +#### #' header_tonsils <- fluidRow( +#### #' shinydashboard::box( +#### #' width = 12, +#### #' collapsible = TRUE, +#### #' collapsed = TRUE, +#### #' title = "How to explore the Tonsil Atlas datasets", +#### #' includeMarkdown( +#### #' system.file("tonsils_example", "header_tonsils.md", package = "iSEEindex") +#### #' ) +#### #' ) +#### #' ) +#### #' +#### #' footer_tonsils <- fluidRow( +#### #' shinydashboard::box( +#### #' width = 12, +#### #' includeMarkdown( +#### #' system.file("tonsils_example", "footer_tonsils.md", package = "iSEEindex") +#### #' ) +#### #' ) +#### #' ) +#### #' +#### #' app <- iSEEindex_runr(bfc, dataset_fun, initial_fun, +#### #' default.add = TRUE, +#### #' default.position = "last", +#### #' app.title = "iSEE ❤️ Tonsil Data Atlas", +#### #' body.header = header_tonsils, +#### #' body.footer = footer_tonsils) +#### #' +#### #' if (interactive()) { +#### #' shiny::runApp(app, port = 1234) +#### #' } +#### # iSEEindex_runr <- function(bfc, +#### # FUN.datasets, +#### # FUN.initial = NULL, +#### # default.add = TRUE, +#### # default.position = c("first", "last"), +#### # app.title = NULL, +#### # body.header = NULL, +#### # body.footer = NULL) { +#### # stopifnot(is(bfc, "BiocFileCache")) +#### # if (is.null(FUN.initial)) { +#### # FUN.initial <- function() NULL +#### # } +#### # +#### # if (is.null(app.title)) { +#### # app.title <- sprintf("iSEEindex - v%s", +#### # packageVersion("iSEEindex")) +#### # } else { +#### # app.title <- app.title +#### # } +#### # +#### # iSEE( +#### # landingPage=.landing_page(bfc, +#### # FUN.datasets, +#### # FUN.initial, +#### # default.add, default.position, +#### # body.header, +#### # body.footer, +#### # already_se_object = TRUE), +#### # appTitle = app.title +#### # ) +#### # } + #' Prepare and Launch the Main App. @@ -258,10 +315,11 @@ iSEEindex_runr <- function(bfc, #' #' @param FUN A function to initialize the \pkg{iSEE} observer #' architecture. Refer to [iSEE::createLandingPage()] for more details. -#' @param bfc An [BiocFileCache()] object. +#' @param bfc A [BiocFileCache()] object. #' @param session The Shiny session object from the server function. #' @param pObjects An environment containing global parameters generated in the #' landing page. +#' @param already_se_object TODO propagated #' #' @return A `NULL` value is invisibly returned. #' @@ -273,7 +331,7 @@ iSEEindex_runr <- function(bfc, #' @importFrom shinyjs enable #' #' @rdname INTERNAL_launch_isee -.launch_isee <- function(FUN, bfc, session, pObjects) { +.launch_isee <- function(FUN, bfc, session, pObjects, already_se_object) { # nocov start dataset_id <- pObjects[[.dataset_selected_id]] which_dataset <- which(pObjects$datasets_table[[.datasets_id]] == dataset_id) @@ -284,7 +342,8 @@ iSEEindex_runr <- function(bfc, withProgress(message = sprintf("Loading '%s'", dataset_title), value = 0, max = 2, { incProgress(1, detail = "(Down)loading object") - se2 <- try(.load_sce(bfc, dataset_id, dataset_metadata)) + se2 <- try(.load_sce(bfc, dataset_id, dataset_metadata, + already_se_object = already_se_object)) incProgress(1, detail = "Launching iSEE app") if (is(se2, "try-error")) { showNotification("Invalid SummarizedExperiment supplied.", type="error") @@ -338,70 +397,62 @@ iSEEindex_runr <- function(bfc, -.launch_isee_runr <- function(FUN, bfc, session, pObjects) { - # nocov start - dataset_id <- pObjects[[.dataset_selected_id]] - which_dataset <- which(pObjects$datasets_table[[.datasets_id]] == dataset_id) - # TODO: refactor as function that takes data set identifier and returns uri - dataset_metadata <- as.list(pObjects$datasets_table[which_dataset, , drop=FALSE]) - # TODO: refactor as function that takes data set identifier and returns title - dataset_title <- pObjects$datasets_table[which_dataset, .datasets_title, drop=TRUE] - withProgress(message = sprintf("Loading '%s'", dataset_title), - value = 0, max = 2, { - incProgress(1, detail = "(Down)loading object") - - - # se2 <- try(.load_sce_runr(bfc, dataset_id, dataset_metadata)) - se2 <- try(.load_sce_runr(bfc, dataset_id, dataset_metadata)) - - - - - - incProgress(1, detail = "Launching iSEE app") - if (is(se2, "try-error")) { - showNotification("Invalid SummarizedExperiment supplied.", type="error") - } else { - if (is.null(pObjects$initial_table)) { - initial <- NULL - tour <- NULL - } else { - initial_id <- pObjects[[.ui_initial]] - which_initial <- which( - pObjects$initial_table[[.initial_config_id]] == initial_id & - pObjects$initial_table[[.initial_datasets_id]] == dataset_id - ) - initial_metadata <- as.list(pObjects$initial_table[which_initial, , drop = FALSE]) - initial_message <- capture.output( - init <- try(.parse_initial(bfc, dataset_id, initial_id, initial_metadata)), - type = "message") - initial <- init$initial - tour <- init$tour - } - if (is(init, "try-error")) { - showModal(modalDialog( - title = "Invalid initial state", - p("An error occured while evaluating the script:"), - markdown(paste0(c("```", initial_message, "```"), collapse = "\n")), - p("Contact the app maintainer for further help."), - footer = NULL, - size = "l", - easyClose = TRUE - )) - return(NULL) - } - FUN(SE=se2, INITIAL=initial, TOUR=tour) - shinyjs::enable(iSEE:::.generalOrganizePanels) # organize panels - shinyjs::enable(iSEE:::.generalLinkGraph) # link graph - shinyjs::enable(iSEE:::.generalExportOutput) # export content - shinyjs::enable(iSEE:::.generalCodeTracker) # tracked code - shinyjs::enable(iSEE:::.generalPanelSettings) # panel settings - shinyjs::enable(iSEE:::.generalVignetteOpen) # open vignette - shinyjs::enable(iSEE:::.generalSessionInfo) # session info - shinyjs::enable(iSEE:::.generalCitationInfo) # citation info - } - }, session = session) - - invisible(NULL) - # nocov end -} +# .launch_isee_runr <- function(FUN, bfc, session, pObjects) { +# # nocov start +# dataset_id <- pObjects[[.dataset_selected_id]] +# which_dataset <- which(pObjects$datasets_table[[.datasets_id]] == dataset_id) +# # TODO: refactor as function that takes data set identifier and returns uri +# dataset_metadata <- as.list(pObjects$datasets_table[which_dataset, , drop=FALSE]) +# # TODO: refactor as function that takes data set identifier and returns title +# dataset_title <- pObjects$datasets_table[which_dataset, .datasets_title, drop=TRUE] +# withProgress(message = sprintf("Loading '%s'", dataset_title), +# value = 0, max = 2, { +# incProgress(1, detail = "(Down)loading object") +# se2 <- try(.load_sce(bfc, dataset_id, dataset_metadata, already_se_object = TRUE)) +# incProgress(1, detail = "Launching iSEE app") +# if (is(se2, "try-error")) { +# showNotification("Invalid SummarizedExperiment supplied.", type="error") +# } else { +# if (is.null(pObjects$initial_table)) { +# initial <- NULL +# tour <- NULL +# } else { +# initial_id <- pObjects[[.ui_initial]] +# which_initial <- which( +# pObjects$initial_table[[.initial_config_id]] == initial_id & +# pObjects$initial_table[[.initial_datasets_id]] == dataset_id +# ) +# initial_metadata <- as.list(pObjects$initial_table[which_initial, , drop = FALSE]) +# initial_message <- capture.output( +# init <- try(.parse_initial(bfc, dataset_id, initial_id, initial_metadata)), +# type = "message") +# initial <- init$initial +# tour <- init$tour +# } +# if (is(init, "try-error")) { +# showModal(modalDialog( +# title = "Invalid initial state", +# p("An error occured while evaluating the script:"), +# markdown(paste0(c("```", initial_message, "```"), collapse = "\n")), +# p("Contact the app maintainer for further help."), +# footer = NULL, +# size = "l", +# easyClose = TRUE +# )) +# return(NULL) +# } +# FUN(SE=se2, INITIAL=initial, TOUR=tour) +# shinyjs::enable(iSEE:::.generalOrganizePanels) # organize panels +# shinyjs::enable(iSEE:::.generalLinkGraph) # link graph +# shinyjs::enable(iSEE:::.generalExportOutput) # export content +# shinyjs::enable(iSEE:::.generalCodeTracker) # tracked code +# shinyjs::enable(iSEE:::.generalPanelSettings) # panel settings +# shinyjs::enable(iSEE:::.generalVignetteOpen) # open vignette +# shinyjs::enable(iSEE:::.generalSessionInfo) # session info +# shinyjs::enable(iSEE:::.generalCitationInfo) # citation info +# } +# }, session = session) +# +# invisible(NULL) +# # nocov end +# } diff --git a/R/iSEEindexResource-class.R b/R/iSEEindexResource-class.R index 9ac6559..2c7caf5 100644 --- a/R/iSEEindexResource-class.R +++ b/R/iSEEindexResource-class.R @@ -376,29 +376,21 @@ iSEEindexRunrResource <- function(x) { #' @export setMethod("precache", "iSEEindexRunrResource", - function(x, bfc, id, ...) - { - # Trim 'runr://' from the original URI and evaluate the R call, - # check that the value is an existing filepath and pass to BiocFileCache, - # which will manage the caching. - # Use action="copy" to leave the original file untouched. - call_string <- sub("runr://", "", x@uri) - env <- new.env() - - # fpath not needed per se, we should have a "valid r call and that is it" - - object_path <- eval(parse(text = call_string)) - - - # fpath <- eval(parse(text = call_string), envir = env) - # stopifnot(file.exists(fpath)) - # object_path <- bfcadd(x = bfc, rname = id, fpath = fpath, action = "copy", ...) - + function(x, bfc, id, ...) +{ + # Trim 'runr://' from the original URI and evaluate the R call, + # We expect already that an SE object will be returned + call_string <- sub("runr://", "", x@uri) + # fpath not needed per se, we should have a "valid r call and that is it" + # this time it is called object, as it is already returning that + object <- eval(parse(text = call_string)) + ## "we have to believe" that this is already somehow cached e.g. via + ## Bioc data packages using the cache, and many times it is so - return(object_path) - }) + return(object) +}) diff --git a/R/landing_page.R b/R/landing_page.R index 236261e..a507561 100644 --- a/R/landing_page.R +++ b/R/landing_page.R @@ -11,6 +11,7 @@ #' in the Shiny `selectizeInput()`. #' @param body.header UI element to display \emph{above} the main landing page body. #' @param body.footer UI element to display \emph{below} the main landing page body. +#' @param already_se_object TODO to be propagated #' #' @return A `function` that defines UI elements and observers for the #' landing page of the app. @@ -24,7 +25,14 @@ #' @importFrom shinyjs disable #' #' @rdname INTERNAL_landing_page -.landing_page <- function(bfc, FUN.datasets, FUN.initial, default.add = TRUE, default.position = c("first", "last"), body.header = NULL, body.footer = NULL) { +.landing_page <- function(bfc, + FUN.datasets, + FUN.initial, + default.add = TRUE, + default.position = c("first", "last"), + body.header = NULL, + body.footer = NULL, + already_se_object) { default.position <- match.arg(default.position) # datasets datasets_available_list <- FUN.datasets() @@ -95,7 +103,7 @@ .create_observers(input, session, pObjects, rObjects, FUN.initial, default.add, default.position) - .create_launch_observers(FUN, bfc, input, session, pObjects) + .create_launch_observers(FUN, bfc, input, session, pObjects, already_se_object = already_se_object) .render_datasets_table(output, pObjects, rObjects) @@ -110,91 +118,89 @@ - - -.landing_page_runr <- function(bfc, FUN.datasets, FUN.initial, default.add = TRUE, default.position = c("first", "last"), body.header = NULL, body.footer = NULL) { - default.position <- match.arg(default.position) - # datasets - datasets_available_list <- FUN.datasets() - .check_datasets_list(datasets_available_list) - datasets_available_table <- .datasets_to_dataframe(datasets_available_list) - # initial configurations - initial_available_list <- FUN.initial() - .check_initial_list(initial_available_list) - initial_available_table <- .initial_to_dataframe(initial_available_list, datasets_available_table[[.datasets_id]]) - # landing page function (return value) - function (FUN, input, output, session) { - # nocov start - output$allPanels <- renderUI({ - tagList( - body.header, - fluidRow( - column(width = 7L, - shinydashboard::box(title = "Available Data Sets", - collapsible = FALSE, width = NULL, - selectizeInput(.ui_dataset_columns, label = "Show columns:", - choices = setdiff(colnames(datasets_available_table), c(.datasets_id, .datasets_uri, .datasets_description)), - selected = c(.datasets_title), - multiple = TRUE, - options = list(plugins=list('remove_button', 'drag_drop'))), - DTOutput(.ui_dataset_table) - )), - column(width = 5L, - shinydashboard::tabBox(id = .ui_box_dataset, title = "Selected dataset", - side = "left", - width = NULL, - tabPanel("Info", - uiOutput(.ui_markdown_overview)), - tabPanel("Configure and launch", - fluidRow( - column(width = 10L, - selectizeInput(.ui_initial, label = "Initial settings:", - choices = character(0))), - column(width = 2L, - br(), - actionButton(.ui_launch_button, label="Launch!", - style="color: #ffffff; background-color: #0092AC; border-color: #2e6da4")) - ), - uiOutput(.ui_initial_overview)) - ) - ) - ), - body.footer - ) # tagList - }) # renderUI - - ## Disable navbar buttons that are not linked to any observer yet - shinyjs::disable(iSEE:::.generalOrganizePanels) # organize panels - shinyjs::disable(iSEE:::.generalLinkGraph) # link graph - shinyjs::disable(iSEE:::.generalExportOutput) # export content - shinyjs::disable(iSEE:::.generalCodeTracker) # tracked code - shinyjs::disable(iSEE:::.generalPanelSettings) # panel settings - shinyjs::disable(iSEE:::.generalVignetteOpen) # open vignette - shinyjs::disable(iSEE:::.generalSessionInfo) # session info - shinyjs::disable(iSEE:::.generalCitationInfo) # citation info - - pObjects <- .create_persistent_objects( - datasets_available_table, - initial_available_table) - rObjects <- reactiveValues( - rerender_datasets=1L, - rerender_overview=1L, - rerender_initial=1L) - - .create_observers(input, session, pObjects, rObjects, FUN.initial, default.add, default.position) - - .create_launch_observers_runr(FUN, bfc, input, session, pObjects) - - .render_datasets_table(output, pObjects, rObjects) - - .render_markdown_overview(output, pObjects, rObjects) - - .render_initial_overview(output, pObjects, rObjects) - - invisible(NULL) - # nocov end - } -} +# .landing_page_runr <- function(bfc, FUN.datasets, FUN.initial, default.add = TRUE, default.position = c("first", "last"), body.header = NULL, body.footer = NULL) { +# default.position <- match.arg(default.position) +# # datasets +# datasets_available_list <- FUN.datasets() +# .check_datasets_list(datasets_available_list) +# datasets_available_table <- .datasets_to_dataframe(datasets_available_list) +# # initial configurations +# initial_available_list <- FUN.initial() +# .check_initial_list(initial_available_list) +# initial_available_table <- .initial_to_dataframe(initial_available_list, datasets_available_table[[.datasets_id]]) +# # landing page function (return value) +# function (FUN, input, output, session) { +# # nocov start +# output$allPanels <- renderUI({ +# tagList( +# body.header, +# fluidRow( +# column(width = 7L, +# shinydashboard::box(title = "Available Data Sets", +# collapsible = FALSE, width = NULL, +# selectizeInput(.ui_dataset_columns, label = "Show columns:", +# choices = setdiff(colnames(datasets_available_table), c(.datasets_id, .datasets_uri, .datasets_description)), +# selected = c(.datasets_title), +# multiple = TRUE, +# options = list(plugins=list('remove_button', 'drag_drop'))), +# DTOutput(.ui_dataset_table) +# )), +# column(width = 5L, +# shinydashboard::tabBox(id = .ui_box_dataset, title = "Selected dataset", +# side = "left", +# width = NULL, +# tabPanel("Info", +# uiOutput(.ui_markdown_overview)), +# tabPanel("Configure and launch", +# fluidRow( +# column(width = 10L, +# selectizeInput(.ui_initial, label = "Initial settings:", +# choices = character(0))), +# column(width = 2L, +# br(), +# actionButton(.ui_launch_button, label="Launch!", +# style="color: #ffffff; background-color: #0092AC; border-color: #2e6da4")) +# ), +# uiOutput(.ui_initial_overview)) +# ) +# ) +# ), +# body.footer +# ) # tagList +# }) # renderUI +# +# ## Disable navbar buttons that are not linked to any observer yet +# shinyjs::disable(iSEE:::.generalOrganizePanels) # organize panels +# shinyjs::disable(iSEE:::.generalLinkGraph) # link graph +# shinyjs::disable(iSEE:::.generalExportOutput) # export content +# shinyjs::disable(iSEE:::.generalCodeTracker) # tracked code +# shinyjs::disable(iSEE:::.generalPanelSettings) # panel settings +# shinyjs::disable(iSEE:::.generalVignetteOpen) # open vignette +# shinyjs::disable(iSEE:::.generalSessionInfo) # session info +# shinyjs::disable(iSEE:::.generalCitationInfo) # citation info +# +# pObjects <- .create_persistent_objects( +# datasets_available_table, +# initial_available_table) +# rObjects <- reactiveValues( +# rerender_datasets=1L, +# rerender_overview=1L, +# rerender_initial=1L) +# +# .create_observers(input, session, pObjects, rObjects, FUN.initial, default.add, default.position) +# +# .create_launch_observers(FUN, bfc, input, session, pObjects, already_se_object = TRUE) +# +# .render_datasets_table(output, pObjects, rObjects) +# +# .render_markdown_overview(output, pObjects, rObjects) +# +# .render_initial_overview(output, pObjects, rObjects) +# +# invisible(NULL) +# # nocov end +# } +# } diff --git a/R/observers.R b/R/observers.R index 86eaff8..79e4f12 100644 --- a/R/observers.R +++ b/R/observers.R @@ -65,17 +65,22 @@ #' @param FUN A function to initialize the \pkg{iSEE} observer #' architecture. Refer to [iSEE::createLandingPage()] for more details. +#' #' @param bfc A [BiocFileCache()] object. #' landing page. +#' @param input TODO +#' @param session TODO +#' @param pObjects TODO +#' @param already_se_object TODO #' #' @importFrom shiny observeEvent #' #' @rdname INTERNAL_create_observers -.create_launch_observers <- function(FUN, bfc, input, session, pObjects) { +.create_launch_observers <- function(FUN, bfc, input, session, pObjects, already_se_object) { # nocov start observeEvent(input[[.ui_launch_button]], { - .launch_isee(FUN, bfc, session, pObjects) + .launch_isee(FUN, bfc, session, pObjects, already_se_object = already_se_object) }, ignoreNULL=TRUE, ignoreInit=TRUE) # nocov end @@ -83,15 +88,15 @@ } - -.create_launch_observers_runr <- function(FUN, bfc, input, session, pObjects) { - - # nocov start - observeEvent(input[[.ui_launch_button]], { - .launch_isee_runr(FUN, bfc, session, pObjects) - }, ignoreNULL=TRUE, ignoreInit=TRUE) - # nocov end - - invisible(NULL) -} +# +# .create_launch_observers_runr <- function(FUN, bfc, input, session, pObjects) { +# +# # nocov start +# observeEvent(input[[.ui_launch_button]], { +# .launch_isee(FUN, bfc, session, pObjects, already_se_object = TRUE) +# }, ignoreNULL=TRUE, ignoreInit=TRUE) +# # nocov end +# +# invisible(NULL) +# } diff --git a/R/utils-datasets.R b/R/utils-datasets.R index 59ab4ba..8eced35 100644 --- a/R/utils-datasets.R +++ b/R/utils-datasets.R @@ -8,6 +8,7 @@ #' @param bfc A [BiocFileCache()] object. #' @param id A data set identifier as a character scalar. #' @param metadata Named list of metadata. See individual resource classes for required and optional metadata. +#' @param already_se_object Logical, TODO - shall we default this to FALSE? #' #' @return #' For `.load_sce()`, a [SingleCellExperiment()] object. @@ -28,66 +29,82 @@ #' #' ## Usage --- #' -#' iSEEindex:::.load_sce(bfc, id, metadata) +#' iSEEindex:::.load_sce(bfc, id, metadata, already_se_object = FALSE) #' -.load_sce <- function(bfc, id, metadata) { - bfc_result <- bfcquery(bfc, id, field = "rname", exact = TRUE) - # nocov start - if (nrow(bfc_result) == 0) { - uri_object <- .metadata_to_object(metadata) - object_path <- precache(uri_object, bfc, id) +#' ## Alternatively, using the runr approach +#' id_tonsil <- "demo_load_sce_tonsil" +#' metadata <- list( +#' uri="runr://HCATonsilData::HCATonsilData(assayType = 'RNA', cellType = 'epithelial')" +#' ) +#' iSEEindex:::.load_sce(bfc, id, metadata, already_se_object = TRUE) +.load_sce <- function(bfc, + id, + metadata, + already_se_object) { + if (!already_se_object) { + bfc_result <- bfcquery(bfc, id, field = "rname", exact = TRUE) + # nocov start + if (nrow(bfc_result) == 0) { + uri_object <- .metadata_to_object(metadata) + object_path <- precache(uri_object, bfc, id) + } else { + object_path <- bfc[[bfc_result$rid]] + } + # nocov end + object <- readRDS(object_path) + object <- .convert_to_sce(object) } else { - object_path <- bfc[[bfc_result$rid]] + # if providing directly an SE object, e.g. via data packages... + uri_object <- .metadata_to_object(metadata) + + object <- precache(uri_object, bfc, id) + object <- .convert_to_sce(object) } - # nocov end - object <- readRDS(object_path) - object <- .convert_to_sce(object) object } -#' @examples -#' -#' library(BiocFileCache) -#' bfc <- BiocFileCache(tempdir()) -#' id <- "demo_load_sce_tonsil" -#' metadata <- list(uri="runr://HCATonsilData::HCATonsilData(assayType = 'RNA', cellType = 'epithelial')") -#' -#' ## Usage --- -#' -#' iSEEindex:::.load_sce_runr(bfc, id, metadata) -.load_sce_runr <- function(bfc, id, metadata) { - bfc_result <- bfcquery(bfc, id, field = "rname", exact = TRUE) - # nocov start - # if (nrow(bfc_result) == 0) { - # uri_object <- .metadata_to_object(metadata) - # object_path <- precache(uri_object, bfc, id) - # } else { - # object_path <- bfc[[bfc_result$rid]] - # } - - - uri_object <- .metadata_to_object_runr(metadata) - - object_call <- precache(uri_object, bfc, id) - # if (nrow(bfc_result) == 0) { - # uri_object <- .metadata_to_object(metadata) - # object_path <- precache(uri_object, bfc, id) - # } else { - # object_path <- bfc[[bfc_result$rid]] - # } - - - # nocov end - # object <- readRDS(object_path) - - object <- object_call - - object <- .convert_to_sce(object) - object -} +### #' @examples +### #' +### #' library(BiocFileCache) +### #' bfc <- BiocFileCache(tempdir()) +### #' id <- "demo_load_sce_tonsil" +### #' metadata <- list(uri="runr://HCATonsilData::HCATonsilData(assayType = 'RNA', cellType = 'epithelial')") +### #' +### #' ## Usage --- +### #' +### #' iSEEindex:::.load_sce_runr(bfc, id, metadata) +# .load_sce_runr <- function(bfc, id, metadata) { +# bfc_result <- bfcquery(bfc, id, field = "rname", exact = TRUE) +# # nocov start +# # if (nrow(bfc_result) == 0) { +# # uri_object <- .metadata_to_object(metadata) +# # object_path <- precache(uri_object, bfc, id) +# # } else { +# # object_path <- bfc[[bfc_result$rid]] +# # } +# +# uri_object <- .metadata_to_object(metadata) +# +# object_call <- precache(uri_object, bfc, id) +# # if (nrow(bfc_result) == 0) { +# # uri_object <- .metadata_to_object(metadata) +# # object_path <- precache(uri_object, bfc, id) +# # } else { +# # object_path <- bfc[[bfc_result$rid]] +# # } +# +# +# # nocov end +# # object <- readRDS(object_path) +# +# object <- object_call +# +# object <- .convert_to_sce(object) +# object +# } @@ -135,6 +152,11 @@ #' )) #' iSEEindex:::.metadata_to_object(list(uri="s3://your-bucket/your-prefix/file.rds")) #' iSEEindex:::.metadata_to_object(list(uri="s3://your-bucket/your-prefix/file.rds")) +#' iSEEindex:::.metadata_to_object( +#' list( +#' uri="runr://HCATonsilData::HCATonsilData(assayType = 'RNA', cellType = 'epithelial')" +#' ) +#' ) .metadata_to_object <- function(x) { scheme <- urltools::url_parse(x[[.datasets_uri]])$scheme scheme_titled <- str_to_title(scheme) @@ -152,28 +174,6 @@ } -#' @examples -#' iSEEindex:::.metadata_to_object(list(uri="runr://HCATonsilData::HCATonsilData(assayType = 'RNA', cellType = 'epithelial')")) -.metadata_to_object_runr <- function(x) { - scheme <- urltools::url_parse(x[[.datasets_uri]])$scheme - scheme_titled <- str_to_title(scheme) - target_class <- sprintf("iSEEindex%sResource", scheme_titled) - constructor.FUN <- try({ - get(target_class) - }, silent = TRUE) - if (is(constructor.FUN, "try-error")) { - stop( - sprintf("No constructor function available for scheme '%s'. ", scheme), - sprintf("Consider implementing the constructor function '%s()'.", target_class) - ) - } - constructor.FUN(x) -} - - - - - #' Check Validity of Data Sets Metadata #' diff --git a/man/iSEEindex.Rd b/man/iSEEindex.Rd index e1eb505..f3842e3 100644 --- a/man/iSEEindex.Rd +++ b/man/iSEEindex.Rd @@ -12,7 +12,8 @@ iSEEindex( default.position = c("first", "last"), app.title = NULL, body.header = NULL, - body.footer = NULL + body.footer = NULL, + already_se_object = FALSE ) } \arguments{ @@ -39,6 +40,8 @@ info on the versions of the \code{iSEEindex} and \code{iSEE} packages.} \item{body.header}{UI element to display \emph{above} the main landing page body.} \item{body.footer}{UI element to display \emph{below} the main landing page body.} + +\item{already_se_object}{TODO} } \value{ An \code{\link[iSEE:iSEE]{iSEE::iSEE()}} app with a custom landing page using a \code{\link[=BiocFileCache]{BiocFileCache()}} to cache a selection of data sets. @@ -126,17 +129,9 @@ The individual sub-lists may also contain additional optional named metadata spe } \examples{ -## -# BiocFileCache ---- -## - -library(BiocFileCache) +library("BiocFileCache") bfc <- BiocFileCache(cache = tempdir()) -## -# iSEEindex ---- -## - dataset_fun <- function() { x <- yaml::read_yaml(system.file(package = "iSEEindex", "example.yaml")) x$datasets @@ -152,6 +147,54 @@ app <- iSEEindex(bfc, dataset_fun, initial_fun) if (interactive()) { shiny::runApp(app, port = 1234) } + +## Alternatively, with the example based on using runr calls + +dataset_fun_tonsils <- function() { + x <- yaml::read_yaml( + system.file("tonsils_example", "tonsil_package.yml", package = "iSEEindex") + ) + x$datasets +} +initial_fun_tonsils <- function() { + x <- yaml::read_yaml( + system.file("tonsils_example", "tonsil_package.yml", package = "iSEEindex") + ) + x$initial +} + +library("shiny") +header_tonsils <- fluidRow( + shinydashboard::box( + width = 12, collapsible = TRUE, collapsed = TRUE, + title = "How to explore the Tonsil Atlas datasets", + includeMarkdown( + system.file("tonsils_example", "header_tonsils.md", package = "iSEEindex") + ) + ) +) +footer_tonsils <- fluidRow( + shinydashboard::box( + width = 12, + includeMarkdown( + system.file("tonsils_example", "footer_tonsils.md", package = "iSEEindex") + ) + ) +) + +app_tonsils <- iSEEindex(bfc, + dataset_fun_tonsils, + initial_fun_tonsils, + default.add = TRUE, + default.position = "last", + app.title = "iSEE ❤️ Tonsil Data Atlas", + body.header = header_tonsils, + body.footer = footer_tonsils, + already_se_object = TRUE) + +if (interactive()) { + shiny::runApp(app_tonsils, port = 5678) +} } \author{ Kevin Rue-Albrecht diff --git a/tests/testthat/test-observers.R b/tests/testthat/test-observers.R index 4a3c337..8b04357 100644 --- a/tests/testthat/test-observers.R +++ b/tests/testthat/test-observers.R @@ -19,7 +19,7 @@ test_that(".create_launch_observers works", { pObjects <- new.env() FUN <- function(SE, INITIAL) invisible(NULL) - out <- iSEEindex:::.create_launch_observers(FUN, bfc, input, session = NULL, pObjects) + out <- iSEEindex:::.create_launch_observers(FUN, bfc, input, session = NULL, pObjects, already_se_object = FALSE) expect_null(out) }) diff --git a/tests/testthat/test-utils-datasets.R b/tests/testthat/test-utils-datasets.R index 134a791..3a3514c 100644 --- a/tests/testthat/test-utils-datasets.R +++ b/tests/testthat/test-utils-datasets.R @@ -10,7 +10,7 @@ test_that(".load_sce works", { ## Usage --- - out <- iSEEindex:::.load_sce(bfc, id, metadata) + out <- iSEEindex:::.load_sce(bfc, id, metadata, already_se_object = FALSE) expect_s4_class(out, "SummarizedExperiment") })