## list of function arguments doe_args <- as.list(formals(doe)) ## list of function inputs selected by user doe_inputs <- reactive({ ## loop needed because reactive values don't allow single bracket indexing for (i in names(doe_args)) { doe_args[[i]] <- input[[paste0("doe_", i)]] } doe_args }) output$ui_doe_int <- renderUI({ req(!is.empty(input$doe_factors)) vars <- gsub("[ ]{2,}", " ", input$doe_factors) %>% gsub("/", "", .) %>% gsub("\\\\n", "\n", .) %>% gsub("[ ]*;[ ]*", ";", .) %>% gsub(";{2,}", ";", .) %>% gsub("[;]+[ ]{0,}\n", "\n", .) %>% gsub("[ ]{1,}\n", "\n", .) %>% gsub("\n[ ]+", "\n", .) %>% gsub("[\n]{2,}", "\n", .) %>% gsub("[ ]+", "_", .) %>% strsplit(., "\n") %>% .[[1]] %>% strsplit(";\\s*") %>% sapply(function(x) x[1]) %>% unique() req(length(vars) > 1) choices <- iterms(vars, 2) selectInput( "doe_int", label = "Interactions:", choices = choices, selected = state_init("doe_int"), multiple = TRUE, size = min(3, length(choices)), selectize = FALSE ) }) output$ui_doe_levels <- renderUI({ req(input$doe_max > 2) make_level <- function(nr) { textInput( paste0("doe_level", nr), paste0("Level ", nr, ":"), value = state_init(paste0("doe_level", nr)) ) } lapply(3:input$doe_max, make_level) }) ## add a spinning refresh icon if the design needs to be (re)calculated run_refresh(doe_args, "doe", init = "factors", label = i18n$t("Create design"), relabel = "Update design", data = FALSE) output$ui_doe <- renderUI({ tagList( wellPanel( actionButton("doe_run", "Create design", width = "100%", icon = icon("play", verify_fa = FALSE), class = "btn-success") ), wellPanel( tags$table( tags$td( numericInput( "doe_max", label = i18n$t("Max levels:"), min = 2, max = 10, value = state_init("doe_max", init = 2), width = "80px" ) ), tags$td( numericInput( "doe_trials", label = i18n$t("# trials:"), min = 1, step = 1, value = state_init("doe_trials", init = NA), width = "65px" ) ), tags$td( numericInput( "doe_seed", label = i18n$t("Rnd. seed:"), min = 0, value = state_init("doe_seed", init = 1234), ## prev default seed 172110 width = "100%" ) ) ), tagList( tags$label(i18n$t("Variable name:")), actionLink( inputId = "doe_add", label = NULL, icon = icon("plus-circle", verify_fa = FALSE), title = i18n$t("Add variable") ), actionLink( inputId = "doe_del", label = NULL, icon = icon("minus-circle", verify_fa = FALSE), title = i18n$t("Remove variable") ) ), textInput("doe_name", NULL, value = state_init("doe_name", "")), textInput("doe_level1", label = i18n$t("Level 1:"), value = state_init("doe_level1")), textInput("doe_level2", label = i18n$t("Level 2:"), value = state_init("doe_level2")), uiOutput("ui_doe_levels"), uiOutput("ui_doe_int") ), wellPanel( HTML(sprintf( "
", i18n$t("Save factorial design:") )), tags$table( tags$td(download_button("doe_download_part", i18n$t("Partial"))), tags$td(download_button("doe_download_full", i18n$t("Full"))) ), HTML(sprintf( "

", i18n$t("Save factors:") )), download_button("doe_download", i18n$t("Factors"), class = "btn-primary"), HTML(sprintf( "

", i18n$t("Upload factors:") )), file_upload_button( "doe_upload", label = i18n$t("Upload factors:"), accept = ".txt", buttonLabel = i18n$t("Factors"), title = i18n$t("Upload DOE factors"), class = "btn-primary" ) ), help_and_report( modal_title = i18n$t("Design of Experiments"), fun_name = "doe", help_file = inclMD(file.path(getOption("radiant.path.design"), "app/tools/help/doe.md")) ) ) }) observeEvent(input$doe_add, { req(input$doe_max) dup <- input$doe_name for (i in 1:input$doe_max) { dtmp <- input[[paste0("doe_level", i)]] if (!is.empty(dtmp)) dup <- c(dup, dtmp) } dup <- paste(dup, collapse = "; ") if (is.empty(input$doe_factors)) { val <- dup } else { val <- paste0(input$doe_factors, "\n", dup) } updateTextInput(session = session, "doe_factors", value = val) }) observeEvent(input$doe_del, { input$doe_factors %>% strsplit("\n") %>% unlist() %>% head(., -1) %>% paste0(collapse = "\n") %>% updateTextInput(session = session, "doe_factors", value = .) }) doe_maker <- function(id = "factors", rows = 5, pre = "doe_", placeholder = i18n$t("Upload an experimental design using the 'Upload factors' button or create a new design using the inputs on the left of the screen. For help, click the ? icon on the bottom left of the screen") ) { id <- paste0(pre, id) tags$textarea( state_init(id), id = id, type = "text", rows = rows, autocomplete = "off", autocorrect = "off", autocapitalize = "off", spellcheck = "false", placeholder = placeholder, class = "form-control" ) } ## output is called from the main radiant ui.R output$doe <- renderUI({ register_print_output("summary_doe", ".summary_doe") ## single tab with components stacked doe_output_panels <- tagList( tabPanel( i18n$t("Summary"), HTML(sprintf("", i18n$t("Design factors:"))), doe_maker("factors", rows = 5), HTML(sprintf( "
", i18n$t("Generated experimental design:") )), verbatimTextOutput("summary_doe") ) ) stat_tab_panel( menu = i18n$t("Design > DOE"), tool = i18n$t("Design of Experiments"), data = NULL, tool_ui = "ui_doe", output_panels = doe_output_panels ) }) .doe <- eventReactive(input$doe_run, { req(!is.empty(input$doe_factors)) int <- "" if (length(input$doe_int) > 0) { int <- input$doe_int } withProgress(message = "Generating design", value = 1, { do.call(doe, doe_inputs()) }) }) .summary_doe <- reactive({ summary(.doe(), eff = TRUE, part = TRUE, full = TRUE) }) dl_doe_download_part <- function(path) { .doe() %>% (function(x) if (class(x)[1] == "character") x else x$part) %>% write.csv(path, row.names = FALSE) } download_handler( id = "doe_download_part", label = i18n$t("Partial"), fun = dl_doe_download_part, fn = "part_factorial", caption = "Save partial factorial", btn = "button" ) dl_doe_download_full <- function(path) { .doe() %>% (function(x) if (class(x)[1] == "character") x else x$full) %>% write.csv(path, row.names = FALSE) } download_handler( id = "doe_download_full", label = i18n$t("Full"), fun = dl_doe_download_full, fn = "full_factorial", caption = "Save full factorial", btn = "button" ) dl_doe_download <- function(path) { cat(paste0(input$doe_factors, "\n"), file = path) } download_handler( id = "doe_download", label = i18n$t("Factors"), fun = dl_doe_download, fn = "doe_factors", caption = "Save DOE factors", type = "txt", class = "btn-primary", btn = "button" ) if (!getOption("radiant.shinyFiles", FALSE)) { doe_uploadfile <- shinyFiles::shinyFileChoose( input = input, id = "doe_upload", session = session, roots = volumes, filetype = "txt" ) } observeEvent(input$doe_upload, { if (getOption("radiant.shinyFiles", FALSE)) { path <- shinyFiles::parseFilePaths(sf_volumes, input$doe_upload) if (inherits(path, "try-error") || is.empty(path$datapath)) { return() } else { path <- path$datapath } inFile <- data.frame( name = basename(path), datapath = path, stringsAsFactors = FALSE ) } else { inFile <- input$doe_upload } fct <- paste0(readLines(inFile$datapath), collapse = "\n") updateTextInput(session = session, "doe_factors", value = fct) ## cleaning out previous settings updateNumericInput(session = session, "doe_max", value = 2) updateNumericInput(session = session, "doe_trials", value = NA) updateTextInput(session = session, "doe_name", value = "") for (i in 1:10) { r_state[[paste0("doe_level", i)]] <<- NULL updateTextInput(session = session, paste0("doe_level", i), value = "") } }) doe_report <- function() { if (getOption("radiant.local", default = FALSE)) { pdir <- getOption("radiant.launch_dir") xcmd <- paste0('# write.csv(result$part, file = "part_factorial.csv")') } else { xcmd <- "" } inp_out <- list(list(eff = TRUE, part = TRUE, full = TRUE)) inp <- clean_args(doe_inputs(), doe_args) if (!is.empty(inp[["factors"]])) { inp[["factors"]] <- strsplit(inp[["factors"]], "\n")[[1]] } update_report( inp_main = inp, fun_name = "doe", outputs = "summary", inp_out = inp_out, figs = FALSE, xcmd = xcmd ) } observeEvent(input$doe_report, { r_info[["latest_screenshot"]] <- NULL doe_report() }) observeEvent(input$doe_screenshot, { r_info[["latest_screenshot"]] <- NULL radiant_screenshot_modal("modal_doe_screenshot") }) observeEvent(input$modal_doe_screenshot, { doe_report() removeModal() ## remove shiny modal after save })