Working with fileInput, reactive functions and namespaces in Shiny

Question

I'm trying to make a Shiny application that dynamically makes a number of tabs from a list, all of which contain a fileInput box. Once files (in this case images), I want to show them as they are uploaded on the corresponding tab. I figured to use a reactive function for this (taken from Dynamically display images from upload in Shiny UI) but unfortunately this isn't working for me.

I make use of Shiny modules in this case, and I made one module for the UI (sectionTabUI) and one for the server functions (sectionTabServer). I can output the list of files as a datatable perfectly with output$files <- renderTable(input$files), but trying to make a reactive source from the input fails on me (cannot coerce type 'closure' to vector of type 'character'). I guess it has something to do with namespacing but I can't figure out what it is.

Just to sum up, these are my main goals:

Arbitrary number of unique tabs, each with their own file input
Present uploaded images dynamically per tab

Below is a minimal working example, thanks in advance!

app.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)

Working with fileInput, reactive functions and namespaces in Shiny

0 Answers0