├── .gitignore ├── www ├── alert.js ├── simple.css ├── hidden_mode.js └── custom.css ├── 01_01_structure.R ├── conference-workshop.Rproj ├── 00_installation.R ├── 01_02_sidebar_layout.R ├── 05_02_css.R ├── 05_03_js.R ├── 01_04_observers.R ├── 05_01_rest_api.R ├── 03_02_dynamic_ui.R ├── 02_00_app.R ├── 01_03_input_controllers.R ├── 02_02_validation.R ├── 03_01_modal.R ├── 02_01_renders.R ├── 02_04_hiding_content.R ├── 02_03_reactive_value.R ├── 03_00_app.R ├── 01_99_exercise.R ├── 02_99_exercise.R ├── 05_00_app.R ├── 04_99_exercise.R ├── 04_01_modules.R ├── 04_00_app.R ├── 06_00_app.R ├── app.R ├── 04_02_modules_communication.R ├── 03_99_exercise.R ├── 05_99_exercise.R └── tools.R /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | rsconnect 6 | -------------------------------------------------------------------------------- /www/alert.js: -------------------------------------------------------------------------------- 1 | $(document).on("click", "button", function() { 2 | alert("You've clicked me!"); 3 | }); 4 | -------------------------------------------------------------------------------- /01_01_structure.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | 3 | ui <- fluidPage( 4 | 5 | ) 6 | 7 | server <- function(input, output, session) { 8 | 9 | } 10 | 11 | shinyApp(ui, server) 12 | -------------------------------------------------------------------------------- /www/simple.css: -------------------------------------------------------------------------------- 1 | body { 2 | background-color: #f0f8ff; 3 | } 4 | 5 | form.well { 6 | background-color: #a2d3ff; 7 | } 8 | 9 | div.well { 10 | background-color: #e6f3ff; 11 | border-radius: 20px; 12 | } 13 | 14 | .well button { 15 | border-radius: 20px; 16 | } 17 | -------------------------------------------------------------------------------- /conference-workshop.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 | -------------------------------------------------------------------------------- /00_installation.R: -------------------------------------------------------------------------------- 1 | install.packages("magrittr") 2 | install.packages("shiny") 3 | install.packages("DT") 4 | install.packages("remotes") 5 | install.packages("httr") 6 | install.packages("glue") 7 | install.packages("dplyr") 8 | install.packages("purrr") 9 | remotes::install_github("r-world-devs/shinyGizmo", ref = "dev") 10 | -------------------------------------------------------------------------------- /01_02_sidebar_layout.R: -------------------------------------------------------------------------------- 1 | # https://shiny.rstudio.com/articles/layout-guide.html 2 | library(shiny) 3 | 4 | ui <- fluidPage( 5 | sidebarLayout( 6 | sidebarPanel( 7 | h3("Sidebar Title"), 8 | "Sidebar" 9 | ), 10 | mainPanel( 11 | div("I'm in the main panel"), 12 | "I'm here as well" 13 | ) 14 | ) 15 | ) 16 | 17 | server <- function(input, output, session) { 18 | 19 | } 20 | 21 | shinyApp(ui, server) -------------------------------------------------------------------------------- /www/hidden_mode.js: -------------------------------------------------------------------------------- 1 | var keysdown = ''; 2 | 3 | check_sequence = function(e) { 4 | keysdown += e.key; 5 | if (/shiny$/.test(keysdown)) { 6 | Shiny.setInputValue('hidden_mode', true); 7 | } 8 | if (/modeoff$/.test(keysdown)) { 9 | Shiny.setInputValue('hidden_mode', false); 10 | } 11 | if (!/s$|h$|i$|n$|y$|m$|o$|d$|e$|f$/.test(keysdown)) { 12 | keysdown = ''; 13 | } 14 | }; 15 | 16 | document.addEventListener('keydown', check_sequence); 17 | -------------------------------------------------------------------------------- /05_02_css.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | 3 | ui <- fluidPage( 4 | tags$head( 5 | tags$link(rel = "stylesheet", type = "text/css", href = "simple.css") 6 | ), 7 | sidebarLayout( 8 | sidebarPanel( 9 | wellPanel( 10 | actionButton("run", "Click Me!") 11 | ), 12 | wellPanel( 13 | actionButton("play", "Click Me!") 14 | ) 15 | ), 16 | mainPanel() 17 | ) 18 | ) 19 | 20 | server <- function(input, output, session) { 21 | 22 | } 23 | 24 | shinyApp(ui, server) -------------------------------------------------------------------------------- /05_03_js.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | 3 | ui <- fluidPage( 4 | tags$head( 5 | tags$link(rel = "stylesheet", type = "text/css", href = "simple.css"), 6 | tags$script(type = "text/javascript", src = "alert.js") 7 | ), 8 | sidebarLayout( 9 | sidebarPanel( 10 | wellPanel( 11 | actionButton("run", "Click Me!") 12 | ), 13 | wellPanel( 14 | actionButton("play", "Click Me!") 15 | ) 16 | ), 17 | mainPanel() 18 | ) 19 | ) 20 | 21 | server <- function(input, output, session) { 22 | 23 | } 24 | 25 | shinyApp(ui, server) -------------------------------------------------------------------------------- /01_04_observers.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | 3 | ui <- fluidPage( 4 | sliderInput( 5 | inputId = "my_slider_one", label = "Select number here", value = 1, min = 1, max = 10, step = 1 6 | ), 7 | actionButton( 8 | inputId = "my_button", label = "Click Me!" 9 | ) 10 | ) 11 | 12 | server <- function(input, output, session) { 13 | observeEvent(input$my_slider_one, { 14 | print("Slider changed") 15 | print(input[["my_slider_one"]]) 16 | }) 17 | 18 | observeEvent(input$my_button, { 19 | updateSliderInput(session, "my_slider_one", value = sample(1:10, 1)) 20 | }) 21 | } 22 | 23 | shinyApp(ui, server) -------------------------------------------------------------------------------- /05_01_rest_api.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(httr) 3 | 4 | # number <- 10 5 | # res <- httr::GET(glue("http://numbersapi.com/{number}")) 6 | # res$status_code 7 | # httr::content(res) 8 | 9 | ui <- fluidPage( 10 | numericInput("number", "Select number", value = 1, min = 0, step = 1), 11 | textOutput("fact") 12 | ) 13 | 14 | server <- function(input, output, session) { 15 | output$fact <- renderText({ 16 | res <- httr::GET(glue("http://numbersapi.com/{input$number}")) 17 | if (res$status_code == 200) { 18 | fact <- httr::content(res) 19 | } else { 20 | fact <- "No response" 21 | } 22 | fact 23 | }) 24 | } 25 | 26 | shinyApp(ui, server) -------------------------------------------------------------------------------- /03_02_dynamic_ui.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(glue) 3 | 4 | ui <- fluidPage( 5 | actionButton("add", "Add"), 6 | numericInput("which", "Which to remove?", value = 1), 7 | actionButton("remove", "Remove"), 8 | div(id = "variables") 9 | ) 10 | 11 | server <- function(input, output, session) { 12 | observeEvent(input$add, { 13 | insertUI( 14 | selector = "#variables", 15 | where = "beforeEnd", 16 | ui = wellPanel(id = input$add, input$add), 17 | immediate = TRUE 18 | ) 19 | }) 20 | 21 | observeEvent(input$remove, { 22 | removeUI( 23 | selector = glue("#{input$which}"), 24 | ) 25 | }) 26 | } 27 | 28 | shinyApp(ui, server) -------------------------------------------------------------------------------- /02_00_app.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | 3 | ui <- fluidPage( 4 | sidebarLayout( 5 | sidebarPanel( 6 | h3("Table Generator"), 7 | numericInput("nrow", "Number of rows", value = 50, min = 1, max = 1000, step = 1), 8 | div(id = "variables"), 9 | div( 10 | id = "define-vars", 11 | textInput("name", "Column name"), 12 | actionButton("new", NULL, icon = icon("plus"), width = "100%") 13 | ), 14 | actionButton("run", "Generate", width = "100%") 15 | ), 16 | mainPanel() 17 | ) 18 | ) 19 | 20 | server <- function(input, output, session) { 21 | 22 | observeEvent(input$new, { 23 | print("new clicked") 24 | print(input$new) 25 | }) 26 | 27 | observeEvent(input$run, { 28 | print("run clicked") 29 | }) 30 | } 31 | 32 | shinyApp(ui, server) 33 | -------------------------------------------------------------------------------- /01_03_input_controllers.R: -------------------------------------------------------------------------------- 1 | # https://shiny.rstudio.com/gallery/widget-gallery.html 2 | 3 | library(shiny) 4 | 5 | ui <- fluidPage( 6 | actionButton( 7 | inputId = "my_button", label = "Click Me" 8 | ), 9 | numericInput( 10 | inputId = "my_number", label = "Place number here", value = 1, min = 1, max = 10, step = 1 11 | ), 12 | textInput( 13 | "my_text", label = "Place text here", value = "Default text" 14 | ), 15 | sliderInput( 16 | inputId = "my_slider_one", label = "Select number here", value = 1, min = 1, max = 10, step = 1 17 | ), 18 | sliderInput( 19 | inputId = "my_slider_two", label = "Select range here", value = c(5, 6), min = 1, max = 10, step = 1 20 | ), 21 | selectInput( 22 | inputId = "my_dropdown", label = "Choose a letter", choices = letters 23 | ) 24 | ) 25 | 26 | server <- function(input, output, session) { 27 | 28 | } 29 | 30 | shinyApp(ui, server) -------------------------------------------------------------------------------- /02_02_validation.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | 3 | ui <- fluidPage( 4 | sidebarLayout( 5 | sidebarPanel( 6 | numericInput("x_max", "Maximum x axis value", value = 10) 7 | ), 8 | mainPanel( 9 | plotOutput("sine"), 10 | tableOutput("plot_table") 11 | ) 12 | ) 13 | ) 14 | 15 | server <- function(input, output, session) { 16 | output$sine <- renderPlot({ 17 | validate(need(input$x_max > 0, message = "No valid data")) 18 | plot_data <- data.frame( 19 | x = seq(0, input$x_max, by = 0.1), 20 | y = sin(seq(0, input$x_max, by = 0.1)) 21 | ) 22 | plot(plot_data$x, plot_data$y, type = "l") 23 | }) 24 | 25 | output$plot_table <- renderTable({ 26 | req(input$x_max > 0) 27 | plot_data <- data.frame( 28 | x = seq(0, input$x_max, by = 0.1), 29 | y = sin(seq(0, input$x_max, by = 0.1)) 30 | ) 31 | plot_data 32 | }) 33 | } 34 | 35 | shinyApp(ui, server) -------------------------------------------------------------------------------- /03_01_modal.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(shinyGizmo) 3 | 4 | ui <- fluidPage( 5 | modalDialogUI( 6 | modalId = "my_modal", 7 | "Modal content" 8 | ), 9 | actionButton("open_second", "Open 2nd modal", icon = icon("pen")), 10 | modalDialogUI( 11 | modalId = "my_modal_2", 12 | textInput("my_text_2", "Place text here"), 13 | textOutput("my_text_2_out"), 14 | button = NULL 15 | ), 16 | modalDialogUI( 17 | modalId = "my_modal_3", 18 | textInput("my_text_3", "Place text here"), 19 | footer = actionButton("close", "Close", icon = icon("times"), `data-dismiss` = "modal") 20 | ), 21 | textOutput("my_text_3_out") 22 | ) 23 | 24 | server <- function(input, output, session) { 25 | 26 | observeEvent(input$open_second, { 27 | showModalUI("my_modal_2") 28 | }) 29 | 30 | output$my_text_2_out <- renderText({ 31 | input$my_text_2 32 | }) 33 | 34 | output$my_text_3_out <- renderText({ 35 | input$my_text_3 36 | }) 37 | 38 | observeEvent(input$close, { 39 | print("modal closed") 40 | }) 41 | } 42 | 43 | shinyApp(ui, server) -------------------------------------------------------------------------------- /02_01_renders.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(glue) 3 | 4 | ui <- fluidPage( 5 | sidebarLayout( 6 | sidebarPanel( 7 | textInput("title", "Title"), 8 | numericInput("x_max", "Maximum x axis value", value = 10, min = 1), 9 | textInput("generated_by", "Generated by:") 10 | ), 11 | mainPanel( 12 | plotOutput("sine"), 13 | tableOutput("plot_table"), 14 | textOutput("gen_by") 15 | ) 16 | ) 17 | ) 18 | 19 | server <- function(input, output, session) { 20 | output$sine <- renderPlot({ 21 | plot_data <- data.frame( 22 | x = seq(0, input$x_max, by = 0.1), 23 | y = sin(seq(0, input$x_max, by = 0.1)) 24 | ) 25 | plot(plot_data$x, plot_data$y, main = input$title, type = "l") 26 | }) 27 | 28 | output$plot_table <- renderTable({ 29 | plot_data <- data.frame( 30 | x = seq(0, input$x_max, by = 0.1), 31 | y = sin(seq(0, input$x_max, by = 0.1)) 32 | ) 33 | plot_data 34 | }) 35 | 36 | output$gen_by <- renderText({ 37 | glue("Chart generated by {input$generated_by}") 38 | }) 39 | } 40 | 41 | shinyApp(ui, server) -------------------------------------------------------------------------------- /02_04_hiding_content.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | 3 | ui <- fluidPage( 4 | sidebarLayout( 5 | sidebarPanel( 6 | numericInput("x_max", "Maximum x axis value", value = 10), 7 | conditionalPanel( 8 | "input.x_max > 0", 9 | textInput("title", "Title") 10 | ) 11 | ), 12 | mainPanel( 13 | plotOutput("sine"), 14 | tableOutput("plot_table") 15 | ) 16 | ) 17 | ) 18 | 19 | server <- function(input, output, session) { 20 | plot_data <- reactiveVal(NULL) 21 | 22 | observeEvent(input$x_max, { 23 | if (identical(input$x_max > 0, TRUE)) { 24 | x <- seq(0, input$x_max, by = 0.1) 25 | plot_data(data.frame(x = x, y = sin(x))) 26 | } else { 27 | plot_data(NULL) 28 | } 29 | }) 30 | 31 | output$sine <- renderPlot({ 32 | validate(need(!is.null(plot_data()), message = "No valid data")) 33 | plot(plot_data()$x, plot_data()$y, main = input$title, type = "l") 34 | }) 35 | 36 | output$plot_table <- renderTable({ 37 | validate(need(!is.null(plot_data()), message = "No valid data")) 38 | plot_data() 39 | }) 40 | } 41 | 42 | shinyApp(ui, server) -------------------------------------------------------------------------------- /02_03_reactive_value.R: -------------------------------------------------------------------------------- 1 | # Rule: 2 | # rval <- reactiveVal() - initializing 3 | # rval() - taking the value 4 | # rval() - reassigning 5 | 6 | library(shiny) 7 | 8 | ui <- fluidPage( 9 | sidebarLayout( 10 | sidebarPanel( 11 | numericInput("x_max", "Maximum x axis value", value = 10), 12 | textInput("title", "Title") 13 | ), 14 | mainPanel( 15 | plotOutput("sine"), 16 | tableOutput("plot_table") 17 | ) 18 | ) 19 | ) 20 | 21 | server <- function(input, output, session) { 22 | plot_data <- reactiveVal(NULL) 23 | 24 | observeEvent(input$x_max, { 25 | if (identical(input$x_max > 0, TRUE)) { 26 | x <- seq(0, input$x_max, by = 0.1) 27 | df <- data.frame(x = x, y = sin(x)) 28 | plot_data(df) 29 | } else { 30 | plot_data(NULL) 31 | } 32 | }) 33 | 34 | output$sine <- renderPlot({ 35 | validate(need(!is.null(plot_data()), message = "No valid data")) 36 | plot(plot_data()$x, plot_data()$y, main = input$title, type = "l") 37 | }) 38 | 39 | output$plot_table <- renderTable({ 40 | validate(need(!is.null(plot_data()), message = "No valid data")) 41 | plot_data() 42 | }) 43 | } 44 | 45 | shinyApp(ui, server) -------------------------------------------------------------------------------- /03_00_app.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(DT) 3 | 4 | ui <- fluidPage( 5 | sidebarLayout( 6 | sidebarPanel( 7 | h3("Table Generator"), 8 | numericInput("nrow", "Number of rows", value = 50, min = 1, max = 1000, step = 1), 9 | div(id = "variables"), 10 | div( 11 | id = "define-vars", 12 | textInput("name", "Column name"), 13 | conditionalPanel( 14 | "input.name != ''", 15 | actionButton("new", NULL, icon = icon("plus"), width = "100%") 16 | ) 17 | ), 18 | conditionalPanel( 19 | "input.nrow > 0", 20 | actionButton("run", "Generate", width = "100%") 21 | ) 22 | ), 23 | mainPanel( 24 | dataTableOutput("table") 25 | ) 26 | ) 27 | ) 28 | 29 | server <- function(input, output, session) { 30 | my_table <- reactiveVal(NULL) 31 | 32 | observeEvent(input$new, { 33 | print("new clicked") 34 | }) 35 | 36 | observeEvent(input$run, { 37 | my_table(iris[1:input$nrow, ]) 38 | }) 39 | 40 | output$table <- renderDataTable({ 41 | validate(need(!is.null(my_table()), message = "No table created.")) 42 | my_table() 43 | }, options = list( 44 | paging = TRUE, 45 | pageLength = 10, 46 | searching = FALSE 47 | )) 48 | } 49 | 50 | shinyApp(ui, server) 51 | -------------------------------------------------------------------------------- /01_99_exercise.R: -------------------------------------------------------------------------------- 1 | # In the below app: 2 | # 1. Modify numericInput in line 20 so that: 3 | # - its value can be accessible by input$nrow 4 | # - its initial value equals 50 5 | # 2. Create actionButton (in line 27) so that: 6 | # - its value can be accessible by input$run, 7 | # - it displays "Generate" label, 8 | # - it covers full width of its container. 9 | # Use actionButton in line 25 as an example. 10 | # 3. Create an observer (in line 40) that listens to the above button changes. 11 | # Make the observer callback print "run clicked" in the console. 12 | # 4. Run app and test it out. 13 | 14 | library(shiny) 15 | 16 | ui <- fluidPage( 17 | sidebarLayout( 18 | sidebarPanel( 19 | h3("Table Generator"), 20 | numericInput(inputId = "my_number", label = "Number of rows", value = 1, min = 1, max = 150, step = 1), 21 | div(id = "variables"), 22 | div( 23 | id = "define-vars", 24 | textInput("name", "Column name"), 25 | actionButton("new", NULL, icon = icon("plus"), width = "100%") 26 | ), 27 | #