【发布时间】：2021-11-19 00:58:41
【问题描述】：
需要帮助我想将信息从 DT Table 传递到 Shiny Dashboard 上的 TabBox，流程如下：TextInput >> DT Table >> TabBox
我已经可以这样做了，但是我上传的任何其他信息都消失了
点击按钮提交信息后，会更新DT Table和Tab box
但问题是，我上传的另一个信息消失了
我的目标是通过 Text Input > 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)
# output$imgview1 <- renderUI({
# tags$img(style="height:1200px; width:100%", src="img1\\0.png")
b64 <- base64enc::dataURI(file = "www\\img1\\0.jpg")
# insertUI(
# selector = "#image-container1",
# where = "afterBegin",
# ui = img(src = b64, width = 100, height = 100)
# )
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)
【问题讨论】：
标签： r shiny shinydashboard shinyapps