Home > Back-end >  How to select subcolumns of values from variables in shiny by input$show_vars?
How to select subcolumns of values from variables in shiny by input$show_vars?

Time:07-28

I have a table of variables and values. Users should be able to select variables by a checkboxGroupInput. I try to select subcolumns of the belonging values by the variable names. Therefore I save the values in vectors for every variable and these variable vectors in a list. The selection with the input$show_vars does not work.

resulting table looks like this

[![library(shiny)
library(dplyr)
library(kableExtra)

Table_1 <- tibble(Answers = "mean", Total = 3, US = 3.5, FR = 4, IT = 2, male = 0, female = 1) # Table as tibble

# variables
vars <- c("Region", "gender") # names of the variables

# values of variables als vectors
Region <- c("US", "FR", "IT") 
gender <- c("male", "female") 

all_cols_list <- list(Region, gender) # later I want to sort the list by sortable input

ui <- fluidPage(
  title = "Table_1",
  sidebarLayout(
    sidebarPanel(
        checkboxGroupInput(inputId = "show_vars", 
                           label = "Variables to show:",
                           choices = vars, 
                           selected = vars)
    ),
    mainPanel(
      tableOutput(outputId = "mytable1")
    )
  )
)

server <- function(input, output) {
  
  output$mytable1 <- reactive({

     selected_cols <- unlist(all_cols_list#\[input$show_vars\] # this does not work if I do not comment it out; I tried get() and unlist() but got Errors
                             ) 

    Table_1 %>%
        select(Answers, Total, all_of(selected_cols)) %>% # select the variables from the input 
        kbl(caption = "Table_1") %>%
        kable_material()  %>% 
        add_header_above(c(" " = 2, "Region" = length(Region), "gender" = length(gender))) %>% # works
     #  add_header_above(c(" " = 2, # this does not work either, dont know why
     #                       if("Region" %in% input$show_vars) "Region" = length(Region),
     #                       if("gender" %in% input$show_vars) "gender" = length(gender)
     #                       )) 
       kable_styling(bootstrap_options = c("striped", "hover"))
 
    })
}  
shinyApp(ui, server)][1]][1]

CodePudding user response:

Here is one approach to make your code work which selects the columns for each variable using all_cols_list[input$show_vars] and also creates the header for your table dynamically:

library(shiny)
library(dplyr)
library(kableExtra)

Table_1 <- tibble(Answers = "mean", Total = 3, US = 3.5, FR = 4, IT = 2, male = 0, female = 1) # Table as tibble

# variables
vars <- c("Region", "gender") # names of the variables

# values of variables als vectors
Region <- c("US", "FR", "IT") 
gender <- c("male", "female") 

all_cols_list <- list(Region = Region, gender = gender) # later I want to sort the list by sortable input

ui <- fluidPage(
  title = "Table_1",
  sidebarLayout(
    sidebarPanel(
      checkboxGroupInput(inputId = "show_vars", 
                         label = "Variables to show:",
                         choices = vars, 
                         selected = vars)
    ),
    mainPanel(
      tableOutput(outputId = "mytable1")
    )
  )
)

server <- function(input, output) {
  
  output$mytable1 <- reactive({
    
    selected_cols <- all_cols_list[input$show_vars]
    header <- c(" " = 2, lengths(selected_cols))
    
    Table_1 %>%
     select(Answers, Total, all_of(unname(unlist(selected_cols)))) %>%
      kbl(caption = "Table_1") %>%
      kable_material()  %>% 
      add_header_above(header) %>% # works
      kable_styling(bootstrap_options = c("striped", "hover"))
    
  })
}  
shinyApp(ui, server)

enter image description here

  • Related