Making Summary Tables Reactive

dplyr
shiny
rstudio
dt

#1

I have a table called "Query". There are six columns in the Query table.. pareto_code (a constant chr value), pct , liv_tester , nf_tester , epi_reactor , ox furnace . Below I have working calculated summary tables. I need to make these summary tables reactive in my dashboard. Currently, they are just coded to show up when the user clicks the specific tab. I want to have 'liv_tester', 'nf_tester', 'epi_reactor', 'ox furnace', 'epi reactor*ox furnace' as a reactive dropdown menu in the sidebar. So, for example when the user selects liv_tester in the dropdown menu.. only the liv_tester_table shows up on the dashboard.

Summary Tables:

Calculates model for pct and Ox Furnace

ox_furnace_table <- query %>% lm(pct~`ox furnace`,.) %>% summary() %>% coef %>% as_tibble(rownames="Model") %>% arrange(`Pr(>|t|)`)

names(ox_furnace_table)[1:5] = c("Model","Scaled Estimate","Standard Error","t Ratio", "Prob >|t|")

Calculates model for pct and liv Tester

liv_tester_table <- query %>% lm(pct~liv_tester,.) %>% summary() %>% coef %>% as_tibble(rownames="Model") %>% arrange(`Pr(>|t|)`)

names(liv_tester_table)[1:5] = c("Model","Scaled Estimate","Standard Error","t Ratio", "Prob >|t|")

Calculates model for pct and nf tester .

nf_tester_table <- query %>% lm(pct~nf_tester,.) %>% summary() %>% coef %>% as_tibble(rownames="Model") %>% arrange(`Pr(>|t|)`)

names(nf_tester_table)[1:5] = c("Model","Scaled Estimate","Standard Error","t Ratio", "Prob >|t|")

Calculates model for pct and epi reactor .

epi_reactor_table <- query %>% lm(pct~`epi reactor`,.) %>% summary() %>% coef %>% as_tibble(rownames="Model") %>% arrange(`Pr(>|t|)`) 

names(epi_reactor_table)[1:5] = c("Model","Scaled Estimate","Standard Error","t Ratio", "Prob >|t|")

Calculates model for pct and epi reactor*ox furnace .

epiandox_table <- query %>% lm(pct~`epi reactor`:`ox furnace`,.) %>% summary() %>% coef %>% as_tibble(rownames="Model") %>% arrange(`Pr(>|t|)`) 

names(epiandox_table)[1:5] = c("Model","Scaled Estimate","Standard Error","t Ratio", "Prob >|t|")

This is my Shiny code so far:

library(odbc) #connect to ODBC Compatible Databases
library(DBI) #database interface definition for communication between R and 
relational database management systems
library(dbplyr) #data manipulation
library(dplyr) #data frames
library(shiny)
library(shinydashboard)

# User Interface ----------------------------------------------------------

ui <- dashboardPage(skin="black",

# dashboardHeader ---------------------------------------------------------


                dashboardHeader(title = "Test",titleWidth = 350,
                                tags$li(a(href = 'https://www.test.com/en',
                                          img(src = 'logo.png',
                                              title = "Homepage", height = "35px"),
                                          style = "padding-top:5px; padding-bottom:5px;"),
                                        class = "dropdown")),

                # dashboardSidebar --------------------------------------------------------

                dashboardSidebar(width=350,


                                 sidebarMenu(
                                   selectInput("pareto_code", label = "Pareto Code:", choices = unique(query$pareto_code), selected = sort(unique(query$pareto_code)) [1], multiple = F)
                                  ),



                # dashboardBody -----------------------------------------------------------

                dashboardBody(
                  tabsetPanel(
                    tabPanel("LIV Testers", 
                             dataTableOutput("LIV"), 
                             NULL
                    ),

                    tabPanel("NF Testers", 
                             dataTableOutput("NF"), 
                             NULL
                    ),

                    tabPanel("Furnace", 
                             dataTableOutput("OX"), 
                             NULL
                    ),

                    tabPanel("Reactor", 
                             dataTableOutput("EPI"), 
                             NULL
                    ),

                    tabPanel("Reactor & Furnace", 
                             dataTableOutput("EPIOX"), 
                             NULL
                    ),


                  #Changes font of the title in dashboard header
                  tags$head(tags$style(HTML('.main-header .logo {
                                            font-family: "Georgia", Times, "Times New Roman", serif;
                                            font-size: 17px;
                                            text-align: center;
                                            text-transform: uppercase;
                                            }
                                            '))),

                  #Changes font of the date/range label 
                  tags$head(tags$style(HTML('.control-label {
                                            font-family: "Georgia", Times, "Times New Roman", serif;
                                            font-size: 13px;
                                            text-align: center;
                                            }
                                            '))),

                  #Changes font of the tabs
                  tags$head(tags$style(HTML('.nav-tabs a {
                                            font-family: "Georgia", Times, "Times New Roman", serif;
                                            font-size: 15px;
                                            color: black !important;
                                            }
                                            ')))

                  )))


# Server ------------------------------------------------------------------


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

  output$LIV <- renderDataTable(liv_tester_table, options = list(searching=FALSE))
  output$NF <- renderDataTable(nf_tester_table, options = list(searching=FALSE))
  output$OX <- renderDataTable(ox_furnace_table, options = list(searching=FALSE))
  output$EPI <- renderDataTable(epi_reactor_table, options = list(searching=FALSE))
  output$EPIOX <- renderDataTable(epiandox_table, options = list(searching=FALSE))
}


# Shiny App ---------------------------------------------------------------


shinyApp(ui, server)

#2

Hi @agold

You'll want to use a selectInput (Reference: https://shiny.rstudio.com/reference/shiny/1.1.0/selectInput.html ) that can pull information out of your results table.

Your server could contain...

server <- function(input, output) {
  output$result <- renderDataTable({
    switch(input$myInputSelect, 
      "LIV" = liv_tester_table,
      "FN" = nf_tester_table,
      "OX" = ox_furnace_table,
      "EPI" = epi_reactor_table,
      "EPIOX" = epiandox_table
    )
  })
}

With myInputSelect added to your UI

selectInput(
  "myInputSelect", 
  "Data:", 
  c(
    "LIV Testers" = "LIV", 
    "NF Testers" = "NF", 
    "Furnace" = "OX", 
    "Reactor" = "EPI", 
    "Reactor & Furnace" = "EPIOX"
  )
)

Hope this helps!
- Barret