├── .gitignore ├── README.md ├── flights-app-single-file.R ├── flights-app.R ├── mod-metr.R ├── mod-plot.R ├── mod-text.R ├── shiny-modules-demo.Rproj └── viz-mtly.R /.gitignore: -------------------------------------------------------------------------------- 1 | rsconnect 2 | \.Rproj.user/ 3 | .Rproj.user 4 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ## Shiny Modules Demo 2 | 3 | This minimal Shiny app is written to demonstrate the use of Shiny modules for intro-level Shiny apps. Code in this repository is discussed in this blog post: https://emilyriederer.netlify.app/post/shiny-modules/ -------------------------------------------------------------------------------- /flights-app-single-file.R: -------------------------------------------------------------------------------- 1 | # # load libraries ---- 2 | # library(nycflights13) 3 | # library(shiny) 4 | # library(ggplot2) 5 | # library(dplyr) 6 | # 7 | # # data prep ---- 8 | # ua_data <- 9 | # nycflights13::flights %>% 10 | # filter(carrier == "UA") %>% 11 | # mutate(ind_arr_delay = (arr_delay > 5)) %>% 12 | # group_by(year, month, day) %>% 13 | # summarize( 14 | # n = n(), 15 | # across(ends_with("delay"), mean, na.rm = TRUE) 16 | # ) %>% 17 | # ungroup() 18 | # 19 | # # plotting function ---- 20 | # viz_monthly <- function(df, y_var, threshhold = NULL) { 21 | # 22 | # ggplot(df) + 23 | # aes( 24 | # x = .data[["day"]], 25 | # y = .data[[y_var]] 26 | # ) + 27 | # geom_line() + 28 | # geom_hline(yintercept = threshhold, color = "red", linetype = 2) + 29 | # scale_x_continuous(breaks = seq(1, 29, by = 7)) + 30 | # theme_minimal() 31 | # } 32 | # 33 | # # plot module ---- 34 | # plot_ui <- function(id) { 35 | # 36 | # fluidRow( 37 | # column(11, plotOutput(NS(id, "plot"))), 38 | # column( 1, downloadButton(NS(id, "dnld"), label = "")) 39 | # ) 40 | # 41 | # } 42 | # 43 | # plot_server <- function(id, df, vbl, threshhold = NULL) { 44 | # 45 | # moduleServer(id, function(input, output, session) { 46 | # 47 | # plot <- reactive({viz_monthly(df(), vbl, threshhold)}) 48 | # output$plot <- renderPlot({plot()}) 49 | # output$dnld <- downloadHandler( 50 | # filename = function() {paste0(vbl, '.png')}, 51 | # content = function(file) {ggsave(file, plot())} 52 | # ) 53 | # 54 | # }) 55 | # } 56 | # 57 | # plot_demo <- function() { 58 | # 59 | # df <- data.frame(day = 1:30, arr_delay = 1:30) 60 | # ui <- fluidPage(plot_ui("x")) 61 | # server <- function(input, output, session) { 62 | # plot_server("x", reactive({df}), "arr_delay") 63 | # } 64 | # shinyApp(ui, server) 65 | # 66 | # } 67 | # 68 | # # text module ---- 69 | # text_ui <- function(id) { 70 | # 71 | # fluidRow( 72 | # textOutput(NS(id, "text")) 73 | # ) 74 | # 75 | # } 76 | # 77 | # text_server <- function(id, df, vbl, threshhold) { 78 | # 79 | # moduleServer(id, function(input, output, session) { 80 | # 81 | # n <- reactive({sum(df()[[vbl]] > threshhold)}) 82 | # output$text <- renderText({ 83 | # paste("In this month", 84 | # vbl, 85 | # "exceeded the average daily threshhold of", 86 | # threshhold, 87 | # "a total of", 88 | # n(), 89 | # "days") 90 | # }) 91 | # 92 | # }) 93 | # 94 | # } 95 | # 96 | # text_demo <- function() { 97 | # 98 | # df <- data.frame(day = 1:30, arr_delay = 1:30) 99 | # ui <- fluidPage(text_ui("x")) 100 | # server <- function(input, output, session) { 101 | # text_server("x", reactive({df}), "arr_delay", 15) 102 | # } 103 | # shinyApp(ui, server) 104 | # 105 | # } 106 | # 107 | # # metric module ---- 108 | # metric_ui <- function(id) { 109 | # 110 | # fluidRow( 111 | # text_ui(NS(id, "metric")), 112 | # plot_ui(NS(id, "metric")) 113 | # ) 114 | # 115 | # } 116 | # 117 | # metric_server <- function(id, df, vbl, threshhold) { 118 | # 119 | # moduleServer(id, function(input, output, session) { 120 | # 121 | # text_server("metric", df, vbl, threshhold) 122 | # plot_server("metric", df, vbl, threshhold) 123 | # 124 | # }) 125 | # 126 | # } 127 | # 128 | # metric_demo <- function() { 129 | # 130 | # df <- data.frame(day = 1:30, arr_delay = 1:30) 131 | # ui <- fluidPage(metric_ui("x")) 132 | # server <- function(input, output, session) { 133 | # metric_server("x", reactive({df}), "arr_delay", 15) 134 | # } 135 | # shinyApp(ui, server) 136 | # 137 | # } 138 | # 139 | # # full application ---- 140 | # ui <- fluidPage( 141 | # 142 | # titlePanel("Flight Delay Report"), 143 | # 144 | # sidebarLayout( 145 | # sidebarPanel = sidebarPanel( 146 | # selectInput("month", "Month", 147 | # choices = setNames(1:12, month.abb), 148 | # selected = 1 149 | # ) 150 | # ), 151 | # mainPanel = mainPanel( 152 | # h2(textOutput("title")), 153 | # h3("Average Departure Delay"), 154 | # metric_ui("dep_delay"), 155 | # h3("Average Arrival Delay"), 156 | # metric_ui("arr_delay"), 157 | # h3("Proportion Flights with >5 Min Arrival Delay"), 158 | # metric_ui("ind_arr_delay") 159 | # ) 160 | # ) 161 | # ) 162 | # server <- function(input, output, session) { 163 | # 164 | # output$title <- renderText({paste(month.abb[as.integer(input$month)], "Report")}) 165 | # df_month <- reactive({filter(ua_data, month == input$month)}) 166 | # metric_server("dep_delay", df_month, vbl = "dep_delay", threshhold = 10) 167 | # metric_server("arr_delay", df_month, vbl = "arr_delay", threshhold = 10) 168 | # metric_server("ind_arr_delay", df_month, vbl = "ind_arr_delay", threshhold = 0.5) 169 | # 170 | # } 171 | # shinyApp(ui, server) 172 | -------------------------------------------------------------------------------- /flights-app.R: -------------------------------------------------------------------------------- 1 | # load libraries ---- 2 | library(nycflights13) 3 | library(shiny) 4 | library(ggplot2) 5 | library(dplyr) 6 | 7 | # load resources ---- 8 | source("viz-mtly.R") 9 | source("mod-plot.R") 10 | source("mod-text.R") 11 | source("mod-metr.R") 12 | 13 | # data prep ---- 14 | ua_data <- 15 | nycflights13::flights %>% 16 | filter(carrier == "UA") %>% 17 | mutate(ind_arr_delay = (arr_delay > 5)) %>% 18 | group_by(year, month, day) %>% 19 | summarize( 20 | n = n(), 21 | across(ends_with("delay"), mean, na.rm = TRUE) 22 | ) %>% 23 | ungroup() 24 | 25 | # full application ---- 26 | ui <- fluidPage( 27 | 28 | titlePanel("Flight Delay Report"), 29 | 30 | sidebarLayout( 31 | sidebarPanel = sidebarPanel( 32 | selectInput("month", "Month", 33 | choices = setNames(1:12, month.abb), 34 | selected = 1 35 | ) 36 | ), 37 | mainPanel = mainPanel( 38 | h2(textOutput("title")), 39 | h3("Average Departure Delay"), 40 | metric_ui("dep_delay"), 41 | h3("Average Arrival Delay"), 42 | metric_ui("arr_delay"), 43 | h3("Proportion Flights with >5 Min Arrival Delay"), 44 | metric_ui("ind_arr_delay") 45 | ) 46 | ) 47 | ) 48 | server <- function(input, output, session) { 49 | 50 | output$title <- renderText({paste(month.abb[as.integer(input$month)], "Report")}) 51 | df_month <- reactive({filter(ua_data, month == input$month)}) 52 | metric_server("dep_delay", df_month, vbl = "dep_delay", threshhold = 10) 53 | metric_server("arr_delay", df_month, vbl = "arr_delay", threshhold = 10) 54 | metric_server("ind_arr_delay", df_month, vbl = "ind_arr_delay", threshhold = 0.5) 55 | 56 | } 57 | shinyApp(ui, server) 58 | -------------------------------------------------------------------------------- /mod-metr.R: -------------------------------------------------------------------------------- 1 | # metric module ---- 2 | metric_ui <- function(id) { 3 | 4 | fluidRow( 5 | text_ui(NS(id, "metric")), 6 | plot_ui(NS(id, "metric")) 7 | ) 8 | 9 | } 10 | 11 | metric_server <- function(id, df, vbl, threshhold) { 12 | 13 | moduleServer(id, function(input, output, session) { 14 | 15 | text_server("metric", df, vbl, threshhold) 16 | plot_server("metric", df, vbl, threshhold) 17 | 18 | }) 19 | 20 | } 21 | 22 | metric_demo <- function() { 23 | 24 | df <- data.frame(day = 1:30, arr_delay = 1:30) 25 | ui <- fluidPage(metric_ui("x")) 26 | server <- function(input, output, session) { 27 | metric_server("x", reactive({df}), "arr_delay", 15) 28 | } 29 | shinyApp(ui, server) 30 | 31 | } -------------------------------------------------------------------------------- /mod-plot.R: -------------------------------------------------------------------------------- 1 | # plot module ---- 2 | plot_ui <- function(id) { 3 | 4 | fluidRow( 5 | column(11, plotOutput(NS(id, "plot"))), 6 | column( 1, downloadButton(NS(id, "dnld"), label = "")) 7 | ) 8 | 9 | } 10 | 11 | plot_server <- function(id, df, vbl, threshhold = NULL) { 12 | 13 | moduleServer(id, function(input, output, session) { 14 | 15 | plot <- reactive({viz_monthly(df(), vbl, threshhold)}) 16 | output$plot <- renderPlot({plot()}) 17 | output$dnld <- downloadHandler( 18 | filename = function() {paste0(vbl, '.png')}, 19 | content = function(file) {ggsave(file, plot())} 20 | ) 21 | 22 | }) 23 | } 24 | 25 | plot_demo <- function() { 26 | 27 | df <- data.frame(day = 1:30, arr_delay = 1:30) 28 | ui <- fluidPage(plot_ui("x")) 29 | server <- function(input, output, session) { 30 | plot_server("x", reactive({df}), "arr_delay") 31 | } 32 | shinyApp(ui, server) 33 | 34 | } -------------------------------------------------------------------------------- /mod-text.R: -------------------------------------------------------------------------------- 1 | # text module ---- 2 | text_ui <- function(id) { 3 | 4 | fluidRow( 5 | textOutput(NS(id, "text")) 6 | ) 7 | 8 | } 9 | 10 | text_server <- function(id, df, vbl, threshhold) { 11 | 12 | moduleServer(id, function(input, output, session) { 13 | 14 | n <- reactive({sum(df()[[vbl]] > threshhold)}) 15 | output$text <- renderText({ 16 | paste("In this month", 17 | vbl, 18 | "exceeded the average daily threshhold of", 19 | threshhold, 20 | "a total of", 21 | n(), 22 | "days") 23 | }) 24 | 25 | }) 26 | 27 | } 28 | 29 | text_demo <- function() { 30 | 31 | df <- data.frame(day = 1:30, arr_delay = 1:30) 32 | ui <- fluidPage(text_ui("x")) 33 | server <- function(input, output, session) { 34 | text_server("x", reactive({df}), "arr_delay", 15) 35 | } 36 | shinyApp(ui, server) 37 | 38 | } -------------------------------------------------------------------------------- /shiny-modules-demo.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | -------------------------------------------------------------------------------- /viz-mtly.R: -------------------------------------------------------------------------------- 1 | viz_monthly <- function(df, y_var, threshhold = NULL) { 2 | 3 | ggplot(df) + 4 | aes( 5 | x = .data[["day"]], 6 | y = .data[[y_var]] 7 | ) + 8 | geom_line() + 9 | geom_hline(yintercept = threshhold, color = "red", linetype = 2) + 10 | scale_x_continuous(breaks = seq(1, 29, by = 7)) + 11 | theme_minimal() 12 | } --------------------------------------------------------------------------------