如何在Shiny Dashboard中实现DT Table到TabBox的数据传递且不丢失上传文件
2026-10-2
Shiny Dashboard信息传递流程中上传资源丢失问题求助及解决方案
我需要在Shiny Dashboard中实现「TextInput → DT Table → TabBox」的信息传递流程，目前基础功能已可正常运行，但点击提交按钮后会出现此前上传的文件、图片等信息丢失的问题，具体现象如下：
- 完成文件、图片上传，填写企业信息后点击提交按钮，系统可正常更新DT Table与TabBox的展示内容
- 提交操作完成后，此前上传的图片、文档等内容会消失，不符合预期需求
我的目标是在实现上述信息传递链路的同时，完整保留所有已上传的文件内容，恳请各位开发者提供可行解决方案。
问题复现代码
library(shinydashboard) ui <- dashboardPage( dashboardHeader( title = "PRD"), dashboardSidebar(uiOutput("sidebarpanel")), dashboardBody(shinyjs::useShinyjs(), uiOutput("body")) ) server <- function(input, output) { output$sidebarpanel <- renderUI({ sidebarMenu( menuItem("Entry Data", tabName = "ED", icon = icon("th")), menuItem("Main Info", tabName = "MI", icon = icon("th")) ) }) output$body <- renderUI({ tabItems( tabItem(tabName ="ED", fluidRow( box(width = 12, fileInput(inputId = "FLK", label = "Upload Document", accept = c(".xlsx",".csv") )), box(width = 12, title = "Image 1", status = "primary", solidHeader = TRUE, collapsible = TRUE, fileInput("myFile1", "Upload an image file", accept = c('image/png', 'image/jpeg')), actionButton('reset1', 'Clear Image'), div(id = "image-container1", style = "display:flexbox")), box(width = 6, title = "Input Company Information", status = "warning", solidHeader = TRUE, collapsible = TRUE, textInput("PCI_CC", "Company Info A"), br(), textInput("PCI_CN", "Company Info B"), br(), textInput("PCI_IS", "Company Info C"), br(), textInput("PCI_AN", "Company Info D"), actionButton("doSUBMIT", "Submit Information")), box(width = 12, title = "Company Information", status = "primary", solidHeader = TRUE, collapsible = TRUE, dataTableOutput('content_PCI')) )), tabItem(tabName ="MI", class = "active", fluidRow( tabBox( title = "Information Tab", id = "tabset1", height = "400px", tabPanel("Information", "Company Info A :", PCI$data[1, 2], br(), br(), "Company Info B :", PCI$data[2, 2], br(), br(), "Company Info C :", PCI$data[3, 2], br(), br(), "Company Info D :", PCI$data[4, 2], br(), br(), "Last Updated :", PCI$data[5, 2] )))) ) }) ########################## UPLOAD IMAGE ##################################### observeEvent(input$myFile1, { inFile <- input$myFile1 if (is.null(inFile)) return() b64 <- base64enc::dataURI(file = inFile$datapath, mime = "image/png") insertUI( selector = "#image-container1", where = "afterBegin", ui = img(src = b64, width = 100, height = 100) ) }) observeEvent(input$reset1, { removeUI( selector = "#image-container1 > *", ) }) ####################### INFO TABLE ########################################## PCI <- reactiveValues(data=NULL) data_PCI = data.frame( Item = c('Company Info A', 'Company Info B', 'Company Info C', 'Company Info D', 'Last Updated'), Description = c(NA, NA, NA, NA, NA) ) PCI_Data <- reactive ({ data_PCI }) observe({ PCI$data <- PCI_Data() }) output$content_PCI <- DT::renderDataTable({ PCI$data %>% datatable(editable = list(target = "cell", disable = list(columns = c(0,1))), options = list(paging = FALSE)) }) observeEvent(input$doSUBMIT, { PCI$data[1, 2] <<- input$PCI_CC PCI$data[2, 2] <<- input$PCI_CN PCI$data[3, 2] <<- input$PCI_IS PCI$data[4, 2] <<- input$PCI_AN PCI$data[5, 2] <<- format(Sys.time(), "%a %b %d %X %Y") }) } shinyApp(ui, server)
更新
补充丢失信息的相关展示截图，进一步明确问题现象。
更新2
我已找到避免图片文件丢失的解决方案，修改后的完整代码如下：
library(shinydashboard) ui <- dashboardPage( dashboardHeader( title = "PRD"), dashboardSidebar(uiOutput("sidebarpanel")), dashboardBody(shinyjs::useShinyjs(), uiOutput("body")) ) server <- function(input, output) { output$sidebarpanel <- renderUI({ sidebarMenu( menuItem("Entry Data", tabName = "ED", icon = icon("th")), menuItem("Main Info", tabName = "MI", icon = icon("th")) ) }) output$body <- renderUI({ tabItems( tabItem(tabName ="ED", fluidRow( box(width = 12, fileInput(inputId = "FLK", label = "Upload Document", accept = c(".xlsx",".csv") )), box(width = 12, title = "Image 1", status = "primary", solidHeader = TRUE, collapsible = TRUE, fileInput("myFile", "Choose a file", accept = c('.jpg')), uiOutput("imgview1")), box(width = 6, title = "Input Company Information", status = "warning", solidHeader = TRUE, collapsible = TRUE, textInput("PCI_CC", "Company Info A"), br(), textInput("PCI_CN", "Company Info B"), br(), textInput("PCI_IS", "Company Info C"), br(), textInput("PCI_AN", "Company Info D"), actionButton("doSUBMIT", "Submit Information")), box(width = 12, title = "Company Information", status = "primary", solidHeader = TRUE, collapsible = TRUE, dataTableOutput('content_PCI')) )), tabItem(tabName ="MI", class = "active", fluidRow( tabBox( title = "Information Tab", id = "tabset1", height = "400px", tabPanel("Information", "Company Info A :", PCI$data[1, 2], br(), br(), "Company Info B :", PCI$data[2, 2], br(), br(), "Company Info C :", PCI$data[3, 2], br(), br(), "Company Info D :", PCI$data[4, 2], br(), br(), "Last Updated :", PCI$data[5, 2] )))) ) }) ########################## UPLOAD IMAGE ##################################### observe({ req(input$myFile) file.copy(input$myFile$datapath,"www\\img1", overwrite = T) b64 <- base64enc::dataURI(file = "www\\img1\\0.jpg") output$imgview1 <- renderUI({ tags$img(src = b64, width = "400px", height = "400px") }) }) ####################### INFO TABLE ########################################## PCI <- reactiveValues(data=NULL) data_PCI = data.frame( Item = c('Company Info A', 'Company Info B', 'Company Info C', 'Company Info D', 'Last Updated'), Description = c(NA, NA, NA, NA, NA) ) PCI_Data <- reactive ({ data_PCI }) observe({ PCI$data <- PCI_Data() }) output$content_PCI <- DT::renderDataTable({ PCI$data %>% datatable(editable = list(target = "cell", disable = list(columns = c(0,1))), options = list(paging = FALSE)) }) observeEvent(input$doSUBMIT, { PCI$data[1, 2] <<- input$PCI_CC PCI$data[2, 2] <<- input$PCI_CN PCI$data[3, 2] <<- input$PCI_IS PCI$data[4, 2] <<- input$PCI_AN PCI$data[5, 2] <<- format(Sys.time(), "%a %b %d %X %Y") }) } shinyApp(ui, server)
内容的提问来源于stack exchange，提问作者Reza AM
相关产品推荐
相关产品推荐
