R for
Authoring!!

PSP Session #29…
…reporting from Shiny: Part II

Problem-Solving Panel
(June 11, 2024)

  • Recap session #28       ↔︎️
  • Focal issues:
    • Job talk presentations🎙
    • Shiny✨ downloads
      • Data reports 📋
  • Shared problem-solving

Recap of Session #28:

.Rmd report ’s from Shiny

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"),
      downloadButton("downloadReport", "Download Report")
      )
  )
)

# 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$downloadReport <- downloadHandler(
    filename = function() {
      paste("data-", Sys.Date(), ".pdf", sep = "")
    },
    content = function(file) {
      render("child_script.Rmd", output_format="pdf_document")
    }
  )
  
  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)
1
Works fine
2
Missing something - will work on this today

.Rmd report ’s from Shiny

Today:

Different ’s from Shiny

  • Data
  • Figure
  • Report

  • Quarto 👀

General structure

Nice tutorial on scripting Shiny apps

🗣 Job talk presentations 🎙


  • Quarto ✍️
  • Hosting 🏡
  • Hyperlinks 🌐

Session Info (June 11, 2024) Rendering:

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