quarto rendering and download now works! 🥳

R/helpers.R

@@ -25,26 +25,28 @@ getfun <- function(x) {
 #'
 #' @param data list to pass to qmd
 #' @param fileformat output format. Ignored if file!=NULL
-#' @param qmd.file qmd file to render. Default is 'here::here("analyses.qmd")'
+#' @param qmd.file qmd file to render. Default is 'here::here("report.qmd")'
-#' @param file exact filename (Optional)
+#' @param ... Passed to `quarto::quarto_render()`
-#' @param ... Ignored for now
 #'
-#' @return none
+#' @return output file name
 #' @export
 #'
-write_quarto <- function(data,fileformat,qmd.file=here::here("analyses.qmd"),file=NULL,...){
+write_quarto <- function(data,fileformat=c("html","docx","odt","pdf","all"),qmd.file=here::here("report.qmd"),...){
-  if (is.null(file)){
+  fileformat <- match.arg(fileformat)
-    file <- paste0("analyses.",fileformat)
+  # Exports data to temporary location
-  }
+  #
-  temp <- tempfile(fileext = ".Rds")
+  # I assume this is more secure than putting it in the www folder and deleting
-  # write_rds(mtcars, temp)
+  # on session end
-  # read_rds(temp)
+  temp <- tempfile(fileext = ".rds")
-  web_data <- data
+  readr::write_rds(data,file=temp)
-  saveRDS(web_data,file=temp)
 
+  ## Specifying a output path will make the rendering fail
+  ## Ref: https://github.com/quarto-dev/quarto-cli/discussions/4041
+  ## Outputs to the same as the .qmd file
   quarto::quarto_render(qmd.file,
-                        output_file = file,
+                        output_format = fileformat,
-                        execute_params = list(data.file=temp)
+                        execute_params = list(data.file=temp),
+                        ...
   )
 }
 

R/regression_table.R

@@ -38,5 +38,5 @@ regression_table <- function(data, args.list = NULL, fun = "gtsummary::tbl_regre
   }
 
   out <- do.call(getfun(fun), c(list(x = data), args.list))
-  return(out)
+  out |> gtsummary::add_glance_source_note()
 }

inst/apps/data_analysis/rsconnect/shinyapps.io/agdamsbo/webResearch.dcf

@@ -5,6 +5,6 @@ account: agdamsbo
 server: shinyapps.io
 hostUrl: https://api.shinyapps.io/v1
 appId: 13276335
-bundleId: 9397034
+bundleId: 9397035
 url: https://agdamsbo.shinyapps.io/webResearch/
 version: 1

inst/apps/data_analysis/server.R

@@ -25,11 +25,16 @@ if (!requireNamespace("webResearch")) {
 library(webResearch)
 
 server <- function(input, output, session) {
+  ## Listing files in www in session start to keep when ending and removing
+  ## everything else.
+  files.to.keep <- list.files("www/")
+
   v <- shiny::reactiveValues(
     list = NULL,
     ds = NULL,
     input = exists("webResearch_data"),
-    local_temp = NULL
+    local_temp = NULL,
+    quarto = NULL
   )
 
   ds <- shiny::reactive({
@@ -88,31 +93,33 @@ server <- function(input, output, session) {
       }
 
       if (is.null(input$include_vars)) {
-        base_vars <- NULL
+        base_vars <- colnames(data)
       } else {
         base_vars <- c(input$include_vars, input$outcome_var)
       }
 
+      data <- dplyr::select(data, dplyr::all_of(base_vars))
+
+      model <- data |>
+        regression_model(
+          outcome.str = input$outcome_var,
+          auto.mode = input$regression_auto == 1,
+          formula.str = input$regression_formula,
+          fun = input$regression_fun,
+          args.list = eval(parse(text = paste0("list(", input$regression_args, ")")))
+        )
+
 
       v$list <- list(
         data = data,
         table1 = data |>
           baseline_table(
-            vars = base_vars,
             fun.args =
               list(
                 by = by.var
               )
           ),
-        table2 = data |>
+        table2 = model |>
-          regression_model(
-            outcome.str = input$outcome_var,
-            auto.mode = input$regression_auto == 1,
-            formula.str = input$regression_formula,
-            fun = input$regression_fun,
-            args.list = eval(parse(text = paste0("list(", input$regression_args, ")"))),
-            vars = input$include_vars
-          ) |>
           regression_table()
       )
 
@@ -128,7 +135,6 @@ server <- function(input, output, session) {
     }
   )
 
-
   output$uploaded <- shiny::reactive({
     if (is.null(v$ds)) {
       "no"
@@ -149,35 +155,30 @@ server <- function(input, output, session) {
 
   shiny::outputOptions(output, "has_input", suspendWhenHidden = FALSE)
 
-  #####
-  #### Generating output
-  #####
-
-  # Downloadable csv of selected dataset ----
-  # output$downloadData <- shiny::downloadHandler(
-  #   filename = "index_lookup.csv",
-  #   content = function(file) {
-  #     write.csv(v$index, file, row.names = FALSE)
-  #   }
-  # )
-
-
   # Could be rendered with other tables or should show progress
   # Investigate quarto render problems
   # On temp file handling: https://github.com/quarto-dev/quarto-cli/issues/3992
   output$report <- downloadHandler(
-    filename = "analyses.html",
+    filename = shiny::reactive({
-    content = function(file) {
+      paste0("report.", input$output_type)
-      local.temp <- paste0("temp.", tools::file_ext(file))
+    }),
+    content = function(file, type = input$output_type) {
       v$list |>
         write_quarto(
-          file = local.temp,
+          fileformat = type,
-          qmd.file = file.path(getwd(), "www/analyses.qmd")
+          qmd.file = file.path(getwd(), "www/report.qmd")
         )
-      v$local_temp <- local.temp
+      file.rename(paste0("www/report.", type), file)
-      file.rename(v$local_temp, file)
     }
   )
 
+  session$onSessionEnded(function() {
+    cat("Session Ended\n")
+    files <- list.files("www/")
+    lapply(files[!files %in% files.to.keep], \(.x){
+      unlink(paste0("www/", .x), recursive = FALSE)
+      print(paste(.x, "deleted"))
+    })
+  })
   #
 }

inst/apps/data_analysis/ui.R

@@ -69,8 +69,6 @@ ui <- bslib::page(
           label = "Choose data file",
           multiple = FALSE,
           accept = c(
-            "text/csv",
-            "text/comma-separated-values,text/plain",
             ".csv",
             ".xlsx",
             ".xls",
@@ -131,9 +129,20 @@ ui <- bslib::page(
         #
         # # Horizontal line ----
         tags$hr(),
+        shiny::conditionalPanel(
+          condition = "input.load",
           h4("Download results"),
-
+          shiny::helpText("Choose your favourite output file format for further work."),
-        shiny::helpText("The download currently works, but the output is not correctly formatted. Work in progress!"),
+          shiny::selectInput(
+            inputId = "output_type",
+            label = "Choose your desired output format",
+            selected = NULL,
+            choices = list(
+              "Word" = "docx",
+              "LibreOffice" = "odt",
+              "PDF" = "pdf"
+            )
+          ),
 
           # Button
           downloadButton(
@@ -141,7 +150,7 @@ ui <- bslib::page(
             label = "Download",
             icon = shiny::icon("download")
           )
-
+        )
       )
     ),
     bslib::nav_spacer(),

inst/apps/data_analysis/www/report.qmd

@@ -1,23 +1,33 @@
 ---
 title: "webResearch analysis results"
 date: today
+author: webResearch Tool
+toc: true
 execute: 
   echo: false
+format: 
+  html:
+    embed-resources: true
+  docx: default
+  odt: default
+  pdf: default
 params:
   data.file: NA
 ---
 
 ```{r setup}
-web_data <- readRDS(file = params$data.file)
+web_data <- readr::read_rds(file = params$data.file)
+library(gtsummary)
+library(gt)
+library(webResearch)
 ```
 
 ## Introduction
 
-
+Research should be free and open with easy access for all. The webResearch tool attempts to help lower the bar to participate in contributing to science.
 
 ## Methods
 
-
 Analyses were conducted in R version `r paste(version["major"],version["minor"],sep=".")` using the web-based data analysis tool 'webResearcher' version `r packageVersion("webResearch")`.
 
 ## Results
@@ -25,12 +35,16 @@ Analyses were conducted in R version `r paste(version["major"],version["minor"],
 Below is the baseline characteristics plotted.
 
 ```{r}
+#| label: tbl-baseline
+#| tbl-cap: Baseline characteristics of included data
 web_data$table1
 ```
 
 Here are the regression results.
 
 ```{r}
+#| label: tbl-regression
+#| tbl-cap: Regression analysis results
 web_data$table2
 ```
 

man/write_quarto.Rd

@@ -6,9 +6,8 @@
 \usage{
 write_quarto(
   data,
-  fileformat,
+  fileformat = c("html", "docx", "odt", "pdf", "all"),
-  qmd.file = here::here("analyses.qmd"),
+  qmd.file = here::here("report.qmd"),
-  file = NULL,
   ...
 )
 }
@@ -17,14 +16,12 @@ write_quarto(
 
 \item{fileformat}{output format. Ignored if file!=NULL}
 
-\item{qmd.file}{qmd file to render. Default is 'here::here("analyses.qmd")'}
+\item{qmd.file}{qmd file to render. Default is 'here::here("report.qmd")'}
 
-\item{file}{exact filename (Optional)}
+\item{...}{Passed to \code{quarto::quarto_render()}}
-
-\item{...}{Ignored for now}
 }
 \value{
-none
+output file name
 }
 \description{
 Wrapper to save data in RDS, load into specified qmd and render