library(shiny)
library(DT)
library(ggplot2)
# Sample dataset
data <- data.frame(
ID = 1:10,
Name = c("John", "Paul", "George", "Ringo", "Mick",
"Keith", "Charlie", "Ronnie", "Roger", "Pete"),
Age = c(40, 42, 38, 41, 43, 45, 39, 40, 44, 42)
)
# Define UI
ui <- fluidPage(
titlePanel("Download CSV Example"),
fluidRow(
sidebarPanel(
sliderInput('ageRange', 'Age Range',
min = 30,
max = 45,
value = c(30, 45)),
plotOutput("distPlot"),
downloadButton("downloadPlot", "Download Histogram")
),
mainPanel(
DTOutput("table"),
downloadButton("downloadData", "Download CSV")
)
)
)
# Define server logic
server <- function(input, output) {
# Reactive expression to filter data based on age range
filtered_data <- reactive({
data[data$Age >= input$ageRange[1] &
data$Age <= input$ageRange[2], ]
})
# Display the table
output$table <- renderDT({
filtered_data()
})
# Download handlers
output$downloadData <- downloadHandler(
filename = function() {
paste("data-", Sys.Date(), ".csv", sep = "")
},
content = function(file) {
write.csv(filtered_data(), file, row.names = FALSE)
}
)
## Copied from above (that works) - want to download image; 5/28/24
output$downloadPlot <- downloadHandler(
filename = function() {
paste("data-", Sys.Date(), ".png", sep = "")
},
content = function(file) {
png(file)
print(ggplot(filtered_data(),aes(x=Age)) +
geom_histogram()
)
dev.off()
}
)
output$distPlot <- renderPlot({
# generate bins based on input$bins from ui.R
# x <- filtered_data$Age
# bins <- seq(min(x), max(x), length.out = input$bins + 1)
# draw the histogram with the specified number of bins
ggplot(filtered_data(),aes(x=Age)) + geom_histogram()
})
}
# Run the app
shinyApp(ui = ui, server = server)
ggplot
(see line 75)
downloadHandler
. png()
-> dev.off()
sandwich (lines 61-65) likely not most efficient way to specify
General structure
Nice tutorial on scripting Shiny apps
R version 4.2.2 (2022-10-31 ucrt)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 10 x64 (build 19045)
Matrix products: default
locale:
[1] LC_COLLATE=English_United States.utf8
[2] LC_CTYPE=English_United States.utf8
[3] LC_MONETARY=English_United States.utf8
[4] LC_NUMERIC=C
[5] LC_TIME=English_United States.utf8
attached base packages:
[1] stats graphics grDevices utils datasets methods base
other attached packages:
[1] ggplot2_3.5.1 DT_0.27 shiny_1.7.4 fontawesome_0.5.2
loaded via a namespace (and not attached):
[1] Rcpp_1.0.10 lubridate_1.9.3 ps_1.7.5 assertthat_0.2.1
[5] digest_0.6.31 utf8_1.2.4 mime_0.12 R6_2.5.1
[9] webshot2_0.1.1 evaluate_0.23 pillar_1.9.0 rlang_1.1.3
[13] rstudioapi_0.15.0 callr_3.7.3 jquerylib_0.1.4 rmarkdown_2.26
[17] labeling_0.4.3 textshaping_0.3.6 webshot_0.5.5 stringr_1.5.1
[21] htmlwidgets_1.6.4 munsell_0.5.1 compiler_4.2.2 httpuv_1.6.9
[25] xfun_0.42 pkgconfig_2.0.3 systemfonts_1.0.4 htmltools_0.5.7
[29] websocket_1.4.1 tidyselect_1.2.1 tibble_3.2.1 emo_0.0.0.9000
[33] fansi_1.0.6 crayon_1.5.2 dplyr_1.1.4 withr_3.0.0
[37] later_1.3.1 grid_4.2.2 jsonlite_1.8.8 xtable_1.8-4
[41] gtable_0.3.5 lifecycle_1.0.4 magrittr_2.0.3 scales_1.3.0
[45] cli_3.6.0 stringi_1.7.12 cachem_1.0.8 farver_2.1.1
[49] promises_1.2.0.1 bslib_0.6.1 ellipsis_0.3.2 ragg_1.2.5
[53] generics_0.1.3 vctrs_0.6.5 tools_4.2.2 glue_1.6.2
[57] purrr_1.0.1 crosstalk_1.2.0 processx_3.8.1 fastmap_1.1.1
[61] yaml_2.3.8 timechange_0.3.0 chromote_0.2.0 colorspace_2.1-0
[65] memoise_2.0.1 knitr_1.45 sass_0.4.9