Hide/Show table in R shiny based on input value

shiny
,
1

I am trying to show/hide a table based on the input selection. Based on my first dropdown if the user selects a value wave2 it should show the table 2 under the 1st tab else it should hide. I tried to use the react input select value to if else condition for output which is not how react works in R. Could someone please check and let me know on where I am wrong .

UI.r

library(shiny)
library(shinydashboard)
library(shinyBS)
library(shinythemes)

dashboardPage(
  dashboardHeader(disable = F, title = "PATH Study"),
  dashboardSidebar(
    uiOutput("choose_wave"),
    uiOutput("choose_category"),
    uiOutput("choose_ethnicity"),
    uiOutput("choose_age"),
    uiOutput("choose_gender")
  ),
  #S dashboardPage(header = dashboardHeader(), sidebar = dashboardSidebar(),body,title = NUll, skin = "yellow"),
  dashboardBody(box(
    width = 12,
    tabBox(
      width = 12,
      id = "tabBox_next_previous",
      tabPanel("Initiation",
               fluidRow(
                 box(
                   title = "TABLE1",
                   width = 5,
                   solidHeader = TRUE,
                   status = "primary",
                   tableOutput("smoke"),
                   collapsible = T,
                   
                 ),
                 box(
                   title = "TABLE2",
                   width = 7,
                   solidHeader = TRUE,
                   status = "primary",
                   tableOutput("first_flov"),
                   collapsible = T
                 )
                  ))
    ),
    uiOutput("Next_Previous")
  ))
)

SERVER.r

library(shiny)
library(shinydashboard)
library(shinyBS)
library(knitr)
library(kableExtra)
library(plyr)
library(tidyverse)
library(DT)
library(dplyr)

shinyServer(function(input, output) {
  print(sessionInfo())

  with_demo_vars <- reactive({
    data_selector(wave(), youth()) %>%
      mutate(
        ethnicity = !!ethnicity(),
        age = !!age_group(),
        gender = !!gender()
      )
  })
  # Drop-down selection box for which Wave and User Type bracket to be selected
  output$choose_wave <- renderUI({
    # This can be static: it is the highest level and the options won't change
    selectInput(
      "selected_wave",
      "Wave",
      choices = list(
        "Wave 1 Adult" = "wave1youthFALSE",
        "Wave 1 Youth" = "wave1youthTRUE",
        "Wave 2 Adult" = "wave2youthFALSE",
        "Wave 2 Youth" = "wave2youthTRUE"
      )
    )
  })

  wave <- reactive({
    as.integer(gsub("wave(\\d)youth.*", "\\1", input$selected_wave))
  })

  youth <- reactive({
    as.logical(gsub("wave\\dyouth(.+)$", "\\1", input$selected_wave))
  })


  # Drop-down selection box for which Gender bracket to be selected
  output$choose_ethnicity <- renderUI({
    selectInput("selected_ethnicity", "Ethnicity", as.list(levels(with_demo_vars()$ethnicity)))
  })
  # Drop-down selection box for which Age bracket to be selected
  output$choose_age <- renderUI({
    selectInput("selected_age", "Age", as.list(levels(with_demo_vars()$age)))
  })
  # Drop-down selection box for which Gender bracket to be selected
  output$choose_gender <- renderUI({
    selectInput("selected_gender", "Gender", as.list(levels(with_demo_vars()$gender)))
  })

  output$selected_var <- renderText({
    paste("You have selected", input$selected_wave)
  })

    myData <- reactive({
    # wave_selected <- input$selected_wave
    category_selected <- req(input$selected_category)
    age_selected <- req(input$selected_age)
    gender_selected <- req(input$selected_gender)
    ethnicity_selected <- req(input$selected_ethnicity)

    # TABLE 1
    df<-data_selector(wave = 1, youth()) %>%
      filter(!!is_ever_user(type = category_selected)) %>%
      pct_first_flavored(type = category_selected)
    df_sub <- names(df) %in% c("variable")
    df <- df[!df_sub]

    df
      })

  first_flov <- reactive({
    category_selected <- req(input$selected_category)
    age_selected <- req(input$selected_age)
    gender_selected <- req(input$selected_gender)
    ethnicity_selected <- req(input$selected_ethnicity)

    first_flov_df <- data_selector(wave = 2, youth()) %>%
      filter(!!is_new_user(type = category_selected)) %>%  # this doesn't apply to wave 1
      pct_first_flavored(type = category_selected)

    first_flov_df_sub <- names(first_flov_df) %in% c("variable")
    first_flov_df <- first_flov_df[!first_flov_df_sub]
    first_flov_df
      })
  output$smoke <-
    renderTable({
      head(myData())
    })
  output$first_flov <-
        if (wave() == 2) {
      renderTable({
        head(first_flov())
      })
    } else {
      renderText({
        paste("You have selected", input$selected_wave)
      })
    }

})
2

I would probably use shinyjs for this. You can start with an element hidden

hidden(div(id = "id", box( ... )))

and then use

toggleElement(id = "id", condition = wave() == 2)

in an observer. The element will show when the condition is true and hide when it is false. See shinyjs on github for more info. It is a great package.

1 Like
3

I did add this

shinyjs::hidden(div(id = "id", box(
                 title = "Wave 2 Ever Tried and % 1st Product Flavored",
                 width = 7,
                 solidHeader = TRUE,
                 status = "primary",
                 tableOutput("selected_var"),
                 collapsible = T
               )))

output$consumption_flav <-  renderTable({
    #head(datatable(myData(), container = smoke_hover))
    head(Mean_Consumption_Flavor())
    # rownames = rownames
    # datatable(abc, colnames = c('Variable', 'Mean', 'Weighted N', 'Standar Error'))
  })

  toggleElement(id = "id", condition = wave() == 2)

I get an error

Error in .getReactiveEnvironment()$currentContext() :
Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)

4

Hi,

you are getting the error because you are trying to get the reactive wave() in a non reactive context (i.e not inside an observer or renderer).

The toggleElement(...) wants to be inside an observer of some sort. Try

observe({
  toggleElement(id = "id", condition = wave() == 2)
})
2 Likes
5

Propbably easier to do use uiOutput and renderUI.

In your UI change:

box(
  title = "TABLE2",
  width = 7,
  solidHeader = TRUE,
  status = "primary",
  tableOutput("first_flov"),
  collapsible = T
)

to:

uiOutput("table2")

then in the server add:

output$table2 <- renderUI({
  req(wave() == 2)
  
  box(
    title = "TABLE2",
    width = 7,
    solidHeader = TRUE,
    status = "primary",
    tableOutput("first_flov"),
    collapsible = T
  )
  
})
1 Like