Chapter 9 Uploads and Downloads
Exercise 9.4.1
Use the ambient package by Thomas Lin Pedersen to generate worley noise and download a PNG of it.
Solution.
Solution
A general method for saving a png file is to select the png driver using the
function png()
. The only argument the driver needs is a filename (this will
be stored relative to your current working directory!). You will not see the
plot when running the plot
function because it is being saved to that file
instead. When we’re done plotting, we used the dev.off()
command to close the
connection to the driver.
library(ambient)
<- ambient::noise_worley(c(100, 100))
noise
png("noise_plot.png")
plot(as.raster(normalise(noise)))
dev.off()
Exercise 9.4.2
Create an app that lets you upload a csv file, select a variable, and then
perform a t.test()
on that variable. After the user has uploaded the csv
file, you’ll need to use updateSelectInput()
to fill in the available
variables. See Section
10.1
for details.
Solution.
Solution
We can use the fileInput
widget with the accept
argument set to .csv
to
allow only the upload of csv files. In the server
function we save the
uploaded data to the the data
reactive and use it to update input$variable
,
which displays variable (i.e. numeric data column) choices. Note that we put
the updateSelectInput
within an observe event because we need the
input$variable
to change if the user selects another file.
library(shiny)
<- fluidPage(
ui sidebarLayout(
sidebarPanel(
fileInput("file", "Upload CSV", accept = ".csv"), # file widget
selectInput("variable", "Select Variable", choices = NULL) # select widget
),mainPanel(
verbatimTextOutput("results") # t-test results
)
)
)
<- function(input, output,session) {
server
# get data from file
<- reactive({
data req(input$file)
# as shown in the book, lets make sure the uploaded file is a csv
<- tools::file_ext(input$file$name)
ext validate(need(ext == "csv", "Invalid file. Please upload a .csv file"))
<- vroom::vroom(input$file$datapath, delim = ",")
dataset
# let the user know if the data contains no numeric column
validate(need(ncol(dplyr::select_if(dataset, is.numeric)) != 0,
"This dataset has no numeric columns."))
dataset
})
# create the select input based on the numeric columns in the dataframe
observeEvent(input$file, {
req(data())
<- dplyr::select_if(data(), is.numeric)
num_cols updateSelectInput(session, "variable", choices = colnames(num_cols))
})
# print t-test results
$results <- renderPrint({
outputif(!is.null(input$variable))
t.test(data()[input$variable])
})
}
shinyApp(ui, server)
Exercise 9.4.3
Create an app that lets the user upload a csv file, select one variable, draw a histogram, and then download the histogram. For an additional challenge, allow the user to select from .png, .pdf, and .svg output formats.
Solution.
Solution
Adapting the code from the example above, rather than print a t-test output, we
save the plot in a reactive and use it to display the plot/download. We can use
the ggsave
function to switch between input$extension
types.
library(shiny)
library(ggplot2)
<- fluidPage(
ui tagList(
br(), br(),
column(4,
wellPanel(
fileInput("file", "Upload CSV", accept = ".csv"),
selectInput("variable", "Select Variable", choices = NULL),
),wellPanel(
radioButtons("extension", "Save As:",
choices = c("png", "pdf", "svg"), inline = TRUE),
downloadButton("download", "Save Plot")
)
),column(8, plotOutput("results"))
)
)
<- function(input, output,session) {
server
# get data from file
<- reactive({
data req(input$file)
# as shown in the book, lets make sure the uploaded file is a csv
<- tools::file_ext(input$file$name)
ext validate(need(ext == "csv", "Invalid file. Please upload a .csv file"))
<- vroom::vroom(input$file$datapath, delim = ",")
dataset
# let the user know if the data contains no numeric column
validate(need(ncol(dplyr::select_if(dataset, is.numeric)) != 0,
"This dataset has no numeric columns."))
dataset
})
# create the select input based on the numeric columns in the dataframe
observeEvent( input$file, {
req(data())
<- dplyr::select_if(data(), is.numeric)
num_cols updateSelectInput(session, "variable", choices = colnames(num_cols))
})
# plot histogram
<- reactive({
plot_output req(!is.null(input$variable))
ggplot(data()) +
aes_string(x = input$variable) +
geom_histogram()
})
$results <- renderPlot(plot_output())
output
# save histogram using downloadHandler and plot output type
$download <- downloadHandler(
outputfilename = function() {
paste("histogram", input$extension, sep = ".")
},content = function(file){
ggsave(file, plot_output(), device = input$extension)
}
)
}
shinyApp(ui, server)
Exercise 9.4.4
Write an app that allows the user to create a Lego mosaic from any .png file using Ryan Timpe’s brickr package. Once you’ve completed the basics, add controls to allow the user to select the size of the mosaic (in bricks), and choose whether to use “universal” or “generic” colour palettes.
Solution.
Solution
Instead of limiting our file selection to a csv as above, here we are going to
limit our input to a png. We’ll use the png::readPNG
function to read in our
file, and specify the size/color of our mosaic in brickr
’s image_to_mosaic
function. Read more about the package and examples
here.
library(shiny)
library(brickr)
library(png)
# Function to provide user feedback (checkout Chapter 8 for more info).
<- function(msg, id = NULL) {
notify showNotification(msg, id = id, duration = NULL, closeButton = FALSE)
}
<- fluidPage(
ui 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"))
)
)
<- function(input, output) {
server
<- reactive({
imageFile if(!is.null(input$myFile))
::readPNG(input$myFile$datapath)
png
})
$result <- renderPlot({
outputreq(imageFile())
<- notify("Transforming image...")
id on.exit(removeNotification(id), add = TRUE)
imageFile() %>%
image_to_mosaic(img_size = input$size, color_palette = input$color) %>%
build_mosaic()
})
}
shinyApp(ui, server)