Shiny: сбросьте реактивное значение, инициируемое внутри applyEvent () при загрузке нового файла с помощью fileInput ()

Question

У меня есть reactiveValue Я пытаюсь выполнить сброс при загрузке нового файла .csv с fileInput(). Это значение сначала инициируется через observeEvent(), когда выбрано значение для input$cohort_EOF_type;когда вы загружаете файл .csv, его столбцы становятся доступными для выбора, а когда вы выбираете значение для input$cohort_EOF_type, вы можете выбрать уникальное значение в этом столбце в другом раскрывающемся меню selectInput() (т. е. input$cohort_Y_name) * 1008. *

Код, который делает это:

  observeEvent(input$cohort_EOF_type,{
    if(input$cohort_EOF_type=="")
      return(NULL)
    rv$outcome <- unique(rv$cohort.data[,input$cohort_EOF_type])
    #rv$outcome <- NULL
    updateSelectInput(session,"cohort_Y_name",choices = rv$outcome)
  })

Я пытался сбросить значение rv$outcome в NULL после загрузки нового файла. Я даже явно установил значение NULL, чтобы убедиться, что мое приложение все еще работает и не падает, если я выполню сброс , вы можете проверить это, раскомментировав строку выше и прокомментировав строку прямо над ней

Проблема, с которой я сталкиваюсь, заключается в том, что я не могу установить rv$outcome <- NULL, потому что она впервые была инициирована в первом фрагменте кода, показанном выше. Я создал еще один observeEvent(), который должен установить значение NULL после загрузки нового файла, но значение rv$outcome остается равным unique(rv$cohort.data[,input$cohort_EOF_type])

Код, который должен сбрасывать результат rv $:

  ### Resetting rv$outcome once a new file is uploaded
  observeEvent(input$cohort_file, rv$outcome <- NULL)

Весь код, может быть запущен в одном файле:

library(shiny)
library(shinyjs)

ui <- fluidPage(

  useShinyjs(),
  navbarPage("Test",
             tabPanel("Cohort",
                      sidebarLayout(
                        sidebarPanel(
                          fileInput("cohort_file", "Choose CSV File",
                                    multiple = FALSE,
                                    accept = c("text/csv",
                                               "text/comma-separated-values,text/plain",
                                               ".csv")),
                          # Horizontal line ----
                          tags$hr(),
                          # Variable selection
                          selectInput('cohort_IDvar', 'ID', choices = ''),
                          selectInput('cohort_index_date', 'Index date', choices = ''),
                          selectInput('cohort_EOF_date', 'End of follow-up date', choices = ''),
                          selectInput('cohort_EOF_type', 'End of follow-up reason', choices = ''),
                          selectInput('cohort_Y_name', 'Outcome', choices = ''),
                          selectInput('cohort_L0', 'Baseline covariate measurements', choices = '', multiple=TRUE, selectize=TRUE),
                          # Horizontal line ----
                          tags$hr(),
                          disabled(
                            actionButton("set_cohort_button","Set cohort")
                          )
                          #actionButton("refresh_cohort_button","Refresh")
                        ),
                        mainPanel(
                          DT::dataTableOutput("cohort_table"),
                          tags$div(id = 'cohort_r_template')
                        )
                      )
             )
  )
)

server <- function(input, output, session) {

  ################################################
  ################# Cohort code
  ################################################

  cohort_data <- reactive({
    inFile_cohort <- input$cohort_file
    if (is.null(inFile_cohort))
      return(NULL)
    df <- read.csv(inFile_cohort$datapath, 
                   sep = ',')
    return(df)
  })

  rv <- reactiveValues(cohort.data = NULL)
  rv <- reactiveValues(cohort.id = NULL)
  rv <- reactiveValues(cohort.index.date = NULL)
  rv <- reactiveValues(cohort.eof.date = NULL)
  rv <- reactiveValues(cohort.eof.type = NULL)
  rv <- reactiveValues(test = NULL)

  ### Creating a reactiveValue of the loaded dataset
  observeEvent(input$cohort_file, rv$cohort.data <- cohort_data())
  ### Resetting rv$outcome once a new file is uploaded
  observeEvent(input$cohort_file, rv$outcome <- NULL)

  ### Displaying loaded dataset in UI
  output$cohort_table <- DT::renderDataTable({
    df <- cohort_data()
    DT::datatable(df,options=list(scrollX=TRUE, scrollCollapse=TRUE))
  })

  ### Collecting column names of dataset and making them selectable input
  observe({
    value <- c("",names(cohort_data()))
    updateSelectInput(session,"cohort_IDvar",choices = value)
    updateSelectInput(session,"cohort_index_date",choices = value)
    updateSelectInput(session,"cohort_EOF_date",choices = value)
    updateSelectInput(session,"cohort_EOF_type",choices = value)
    observeEvent(req(input$cohort_IDvar,input$cohort_index_date,input$cohort_EOF_date,input$cohort_EOF_type),{
      cohort.L0.values <- value[!value%in%c(input$cohort_IDvar,input$cohort_index_date,input$cohort_EOF_date,input$cohort_EOF_type)]
      updateSelectInput(session,"cohort_L0",choices = cohort.L0.values)
    })
  })

  ### Creating selectable input for Outcome based on End of Follow-Up unique values
  observeEvent(input$cohort_EOF_type,{
    if(input$cohort_EOF_type=="")
      return(NULL)
    rv$outcome <- unique(rv$cohort.data[,input$cohort_EOF_type])
    updateSelectInput(session,"cohort_Y_name",choices = rv$outcome)
  })

  ### Series of observeEvents for creating reactiveValue vector of selected column - introduced if statement so that if new file is uploaded the observeEvent will triger and set input values to NULL; otherwise, app will crash since input values
  observeEvent(input$cohort_IDvar, {
    if(input$cohort_IDvar=="")
      return(NULL)
    rv$cohort.id <- cohort_data()[,input$cohort_IDvar]
  })
  observeEvent(input$cohort_index_date, {
    if(input$cohort_index_date=="")
      return(NULL)
    rv$cohort.index.date <- cohort_data()[,input$cohort_index_date]
  })
  observeEvent(input$cohort_EOF_date, {
    if(input$cohort_EOF_date=="")
      return(NULL)
    rv$cohort.eof.date <- cohort_data()[,input$cohort_EOF_date]
  })
  observeEvent(input$cohort_EOF_type, {
    if(input$cohort_EOF_type=="")
      return(NULL)
    rv$cohort.eof.type <- cohort_data()[,input$cohort_EOF_type]
  })

  ### R code template of function
  cohort_code <- eventReactive(input$set_cohort_button,{
    paste0("cohort <- setCohort(data = as.data.table(",input$cohort_file$name,"), IDvar = ",input$cohort_IDvar,", index_date = ",input$cohort_index_date,", EOF_date = ",input$cohort_EOF_date,", EOF_type = ",input$cohort_EOF_type,", Y_name = ",input$cohort_Y_name,", L0 = c(",paste0(input$cohort_L0,collapse=","),"))")
  })

  ### R code template output fo UI
  output$cohort_code <- renderText({
    paste0("cohort <- setCohort(data = as.data.table(",input$cohort_file$name,"), IDvar = ",input$cohort_IDvar,", index_date = ",input$cohort_index_date,", EOF_date = ",input$cohort_EOF_date,", EOF_type = ",input$cohort_EOF_type,", Y_name = ",input$cohort_Y_name,", L0 = c(",paste0(input$cohort_L0,collapse=","),"))")
  })

  ### Disables cohort button when "Set cohort" button is clicked
  observeEvent(input$set_cohort_button, {
    disable("set_cohort_button")
  })

  ### Disables cohort button if different dataset is loaded
  observeEvent(input$cohort_file, {
    disable("set_cohort_button")
  })

  ### This is where I run into trouble
  observeEvent({
    req(    input$cohort_IDvar,
            input$cohort_index_date,
            input$cohort_EOF_date,
            input$cohort_EOF_type,
            input$cohort_Y_name,
            input$cohort_L0)
  }, {
    enable("set_cohort_button")
  })

  ### Inserts heading and R template code in UI when "Set cohort" button is clicked
  observeEvent(input$set_cohort_button, {
    insertUI(
      selector = '#cohort_r_template',
      ui = tags$div(id = "cohort_insertUI", 
                    h3("R Template Code"),
                    verbatimTextOutput("cohort_code"))
    )
  })

  ### Removes heading and R template code in UI when new file is uploaded or when input is changed
  observeEvent({
    input$cohort_file
    input$cohort_IDvar
    input$cohort_index_date
    input$cohort_EOF_date
    input$cohort_EOF_type
    input$cohort_Y_name
    input$cohort_L0
  }, {
    removeUI(
      selector = '#cohort_insertUI'
    )
  })

}

# Run the application 
shinyApp(ui = ui, server = server)