#' Search, select and load modules
#' @param id shiny id
#' @importFrom shinydashboard box
#' @importFrom DT DTOutput
#' @import shiny
#' @export
#' @examples
#' \dontrun{
#' library(shiny)
#' library(shinydashboard)
#' library(flowR)
#' library(DT)
#'
#' if (interactive()){
#'
#' ui <- dashboardPage(
#' dashboardHeader(title = "Modules"),
#' sidebar = dashboardSidebar(disable = TRUE),
#' body = dashboardBody(
#' ModulesUI("module")
#' )
#' )
#'
#' server <- function(input, output, session) {
#' rval <- reactiveValues(modules = c("Import"))
#' rval <- callModule(Modules, "module", rval = rval)
#' }
#'
#' shinyApp(ui, server)
#'
#' }
#' }
<- (id) {
<- NS(id)
fluidRow(
column( = 4,
( = , = , = "Module selection",
selectizeInput(("mod_selection"),
"Selected modules",
choices = ,
selected = ,
multiple = ),
actionButton(("apply"), "apply selection")
)
),
column( = 8,
( = "Search for modules",
= , = ,
selectizeInput(("packages"),
"Select Packages",
choices = ,
selected = ,
multiple = ),
DTOutput(("mod_description")),
actionButton(("add_modules"), "add selected modules")
)
)
)
}
#' server function for the shiny module Modules
#' @param input shiny input
#' @param output shiny output
#' @param session shiny session
#' @param rval reactivevalues object with the following elements :
#' \describe{
#' \item{gating_set}{: a GatingSet object}
#' \item{modules}{: Names of pre-selected modules}
#' }
#' @return The input reactivevalues object 'rval' with updated elements :
#' \describe{
#' \item{modules}{: names of selected modules}
#' }
#' @import shiny
#' @importFrom utils sessionInfo
#' @importFrom DT renderDT
#' @rdname ModulesUI
#' @export
<- (input, output, session, rval) {
rval_mod <- reactiveValues(modules = ,
df_module_info = ,
packages = ,
choices = )
observe({
rval_mod$packages <- ((()$otherPkgs), ".GlobalEnv")
updateSelectizeInput(session, "packages",
choices = rval_mod$packages,
selected = ("flowR", ".GlobalEnv"))
})
observe({
updateSelectizeInput(session, "mod_selection",
choices = rval_mod$choices,
selected = rval$modules)
})
observeEvent(input$, {
(!(input$mod_selection)){
rval$modules <- (input$mod_selection, "Modules")
}
})
observe({
df_info_list <- ()
(pack input$packages){
(pack == ".GlobalEnv"){
pack_objs <- (envir=)
((pack_objs)>0){
mod_ui_name <- pack_objs[grep("UI$", pack_objs)]
((mod_ui_name)>0){
mod_name <- ((mod_ui_name, = "UI"))
mod_is_valid <- (1:(mod_name), (x){
server_exists <- !(( mod_name[x], pack_objs))
(server_exists){
check_server_args <- ( ("input", "output", "session", "rval") %in%
((mod_name[x])))
check_ui_args <- "id" %in% ((mod_ui_name[x]))
(check_server_args & check_ui_args)
}{
()
}
})
((mod_is_valid)>0){
mod_name <- mod_name[mod_is_valid]
df_info_list[pack]] <- (package = (pack, (mod_name)),
module = mod_name,
description = (, (mod_name)))
}
}
}
}{
info <- ( = pack, character.only = )
pack_objs <- (("package:", pack))
module_info <- info$info[2]]
idx_ui <- ("UI$", pack_objs)
((idx_ui)>0){
mod_ui_name <- pack_objs[idx_ui]
mod_name <- ((mod_ui_name, = "UI"))
mod_is_valid <- (1:(mod_name), (x){
server_exists <- !(( mod_name[x], pack_objs))
(server_exists){
check_server_args <- ( ("input", "output", "session", "rval") %in%
((mod_name[x])))
check_ui_args <- "id" %in% ((mod_ui_name[x]))
(check_server_args & check_ui_args)
}{
()
}
})
((mod_is_valid)>0){
mod_ui_name <- mod_ui_name[mod_is_valid]
mod_name <- mod_name[mod_is_valid]
module_info <- (package_name = pack)
((module_info)>0){
description <- (1:(mod_name), (x){
idx_server_fonction <- (("^", mod_name[x], " "), module_info)
idx_ui_fonction <- (("^", mod_ui_name[x], " "), module_info)
((idx_ui_fonction)>0){
(module_info[idx_ui_fonction[1]])
} ((idx_server_fonction)>0){
(module_info[idx_server_fonction[1]])
}{
}
})
}{
description <- (, (mod_name))
}
df_info_list[pack]] <- (package = (pack, (mod_name)),
module = mod_name,
description = description)
}{
df_info_list[pack]] <-
}
}
}
}
rval_mod$df_module_info <- (, df_info_list)
rval_mod$choices <- (rval_mod$choices, rval_mod$df_module_info$module)
})
output$mod_description <- renderDT({
DT::datatable(rval_mod$df_module_info, = )
})
observeEvent(input$add_modules, {
new_modules <- rval_mod$df_module_info$module[input$mod_description_rows_selected]
updateSelectizeInput(session, "mod_selection",
selected = (new_modules, input$mod_selection))
})
(rval)
}
#' get description of package's functions
#' @param package_name Name of the package
#' @return A vector with the description of the functions in the package
<- (package_name){
info <- ( = package_name, character.only = )
pack_info <- info$info[2]]
idx_blank <- ("^ ", pack_info)
((idx_blank)>0){
pack_info[idx_blank] <- (pack_info[idx_blank], (x){
(x,
= ("[^ ]", x),
= (x))
})
}
pack_info[idx_blank-1] <- (pack_info[idx_blank-1], pack_info[idx_blank])
pack_info <- pack_info-idx_blank]
(pack_info)
}
#' Suppresses the function name from its description as
#' returned by 'get_package_functions_info()'
#' @param info a character string
#' @return a character string
<- (info){
s <- (" +", info)
s <- (info, = s + (s, "match.length"), = (info))
(s)
}
### Tests #########################################################################################
#
# library(shiny)
# library(shinydashboard)
# library(flowR)
# library(DT)
#
# if (interactive()){
#
# ui <- dashboardPage(
# dashboardHeader(title = "Modules"),
# sidebar = dashboardSidebar(disable = TRUE),
# body = dashboardBody(
# ModulesUI("module")
# )
# )
#
# server <- function(input, output, session) {
# rval <- reactiveValues(modules = c("Import"))
# rval <- callModule(Modules, "module", rval = rval)
# }
#
# shinyApp(ui, server)
#
# }
