Динамически генерировать модули и значения доступа в R Shiny

Question

Я пытаюсь позволить пользователям создавать текстовые поля в приложении Shiny в виде модулей, чтобы их входные данные были включены в отчет об уценке R, сгенерированный приложением.

Я (наконец) получил егоработает, но то, что я сделал, кажется хакерским и, вероятно, плохой практикой.Я размещаю эту часть своего приложения с кодом здесь: https://olivrm.shinyapps.io/add_modules/

Части, которые меня не устраивают:

• Все происходит внутри observeEvent(input$add_module, {...}.Я сохраняю входные данные, чтобы использовать их в качестве значений текстового поля по умолчанию, поскольку все они восстанавливаются каждый раз, когда вы добавляете новый компонент.
• Способ доступа к входным данным текстового поля для создания реактивного texts.Использование parse() и eval() не кажется хорошим, но я не знаю, как еще добраться до содержания.

Итак, с точки зрения конкретного вопроса: как вы должны динамически добавлятьмодули для приложений Shiny, и как вы получаете доступ к их возвращаемым значениям?

Я раньше не использовал Shiny, поэтому мне бы хотелось узнать «правильный» способ сделать это.

Вот еще раз код на случай, если shinyapps.io не работает (или если я удалю его позже).

library(shiny)
library(purrr)

# Module UI function
commentTextUI <- function(id, default_text = "default (ui)") {
    ns <- NS(id)

    tagList(
        textAreaInput(ns("report_text"),
                      "Add text:",
                      default_text),
        actionButton(ns("btn_save_text"),
                     label = "save this text")
    )
}


# Module server function
# Return value: actual text? Does that work?
commentText <- function(input, output, session, default_text = "default (server)") {
    text_content <- eventReactive(input$btn_save_text, {
        # If the button hasn't been clicked yet, return the default text (i.e.
        # save when the button is clicked), and otherwise the input. Also
        # default for if it's NULL because the components take a moment to
        # generate, so this avoids an error message before the button goes from
        # NULL to 0. (tried using req but that did something very weird)
        if (is.null(input$btn_save_text) || input$btn_save_text == 0) {
            default_text
        } else {
            input$report_text
        }
    }, ignoreNULL = FALSE)

    reactive({text_content()})
}





# UI
ui <- fluidPage(
    actionButton("add_module", "Add module"),
    uiOutput("modules"),
    verbatimTextOutput("module_output", placeholder = TRUE),
    actionButton("browser", "browser()")
)

# Server
server <- function(input, output) {
    rv <- reactiveValues(
        module_output_list = list(),
        module_input_list = list(),
        save_texts = list()
    )

    observeEvent(input$add_module, {
        # Create a static version of the text box inputs to re-add in a minute
        static_texts <- texts()
        # Save those static ones in the reactive values
        rv$save_texts <- static_texts
        # add a module instance once for each time the button has been clicked
        1:input$add_module %>%
            walk(function(i) {
                # Set the default text in the text box to either what you've
                # saved in rv$save_texts, or, if that's NULL, just a default
                # text
                default_text <- rv$save_texts %>%
                    pluck(i) %||%
                    "default (in map in app server)"

                # Call the module and save its output to the reactive value list
                rv$module_output_list[[i]] <- callModule(commentText,
                                                         id = i,
                                                         default_text = default_text)
                # Save the input box + button to the list of module UI elements
                rv$module_input_list[[i]] <- commentTextUI(
                    id = i,
                    default_text = default_text
                )
            })
    })

    # Display the list of module UI elements (text boxes and buttons)
    output$modules <- renderUI({
        tagList(rv$module_input_list)
    })

    # Reactive expression to extract the text inputs. Surely there's a better
    # way for this than eval/parse
    texts <- reactive({
        seq_along(rv$module_output_list) %>%
            map(function(x) {
                paste0("rv$module_output_list[[", x, "]]()") %>%
                    parse(text = .) %>%
                    eval()
            })
    })

    # Just show the output of each text box
    output$module_output <- renderPrint({
        texts() %>%
            paste(collapse = "\n\n") %>%
            cat()
    })

    # For testing
    observeEvent(input$browser, {browser()})
}

# Run the application
shinyApp(ui = ui, server = server, options = list(display.mode = "showcase"))