conditional panel combined with reactivity in shiny

Question

I am writing a shiny app to realize the following effects:

Whenever I choose variable included by categoryname, the web will generate the slider (here I use conditional panel) which provides a divider. It divides the selected variable into 2 groups and form a new column added to the original data set.

The web page can be generated now. My problem is:

1. The slider should be hided when I am not choosing the variable in categoryname, but it always appears.

2. Whenever I choose the variable in categoryname, the page will exit.

The error shows:

Warning in max(MT_EG$id_arm) :
  no non-missing arguments to max; returning -Inf
Warning in input$divider$max <- max(MT_EG$id_arm) :
  Coercing LHS to a list
Warning: Error in $<-.reactivevalues: Attempted to assign value to a read-only reactivevalues object
  75: stop
  74: $<-.reactivevalues
  72: observeEventHandler [/opt/bee_tools/shiny/3.5.1/users/denga2/teal.modules.km/testapp/app.R#75]
   1: runApp

Well the attempt to change the max an min of the slider isn't the only cause. When I set it to be fixed, the page also exits.

Here in the code I simply use mtcars dataset so that all of you can get access to.

library(shiny)

categoryname = c("mpg_group", "disp_group")
MT_EG = mtcars[,1:5]

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

   # Application title
   titlePanel("Mtcars Data"),

   # Sidebar with a slider input for number of bins 
   sidebarLayout(
      sidebarPanel(

         selectInput(inputId = "arm",
                     label = "ARM VARIABLE",
                     choices = c("mpg_group", "cyl", "disp_group", "hp", "drat"),
                     selected = "cyl"),

         conditionalPanel(
           condition = "categoryname.includes(input.arm)",
           #condition = "categoryname == input.arm",

           #optionalSliderInputValMinMax("divider", "divide slider", c(50,0,100), ticks = FALSE)
           sliderInput("divider", "divide slider", 0, 100, 50)
         )
      ),

      # Show a plot of the generated distribution
      mainPanel(
         uiOutput("data")
      )
   )
)

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

   observeEvent(
     input$arm,
     {
     if (input$arm %in% categoryname){
       # start over and remove the former column if exists
       MT_EG = MT_EG[, !(colnames(MT_EG) %in% input$arm)]

       id_arm_var <- input$arm
       id_arm <- unlist(str_split(id_arm_var,'_'))[1]

       # change the range of the slider
       input$divider$max = max(MT_EG$id_arm)
       input$divider$min = min(MT_EG$id_arm)

       # generate a new column and bind
       divi <- data.frame(id_arm_var = MT_EG$id_arm>input$divider)
       divi$id_arm_var[divi$id_arm_var==TRUE] <- paste0(id_arm_var, " Larger")
       divi$id_arm_var[divi$id_arm_var==FALSE] <- paste0(id_arm_var, " Smaller")
       MT_EG <- cbind(MT_EG,divi)
     }

   output$data=renderTable(MT_EG)
   })
}

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

Any ideas? Thank you guys!

Answer 1

There are several errors.

id_arm is not the name of a column of MT_EG. This a variable which contains a string, and this string is the name of a column of MT_EG. So you have to do MT_EG[[id_arm]] instead of MT_EG$id_arm.

You cannot update the slider by doing input$divider$max = max(MT_EG$id_arm). See ?updateSliderInput to update a slider.

condition = "categoryname.includes(input.arm)" is not correct. There's no variable categoryname in the JavaScript side. Instead, you can do:

condition = "input.arm == 'mpg_group' || input.arm = 'disp_group'"

Answer 2

MT_EG$id_arm is not valid R syntax espially id_arm a variable contains the column name, to do a such call use MT_EG[[id_arm]] or MT_EG[,id_arm]. In MT_EG[,id_arm] becareful with drop=FASLE and drop=TRUE. Use updateSliderInput to update Sliderinput during the seesion.

library(shiny)

  categoryname = c("mpg_group", "disp_group")
  MT_EG = mtcars[,1:5]

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

    # Application title
    titlePanel("Mtcars Data"),

    # Sidebar with a slider input for number of bins 
    sidebarLayout(
      sidebarPanel(
        sliderInput("bins",
                    "Number of bins:",
                    min = 1,
                    max = 50,
                    value = 30),

        selectInput(inputId = "arm",
                    label = "ARM VARIABLE",
                    choices = c("mpg_group", "cyl", "disp_group", "hp", "drat"),
                    selected = "cyl"),
        conditionalPanel(
          #condition = "categoryname.includes(input.arm)",
          condition = "input.arm == 'disp_group' | input.arm == 'mpg_group'",

          sliderInput("divider", "divide slider", 0, 100, 50)
        )
      ),

      # Show a plot of the generated distribution
      mainPanel(
        plotOutput("distPlot"),
        uiOutput("data")
      )
    )
  )

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

    output$distPlot <- renderPlot({
      # generate bins based on input$bins from ui.R
      x    <- MT_EG[, 1] 
      bins <- seq(min(x), max(x), length.out = input$bins + 1)

      # draw the histogram with the specified number of bins
      hist(x, breaks = bins, col = 'darkgray', border = 'white')
    })

    observeEvent(
      input$arm,
      {
        if (input$arm %in% categoryname){
          #browser()
          # start over and remove the former column if exists
          MT_EG = MT_EG[, !(colnames(MT_EG) %in% input$arm)]

          id_arm_var <- input$arm
          id_arm <- unlist(str_split(id_arm_var,'_'))[1]

          # change the range of the slider
          #input$divider$max = max(MT_EG$id_arm)
          val <- input$divider
          mx = max(MT_EG[[id_arm]])
          mn = min(MT_EG[[id_arm]])
          updateSliderInput(session, inputId = "divider", min=floor(mn/2),max = mx + 4,step = 1,value = (mn+1)%%2 + 1)
          #input$divider$min = min(MT_EG$id_arm)

          # generate a new column and bind
          #divi <- data.frame(id_arm_var = MT_EG$id_arm>input$divider)
          divi <- data.frame(id_arm_var = MT_EG[[id_arm]]>input$divider)
          divi$id_arm_var[divi$id_arm_var==TRUE] <- paste0(id_arm_var, " Larger")
          divi$id_arm_var[divi$id_arm_var==FALSE] <- paste0(id_arm_var, " Smaller")
          MT_EG <- cbind(MT_EG,divi)
        }

        output$data=renderTable(MT_EG)
      })
  }

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

Update

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

    output$distPlot <- renderPlot({
      # generate bins based on input$bins from ui.R
      x    <- MT_EG[, 1] 
      bins <- seq(min(x), max(x), length.out = input$bins + 1)

      # draw the histogram with the specified number of bins
      hist(x, breaks = bins, col = 'darkgray', border = 'white')
    })

    data <- reactiveValues()

    observeEvent(
      input$arm,
      {
        if (input$arm %in% categoryname){
          #browser()
          # start over and remove the former column if exists
          MT_EG = MT_EG[, !(colnames(MT_EG) %in% input$arm)]

          id_arm_var <- input$arm
          id_arm <- unlist(str_split(id_arm_var,'_'))[1]

          data$armv <- id_arm_var
          data$arm <- id_arm
          # change the range of the slider
          #input$divider$max = max(MT_EG$id_arm)
          val <- input$divider
          mx = max(MT_EG[[id_arm]])
          mn = min(MT_EG[[id_arm]])
          updateSliderInput(session, inputId = "divider", min=floor(mn/2),max = mx + 4,step = 1,value = (mn+1)%%2 + 1)
          #input$divider$min = min(MT_EG$id_arm)

          # generate a new column and bind
          #divi <- data.frame(id_arm_var = MT_EG$id_arm>input$divider)

        }
      })

  df_final <- reactive({
    req(data$armv, data$arm) #Do not start process data$armv and data$arm unless they are available. To prevent unnecessary Error messages
    id_arm_var <- data$armv
    id_arm <- data$arm
      divi <- data.frame(id_arm_var = MT_EG[[id_arm]]>input$divider)
      divi$id_arm_var[divi$id_arm_var==TRUE] <- paste0(id_arm_var, " Larger")
      divi$id_arm_var[divi$id_arm_var==FALSE] <- paste0(id_arm_var, " Smaller")
      MT_EG <- cbind(MT_EG,divi)
    })

    output$data=renderTable(df_final())

  }