Skip to content

Instantly share code, notes, and snippets.

@shv38339
Created June 3, 2017 16:06
Show Gist options
  • Save shv38339/973fa759f36d23d454cdb8687ca06ce3 to your computer and use it in GitHub Desktop.
Save shv38339/973fa759f36d23d454cdb8687ca06ce3 to your computer and use it in GitHub Desktop.
Cascadia R Conference - Lightning Talk - Shiny App
#libraries
library(shiny)
library(ggplot2)
library(dplyr)
library(DT)
library(tableone)
# data
# mtcars[, c("cyl", "vs", "am", "gear", "carb")] <- lapply(mtcars[, c("cyl", "vs", "am", "gear", "carb")], factor)
# data1
# TODO: Enter factor_vars
factor_vars <- c("cyl", "vs", "am", "gear", "carb")
mtcars[, factor_vars] <- lapply(mtcars[, factor_vars], factor)
# histogram function
ggMeanMedian <- function(x, data, binwidth){
require(ggplot2)
ggplot(data = data, aes(x = x)) +
geom_histogram(aes(y = ..density..), binwidth = binwidth,
colour = "black", fill = "white") +
geom_density(alpha = .2, fill = "#FF6666") +
geom_vline(aes(xintercept = mean(x), color = "mean"),
linetype = "dashed", size = 2) +
geom_vline(aes(xintercept = median(x), color = "median"),
linetype = "dashed", size = 2) +
scale_color_manual(name = "Dispersion",
values = c(median = "blue", mean = "red"))
}
# user interface
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("var", label = "Select a variable to see a summary plot:",
choices = names(mtcars), multiple = FALSE),
radioButtons("strata", label = "Stratify by another variable?",
choices = c("No", "Yes"), selected = "No"),
conditionalPanel("input.strata == 'Yes'",
selectInput("y", label = "Stratify by:",
choices = factor_vars, multiple = FALSE)
)
),
mainPanel(tabsetPanel(
tabPanel("Table", DT::dataTableOutput("table"),
plotOutput("plot")),
tabPanel("Introduction", verbatimTextOutput("text1")),
tabPanel("Talking Points", verbatimTextOutput("text2"))
))
)
)
# server
server <- function(input, output, session){
observe({
input$var
vars <- input$var
updateSelectInput(session = session, inputId = "y",
choices = factor_vars[factor_vars != vars])
})
output$table <- DT::renderDataTable({
if(input$strata == "No"){
tbl <- CreateTableOne(vars = input$var, data = mtcars)
tbl1 <- print(tbl, showAllLevels = TRUE, test = FALSE)
colnames(tbl1) <- c("levels", "Overall (%)")
datatable(tbl1, caption = paste("Descriptive Statistics of", input$var),
selection = list(mode = "single", target = "row"),
class = 'cell-border strip hover', options = list(dom = 't'))
} else {
tbl <- CreateTableOne(vars = input$var, strata = input$y, data = mtcars)
tbl1 <- print(tbl, showAllLevels = TRUE, test = FALSE)
datatable(tbl1, caption = paste("Descriptive Statistics of", input$var, "stratified by", input$y),
selection = list(mode = "single", target = "row"),
class = 'cell-border strip hover', options = list(dom = 't'))
}
})
output$plot <- renderPlot({
if(input$strata == "No"){
p <- ggplot(data = mtcars)
info = input$table_rows_selected
if(is.null(info) || is.na(info)){
return()
} else if(info == 1){
text = paste("A row containing sample size information.")
ggplot() + annotate("text", x = 4, y = 25, size=8, label = text) +
theme_bw() + theme(panel.grid.major=element_blank(), panel.grid.minor=element_blank())
} else if(info >= 2 & is.factor(mtcars[[input$var]]) == FALSE){
p <- ggMeanMedian(x = mtcars[[input$var]], data = mtcars, binwidth = 3)
p <- p + xlab(paste(input$var))
print(p)
} else if(info >= 2 & is.factor(mtcars[[input$var]]) == TRUE){
info = info - 1
mtcars$highlight <- ifelse(mtcars[[input$var]] == levels(mtcars[[input$var]])[info], "highlight", "not")
p <- ggplot(data = mtcars)
p <- p + geom_bar(aes(x = mtcars[[input$var]], fill = highlight), width = 0.5) +
xlab(paste(input$var)) +
theme(legend.position = 'none')
print(p)
}
} else {
p <- ggplot(data = mtcars)
info = input$table_rows_selected
if(is.null(info) || is.na(info)){
return()
} else if(info == 1){
text = paste("A row containing sample size information.")
ggplot() + annotate("text", x = 4, y = 25, size=8, label = text) +
theme_bw() + theme(panel.grid.major=element_blank(), panel.grid.minor=element_blank())
} else if(info >= 2 & is.factor(mtcars[[input$var]]) == FALSE){
p <- ggMeanMedian(x = mtcars[[input$var]], data = mtcars, binwidth = 3)
facets <- paste('.', '~', input$y)
p <- p + facet_grid(facets) +
xlab(paste(input$var))
print(p)
} else if(info >= 2 & is.factor(mtcars[[input$var]]) == TRUE){
info = info - 1
mtcars$highlight <- ifelse(mtcars[[input$var]] == levels(mtcars[[input$var]])[info], "highlight", "not")
p <- ggplot(data = mtcars)
p <- p + geom_bar(aes(x = mtcars[[input$var]], fill = highlight), width = 0.5) +
facet_grid(mtcars[[input$var]] ~ mtcars[[input$y]]) +
xlab(paste(input$var)) +
theme(legend.position = 'none')
print(p)
}
}
})
output$text1 <- renderText({
paste("Title: Amending Descriptive Statistics Tables w/ Dynamic Visualizations",
"\n",
"or what it should have been called:\n How to make your tables NOT SUCK",
"\n",
"Packages used: DT & tableone",
"\n",
"(Please note that I know I am preaching to the choir)",
sep = "\n")
})
output$text2 <- renderText({
paste("- Delivering Tables or Plots to Collaborators",
"\n",
"- Easily Digestible",
"\n",
"- Slowly talk through important variables",
"\n",
"- Do you really need a table that spans over a page?",
sep = "\n")
})
}
shinyApp(ui = ui, server = server)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment