简体   繁体   中英

R Shiny reactive select Input

I keep getting an error when I try and make my select Input in R shiny reactive on another select Input. I've tried renderUi and updateSelectizeInput without success. I'd prefer to use updateSelectize as this is in keeping with the rest of the app.

I want the second select input to be the column names of columns that are not NA. Here is some cut down code:

library(dplyr)
library(shiny)

df <- setNames(data.frame(matrix(c(NA, NA, NA, 4, 6, 2, 1, 6, NA, NA), ncol = 5, nrow = 2, byrow = TRUE)), c("t1", "t2", "t3", "t4", "t5"))
df <- cbind(data.frame(ID = c("a", "b"), stringsAsFactors = FALSE), df)

all_drop_options <- df %>% pull(ID)

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

  updateSelectizeInput(session = session, inputId = "SID",
                       choices = all_drop_options, selected = "a",
                       server = TRUE)

  new_dat <- reactive({
    df %>% filter(ID == input$SID)
  })

  year_opts2 <- reactive({
    new_dat() %>%
      select(-ID) %>%
      select_if(~!is.na(.)) %>% colnames()
  })

  observe({
    updateSelectizeInput(session = session, inputId = "yr",
                         choices = year_opts2()
    )})
}

ui <- fluidPage(

  selectInput(inputId = "SID", label = NULL,
              choices = "a", selected = "a"),

  selectInput(inputId = "yr", label = "",choices = "")
)

shinyApp(ui, server)

Your problem is this:

new_dat <- reactive({
    df %>% filter(ID == input$SID)
  })

Trying to evaluate that inside of reactve() won't work. Simply put the df %>% filter(ID == input$SID) in place of:

new_dat()

so:

library(dplyr)
library(shiny)

df <- setNames(data.frame(matrix(c(NA, NA, NA, 4, 6, 2, 1, 6, NA, NA), ncol = 5, nrow = 2, byrow = TRUE)), c("t1", "t2", "t3", "t4", "t5"))
df <- cbind(data.frame(ID = c("a", "b"), stringsAsFactors = FALSE), df)

all_drop_options <- df %>% pull(ID)



ui <- fluidPage(

  selectInput(inputId = "SID", label = NULL,
              choices = "a", selected = "a"),

  selectInput(inputId = "yr", label = "",choices = "")
)


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

  updateSelectizeInput(session = session, inputId = "SID",
                       choices = all_drop_options, selected = "a",
                       server = TRUE)


  year_opts2 <- reactive({
    tryCatch({
    df %>% filter(ID == input$SID) %>%
      select(-ID) %>%
      select_if(~!is.na(.)) %>% colnames()},
    error = function(x){
      return('')
    })
  })

  observe({
    updateSelectizeInput(session = session, inputId = "yr",
                         choices = year_opts2()
    )})
}


shinyApp(ui, server)

edit:

As you noted, the script sometimes bugs because the filter returns an empty dataframe occasionally by error which stops colnames() from excecuting.

I added a tryCatch to mitigate for this but not entirely sure why it's happening!

Background:

For some reasons "I don't know about them" in the 2nd reactive , new_dat() become null after the 1st iteration, So select_if does what should be done and generates this error.

#Run this code for better understanding
observe(print(new_dat()))

year_opts2 <- reactive({
   browser()
 new_dat() %>%
   select(-ID) %>%
   select_if(~!is.na(.)) %>%
   colnames()

})

observe(print(year_opts2()))

Now, if we comment browser() and select_if(~!is.na(.)) code will work without any errors. Like so

observe(print(new_dat()))

year_opts2 <- reactive({
#browser()
 new_dat() %>%
   select(-ID) %>%
  #select_if(~!is.na(.)) %>%
   colnames()

})

observe(print(year_opts2()))

Solution:

Hopefully, below will solve your problem

year_opts2 <- reactive({
 colnames(new_dat()[,!is.na(new_dat())][-1])
})

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.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM