运行 Render.ui 仅在文件上传后的逻辑

Question

我正在尝试运行一个带有多个脚本函数的闪亮应用程序。我有一个侧边栏 select 输入，它访问一个变量，该变量仅在上传文件并处理“db_prep”R 脚本后创建。 “db_prep”R 脚本还结合了首先加载的“full_db”的元素。我曾尝试使用 renderUI 来解决这个问题，但我无法确定哪里出错了。理想情况下，我想运行应用程序，上传我的文件，然后运行我在上传文件上的函数，然后 full_db 在下一个箱线图选项卡中生成输出。

这里是 ui:


#compiled db
full_db <- read.csv("./full_db.csv", header = TRUE, sep = ",", stringsAsFactors = FALSE)


 
# ui ----

ui <- fluidPage(
  theme = shinytheme("superhero"),
  titlePanel("Title"),
  tabsetPanel(type = "tabs",
              tabPanel("File Upload",
                       
                       # Sidebar layout with input and output definitions ----
                       sidebarLayout(
                         
                         # Sidebar panel for inputs ----
                         sidebarPanel(
                           
                           # Input: Select a file ----
                           fileInput("file1", "Choose CSV File",
                                     multiple = FALSE,
                                     accept = c("text/csv",
                                                "text/comma-separated-values,text/plain",
                                                ".csv")),
                           
                           # Horizontal line ----
                           tags$hr(),
                           
                           # Input: Checkbox if file has header ----
                           checkboxInput("header", "Header", TRUE),
                           
                           # Input: Select separator ----
                           radioButtons("sep", "Separator",
                                        choices = c(Comma = ",",
                                                    Semicolon = ";",
                                                    Tab = "\t"),
                                        selected = ","),
                           
                           # Input: Select quotes ----
                           radioButtons("quote", "Quote",
                                        choices = c(None = "",
                                                    "Double Quote" = '"',
                                                    "Single Quote" = "'"),
                                        selected = '"'),
                           
                           # Horizontal line ----
                           tags$hr(),
                           
                           # Input: Select number of rows to display ----
                           radioButtons("disp", "Display",
                                        choices = c(Head = "head",
                                                    All = "all"),
                                        selected = "head")
                           
                         ),
                         
                         # Main panel for displaying outputs ----
                         mainPanel(
                           
                           # Output: Data file ----
                           tableOutput("contents")
                           
                         )
                       )  
              ),
              
              uiOutput("moreControls"),
              
              
              # Main panel for displaying outputs ----
              mainPanel(
                h1("Actions"),
                plotOutput("plot", width = "100%"))
  ))

服务器：

# server ----
# Define server logic to plot various variables against 
server <- function(input, output, session) {
  
  #server logic for file upload tab
  output$contents <- renderTable({
    
    # input$file1 will be NULL initially. After the user selects
    # and uploads a file, head of that data file by default,
    # or all rows if selected, will be shown.
    
    req(input$file1)
    
    # when reading semicolon separated files,
    # having a comma separator causes `read.csv` to error
    tryCatch(
      {
        df_x <- read.csv(input$file1$datapath,
                         header = input$header,
                         sep = input$sep,
                         quote = input$quote)
        if(is.null(input$file1)){
          return(NULL)
        }
      },
      error = function(e) {
        # return a safeError if a parsing error occurs
        stop(safeError(e))
      }
    )
    
    if(input$disp == "head") {
      return(head(df_x))
    }
    else {
      return(df_x)
    }
    
  })
  
  
  
  #server logic for boxplot tab
  #required scripts & functions
  source("db_prep.R")
  source("box_75_test.R")
  source("box_80_test.R")
  source("box_85_test.R")
  source("box_90_test.R")
  source("box_95_test.R")
  
  
  output$moreControls <- renderUI({
    if(is.null(input$file1())) return()
    tabPanel("Boxplot",
             sidebarPanel("output.fileUploaded", 
                          selectInput("variable", "Action:", unique(qc$Action)),
                          sliderInput("quantile", "Quantile Range:",
                                      min = 75, max = 95, value = c(85), step = 5
                          )
             ))
  })
  
  
  
  # reprex ----
  s_75 <- function(var) box_75_test(var) 
  s_80 <- function(var) box_80_test(var) 
  s_85 <- function(var) box_85_test(var) 
  s_90 <- function(var) box_90_test(var)
  s_95 <- function(var) box_95_test(var) 
  
  fn <- reactive(get(paste0("s_", input$quantile)))
  output$plot <-  renderPlot(fn()(input$variable), height = 800, width = 800)
  #    ^^^ note the reactive value goes fn()(var)
  
  
}

shinyApp(ui, server)

Answer 1

我遇到的问题是由于调用源代码也依赖于只能在上传 csv 文件后构建的数据框的创建。最初，我只能在 shiny 会话结束后创建一个数据框作为对象，但我能够通过将源文件和函数包装在 observeEvent 处理程序中来解决这个问题，如下所示：

  observeEvent(input$file1, {
    req(df_x)
    source("db_prep.R")
      # reprex ----
  s_75 <- function(var) box_75(var) 
  s_80 <- function(var) box_80(var) 
  s_85 <- function(var) box_85(var) 
  s_90 <- function(var) box_90(var)
  s_95 <- function(var) box_95(var) 
  
    fn <- reactive(get(paste0("s_", input$quantile)))
  output$plot <-  renderPlot(fn()(input$variable), height = 800, width = 800)

可能有更优雅的方法来实现这一点，但它确实有效。

运行 Render.ui 仅在文件上传后的逻辑

Run Render.ui logic only after file has been uploaded

r

shiny