R for
Authoring!!

PSP Session #31…
…return of the APA

Problem-Solving Panel
(June 25, 2024)

• Recap session #30       ↔︎️
• Focal issue:
  • APA Quarto extension 🐒
• Shared problem-solving

Recap of Session #30:

Shiny✨ ’s

• Data
• Figure
• Report
• Quarto 👀

Caution

If you copy .Rmd, please add one tick mark to lines #17 and #22

• App script ✍️
• .Rmd specs 📑

library(shiny)
library(rmarkdown)
library(ggplot2)

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)
)

server <- function(input, output) {
  filtered_data <- reactive({
    data[data$Age >= input$ageRange[1] & 
           data$Age <= input$ageRange[2], ]
  })
  
  output$distPlot <- renderPlot({
    ggplot(filtered_data(),aes(x=Age)) + 
      geom_histogram()
  })
  
  output$downloadReport <- downloadHandler(
    filename = function() {
      paste('my-report', sep = '.', switch(
        input$format, PDF = 'pdf', 
                      HTML = 'html', 
                      Word = 'docx'
      ))
    },
    
    content = function(file) {                       
      src <- normalizePath('child_script.Rmd')
      owd <- setwd(tempdir())
      on.exit(setwd(owd))
      file.copy(src, 'child_script.Rmd', 
                overwrite = TRUE)
      
     out <- rmarkdown::render('child_script.Rmd',
       params = list(text = input$text, 
                     outp=input$Try, 
                     age=input$ageRange),
       switch(input$format,
            PDF = pdf_document(), 
            HTML = html_document(), 
            Word = word_document()
                               ))
      file.rename(out, file)
    }
  )
}

ui <- fluidPage(
  tags$textarea(id="text", rows=10, cols=15, 
            placeholder="Some placeholder text"),
  
  flowLayout(sliderInput('ageRange', 'Age Range', 
                         min = 30, 
                         max = 45, 
                         value = c(30, 45)),
             plotOutput("distPlot"),
             radioButtons('format',                  
                'Document format', 
                c('HTML', 'Word','PDF'),
                    inline = FALSE),
             checkboxGroupInput(
    "Try","Let's hope this works",
    choiceNames = list("include hi",
                       "include hey",
                       "include hello",
                       "include how are you"),
    choiceValues = list("HI",
                        "HEY",
                        "HELLO",
                        "HOW ARE YOU")),
             downloadButton('downloadReport'))
)

shinyApp(ui = ui, server = server)

1

Most interactive functionality currently dependent on this filtered_data object (dataframe)

2

Rendered report name and proper file extension (.html, .pdf, or .docx)

3

Locates and renders “child” .Rmd report template – parameters also identified here

4

Our two elements of most immediate interest (in addition to the downloadReport button on line #76)

---
title: "Testing with Diego"
output: html_document
params:
  text: 'NULL'
  outp: 'NULL'
  age: 'NULL'
---

# Fiddling around

`r params[["text"]]`
`r params[["outp"]]`

the selected age range is `r params[["age"]]`

``{r, warning=FALSE, echo=FALSE, message=FALSE}
library(ggplot2)

ggplot(filtered_data(),aes(x=Age)) +
  geom_histogram()
``

the picture above is reflecting ages from 
`r nrow(filtered_data())` British rockers.

1

Default output type for report – UI has check-box options to override this default

2

One way to “call in” values from dynamic reactive app elements

3

dataname() convention used with reactive dataframes

Today:

\(\Psi\) APA Quarto Extension 🙈

Session Info (June 25, 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] fontawesome_0.5.2

loaded via a namespace (and not attached):
 [1] lubridate_1.9.3   emo_0.0.0.9000    digest_0.6.31     crayon_1.5.2     
 [5] assertthat_0.2.1  lifecycle_1.0.4   jsonlite_1.8.8    magrittr_2.0.3   
 [9] evaluate_0.23     stringi_1.7.12    rlang_1.1.3       cli_3.6.0        
[13] rstudioapi_0.15.0 vctrs_0.6.5       generics_0.1.3    rmarkdown_2.26   
[17] tools_4.2.2       stringr_1.5.1     glue_1.6.2        purrr_1.0.1      
[21] xfun_0.42         yaml_2.3.8        fastmap_1.1.1     compiler_4.2.2   
[25] timechange_0.3.0  htmltools_0.5.7   knitr_1.45