How to make this R Shiny table example reactive?-CodePudding

I found the following code that creates an RShiny app that allows users to visualize a data table based on certain columns that they select. See following code (should run on it's own):

library(shiny)
library(ggplot2)  # for the diamonds dataset

ui <- fluidPage(
  title = "Examples of DataTables",
  sidebarLayout(
    sidebarPanel(
      conditionalPanel(
        'input.dataset === "diamonds"',
        checkboxGroupInput("show_vars", "Columns in diamonds to show:",
                           names(diamonds), selected = names(diamonds))
      )
    ),
    mainPanel(
      tabsetPanel(
        id = 'dataset',
        tabPanel("diamonds", DT::dataTableOutput("mytable1")),
      )
    )
  )
)

server <- function(input, output) {
  
  # choose columns to display
  diamonds2 = diamonds[sample(nrow(diamonds), 1000), ]
  output$mytable1 <- DT::renderDataTable({
    DT::datatable(diamonds2[, input$show_vars, drop = FALSE])
  })
  
}

shinyApp(ui, server)

My question is, how can I change this dataset to be reactive, such that instead of always using the diamonds dataset, a data table would result based on what dataset I select from a dropdown menu? Such as adding a selectInput() argument?

CodePudding user response：

If you are just trying to have different tables show based on a selectInput(), then this will work for a small number of tables. Essentially, the output table is an if else statement, which displays a different table depending on what's selected in the selectInput().

library(shiny)
library(ggplot2)  # for the diamonds dataset

ui <- fluidPage(
  title = "Examples of DataTables",
  sidebarLayout(
    sidebarPanel(
      selectInput("Datasetchoice", "Dataset", choices = c("diamonds", "iris", "mtcars")), #Choose which dataset to display
      conditionalPanel(
        'input.dataset === "diamonds"',
        checkboxGroupInput("show_vars", "Columns in diamonds to show:",
                           names(diamonds), selected = names(diamonds))
      )
    ),
    mainPanel(
      tabsetPanel(
        id = 'dataset',
        tabPanel("diamonds", DT::dataTableOutput("mytable1"))
      )
    )
  )
)

server <- function(input, output) {
  
  # choose columns to display
  diamonds2 = diamonds[sample(nrow(diamonds), 1000), ]
  output$mytable1 <- DT::renderDataTable({
    if(input$Datasetchoice == "diamonds") { #If else statement, show a different table depending on the choice
    DT::datatable(diamonds2[, input$show_vars, drop = FALSE])
    } else if (input$Datasetchoice == "iris") {
      DT::datatable(iris)
    } else if(input$Datasetchoice == "mtcars") {
      DT::datatable(mtcars)
    }
  })
  
}

shinyApp(ui, server)

CodePudding user response：

Here is a solution that updates the checkboxes and the table upon selection of a different dataset. No limit on the number of datasets. But the datasets must be dataframes.

library(shiny)
library(datasets)  # for the datasets

ui <- fluidPage(
  title = "Examples of DataTables",
  sidebarLayout(
    sidebarPanel(
      selectInput("dat", 
                  label = "Choose data",
                  choices = c("cars", "mtcars", "faithful", "iris", "esoph", "USArrests")),
      checkboxGroupInput("datavars", "Columns to show", 
                         choices = NULL, 
                         selected = NULL)
    ),
    mainPanel(
      tabsetPanel(
        id = 'dataset',
        tabPanel("dataset", DT::dataTableOutput("mytable1")),
      )
    )
  )
)

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

  r <- reactiveValues(
    dataobj = NULL
  )
  observeEvent(input$dat, { 
    dataobj    <- r$dataobj <- get(input$dat, 'package:datasets') 
    datavars   <- names(dataobj)
    freezeReactiveValue(input, "datavars")
    updateCheckboxGroupInput(session, "datavars", 
                             choices = datavars, 
                             selected = datavars)
  })
  
  output$mytable1 <- DT::renderDataTable({
    req(r$dataobj, input$datavars)
    DT::datatable(r$dataobj[, input$datavars, drop = FALSE])
  })
  
}

shinyApp(ui, server)