Shiny Useful Code

Created by Chia, Jonathan, last modified on Apr 09, 2022

Introduction

For making production ready shiny dashboards - table of contents in no particular order

Note: this article assumes reader already has a basic shiny understanding

Table of Contents

Why Use Shiny?

  1. Shiny is a simple extension of R

  2. Shiny provides detailed customization but an easy framework

Setup Dashboard URL

  1. Log into bi-rstudio - you will create your dashboard on this server so people in the company can access through a URL link

  2. Create a ShinyApps folder in your home directory

  4. In your Shiny Apps folder, create a folder for your dashboard - here we named it mydashboard

  6. Now people can access your dashboard through http://bi-rstudio:3838/yourusername/mydashboard/

  7. Finally, in the mydashboard folder, create a R file named "app.R"

The URL link only works if you have a folder named ShinyApps, a dashboard folder, and then an app.R file.

Login/Authentication

For better security, create an authentication page for the dashboard

UI

require(shinymanager)

# this inactivity function will close the dashboard after enough idle time

inactivity <- "function idleTimer() {
	var t = setTimeout(logout, 120000);window.onmousemove = resetTimer; // catches mouse 
	movementswindow.onmousedown = resetTimer; // catches mouse 
	movementswindow.onclick = resetTimer;     // catches mouse 
	clickswindow.onscroll = resetTimer;    // catches scrollingwindow.onkeypress = resetTimer;  //catches keyboard 
	actionsfunction logout() {window.close();  //close the window
}
function resetTimer() {
	clearTimeout(t);t = setTimeout(logout, 120000);  // time is in milliseconds (1000 is 1 second)
}
}
idleTimer();"

ui <- shinymanager::secure_app(tags_top = tags$img(src = "https://upload.wikimedia.org/wikipedia/commons/9/9a/JTV_Logo.png", width = 200), 
			       tags_bottom = tags$div(tags$p("Username: JTV Email (lowercase)",    
			       tags$p("For access to this dashboard, please  contact ",     
 			       tags$a(href = paste("mailto:",cfg$user$manager_email,"?Subject=Shiny%20Manager",sep=""), target = "_top", cfg$user$manager_name)))),
			       head_auth = tags$script(inactivity),  
			       dashboardPage(header, sidebar, body))

Server

credentials_df <- data.frame(user = c("joebob@jtv.com", "exampleuser@jtv.com"),    
 					password = c("123", "123"),    comment = c("user"),    stringsAsFactors = FALSE)

result_auth <- shinymanager::secure_server(check_credentials = check_credentials(credentials_df))    

output$res_auth <- renderPrint({ reactiveValuesToList(result_auth) })

Tip: For credentials_df, create it using config file

credentials_df <- data.frame(user = c(cfg$user1, cfg$user2), 
			     password = c(cfg$password1, cfg$password2))

IMPORTANT NOTE:

observe() function will not work because of the authentication page unless you use the below code:

observe({    
	if(is.null(input$shinymanager_where) || (!is.null(input$shinymanager_where) && input$shinymanager_where %in% "application")){
		# insert code here
	}
})

Additionally, sometimes observeEvent() function will trigger at initialization because of the authentication page. Set init = FALSE to avoid this issue:

observeEvent(input$actionbutton, init = FALSE, {
	# insert code here
})

Display Markdown/HTML Documents

Markdown documents can be very good for explanation pages in dashboards.

markdown/html in shiny: https://shiny.rstudio.com/gallery/including-html-text-and-markdown-files.html

markdown cheat sheet: https://www.markdownguide.org/cheat-sheet/

Email DataTable as CSV/Excel within Company through SMTP

Create an email button:

Clicking the green email button reveals this dropdown:

UI

require(shinyWidgets)
require(shinyAce)

dropdownButton(tags$h3("Send Email with List as Attachment"),                                                                            
		splitLayout(radioButtons('format', 'Attach List As:', c('CSV', 'Excel'), inline = TRUE),
		actionButton('send', "Send", icon = icon("envelope"))),                                                                            
		textInput("to", "To:", value=""),                                                                            
		textInput("cc", "Cc:", value=""),                                                                            
		textInput("subject", "Subject:", value=NULL),
		shinyAce::aceEditor("message", value=" ", height = "200px"),                                                                            
		tags$body("Instructions: to send to multiple people, place commas in between emails"),                                                                            
		tags$body("For example: joe@jtv.com, bob@jtv.com"),                                                                            
		tags$body("Note: email is sent from the email that you logged in with"),                                                                            
		status = 'success',                                                                            
		up = TRUE,                                                                            
		icon=icon('envelope'))

Server

require(mailR)

observeEvent(input$send, {        
	withProgress(message = 'Emailing', value = 0, {      
		incProgress(1/3, detail = "Compiling List")            
		if (input$format == "Excel") {        
		path <- paste0('temp_files/filtered_customer_list_', session$token, '.xlsx')        
		xlsx::write.xlsx(values$df, path, row.names = FALSE)      }   # values$df is the datatable as seen in the above picture    

		if (input$format == "CSV") {        
		path <- paste0('temp_files/filtered_customer_list_', session$token, '.csv')        
		data.table::fwrite(values$df, path)      }                  

		incProgress(1/3, detail = "Writing Email")      
		user <- reactiveValuesToList(result_auth)$user      

		if (input$cc == "") {        
		send.mail(from = user,                  
				to = input$to,                  
				# cc = input$cc,                  
				# bcc = input$bcc,                  
				subject = input$subject,                  
				body = input$message,                  
				smtp = list(host.name = -----, port = --),                  
				authenticate = FALSE,                  
				send = TRUE,                  
				attach.files = path)      
		} else {        
		send.mail(from = user,                  
				to = input$to,                  
				cc = input$cc,                  
				# bcc = input$bcc,                  
				subject = input$subject,                  
				body = input$message,                  
				smtp = list(host.name = -----, port = --),                  
				authenticate = FALSE,                  
				send = TRUE,                  
				attach.files = path)      }            

		incProgress(1/3, detail = "Finished")    })            

	        system(paste("rm -f", path))  })

Download DataTable as CSV/Excel

UI

column(1, downloadButton('csv', "CSV")),                             
column(1, downloadButton('excel', "Excel")),

Server

# NOTE: values$df is the dataframe you want to download

output$csv <- downloadHandler(        
		# This function returns a string which tells the client browser what name to use when saving the file.    
		filename = function() {      
		paste("customer-filtered-", Sys.Date(), ".csv", sep="")    },        

		# This function should write data to a file given to it by the argument 'file'.    
		content = function(file) {      
		# Write to a file specified by the 'file' argument      
		write.table(values$df, file,  row.names = FALSE)    }  )      



output$excel <- downloadHandler(        
		filename = function() {      
		paste("customer-filtered-", Sys.Date(), ".xlsx", sep="")    },    

		content = function(file) {            
		xlsx::write.xlsx(values$df, file, row.names = FALSE)    }  )

Create Report Compiler Tab

Users can compile a report in word/html using screenshots through this tab

How to build:

  1. Create screenshot button

  2. Create report compiling tab

Screenshot Button

Adds screenshot button to top right corner of the dashboard

UI

header <- dashboardHeader(title = "Cool Title",                            
		tags$li(class = 'dropdown', actionLink("screenshot", "Screenshot", icon = icon("camera")))
)

Server

require(shinyscreenshot) 
observeEvent(input$screenshot, {                         # will save the screenshots into a temp directory                      screenshot(filename = paste0('dashboard_screenshot_', Sys.Date())) })

Report Tab

UI

build_report_page <- fluidPage(  
# App title ----  
titlePanel("Compile Reports using Screenshots"),  
sidebarLayout(    
	sidebarPanel(      
			fileInput("file1", "File Uploader", multiple = TRUE, accept = c(".png"), buttonLabel = "Upload"), 
			tags$hr(), 

			helpText("Type an executive summary here:"),      
			shinyAce::aceEditor("markdowninput", value="Please use any **markdown** syntax", height = "75px", mode = "markdown", showLineNumbers = FALSE),      
			tags$hr(),      

			splitLayout(        
					downloadButton('build_report',"Download Report",class="butt"),        
					actionButton("preview", "Preview Report", style="color: #E6EBEF; background-color: steelblue")      ),      
					tags$head(tags$style(".butt{background-color:steelblue;} .butt{color: #e6ebef;}")),      
					radioButtons('format_report', 'Document format', c('Word', 'HTML'), inline = TRUE),    ),        

	mainPanel(      
			# Output: Data file ----      
			uiOutput("markdown")    )      ))

Server

output$htmlmarkdown <- reactive({ note_in_html(input$markdowninput) })    

observeEvent(input$preview, {    
				src <- normalizePath('doc/documents/report_compiler_md.Rmd')    
				owd <- setwd(tempdir())    
				on.exit(setwd(owd))    

				file.copy(src, 'report_compiler_md.Rmd', overwrite = TRUE)    
				out <- knitr::knit('report_compiler_md.Rmd')     
				values$src <- normalizePath(out)  })    

output$markdown <- renderUI({    
				if (input$preview > 0) {      
					file <- values$src    
				} else {      
					file <- 'doc/documents/blank_report_compiler.md'    
				}    

				includeMarkdown(file)  })    


output$build_report = downloadHandler(        
				filename<- function(){            
					paste("Customer_Segmentation_Report",Sys.Date(),switch(input$format_report, HTML = '.html', Word = '.docx'),sep = "")},                

				content = function(file) {            
					if (input$format_report=="HTML"){                
						withProgress(message = 'Download in progress', detail = 'This may take a while...', value = 0, {                                                                                      
							src <- normalizePath('doc/documents/report_compiler_html.Rmd')                                                                     
							# temporarily switch to the temp dir, in case you do not have write permission to the current working directory                                              
							owd <- setwd(tempdir())                                              
							on.exit(setwd(owd))                                              

							file.copy(src, 'report_compiler_html.Rmd', overwrite = TRUE)                       
							# images will already be in tmp directory so .Rmd file can reference them                                              
							library(rmarkdown)                                              
							out <- render('report_compiler_html.Rmd', html_document())                                              
							file.rename(out, file) 
						})                
							### below is the end of pdf content              
					}else{                
						withProgress(message = 'Download in progress',  detail = 'This may take a while...', value = 0, {                                              
					        	src <- normalizePath('doc/documents/report_compiler_word.Rmd')                                                                     
							owd <- setwd(tempdir())                                              
							on.exit(setwd(owd))                                              
							file.copy(src, 'report_compiler_word.Rmd', overwrite = TRUE)                                                          
							library(rmarkdown)                                              
							out <- render('report_compiler_word.Rmd', word_document())                                              
							file.rename(out, file)                                            
						})              
					}                    
})

Documents - YOU WILL NEED THESE FILES

report_compiler_md.Rmd

--- 
title: "Customer Segmentation Report"
date: "`r format(Sys.time(), '%d %B, %Y')`"
output: md_document
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = F)
knitr::asis_output(input$markdowninput)
mydirectory <- list.files(include.dirs=TRUE)
myimages<-list.files(mydirectory[1], pattern = ".png", full.names = TRUE)
knitr::include_graphics(myimages)

report_compiler_html.Rmd - same as above but with output: html_document

report_compiler_word.Rmd - same as above but with output: word_document

DataTable Formatting Function Examples

DataTable formatting is an absolute pain and takes forever. Below are some functions I use to make life easier:

Number Formatting

Function

# applies number formatting to DataTable (currency, rounding, percentages)
#
# @param DataTable: a DataTable object# @param perc_columns: vector of column names that need percentage formatting
# @param num_columns: vector of column names that need to be rounded
# @param currency_columns: vector of column names that need dollar formatting
#
# @return DataTable with percentages rounded to 2 decimal places and currency/numbers rounded to 0 decimal places
formatstyle_number <- function(DataTable, perc_columns, num_columns, currency_columns) {  
	if (!FALSE %in% perc_columns) {    
		for (i in perc_columns) {      DataTable <- DataTable %>% formatPercentage(., i, 2)    }  
	}  
	if (!FALSE %in% num_columns) {    
		for (i in num_columns) {      DataTable <- DataTable %>% formatCurrency(., i, "", digits = 0)    }  
	}  
	if (!FALSE %in% currency_columns) {    
		for (i in currency_columns) {      DataTable <- DataTable %>% formatCurrency(., i, "$", digits = 0)    }  
	}  

	DataTable
}

Server Example

output$table <- renderDataTable({
	datatable(df) %>% formatstyle_number(., c('Return Rate', 'Cancel Rate', 'Percent Temporary Discount'), c('Total Orders'), c('Gross Margin', 'CLV 5'))
})

Server without function

output$table <- renderDataTable({
	datatable(df) %>% 
		formatPercentage(., 'Return Rate', 2) %>%
		formatPercentage(., 'Cancel Rate', 2) %>%
		formatPercentage(., 'Percent Temporary Discount', 2) %>%
		formatCurrency(., 'Total Orders', "", digits = 0) %>%
		formatCurrency(., 'Gross Margin', "$", digits = 0) %>%
		formatCurrency(., 'CLV 5', "$", digits = 0)
})

Border Formatting

Function

# Adds vertical lines into the table for column separation
#
# @param left_columns: vector of column names to place vertical borders on left of
# @param right: column name of column to place vertical border at the right of
#
# @return DataTable with vertical line borders
formatstyle_border_vertical <- function(DataTable, left_columns, right) {  
	for (i in left_columns) {    
		DataTable <- DataTable %>% formatStyle(., i, `border-left` = "solid 2px #000")  
	}  
	
	DataTable %>% formatStyle(., right, `border-right` = "solid 2px #000")
}

Conditional Formatting

The below function is more complicated. Ask Jonathan or Tyki for an explanation if it is confusing.

Function

# applies conditional color formatting to a DataTable
#
#
# @param DataTable: a DataTable object
# @param columns: vector of column names to be formatted
# @param is_total: TRUE formats the "total" row. FALSE for DataTables without "total" row
# @param colors: vector of colors in hex format - must be odd number of colors
#
# @return a DataTable with columns that are colored based on quantiles of numbers in column
formatstyle_color <- function(DataTable, columns, colors) {  
	if (is_total == TRUE) {    
		for (i in columns) {      
			DataTable <- DataTable %>%         
				formatStyle(., i, backgroundColor = styleInterval(DataTable$x$data[-nrow(DataTable$x$data), ] %>% 
											pull(i) %>% 
											quantile(prob = seq(0, 1, by = 1/length(colors))[-c(1, length(colors)+1)]),
										  colors)
				) %>%      
				formatStyle(., 1:ncol(DataTable$x$data), 
						valueColumns = 1,                     
						backgroundColor = styleEqual("Total", "white"))    
		}  
	} else {    
		for (i in columns) {      
			DataTable <- DataTable %>% 
				formatStyle(., i, backgroundColor = styleInterval(DataTable$x$data %>% 
											pull(i) %>% 
											quantile(prob = seq(0, 1, by = 1/length(colors))[-c(1, length(colors)+1)],na.rm=TRUE), 
									         colors)
				)    
		}  
	}  

	DataTable

}

Notes:

Datatable$x$data references the dataframe that was put into the datatable() function

Reference: https://rstudio.github.io/DT/functions.html

Build your own functions using the same strategies from these formulas

Shiny Widgets - Dropdown, Sweet Alerts, PickerInput, SwitchInput, etc.

This package provides improved UI widgets such as pickerInput(), dropdownButton(), and sweet alerts

https://dreamrs.github.io/shinyWidgets/index.html

When to use Column() vs. SplitLayout()

SplitLayout() automatically places UI widgets equally spread apart, so it's easier to use

UI - sliderinput will take up half of the screen and plot output will take up the other half

fluidRow(   
	splitLayout(      
		sliderInput("obs", "Number of observations:", min = 1, max = 1000, value = 500),        
		plotOutput("distPlot")
		)
	)

Column() gives you full control of UI widget location, so it gives more detailed fine-tuning

UI - slider input takes up 1/3 of the screen and plot output takes up 2/3

 fluidRow(    
	column(4,      
		sliderInput("obs", "Number of observations:", min = 1, max = 1000, value = 500)    ),    
	column(8,      
		plotOutput("distPlot")    )
	)

# The grid width of the column (must be between 1 and 12)

IMPORTANT NOTE: use column() if selectInput() dropdown doesn't dropdown fully

Using SplitLayout()

Using column()

Adding Tool Tips

Put tool tips over/under widgets

UI

require(shinyBS)

fluidRow(
numericRangeInput("clv_5", "5-Year CLV:", value = c(NA,NA)),
bsTooltip('clv_5', "Expected 5 year GM", placement = "top")
)

# IMPORTANT: be careful not to have apostrophes in the tooltip or it will not show. 
# For example: 
# 	bsTooltip('clv_5', "Customer's 5 year GM", placement = "top")   --  this is incorrect

Useful Database Connection Functions

Connection

con <- dbConnect(odbc::odbc(),                          
			uid = ----,                           
			pwd = ----,                          
			"OracleODBC")

Close connection at end of app

session$onSessionEnded(function() {dbDisconnect(con)})

Write data.frame() to Oracle

DBI::dbWriteTable(con, "TABLE_NAME", df, append = FALSE, overwrite = FALSE, temporary = FALSE)

Append data to global temporary table in oracle 

# note: dbWriteTable('temporary = TRUE') does not work with odbc package 
# you have to create a global temporary table in oracle and then append data onto that table using dbWriteTable

dbWriteTable(con, 'GLOBAL_TEMP_TABLE_NAME', df, append=TRUE)

Lazy Load table from oracle into R - see DBPLYR section for more details

lazy_table <- dbplyr::tbl(con,sql("USER.EXAMPLE_TABLE"))

Highchart Visualization Tips

I highly recommend using highcharts for best-in-class tooltips and visualizations

https://jkunst.com/highcharter/

Example:

Non-Standard Evaluation (NSE) of columns

Problem:

bar_chart <- function(df, variable_name_str) {
	hchart(df, 'bar', hcaes(x = variable_name_str, y = 'Placed_Orders'))
	
}

bar_chart(df, 'gemstone')

# This function doesn't work because it thinks x is 'variable_name_str' instead of 'gemstone'

Solution:

bar_chart <- function(df, variable_name_str) {  
column <- sym(variable_name_str)  
hchart(df, 'bar', hcaes(x = !!column, y = 'Placed_Orders'))
}

This solution should work in other scenarios outside of highchart visualizations as well

Tool Tips

Below is an example of a tooltip. The dataframe has three columns: Gemstone, Placed_Orders, and Percent_Placed_Orders

To add a tooltip, all you need is point.Variable_Name

hc_tooltip(pointFormat = "Placed Orders: {point.Placed_Orders}")

Another example with number formatting and adding a percentage sign to the end of percent_placed_orders:

hchart(df, 'bar', hcaes(x = 'Gemstone', y = 'Placed_Orders')) %>%    
	hc_tooltip(pointFormat = '<b>{point.Placed_Orders:.f}</b> ({point.Percent_Placed_Orders:.1f}%)<br/>') %>%    
	hc_add_theme(hc_theme_smpl())

You can add them to series

hchart(month_data_filtered, 'line', hcaes(x=!!sym(time_period), y=TTL_GM), name='TY', color='blue', tooltip = list(pointFormat = "TY GM: {point.y}")) %>% 
  hc_add_series(month_data_filtered, 'line', hcaes(x=!!sym(time_period), y=LY_TTL_GM), name='LY', color='grey', tooltip = list(pointFormat = 'LY GM: {point.y}')) %>% 
  hc_add_series(month_data_filtered, 'column', hcaes(x=!!sym(time_period), y=REALIZED_SPEND), name='TY Realized Spend', color='blue', tooltip = list(pointFormat = '{point.y}')) %>% 
  hc_add_series(month_data_filtered, 'column', hcaes(x=!!sym(time_period), y=LY_REALIZED_SPEND), name='LY Realized Spend', color='grey', tooltip = list(pointFormat = '{point.y}'))

Y axis formatting

Here's how you add percentage to the y axis

hchart(pp_rdf(), 'column', hcaes(x = ENTRY_UNIT_PP, y = GM_PERC*100), name='% of GM Spent in this Bucket') %>% 
	hc_title(text = "% of GM Spent Per Price Point in Last Year") %>% 
	hc_yAxis(labels = list(format = "{value:.0f}%"))

Regression Line

hchart(pinterest_gross_up(), 'scatter', hcaes(x=WEEK, y=PERC_CLICK_ORDERS), regression = TRUE,
		regressionSettings = list(
		type = "linear",
		dashStyle = "ShortDash",
		color = "black",
		order = 3,
		lineWidth = 4,
		name = "%eq | r2: %r",
		hideInLegend = TRUE)
) %>% 
hc_title(text = 'Estimated % of Orders from Clicks (120 Day Attribution Window)') %>% 
hc_add_dependency("plugins/highcharts-regression.js")

SUPER USEFUL WEBSITE

https://www.tmbish.me/lab/highcharter-cookbook/

Highchart Thousands Separator (Get rid of the spaces and put commas instead)

# highcharter global options
hcoptslang <- getOption("highcharter.lang")
hcoptslang$thousandsSep <- ','
options(highcharter.lang = hcoptslang)

Information Button on Header

After clicking the top right information button, display a markdown document in a modal window

UI

header <- dashboardHeader(title = "title", tags$li(actionLink("openModal", label = "Information", icon = icon("info")), class = "dropdown"))

Server

observeEvent(input$openModal, {    
	showModal(      
		modalDialog(        
			includeMarkdown(filepath_to_markdown_doc), easyClose = TRUE, size = 'l'
		))  
})

TabsetPanels()

Tabset Panels are really help to organize dashboards. For example:

https://shiny.rstudio.com/gallery/tabsets.html

Good Color Schemes

To find good color gradients, see this website:

https://learnui.design/tools/data-color-picker.html

(Can also use this to find colors for conditional formatting)

Icons

For anytime you use icon=icon() in actionButtons, actionLinks, sidebar tabs, etc.

https://fontawesome.com/icons?d=gallery

Progress Loading Bars

Helps executives not get frustrated with wait times when you perform high-intensive computations

https://shiny.rstudio.com/gallery/progress-bar-example.html

Dashboard Logs

Sends log information to table in database. Big thanks to Gable for the code on this:

Server

# Create Log Table in Database
# log <- data.frame(stringsAsFactors = FALSE,
#                   TIME_STAMP = as.character(paste("'", Sys.time(), "'", sep = "")),
#                   DASHBOARD = "'BEGIN_LOG'",
#                   USER = "'BEGIN_LOG'",
#                   SESSION_ID = "'BEGIN_LOG'",
#                   INPUT = "'BEGIN_LOG'")
# 
# dbWriteTable(connection, "DASHBOARD_LOG", log, append = FALSE, overwrite = TRUE)

observeEvent(input$tabs, {    # When tab is changed it will trigger
	session <- as.character(session$token)    
	user <- reactiveValuesToList(result_auth)$user    
	values$log <-  data.frame(      
			stringsAsFactors = FALSE,      
			SESSION_ID = paste("'", as.character(session), "'", sep = ""),      
			DASHBOARD = "'SEGMENTATION'",      
			USER = paste("'", as.character(user), "'", sep = ""),      
			INPUT = paste("'", input$tabs, "'", sep = ""),      
			TIME_STAMP = as.character(paste("'", Sys.time(), "'", sep = ""))    )        

	qry <- sqlAppendTable(con, "DASHBOARD_LOG", values$log, row.names = FALSE)    
	res <- dbSendStatement(con, qry)    
	dbClearResult(res)      
})

UI - input$tabs comes from the id in the sidebar

sidebarMenu(id = "tabs",              
	menuItem("Dashboard Information", tabName = "about", icon=icon("info"))
)

Pool Package and Handling Connections

Best Solution

The pool package is the best way to handle complex dashboards with multiple connections; however, I haven't had any success with pool and odbc package

# Couldn't get this to work
# library(pool)
# pool <- dbPool(drv=odbc::odbc(),
#                driver=OracleODBC,
#                server=#####,
#                uid=#####,
#                pwd=#####,
#                port=##### )

https://shiny.rstudio.com/articles/overview.html

Current Solution

Initialize one connection at beginning of server and then close it at the end of the session

server <- function(input, output, session) {
	# initialize connection to database  
	con <- dbConnect(odbc::odbc(),                           
	uid = ####,                           
	pwd = ####,                          
	"OracleODBC")

	#Code

	
	session$onSessionEnded(function() {DBI::dbDisconnect(con)})
}

Show/Hide Tabset Panels

Here is an example for how to show/hide tabset panels using a switch input button:

UI

switchInput("minimizetab", label = "Show Filters", value = TRUE, onLabel = "YES", offLabel = "NO")

tabsetPanel(id = 'filtertabs', 
	tabPanel("Main Filters", #code),
	tabPanel("Financial Filters", #code),
	tabPanel("Department Filters", #code),
	tabPanel("Product Filters", #code),
	tabPanel("Host Filters", #code),
	tabPanel("Time Filters", #code),
	tabPanel("Advanced Filtering", #code)
)

Here are the tabsetpanels - they will be hidden if the switch input is clicked

Server

observeEvent(input$minimizetab, {      
	if (input$minimizetab == TRUE) {        
		showTab(inputId = "filtertabs", target = "Main Filters")# notice target references the title not the id       
		showTab(inputId = "filtertabs", target = "Financial Filters")        
		showTab(inputId = "filtertabs", target = "Department Filters")        
		showTab(inputId = "filtertabs", target = "Product Filters")        
		showTab(inputId = "filtertabs", target = "Host Filters")        
		showTab(inputId = "filtertabs", target = "Time Filters")        
		showTab(inputId = 'filtertabs', target = "Advanced Filtering")      
	} else {        
		hideTab(inputId = "filtertabs", target = "Main Filters")        
		hideTab(inputId = "filtertabs", target = "Financial Filters")        
		hideTab(inputId = "filtertabs", target = "Department Filters")        
		hideTab(inputId = "filtertabs", target = "Product Filters")        
		hideTab(inputId = "filtertabs", target = "Host Filters")        
		hideTab(inputId = "filtertabs", target = "Time Filters")        
		hideTab(inputId = "filtertabs", target = "Advanced Filtering")      }      
})

Dbplyr

"dbplyr is the database backend for dplyr. It allows you to use remote database tables as if they are in-memory data frames by automatically converting dplyr code into SQL."

Dbplyr is useful when working with tables that are way too big to download into R.

Value Box Headers

Headers can have subtext, icons, and different colors

UI

fluidPage(    
valueBoxOutput(outputId = "intro_header", width = 12)
)

Server

output$intro_header <- renderValueBox({
	valueBox(tags$p("Customer Clustering Dashboard", 
	style = cfg$format$server$font$size), 
	paste0("Date Last Updated: ", 
		format(file.info("filepath.Rdata")$mtime, "%Y-%m-%d")),  
	width = 2, 
	color = "navy"
)})

# For icons, you can add 'icon = icon("text")' to the valuebox

Force Update/Restart of the Application

Problem: after updating data/code in the dashboard, the application doesn't update if someone has the dashboard open on one of their browser tabs - even if they are logged out/timed out.

Solution:

Create a blank text file named 'restart.txt' in the application directory. This will start a 'new R process to run the "new" (restarted) Shiny Application for this and future users'.

Old sessions will remain unchanged until old user refreshes/relogs in. This shouldn't be a problem though because dashboard can be build to time out (see table of contents) Make a bash file that runs 'touch restart.txt' to restart the app every day at a specific time. The Shiny Server updates based on the modified time of the 'restart.txt' file. Documentation: http://rstudio.github.io/shiny-server/os/0.4.0/#restarting-an-application

Shiny Reports using R Markdown

https://github.com/davidruvolo51/shinyAppTutorials/tree/main/rmarkdown-app

https://shiny.rstudio.com/articles/generating-reports.html

I believe this is the solution to automating executive dashboard reports. If you want to see an example, check out the executive_report folder in the executive dashboard.

To Add

DataTable Row Last Clicked/Row Selected

SQL Queries and preventing SQL Injections

Document generated by Confluence on Apr 09, 2022 16:54

Atlassian

PreviousTime Series ClusteringNextR Markdown Reports

Last updated