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)