9 Uploads and downloads

9.4 Exercises

library(shiny)
# Increase max limit of size of uploaded file
options(shiny.maxRequestSize = 10 * 1024^2)

ui <- fluidPage(
  # upload a csv file
  fileInput("upload", NULL, 
            buttonLabel = "Upload CSV", accept = ".csv"),
  # select a variable
  selectInput("var", "Select a variable", choices = NULL),
  # show output of t.test()
  verbatimTextOutput("t_test")
)

server <- function(input, output, session) {
  # uploaded dataset
  data <- reactive({
    req(input$upload)
    readr::read_csv(input$upload$datapath)
  })
  # once user uploads data, fill in the available variables
  observeEvent(data(), {
    choices <- unique(colnames(data()))
    updateSelectInput(inputId = "var", choices = choices) 
  })
  # show output of t-test
  output$t_test <- renderPrint({ 
    req(input$var)
    t.test(data()[[input$var]], mu = 0) 
  })
}

shinyApp(ui, server)

library(shiny)
library(tidyverse)

ui <- fluidPage(
  # upload a csv file
  fileInput("upload", NULL, 
            buttonLabel = "Upload CSV", accept = ".csv"),
  # select a variable
  selectInput("var", "Select a variable", choices = NULL),
  # show histogram
  plotOutput("plot"),
  radioButtons("ext", "Save As:",
               choices = c("png", "pdf", "svg"), inline = TRUE),
  # download histogram
  downloadButton("download")
)

server <- function(input, output, session) {
  # uploaded dataset
  data <- reactive({
    req(input$upload)
    read_csv(input$upload$datapath)
  })
  # once user uploads data, fill in the available variables
  observeEvent(data(), {
    choices <- unique(colnames(data()))
    updateSelectInput(inputId = "var", choices = choices) 
  })
  # create reactive plot 
  plot_output <- reactive({
    req(input$var)
    ggplot(data()) +
      geom_histogram(aes(.data[[input$var]]))
  })
  # show histogram
  output$plot <- renderPlot({
    req(input$var)
    plot_output()
  })
  # download 
  output$download <- downloadHandler(
    filename = function() {
      paste("histogram", input$ext, sep = ".")
    }, 
    content = function(file) {
      ggsave(file, plot_output(), device = input$ext)
    }
  )
}

shinyApp(ui, server)

4. From Mastering Shiny Solutions 2021:

library(shiny)
library(brickr)
library(png)

# Function to provide user feedback (checkout Chapter 8 for more info).
notify <- function(msg, id = NULL) {
  showNotification(msg, id = id, duration = NULL, closeButton = FALSE)
}

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      fluidRow(
        fileInput("myFile", "Upload a PNG file", accept = c('image/png')),
        sliderInput("size", "Select size:", min = 1, max = 100, value = 35),
        radioButtons("color", "Select color palette:", choices = c("universal", "generic"))
      )
    ),
    mainPanel(
      plotOutput("result"))
  )
)

server <- function(input, output) {
  
  imageFile <- reactive({
    if(!is.null(input$myFile))
      png::readPNG(input$myFile$datapath)
  })
  
  output$result <- renderPlot({
    req(imageFile())
    
    id <- notify("Transforming image...")
    on.exit(removeNotification(id), add = TRUE)
    
    imageFile() %>%
      image_to_mosaic(img_size = input$size, color_palette = input$color) %>%
      build_mosaic()
  })
}

shinyApp(ui, server)

5. From the 9.3 Case study, the main change happens in the cleaning step inside the server function, where one large reactive is broken down into three smaller ones.

library(shiny)

# Uploading and parsing the file

ui_upload <- sidebarLayout(
  sidebarPanel(
    fileInput("file", "Data", buttonLabel = "Upload..."),
    textInput("delim", "Delimiter (leave blank to guess)", ""),
    numericInput("skip", "Rows to skip", 0, min = 0),
    numericInput("rows", "Rows to preview", 10, min = 1)
  ),
  mainPanel(
    h3("Raw data"),
    tableOutput("preview1")
  )
)

# Cleaning the file
ui_clean <- sidebarLayout(
  sidebarPanel(
    checkboxInput("snake", "Rename columns to snake case?"),
    checkboxInput("constant", "Remove constant columns?"),
    checkboxInput("empty", "Remove empty cols?")
  ),
  mainPanel(
    h3("Cleaner data"),
    tableOutput("preview2")
  )
)

# Downloading the file.

ui_download <- fluidRow(
  column(width = 12, downloadButton("download", class = "btn-block"))
)

# which get assembled into a single fluidPage():

ui <- fluidPage(
  ui_upload,
  ui_clean,
  ui_download
)

server <- function(input, output, session) {
  # Upload ---------------------------------------------------------
  raw <- reactive({
    req(input$file)
    delim <- if (input$delim == "") NULL else input$delim
    vroom::vroom(input$file$datapath, delim = delim, skip = input$skip)
  })
  output$preview1 <- renderTable(head(raw(), input$rows))
  
  # Clean step ---------------------------------------------------------
  # Breaking one large reactive up into multiple pieces
  cleaned_names <- reactive({
    out <- raw()
    
    if (input$snake) {
      names(out) <- janitor::make_clean_names(names(out))
    }
    out
  })
  
  removed_empty <- reactive({
    out <- cleaned_names()
  
    if (input$empty) {
      out <- janitor::remove_empty(out, "cols")
    }
    out
  })
    
  removed_constant <- reactive({
    out <- removed_empty()
   
    if (input$constant) {
      out <- janitor::remove_constant(out)
    }
    out
  })
  
  output$preview2 <- renderTable(head(removed_constant(), input$rows))
  
  # Download -------------------------------------------------------
  output$download <- downloadHandler(
    filename = function() {
      paste0(tools::file_path_sans_ext(input$file$name), ".tsv")
    },
    content = function(file) {
      vroom::vroom_write(removed_constant(), file)
    }
  )
}

shinyApp(ui, server)