r - 在 Shiny 中使用 fileInput、响应式函数和命名空间

Question

我正在尝试制作一个 Shiny 应用程序，该应用程序可以动态地从列表中创建多个选项卡，所有这些选项卡都包含一个 fileInput 框。一旦文件（在本例中为图像），我想在它们上传到相应的选项卡时显示它们。我想为此使用一个反应函数（取自Dynamically display images from upload in Shiny UI），但不幸的是这对我不起作用。

在这种情况下，我使用了 Shiny 模块，我为 UI 制作了一个模块（sectionTabUI），为服务器功能制作了一个模块（sectionTabServer）。我可以完美地将文件列表输出为数据表output$files <- renderTable(input$files)，但是尝试从输入中创建反应源对我来说失败了（cannot coerce type 'closure' to vector of type 'character'）。我想这与命名空间有关，但我不知道它是什么。

总结一下，这些是我的主要目标：

1. 任意数量的唯一选项卡，每个选项卡都有自己的文件输入
2. 每个选项卡动态显示上传的图像

下面是一个最小的工作示例，在此先感谢！

应用程序.R

library(shiny)

sectionTabUI <- function(id, title) {
    ns <- NS(id)
    tabPanel(
        title = title,
        sidebarLayout(
            sidebarPanel(
                tagList(
                    fileInput(
                        inputId = ns("files"),
                        label = paste(id),
                        multiple = TRUE
                    )
                )
            ),
            mainPanel(
                sectionTabServer(id),
                tableOutput(ns("files")),
                # uiOutput("images")
            )
        )
    )
}

sectionTabServer <- function(id) {
    moduleServer(
        id,
        function(input, output, session) {
            ns <- session$ns
            output$files <- renderTable(input$files)


            # TODO: This doesn't work
            # TODO: cannot coerce type 'closure' to vector of type 'character'
            files <- reactive({
                validate(need(input$files))
                # files$datapath <- gsub("\\\\", "/", files$datapath)
                input$files
            })

            # TODO: Commented out as the above isn't working yet
            # output$images <- renderUI({
            #     if (is.null(input$files)) {
            #         return(NULL)
            #     }

            #     image_output_list <- lapply(
            #         1:nrow(files()),
            #         function(i) {
            #             print(i)
            #             imagename <- paste0("image", i)
            #             imageOutput(imagename)
            #         }
            #     )

            #     do.call(tagList, image_output_list)
            # })

            # observe({
            #     if (is.null(input$files)) {
            #         return(NULL)
            #     }
            #     for (i in 1:nrow(files())) {
            #         print(i)
            #         local({
            #             my_i <- i
            #             imagename <- paste0("image", my_i)
            #             print(imagename)
            #             output[[imagename]] <-
            #                 renderImage(
            #                     {
            #                         list(
            #                             src = files()$datapath[my_i],
            #                             alt = "Image failed to render"
            #                         )
            #                     },
            #                     deleteFile = FALSE
            #                 )
            #         })
            #     }
            # })
        }
    )
}

ui <- navbarPage(
    id = "appnavbar",
    "Report",
    tabPanel("settings", actionButton("savestructure", "Save Report Structure")),
    tabPanel(
        "output",
        fluidPage(
            mainPanel(
                tabsetPanel(
                    id = "section_tabs",
                    tabPanel(
                        "Report Settings",
                        textInput("title", "Title", "Title"),
                        dateInput("date", "Date", value = NULL, format = "d MM, yyyy")
                    )
                )
            )
        )
    )
)

# This is just arbitrary at this point, the real application has a different implementation that lets the user control which tabs will be shown
sections <- c("Section 1", "Section 2", "Section 3")

server <- function(input, output, session) {
    # Dynamically adds tabs based on document structure
    observeEvent(input$savestructure, {
        # Remove earlier added tabs if user changes structure
        if (!exists("sections_old")) {
            sections_old <<- c()
        } else if (length(sections_old > 0)) {
            for (section in sections_old) {
                removeTab("section_tabs", section)
            }
        }
        updateTabsetPanel(session, "appnavbar", selected = "output")
        for (section in sections) {
            appendTab(
                inputId = "section_tabs",
                sectionTabUI(id = section, title = section),
            )
        }
        sections_old <<- sections
    })
}

shinyApp(ui = ui, server = server)

标签： rshiny