如何根据闪亮的动作按钮的输出更新下拉列表？

Question

我写了一个代码来做以下事情

1) 一个包含各种选项卡的简单仪表板页面

2) 一个这样的选项卡是上传文件，我们从本地系统上传一些文件并在主面板中显示输出

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)

下拉“表格”现在没有更新/填充。请帮助解决问题

Answer 1

您的代码可能需要大量工作，我建议您查看 reactiveValues 和 eventReactive，例如不要在服务器文件中使用函数 - 我实际上开始重写您的整个应用程序，但后来决定专注于手头的问题。

这是一个开始：

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)

我在v() 之前移动了inFile <- req(input$file1) 并添加了req() 以删除加载应用程序时的初始错误消息，但主要工作在这块：

    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)
    })

然后在此处将files 更改为files()：

    output$tables <- renderUI({
        selectInput("table","Table:",choices = files())
    })

这应该可以回答您当前的问题，但您的应用还有很多其他问题，所以当它们出现时请告诉我。