mirror of
https://github.com/agdamsbo/FreesearchR.git
synced 2026-06-19 12:37:30 +02:00
quarto rendering and download now works! 🥳
This commit is contained in:
parent
c5a15bfb1e
commit
0c0c2313a9
8 changed files with 95 additions and 72 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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"))
|
||||
})
|
||||
})
|
||||
#
|
||||
}
|
||||
|
|
|
|||
BIN
inst/apps/data_analysis/testing_output.rds
Normal file
BIN
inst/apps/data_analysis/testing_output.rds
Normal file
Binary file not shown.
|
|
@ -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(),
|
||||
|
|
|
|||
|
|
@ -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
|
||||
```
|
||||
|
||||
Loading…
Add table
Add a link
Reference in a new issue