unable to reset the textinput and selectinput in r shiny app

shiny
1

Unable to reset the textinput and selectinput. I tried to create the action button reset. Also used observeEvent. could you please help. I want to understand why the reset with observeEvent is not working, also when I manually clear the textinput, the app gives error. Any reason

UI part

library(shiny)
library(shinyjs)
library(magrittr)
library(tidyverse)

# Define UI for application that draws a histogram
ui <- fluidPage(

    # Application title
    titlePanel("Package with datasets and functions"),
    div(id='form',
    # Sidebar with a slider input for number of bins 
    sidebarLayout(
        sidebarPanel(
            textInput('pkg','Package Name', value = NULL),
            actionButton("update", "Update View"),
            actionButton("reset", "Reset inputs"),
            helpText('Please enter the package name for which you want to see the list of datasets and functions (with parameters)'),
            br(),
            # br(),
            selectInput('dat','Datasets', choices = NULL, selected = NULL)
        ),

        # Show a plot of the generated distribution
        mainPanel(
          tabsetPanel(
            id = 'dataset',
            tabPanel("List of Datasets in the Package", DTOutput("dataset1")),
            tabPanel("Datasets View", DTOutput("dataset2")),
            tabPanel("List of Functions with Parameters in the Package", verbatimTextOutput('func'))
        )
        )
    )
)
)

server part

# Define server logic required to draw a histogram
server <- function(input, output, session) {

  pkgs <- reactive({input$pkg})
  
  observeEvent(input$reset, {
    #pkgs() <- NULL
    updateSelectInput(session, 'dat','Datasets', choices = NULL, selected = NULL)
    updateTextInput('pkg','Package Name', value = NULL)
  })
  
  # 
  # if (!is.null(pkgs())){
  df <- reactive({
    # pksis <- require(input$pkg)
    # cat(pksis)
    # if (input$pkg %in% rownames(installed.packages()) == TRUE) {
  data_name1 <- data(package=input$pkg)
  data_name2 <- as_tibble(data_name1$results) %>% rename(name=Item, label=Title) %>% select(-LibPath, -Package)
  data_name2
    # } else {
    #   install.packages(input$pkg)
    #   library(input$pkg)
    #   data_name1 <- data(package=input$pkg)
    #   data_name2 <- as_tibble(data_name1$results) %>% rename(name=Item, label=Title) %>% select(-LibPath, -Package)
    #   data_name2
    # }
    })
  # }


  obse <- eventReactive(input$update, { df() })
  funct <- eventReactive(input$update, { paste0('package:',input$pkg) })
  
# if (!is.null(pkg1())){
  observe({
    req(obse())
    updateSelectInput(session, inputId = "dat", label = "Datasets", choices = c(df()$name), selected = df()$name[1])
    
  })
  

# }
  
  
  
  df2 <- reactive({
    req(obse())
    e <- new.env()
    library(package = input$pkg, character.only = TRUE)
    out <- data(list=input$dat, package = input$pkg, envir = e)
    e[[out]]
    # new <- input$dat
    # data(new, package = input$pkg)
    # cat(new)
  })
  
  
    output$dataset1 <- renderDataTable({
      DT::datatable(obse())
    })
    
    output$dataset2 <- renderDataTable({
      df2()
    })
    
    output$func <- renderPrint({
      lsf.str(funct())
    })
    
    observeEvent(input$reset,{
      output$dataset1 <- renderDataTable({
        
      })
      
      output$dataset2 <- renderDataTable({
       
      })
      
      output$func <- renderPrint({
      
      })
      
    })
    
}
# Run the application 
# undebug(shinyApp)
shinyApp(ui = ui, server = server)
2

Below is a working server section with updates commented as # NEW ADDDITION. The observeEvent() for resetting was not working because choices needed to be set to character(0) for the updateSelectInput and value set to NA for the updateTextInput. The obse object was changed to a reactiveValue so it could be reset with the reset button and re-established with the update button. To fix the app erroring on a manual clear of the textInput, req(input$pkg) was added to df and df2. One final addition was a tryCatch in df to handle cases where a nonexistent package name was entered, which caused the app to crash.

I hope these updates address the issues you were encountering.

# Define server logic required to draw a histogram
server <- function(input, output, session) {
  
  pkgs <- reactive({input$pkg})
  
  observeEvent(input$reset, {
    updateSelectInput(session, 'dat','Datasets', choices = character(0)) # NEW ADDTIION
    updateTextInput(session, 'pkg','Package Name', value = NA) # NEW ADDITION
    obse$d <<- NULL # NEW ADDITION
  })
  
  observeEvent(input$update, { # NEW ADDITION
    obse$d <<- df()
  })
  
  df <- eventReactive(input$update, {
    req(input$pkg) # NEW ADDITION
    
    # NEW ADDDITION: ensure the package exists before proceeding
    check = 'no error'
    data_name2 = NULL
    tryCatch(data(package = input$pkg), error = function(cond) {check <<- 'error'})
    
    if(check == 'no error') {
      data_name1 <- data(package=input$pkg)
      data_name2 <- as_tibble(data_name1$results) %>% rename(name=Item, label=Title) %>% select(-LibPath, -Package)
      data_name2
    }
    data_name2
  })
  
  obse <- reactiveValues(d = NULL) # NEW ADDITION as reactiveValue
  
  funct <- eventReactive(input$update, { paste0('package:',input$pkg) })
  
  observe({
    req(obse$d)
    updateSelectInput(session, inputId = "dat", label = "Datasets", choices = c(df()$name), selected = df()$name[1])
    
  })
  
  df2 <- reactive({
    req(obse$d, 
        input$pkg) # NEW ADDITION
    
    e <- new.env()
    library(package = input$pkg, character.only = TRUE)
    out <- data(list=input$dat, package = input$pkg, envir = e)
    e[[out]]
  })  
  
  output$dataset1 <- renderDataTable({
    req(obse$d) # NEW ADDITION
    DT::datatable(obse$d)
  })
  
  output$dataset2 <- renderDataTable({
    df2()
  })
  
  output$func <- renderPrint({
    lsf.str(funct())
  })
  
}
1 Like
3

thank you @scottyd22 for your response, it is very helpful. I tried your code and it worked, however i am struck with another update, i am unable to reset the function details to NULL if we reset, its not working, not sure where i am going wrong

here the updates i made are commented as # my updates

# Define server logic required to draw a histogram
server <- function(input, output, session) {

  pkgs <- reactive({input$pkg})
  
  
  df <- eventReactive(input$update, {
    req(input$pkg)
    
    check <- 'no error'
    data_name2 <- NULL
    tryCatch(data(package=input$pkg), error=function(cond) {check <<- 'error'})
    
    if (check == 'no error') {
   data_name1 <- data(package=input$pkg)
  data_name2 <- as_tibble(data_name1$results) %>% rename(name=Item, label=Title) %>% select(-LibPath, -Package)
  data_name2
    } 
    data_name2
    })

  # my update
  fun <- eventReactive(input$update, {
    req(input$pkg)
    
    check1 <- 'no error'
    
    tryCatch(lsf.str(paste0('package:',input$pkg)), error=function(cond) {check1 <<- 'error'})
    
    if (check1 == 'no error') {
      lsf.str(paste0('package:',input$pkg))
    } 
    #print('reset')
  })
  
  obse <- reactiveValues(d=NULL)
  funct <- reactiveValues(s=NULL)
  
  
  observeEvent(input$update, {
    obse$d <- df()
    funct$s <- fun()
  })
  

  observe({
    req(obse$d)
    updateSelectInput(session, inputId = "dat", label = "Datasets", choices = c(df()$name), selected = df()$name[1])
    
  })
  

  df2 <- reactive({
    req(obse$d, input$pkg)
    e <- new.env()
    library(package = input$pkg, character.only = TRUE)
    out <- data(list=input$dat, package = input$pkg, envir = e)
    e[[out]]
  })
  
  
    output$dataset1 <- renderDataTable({
      DT::datatable(obse$d)
    })
    
    output$dataset2 <- renderDataTable({
      df2()
    })
    
    output$func <- renderPrint({
      funct$s
    })
    
    observeEvent(input$reset,{
      updateTextInput(session, 'pkg','Package Name', value = NA)
      
      updateSelectInput(session, 'dat','Datasets', choices = character(0))
      
      obse$d <- NULL
      # my update
      output$func <- renderPrint({
        print('reset')
      })
      
    })
    
}
4

I think the updates below to my original post take care of the issue, which are shown with # 2nd update. Also, within df(), I changed rename to dplyr::rename because I was encountering an error after trying a second package input (must have been a conflicting function name).

# Define server logic required to draw a histogram
server <- function(input, output, session) {
  
  pkgs <- reactive({input$pkg})
  
  observeEvent(input$reset, {
    updateSelectInput(session, 'dat','Datasets', choices = character(0)) # NEW ADDTIION
    updateTextInput(session, 'pkg','Package Name', value = NA) # NEW ADDITION
    obse$d <<- NULL # NEW ADDITION
    funct$d <<- NULL # 2nd update
  })
  
  observeEvent(input$update, { # NEW ADDITION
    obse$d <<- df()
    funct$d <<- paste0('package:',input$pkg) # 2nd update
  })
  
  df <- eventReactive(input$update, {
    req(input$pkg) # NEW ADDITION
    
    # NEW ADDDITION: ensure the package exists before proceeding
    check = 'no error'
    data_name2 = NULL
    tryCatch(data(package = input$pkg), error = function(cond) {check <<- 'error'})
    
    if(check == 'no error') {
      data_name1 <- data(package=input$pkg)
      data_name2 <- as_tibble(data_name1$results) %>% dplyr::rename(name = Item, label = Title) %>% select(-LibPath, -Package)
      data_name2
    }
    data_name2
  })
  
  obse <- reactiveValues(d = NULL) # NEW ADDITION as reactiveValue  
  funct <- reactiveValues(d = NULL) # 2nd update
  
  observe({
    req(obse$d)
    updateSelectInput(session, inputId = "dat", label = "Datasets", choices = c(df()$name), selected = df()$name[1])
    
  })
  
  df2 <- reactive({
    req(obse$d, 
        input$pkg) # NEW ADDITION
    
    e <- new.env()
    library(package = input$pkg, character.only = TRUE)
    out <- data(list=input$dat, package = input$pkg, envir = e)
    e[[out]]
  })
  
  
  output$dataset1 <- renderDataTable({
    req(obse$d) # NEW ADDITION
    DT::datatable(obse$d)
  })
  
  output$dataset2 <- renderDataTable({
    df2()
  })
  
  output$func <- renderPrint({
    req(funct$d) # 2nd upddate
    lsf.str(funct$d) # 2nd update
  })
  
}
1 Like
5

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.