diff --git a/DESCRIPTION b/DESCRIPTION index 669a8d2..1dd03bf 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,10 +1,11 @@ Package: FacileIncubator Type: Package Title: Incubator for half-baked ideas -Version: 0.0.8 +Version: 0.0.9 Authors@R: c( person("Steve", "Lianoglou", , "lianoglou@dnli.com", c("aut", "cre"), comment = c(ORCID = "0000-0002-0924-1754")), + person("Jonathan", "Carroll", email = "rpkg@jcarroll.com.au", role = c("ctb"), comment = c(ORCID = "0000-0002-1404-5264")), person("Denali Therapeutics", role = c("cph", "fnd"))) Description: This is a safe place to develop half-baked ideas that are surely destined for greatness someday. diff --git a/inst/shiny/sandbox/server.R b/inst/shiny/sandbox/server.R new file mode 100644 index 0000000..abb13be --- /dev/null +++ b/inst/shiny/sandbox/server.R @@ -0,0 +1,191 @@ +library(shiny) + +# https://github.com/Appsilon/dynamic-shiny-modules/blob/3b05aad99f633103788b62a94d8ed198ce4b977b/after.R +remove_shiny_inputs <- function(id, .input) { + invisible( + lapply(grep(id, names(.input), value = TRUE), function(i) { + .subset2(.input, "impl")$.values$remove(i) + }) + ) +} + +remove_observers <- function(id, .session) { + invisible( + lapply(grep(paste0(id, "_observer"), names(.session$userData), value = TRUE), + function(i) { + .subset2(.session$userData, i)$destroy() + }) + ) +} + +module_UI <- function(id, ui) { + ns <- NS(id) + div(id = id, ui) +} + +shinyServer(function(input, output, session) { + + module_stack <- reactiveVal(NULL) + results_stack <- reactiveVal( + tibble::tibble( + id = character(), + analysis = character(), + result = list() + ) + ) + + observe({ + shinyjs::disable("remove_module") + }) + + ## UI only works with debug = TRUE for some reason (!) + debug <- TRUE + bs4dash <- getOption("facile.bs4dash") + options(facile.bs4dash = FALSE) + on.exit(options(facile.bs4dash = bs4dash)) + + x <- eventReactive(input$dataset, { + switch(req(input$dataset), + "TCGA" = FacileData:::exampleFacileDataSet(), + results_stack()[results_stack()$id == input$dataset, "result", drop = TRUE][[1]] + ) + }) + + analysisModule <- reactive({ + switch(req(input$analysis), + "filter" = FacileShine::filteredReactiveFacileDataStore, + "fdge" = FacileAnalysis::fdgeAnalysis, + "fpca" = FacileAnalysis::fpcaAnalysis, + "ffsea" = FacileAnalysis::ffseaAnalysis, + NULL + ) + }) + + analysisUI <- reactive({ + switch(req(input$analysis), + "filter" = FacileShine::filteredReactiveFacileDataStoreUI, + "fdge" = FacileAnalysis::fdgeAnalysisUI, + "fpca" = FacileAnalysis::fpcaAnalysisUI, + "ffsea" = FacileAnalysis::ffseaAnalysisUI, + NULL + ) + }) + + observeEvent(input$add_module, { + req(input$analysis != "none") + + # store the id of the newly added module using the + # value of the actionButton to make it unique + module_id <- paste0("id_", input$add_module) + if (debug) print(paste0("this module is ", module_id)) + module_stack(c(module_id, module_stack())) + + ui_with_id <- module_UI( + module_id, + tagList( + analysisUI()("analysis", debug = debug) + ) + ) + + ## NOTE: immediate = TRUE is necessary! + insertUI("#gadget_container", "afterEnd", ui_with_id, immediate = TRUE) + + shinyjs::disable("add_module") + shinyjs::enable("remove_module") + + isolate(module_res()) + }) + + observeEvent(input$remove_module, { + if (NROW(req(module_stack())) > 0) { + if (debug) { + print(paste0("removing module ", module_stack()[1])) + } + removeUI(paste0("#", module_stack()[1])) + } + remove_shiny_inputs(module_stack()[1], input) + remove_observers(module_stack()[1], session) + module_stack(module_stack()[-1]) + + shinyjs::enable("add_module") + shinyjs::disable("remove_module") + }) + + ## this logic should be isolated into a function + rfds <- reactive({ + req(input$dataset) + req(input$analysis != "none") + + .x <- x() + fds. <- FacileData::fds(.x) + + if (is(fds., "BoxedFacileDataStore")) { + samples. <- FacileShine::active_samples(.x) + } else { + samples. <- FacileData::samples(.x) + } + samples. <- dplyr::collect(samples., n= Inf) + + checkmate::assert_class(fds., "FacileDataStore") + checkmate::assert_class(samples., "facile_frame") + + FacileShine::ReactiveFacileDataStore(fds., "analysis", samples = samples., debug = debug) + }) + + module_res <- reactive({ + if (req(input$analysis) == "filter") { + rfds() + } else { + callModule(analysisModule(), + id = "analysis", + rfds = rfds(), + aresult = x(), + gdb = reactive({sparrow::exampleGeneSetDb()}), + path= reactive(rfds()[["parent.dir"]]), + debug = debug + ) + } + }) + + observeEvent(input$add_module, { + input$dataset + req(input$analysis != "none") + module_res() + }) + + observeEvent(input$remove_module, { + + if (is(req(module_res()), "ReactiveFacileDataStore")) { + res <- module_res() + } else { + res <- FacileAnalysis::faro(module_res()) + } + + results_stack( + rbind( + results_stack(), + tibble::tibble( + id = paste0("result_", input$add_module), + analysis = input$analysis, + result = list(res) + ) + ) + ) + if (debug) { + print("results stack:") + print(results_stack()) + } + + shinyWidgets::updatePickerInput( + session, "dataset", + choices = c("TCGA", results_stack()$id), + selected = input$dataset + ) + }) + + output$results_list <- renderTable({ + results_stack()[, c("id", "analysis")] + }) + +}) + diff --git a/inst/shiny/sandbox/ui.R b/inst/shiny/sandbox/ui.R new file mode 100644 index 0000000..8fd2e67 --- /dev/null +++ b/inst/shiny/sandbox/ui.R @@ -0,0 +1,32 @@ +library(shiny) + +shinyUI(fluidPage( + + # Application title + titlePanel("FacileSandbox"), + + sidebarLayout( + sidebarPanel(width = 3, + shinyjs::useShinyjs(), + shinyWidgets::pickerInput("dataset", + "Select an input:", + choices = c("TCGA"), + selected = "TCGA" + ), + shinyWidgets::pickerInput("analysis", + "Select an output:", + choices = c("none", "filter", "fdge", "fpca", "ffsea"), + selected = "none" + ), + actionButton("add_module", "Add", icon = icon("plus-circle")), + actionButton("remove_module", "Done", icon = icon("check-circle")), + br(), + h4("Results:"), + tableOutput("results_list") + ), + + mainPanel( + tags$div(id = "gadget_container") + ) + ) +))