#r #shiny #shinydashboard #shinyapps
Вопрос:
Нужна помощь, я хотел бы передать информацию из таблицы DT в поле вкладок на блестящей панели управления с помощью следующего потока: TextInput >>> Таблица DT > > > > > > > Поле вкладок
Я уже мог бы это сделать, но проблема в том, что любая другая информация, которую я загружал, исчезает
после нажатия кнопки отправить информацию она обновит таблицу DT и поле вкладки
для поля вкладки 
Но проблема в том, что другая информация, которую я загружал, исчезает
Моя цель состоит в том, чтобы передать информацию из ввода текста > Таблицы DT >> Вкладки без потери какой-либо информации для другого файла, который я загрузил, любое решение действительно ценится
Обновить
Я приведу более подробную информацию о том, какая информация исчезает
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)
Ответ №1:
Должно сработать следующее:
observeEvent(input$doSUBMIT, {
PCIdata <- data_PCI
PCIdata[1, 2] <- input$PCI_CC
PCIdata[2, 2] <- input$PCI_CN
PCIdata[3, 2] <- input$PCI_IS
PCIdata[4, 2] <- input$PCI_AN
PCIdata[5, 2] <- format(Sys.time(), "%a %b %d %X %Y")
PCI$data <<- rbind(PCIdata,na.omit(PCI$data))
})