diff --git a/R/helpers.R b/R/helpers.R index d44a269..2e814fb 100644 --- a/R/helpers.R +++ b/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 file exact filename (Optional) -#' @param ... Ignored for now +#' @param qmd.file qmd file to render. Default is 'here::here("report.qmd")' +#' @param ... Passed to `quarto::quarto_render()` #' -#' @return none +#' @return output file name #' @export #' -write_quarto <- function(data,fileformat,qmd.file=here::here("analyses.qmd"),file=NULL,...){ - if (is.null(file)){ - file <- paste0("analyses.",fileformat) - } - temp <- tempfile(fileext = ".Rds") - # write_rds(mtcars, temp) - # read_rds(temp) - web_data <- data - saveRDS(web_data,file=temp) +write_quarto <- function(data,fileformat=c("html","docx","odt","pdf","all"),qmd.file=here::here("report.qmd"),...){ + fileformat <- match.arg(fileformat) + # Exports data to temporary location + # + # I assume this is more secure than putting it in the www folder and deleting + # on session end + temp <- tempfile(fileext = ".rds") + readr::write_rds(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, - execute_params = list(data.file=temp) + output_format = fileformat, + execute_params = list(data.file=temp), + ... ) } diff --git a/R/regression_table.R b/R/regression_table.R index 2597246..785ea75 100644 --- a/R/regression_table.R +++ b/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() } diff --git a/inst/apps/data_analysis/rsconnect/shinyapps.io/agdamsbo/webResearch.dcf b/inst/apps/data_analysis/rsconnect/shinyapps.io/agdamsbo/webResearch.dcf index 9640c24..fdfc73c 100644 --- a/inst/apps/data_analysis/rsconnect/shinyapps.io/agdamsbo/webResearch.dcf +++ b/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 diff --git a/inst/apps/data_analysis/server.R b/inst/apps/data_analysis/server.R index fd3c880..3aa5379 100644 --- a/inst/apps/data_analysis/server.R +++ b/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 |> - 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 - ) |> + table2 = model |> 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", - content = function(file) { - local.temp <- paste0("temp.", tools::file_ext(file)) + filename = shiny::reactive({ + paste0("report.", input$output_type) + }), + content = function(file, type = input$output_type) { v$list |> write_quarto( - file = local.temp, - qmd.file = file.path(getwd(), "www/analyses.qmd") + fileformat = type, + qmd.file = file.path(getwd(), "www/report.qmd") ) - v$local_temp <- local.temp - file.rename(v$local_temp, file) + file.rename(paste0("www/report.", type), 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")) + }) + }) # } diff --git a/inst/apps/data_analysis/testing_output.rds b/inst/apps/data_analysis/testing_output.rds new file mode 100644 index 0000000..9ad95e0 Binary files /dev/null and b/inst/apps/data_analysis/testing_output.rds differ diff --git a/inst/apps/data_analysis/ui.R b/inst/apps/data_analysis/ui.R index 155af16..282dd10 100644 --- a/inst/apps/data_analysis/ui.R +++ b/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,17 +129,28 @@ ui <- bslib::page( # # # Horizontal line ---- tags$hr(), - h4("Download results"), + shiny::conditionalPanel( + condition = "input.load", + h4("Download results"), + shiny::helpText("Choose your favourite output file format for further work."), + shiny::selectInput( + inputId = "output_type", + label = "Choose your desired output format", + selected = NULL, + choices = list( + "Word" = "docx", + "LibreOffice" = "odt", + "PDF" = "pdf" + ) + ), - shiny::helpText("The download currently works, but the output is not correctly formatted. Work in progress!"), - - # Button - downloadButton( - outputId = "report", - label = "Download", - icon = shiny::icon("download") + # Button + downloadButton( + outputId = "report", + label = "Download", + icon = shiny::icon("download") + ) ) - ) ), bslib::nav_spacer(), diff --git a/inst/apps/data_analysis/www/analyses.qmd b/inst/apps/data_analysis/www/report.qmd similarity index 50% rename from inst/apps/data_analysis/www/analyses.qmd rename to inst/apps/data_analysis/www/report.qmd index f5a27d4..d65dbee 100644 --- a/inst/apps/data_analysis/www/analyses.qmd +++ b/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 ``` diff --git a/man/write_quarto.Rd b/man/write_quarto.Rd index 7f3e23d..7696d7e 100644 --- a/man/write_quarto.Rd +++ b/man/write_quarto.Rd @@ -6,9 +6,8 @@ \usage{ write_quarto( data, - fileformat, - qmd.file = here::here("analyses.qmd"), - file = NULL, + fileformat = c("html", "docx", "odt", "pdf", "all"), + qmd.file = here::here("report.qmd"), ... ) } @@ -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{...}{Ignored for now} +\item{...}{Passed to \code{quarto::quarto_render()}} } \value{ -none +output file name } \description{ Wrapper to save data in RDS, load into specified qmd and render