How to update dropdown list based on the output of action button in shiny?
Question
I have written a code that does the following
1) A simple dashboard page that has various tabs
2) One such tab is upload file, where we upload some file from local system and displays the output in main panel
3) There is another option where we can save the uploaded file name and path on clicking an action button "Save to Database"
4) Once it is clicked, the file name and path will be stored in two different vectors "tablelist" and "filePath"
5) Once this works fine, we navigate to another tab "View Tables", where there is a dropdown to select tables. This table list would be the vector "tablelist" that would be generated and updated after the action button being clicked.
6) I have tried some code for the same, but it is not working.
Please help. Below is the code
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)
The dropdown "table" is not getting updated/populated now. Please help fixing the issue
1 answers
solution1
1 2019-08-19 08:59:43
Your code could use a lot of work and I suggest you take a look at reactiveValues and eventReactive and not using functions in your server file for example - I actually started rewriting your entire app but then decided to focus on the question at hand.
Here is a start:
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)
I moved inFile <- req(input$file1) before v() and added the req() to remove the initial error message on loading the app but the main work was in this piece:
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)
})
and then changing files to files() here:
output$tables <- renderUI({
selectInput("table","Table:",choices = files())
})
This should answer your current question but there are lots of other issues with your app so let me know when they come up.
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.
Related Question
Reset action button output in shiny
Shiny update a table with an action button
How to update default csv data with action button in Shiny?
Shiny app in R : How to update table output based on inputs selection
r Shiny action button and data table output
Update valuebox using action button in R Shiny
In Shiny, avoid overlap of selectInput dropdown with action button underneath it
how to update dataTable in shiny with button
Shiny — how to output a reactive list?
Update radio button after action button input shiny
Related Tags