R 如何根据shiny中操作按钮的输出更新下拉列表?
我已经编写了一个代码,可以执行以下操作 1具有各种选项卡的简单仪表板页面 其中一个标签是upload file,我们从本地系统上传一些文件,并在主面板中显示输出 3还有一个选项,我们可以通过单击“保存到数据库”的操作按钮来保存上载的文件名和路径 4单击后,文件名和路径将存储在两个不同的向量tablelist和filePath中 5一旦工作正常,我们将导航到另一个选项卡“查看表”,其中有一个下拉列表来选择表。此表列表是在单击操作按钮后生成和更新的向量表列表 6我尝试了一些相同的代码,但它不起作用 请帮忙。下面是代码R 如何根据shiny中操作按钮的输出更新下拉列表?,r,user-interface,shiny,shinydashboard,R,User Interface,Shiny,Shinydashboard,我已经编写了一个代码,可以执行以下操作 1具有各种选项卡的简单仪表板页面 其中一个标签是upload file,我们从本地系统上传一些文件,并在主面板中显示输出 3还有一个选项,我们可以通过单击“保存到数据库”的操作按钮来保存上载的文件名和路径 4单击后,文件名和路径将存储在两个不同的向量tablelist和filePath中 5一旦工作正常,我们将导航到另一个选项卡“查看表”,其中有一个下拉列表来选择表。此表列表是在单击操作按钮后生成和更新的向量表列表 6我尝试了一些相同的代码,但它不起作用
library(shinydashboard)
library(leaflet)
library(ggplot2)
library(DT)
library(openxlsx)
# -----------------------------------------------------------------------------
# Dashboard UI
# -----------------------------------------------------------------------------
dataset <- c("P1-Long-Term-Unemployment-Statistics","P1-OfficeSupplies","P1-SuperStoreUS-2015")
ui <- dashboardPage(
dashboardHeader(
title = "Validation Tool"
),
dashboardSidebar(
sidebarMenu(
menuItem("Upload File", tabName = "file", icon = icon("database")),
menuItem("View Tables", tabName = "view", icon = icon("database")),
menuItem("Append Data", tabName = "append", icon = icon("database")),
menuItem("Update Table", tabName = "update", icon = icon("crosshairs")),
menuItem("Construct Table", tabName = "construct", icon = icon("fire"))
),
div(style = "padding-left: 15px;padding-right: 5px; padding-top: 40px;",
p(class = "small", "Note : This validation tools automates the mainstream process involved in creating a Master data for detailed analysis ")
)
),
dashboardBody(
tabItems(
# Current location ------------------------------------------------------
tabItem(tabName = "view",
mainPanel(
titlePanel(h2("Explore Datasets")),fluidRow(
column(6,
uiOutput("tables")
),
column(6,
uiOutput("sheets")
)
),
tabsetPanel(type="tab",
tabPanel("Data",br(),div(DT::dataTableOutput("table"),style = "font-size: 100%;width: 150%")
),
tabPanel("Summary"),
tabPanel("Plot")
)
)
),
##################### Tab Item 2 Begins ###########################
tabItem(tabName = "file",
mainPanel(
titlePanel(h2("Upload your XLSX file here ")), fluidRow(
column(6,
fileInput('file1', 'Choose a XLSX file to upload',
accept = c('.xlsx'))),
column(6,actionButton("save","Save to Database")),
div(DT::dataTableOutput("contents"),style = "font-size: 100%;width: 150%")
)
)
)
#####################End of Tab Item 2#############################
)
)
)
# -----------------------------------------------------------------------------
# Dashboard server code
# -----------------------------------------------------------------------------
options(shiny.maxRequestSize = 30*1024^2)
validate_file <- function(input) {
if (length(input) > 0 & !is.null(input) & input!= "application/vnd.openxmlformats-officedocument.spreadsheetml.sheet") {
"Please upload a XLSX file"
} else {
NULL
}
}
server <- function(input, output,session) {
my_file <- function(){
my_file <- paste0("D:/Dataset/",input$table,".xlsx")
}
sheetNames <- function(){
sheetNames <- getSheetNames(my_file())
}
output$sheets <- renderUI({
selectInput("sheet","Sheet:",choices = sheetNames())
})
tablelist<-c()
output$tables <- renderUI({
selectInput("table","Table:",choices = files)
})
output$table <- renderDT(read.xlsx(my_file(),sheet=as.character(input$sheet)),class="display nowrap compact",
filter = "top",options = list(
scrollX = T,
scrollCollapse=TRUE, pageLength=20,scrollY="260px",lengthMenu=c(20,40,60,80,100),
search = list(regex = FALSE, caseInsensitive = FALSE)))
# output$contents <- renderTable({
# # input$file1 will be NULL initially. After the user selects
# # and uploads a file, it will be a data frame with 'name',
# # 'size', 'type', and 'datapath' columns. The 'datapath'
# # column will contain the local filenames where the data can
# # be found.
#
# inFile <- input$file1
# if (is.null(inFile))
# return(NULL)
# read.xlsx(inFile$name, sheet=1)
# })
############################## Validate Scenario ########################
v <- reactive({
type <- input$file1
validate(validate_file(type$type))
})
############################# Scenario Ends ############################
output$contents <- renderDT({
# input$file1 will be NULL initially. After the user selects
# and uploads a file, it will be a data frame with 'name',
# 'size', 'type', and 'datapath' columns. The 'datapath'
# column will contain the local filenames where the data can
# be found.
v()
inFile <- input$file1
if (is.null(inFile))
return(NULL)
read.xlsx(inFile$datapath, sheet=1)
},class="display nowrap compact",
options = list(
scrollX = T,
pageLength=20,scrollY="340px",lengthMenu=c(20,40,60,80,100)
))
############################# ACtion Button Save ######################################
save_result <- function(){
save_result <- observeEvent(input$save,{
filenm <- input$file1
filenm$name
tablelist <- c(tablelist,as.character(filenm$name))
filePath <- c(filePath,as.character(filenm$dataPath))
})
return (tablelist)
}
files <- save_result()
############################# End of Action button ####################################
}
shinyApp(ui, server)
下拉表现在未更新/填充。请帮助解决此问题您的代码可能需要大量工作,我建议您查看并不要使用服务器文件中的函数,例如,我实际上已开始重写您的整个应用程序,但随后决定专注于手头的问题 这是一个开始:
library(shinydashboard)
library(leaflet)
library(ggplot2)
library(DT)
library(openxlsx)
# -----------------------------------------------------------------------------
# Dashboard UI
# -----------------------------------------------------------------------------
dataset <- c("P1-Long-Term-Unemployment-Statistics","P1-OfficeSupplies","P1-SuperStoreUS-2015")
ui <- dashboardPage(
dashboardHeader(
title = "Validation Tool"
),
dashboardSidebar(
sidebarMenu(
menuItem("Upload File", tabName = "file", icon = icon("database")),
menuItem("View Tables", tabName = "view", icon = icon("database")),
menuItem("Append Data", tabName = "append", icon = icon("database")),
menuItem("Update Table", tabName = "update", icon = icon("crosshairs")),
menuItem("Construct Table", tabName = "construct", icon = icon("fire"))
),
div(style = "padding-left: 15px;padding-right: 5px; padding-top: 40px;",
p(class = "small", "Note : This validation tools automates the mainstream process involved in creating a Master data for detailed analysis ")
)
),
dashboardBody(
tabItems(
# Current location ------------------------------------------------------
tabItem(tabName = "view",
mainPanel(
titlePanel(h2("Explore Datasets")),fluidRow(
column(6,
uiOutput("tables")
),
column(6,
uiOutput("sheets")
)
),
tabsetPanel(type="tab",
tabPanel("Data",br(),div(DT::dataTableOutput("table"),style = "font-size: 100%;width: 150%")
),
tabPanel("Summary"),
tabPanel("Plot")
)
)
),
##################### Tab Item 2 Begins ###########################
tabItem(tabName = "file",
mainPanel(
titlePanel(h2("Upload your XLSX file here ")), fluidRow(
column(6,
fileInput('file1', 'Choose a XLSX file to upload',
accept = c('.xlsx'))),
column(6,actionButton("save","Save to Database")),
div(DT::dataTableOutput("contents"),style = "font-size: 100%;width: 150%")
)
)
)
#####################End of Tab Item 2#############################
)
)
)
# -----------------------------------------------------------------------------
# Dashboard server code
# -----------------------------------------------------------------------------
options(shiny.maxRequestSize = 30*1024^2)
validate_file <- function(input) {
if (length(input) > 0 & !is.null(input) & input!= "application/vnd.openxmlformats-officedocument.spreadsheetml.sheet") {
"Please upload a XLSX file"
} else {
NULL
}
}
server <- function(input, output,session) {
my_file <- function(){
my_file <- paste0("D:/Dataset/",input$table,".xlsx")
}
sheetNames <- function(){
sheetNames <- getSheetNames(my_file())
}
output$sheets <- renderUI({
selectInput("sheet","Sheet:",choices = sheetNames())
})
tablelist<-c()
output$tables <- renderUI({
selectInput("table","Table:",choices = files())
})
output$table <- renderDT(read.xlsx(my_file(),sheet=as.character(input$sheet)),class="display nowrap compact",
filter = "top",options = list(
scrollX = T,
scrollCollapse=TRUE, pageLength=20,scrollY="260px",lengthMenu=c(20,40,60,80,100),
search = list(regex = FALSE, caseInsensitive = FALSE)))
# output$contents <- renderTable({
# # input$file1 will be NULL initially. After the user selects
# # and uploads a file, it will be a data frame with 'name',
# # 'size', 'type', and 'datapath' columns. The 'datapath'
# # column will contain the local filenames where the data can
# # be found.
#
# inFile <- input$file1
# if (is.null(inFile))
# return(NULL)
# read.xlsx(inFile$name, sheet=1)
# })
############################## Validate Scenario ########################
v <- reactive({
type <- input$file1
validate(validate_file(type$type))
})
############################# Scenario Ends ############################
output$contents <- renderDT({
# input$file1 will be NULL initially. After the user selects
# and uploads a file, it will be a data frame with 'name',
# 'size', 'type', and 'datapath' columns. The 'datapath'
# column will contain the local filenames where the data can
# be found.
inFile <- req(input$file1)
v()
if (is.null(inFile))
return(NULL)
read.xlsx(inFile$datapath, sheet=1)
},class="display nowrap compact",
options = list(
scrollX = T,
pageLength=20,scrollY="340px",lengthMenu=c(20,40,60,80,100)
))
############################# ACtion Button Save ######################################
files <- eventReactive(input$save,{
filenm <- input$file1
filenm$name
tablelist <- c(tablelist,as.character(filenm$name))
filePath <- c(filePath,as.character(filenm$dataPath))
return (tablelist)
})
############################# End of Action button ####################################
}
shinyApp(ui, server)
然后在此处将文件更改为文件:
这应该可以回答您当前的问题,但您的应用程序还有很多其他问题,因此在出现问题时请告诉我。getSheetNames不应该处于被动环境中吗?Try choices=getSheetNamespaste0D:/Dataset/,input$table,.xlsx。获取工作表名称的部分是单独工作的,但这里的问题是我无法更新将填充下拉表的向量表列表。我看不到下拉列表了是的,我明白。我不熟悉闪亮的编程,并试图通过实践来学习。我需要你的帮助:
files <- eventReactive(input$save,{
filenm <- input$file1
filenm$name
tablelist <- c(tablelist,as.character(filenm$name))
filePath <- c(filePath,as.character(filenm$dataPath))
return (tablelist)
})
output$tables <- renderUI({
selectInput("table","Table:",choices = files())
})