resolving report creating on server by exporting/importing kable/md table. works for now. Not ideal.

This commit is contained in:
Andreas Gammelgaard Damsbo 2025-01-23 08:44:38 +01:00
parent 9f828aa4bd
commit 02dfcf50d6
No known key found for this signature in database
11 changed files with 143 additions and 55 deletions

View file

@ -54,7 +54,10 @@ Imports:
apexcharter, apexcharter,
teal.modules.general, teal.modules.general,
esquisse, esquisse,
janitor janitor,
flextable,
gt,
kableExtra
Suggests: Suggests:
styler, styler,
devtools, devtools,

View file

@ -29,19 +29,23 @@ getfun <- function(x) {
#' @return output file name #' @return output file name
#' @export #' @export
#' #'
write_quarto <- function(data, ...) { write_quarto <- function(data,...) {
# Exports data to temporary location # Exports data to temporary location
# #
# I assume this is more secure than putting it in the www folder and deleting # I assume this is more secure than putting it in the www folder and deleting
# on session end # on session end
temp <- tempfile(fileext = ".rds")
readr::write_rds(data, file = temp) # temp <- base::tempfile(fileext = ".rds")
# readr::write_rds(data, file = here)
readr::write_rds(data, file = "www/web_data.rds")
## Specifying a output path will make the rendering fail ## Specifying a output path will make the rendering fail
## Ref: https://github.com/quarto-dev/quarto-cli/discussions/4041 ## Ref: https://github.com/quarto-dev/quarto-cli/discussions/4041
## Outputs to the same as the .qmd file ## Outputs to the same as the .qmd file
quarto::quarto_render( quarto::quarto_render(
execute_params = list(data.file = temp), execute_params = list(data.file = "web_data.rds"),
# execute_params = list(data.file = temp),
... ...
) )
} }

0
R/redcap.R Normal file
View file

View file

@ -267,7 +267,8 @@ supported_functions <- function() {
out.type = "continuous", out.type = "continuous",
fun = "stats::lm", fun = "stats::lm",
args.list = NULL, args.list = NULL,
formula.str = "{outcome.str}~{paste(vars,collapse='+')}" formula.str = "{outcome.str}~{paste(vars,collapse='+')}",
table.fun = "gtsummary::tbl_regression"
), ),
glm = list( glm = list(
descr = "Logistic regression model", descr = "Logistic regression model",
@ -275,7 +276,8 @@ supported_functions <- function() {
out.type = "dichotomous", out.type = "dichotomous",
fun = "stats::glm", fun = "stats::glm",
args.list = list(family = stats::binomial(link = "logit")), args.list = list(family = stats::binomial(link = "logit")),
formula.str = "{outcome.str}~{paste(vars,collapse='+')}" formula.str = "{outcome.str}~{paste(vars,collapse='+')}",
table.fun = "gtsummary::tbl_regression"
), ),
polr = list( polr = list(
descr = "Ordinal logistic regression model", descr = "Ordinal logistic regression model",
@ -286,7 +288,8 @@ supported_functions <- function() {
Hess = TRUE, Hess = TRUE,
method = "logistic" method = "logistic"
), ),
formula.str = "{outcome.str}~{paste(vars,collapse='+')}" formula.str = "{outcome.str}~{paste(vars,collapse='+')}",
table.fun = "gtsummary::tbl_regression"
) )
) )
} }

View file

@ -11,7 +11,7 @@
#' #'
#' @examples #' @examples
#' \dontrun{ #' \dontrun{
#' gtsummary::trial |> #' tbl <- gtsummary::trial |>
#' regression_model( #' regression_model(
#' outcome.str = "stage", #' outcome.str = "stage",
#' fun = "MASS::polr" #' fun = "MASS::polr"
@ -140,3 +140,6 @@ tbl_merge <- function(data) {
data |> gtsummary::tbl_merge(tab_spanner = names(data)) data |> gtsummary::tbl_merge(tab_spanner = names(data))
} }
} }
# as_kable(tbl) |> write_lines(file=here::here("inst/apps/data_analysis_modules/www/_table1.md"))
# as_kable_extra(tbl)|> write_lines(file=here::here("inst/apps/data_analysis_modules/www/table1.md"))

View file

@ -1139,19 +1139,23 @@ getfun <- function(x) {
#' @return output file name #' @return output file name
#' @export #' @export
#' #'
write_quarto <- function(data, ...) { write_quarto <- function(data,...) {
# Exports data to temporary location # Exports data to temporary location
# #
# I assume this is more secure than putting it in the www folder and deleting # I assume this is more secure than putting it in the www folder and deleting
# on session end # on session end
temp <- tempfile(fileext = ".rds")
readr::write_rds(data, file = temp) # temp <- base::tempfile(fileext = ".rds")
# readr::write_rds(data, file = here)
readr::write_rds(data, file = "www/web_data.rds")
## Specifying a output path will make the rendering fail ## Specifying a output path will make the rendering fail
## Ref: https://github.com/quarto-dev/quarto-cli/discussions/4041 ## Ref: https://github.com/quarto-dev/quarto-cli/discussions/4041
## Outputs to the same as the .qmd file ## Outputs to the same as the .qmd file
quarto::quarto_render( quarto::quarto_render(
execute_params = list(data.file = temp), execute_params = list(data.file = "web_data.rds"),
# execute_params = list(data.file = temp),
... ...
) )
} }
@ -1711,6 +1715,13 @@ redcap_app <- function() {
} }
########
#### Current file: R//redcap.R
########
######## ########
#### Current file: R//regression_model.R #### Current file: R//regression_model.R
######## ########
@ -1984,7 +1995,8 @@ supported_functions <- function() {
out.type = "continuous", out.type = "continuous",
fun = "stats::lm", fun = "stats::lm",
args.list = NULL, args.list = NULL,
formula.str = "{outcome.str}~{paste(vars,collapse='+')}" formula.str = "{outcome.str}~{paste(vars,collapse='+')}",
table.fun = "gtsummary::tbl_regression"
), ),
glm = list( glm = list(
descr = "Logistic regression model", descr = "Logistic regression model",
@ -1992,7 +2004,8 @@ supported_functions <- function() {
out.type = "dichotomous", out.type = "dichotomous",
fun = "stats::glm", fun = "stats::glm",
args.list = list(family = stats::binomial(link = "logit")), args.list = list(family = stats::binomial(link = "logit")),
formula.str = "{outcome.str}~{paste(vars,collapse='+')}" formula.str = "{outcome.str}~{paste(vars,collapse='+')}",
table.fun = "gtsummary::tbl_regression"
), ),
polr = list( polr = list(
descr = "Ordinal logistic regression model", descr = "Ordinal logistic regression model",
@ -2003,7 +2016,8 @@ supported_functions <- function() {
Hess = TRUE, Hess = TRUE,
method = "logistic" method = "logistic"
), ),
formula.str = "{outcome.str}~{paste(vars,collapse='+')}" formula.str = "{outcome.str}~{paste(vars,collapse='+')}",
table.fun = "gtsummary::tbl_regression"
) )
) )
} }
@ -2332,7 +2346,7 @@ regression_model_uv_list <- function(data,
#' #'
#' @examples #' @examples
#' \dontrun{ #' \dontrun{
#' gtsummary::trial |> #' tbl <- gtsummary::trial |>
#' regression_model( #' regression_model(
#' outcome.str = "stage", #' outcome.str = "stage",
#' fun = "MASS::polr" #' fun = "MASS::polr"
@ -2462,6 +2476,9 @@ tbl_merge <- function(data) {
} }
} }
# as_kable(tbl) |> write_lines(file=here::here("inst/apps/data_analysis_modules/www/_table1.md"))
# as_kable_extra(tbl)|> write_lines(file=here::here("inst/apps/data_analysis_modules/www/table1.md"))
######## ########
#### Current file: R//report.R #### Current file: R//report.R
@ -3736,7 +3753,7 @@ ui_elements <- list(
label = "Download report", label = "Download report",
icon = shiny::icon("download") icon = shiny::icon("download")
), ),
shiny::helpText("If choosing to output to MS Word, please note, that when opening the document, two errors will pop-up. Choose to repair and choose not to update references. The issue is being worked on. You can always choose LibreOffice instead."), # shiny::helpText("If choosing to output to MS Word, please note, that when opening the document, two errors will pop-up. Choose to repair and choose not to update references. The issue is being worked on. You can always choose LibreOffice instead."),
shiny::tags$hr(), shiny::tags$hr(),
shiny::h4("Data"), shiny::h4("Data"),
shiny::helpText("Choose your favourite output data format to download the modified data."), shiny::helpText("Choose your favourite output data format to download the modified data."),
@ -3871,7 +3888,6 @@ ui <- bslib::page_fixed(
library(readr) library(readr)
library(MASS) library(MASS)
library(stats) library(stats)
library(gtsummary)
library(gt) library(gt)
library(openxlsx2) library(openxlsx2)
library(haven) library(haven)
@ -3895,6 +3911,7 @@ library(data.table)
library(IDEAFilter) library(IDEAFilter)
library(shinyWidgets) library(shinyWidgets)
library(DT) library(DT)
library(gtsummary)
# library(freesearcheR) # library(freesearcheR)
# source("functions.R") # source("functions.R")
@ -4411,6 +4428,9 @@ server <- function(input, output, session) {
.x .x
} }
})() })()
gtsummary::as_kable(rv$list$table1) |>
readr::write_lines(file="./www/_table1.md")
} }
) )
@ -4453,7 +4473,7 @@ server <- function(input, output, session) {
# browser() # browser()
rv$list$regression$options <- get_fun_options(input$regression_type) |> rv$list$regression$params <- get_fun_options(input$regression_type) |>
(\(.x){ (\(.x){
.x[[1]] .x[[1]]
})() })()
@ -4542,6 +4562,9 @@ server <- function(input, output, session) {
rv$list$regression$table <- out |> rv$list$regression$table <- out |>
tbl_merge() tbl_merge()
gtsummary::as_kable(rv$list$regression$table) |>
readr::write_lines(file="./www/_regression_table.md")
rv$list$input <- input rv$list$input <- input
}, },
warning = function(warn) { warning = function(warn) {
@ -4559,7 +4582,7 @@ server <- function(input, output, session) {
shiny::req(rv$list$regression$table) shiny::req(rv$list$regression$table)
rv$list$regression$table |> rv$list$regression$table |>
gtsummary::as_gt() |> gtsummary::as_gt() |>
gt::tab_header(gt::md(glue::glue("**Table 2: {rv$list$regression$options$descr}**"))) gt::tab_header(gt::md(glue::glue("**Table 2: {rv$list$regression$params$descr}**")))
}) })
@ -4582,7 +4605,6 @@ server <- function(input, output, session) {
bslib::nav_select(id = "main_panel", selected = "Data") bslib::nav_select(id = "main_panel", selected = "Data")
}) })
############################################################################## ##############################################################################
######### #########
######### Reactivity ######### Reactivity
@ -4634,7 +4656,7 @@ server <- function(input, output, session) {
paste0("report.", input$output_type) paste0("report.", input$output_type)
}), }),
content = function(file, type = input$output_type) { content = function(file, type = input$output_type) {
shiny::req(rv$list$regression) # shiny::req(rv$list$regression)
## Notification is not progressing ## Notification is not progressing
## Presumably due to missing ## Presumably due to missing
shiny::withProgress(message = "Generating the report. Hold on for a moment..", { shiny::withProgress(message = "Generating the report. Hold on for a moment..", {

View file

@ -5,6 +5,6 @@ account: agdamsbo
server: shinyapps.io server: shinyapps.io
hostUrl: https://api.shinyapps.io/v1 hostUrl: https://api.shinyapps.io/v1
appId: 13611288 appId: 13611288
bundleId: 9672500 bundleId: 9687528
url: https://agdamsbo.shinyapps.io/freesearcheR/ url: https://agdamsbo.shinyapps.io/freesearcheR/
version: 1 version: 1

View file

@ -1,7 +1,6 @@
library(readr) library(readr)
library(MASS) library(MASS)
library(stats) library(stats)
library(gtsummary)
library(gt) library(gt)
library(openxlsx2) library(openxlsx2)
library(haven) library(haven)
@ -25,6 +24,7 @@ library(data.table)
library(IDEAFilter) library(IDEAFilter)
library(shinyWidgets) library(shinyWidgets)
library(DT) library(DT)
library(gtsummary)
# library(freesearcheR) # library(freesearcheR)
# source("functions.R") # source("functions.R")
@ -541,6 +541,9 @@ server <- function(input, output, session) {
.x .x
} }
})() })()
gtsummary::as_kable(rv$list$table1) |>
readr::write_lines(file="./www/_table1.md")
} }
) )
@ -583,7 +586,7 @@ server <- function(input, output, session) {
# browser() # browser()
rv$list$regression$options <- get_fun_options(input$regression_type) |> rv$list$regression$params <- get_fun_options(input$regression_type) |>
(\(.x){ (\(.x){
.x[[1]] .x[[1]]
})() })()
@ -672,6 +675,9 @@ server <- function(input, output, session) {
rv$list$regression$table <- out |> rv$list$regression$table <- out |>
tbl_merge() tbl_merge()
gtsummary::as_kable(rv$list$regression$table) |>
readr::write_lines(file="./www/_regression_table.md")
rv$list$input <- input rv$list$input <- input
}, },
warning = function(warn) { warning = function(warn) {
@ -689,7 +695,7 @@ server <- function(input, output, session) {
shiny::req(rv$list$regression$table) shiny::req(rv$list$regression$table)
rv$list$regression$table |> rv$list$regression$table |>
gtsummary::as_gt() |> gtsummary::as_gt() |>
gt::tab_header(gt::md(glue::glue("**Table 2: {rv$list$regression$options$descr}**"))) gt::tab_header(gt::md(glue::glue("**Table 2: {rv$list$regression$params$descr}**")))
}) })
@ -712,7 +718,6 @@ server <- function(input, output, session) {
bslib::nav_select(id = "main_panel", selected = "Data") bslib::nav_select(id = "main_panel", selected = "Data")
}) })
############################################################################## ##############################################################################
######### #########
######### Reactivity ######### Reactivity
@ -764,7 +769,7 @@ server <- function(input, output, session) {
paste0("report.", input$output_type) paste0("report.", input$output_type)
}), }),
content = function(file, type = input$output_type) { content = function(file, type = input$output_type) {
shiny::req(rv$list$regression) # shiny::req(rv$list$regression)
## Notification is not progressing ## Notification is not progressing
## Presumably due to missing ## Presumably due to missing
shiny::withProgress(message = "Generating the report. Hold on for a moment..", { shiny::withProgress(message = "Generating the report. Hold on for a moment..", {

View file

@ -389,7 +389,7 @@ ui_elements <- list(
label = "Download report", label = "Download report",
icon = shiny::icon("download") icon = shiny::icon("download")
), ),
shiny::helpText("If choosing to output to MS Word, please note, that when opening the document, two errors will pop-up. Choose to repair and choose not to update references. The issue is being worked on. You can always choose LibreOffice instead."), # shiny::helpText("If choosing to output to MS Word, please note, that when opening the document, two errors will pop-up. Choose to repair and choose not to update references. The issue is being worked on. You can always choose LibreOffice instead."),
shiny::tags$hr(), shiny::tags$hr(),
shiny::h4("Data"), shiny::h4("Data"),
shiny::helpText("Choose your favourite output data format to download the modified data."), shiny::helpText("Choose your favourite output data format to download the modified data."),

View file

@ -1,22 +1,45 @@
--- ---
format:
html:
embed-resources: true
title: "freesearcheR analysis results" title: "freesearcheR analysis results"
date: today date: today
format: docx
author: freesearcheR Tool author: freesearcheR Tool
toc: true toc: false
execute: execute:
echo: false echo: false
params: params:
data.file: NA data.file: NA
--- ---
```{r setup} ```{r}
#| message: false
#| warning: false
# if (!requireNamespace("gtsummary")){
# install.packages("gtsummary")
# } else {
# library(gtsummary)
# }
#
# if (!requireNamespace("gt")){
# install.packages("gt")
# } else {
# library(gt)
# }
#
# if (!requireNamespace("readr")){
# install.packages("readr")
# } else {
# library(readr)
# }
# requireNamespace("gtsummary")
# requireNamespace("gt")
# require(gt)
# require(flextable)
# if (!requireNamespace("readr")){
# install.packages("readr")
# }
web_data <- readr::read_rds(file = params$data.file) web_data <- readr::read_rds(file = params$data.file)
library(gtsummary) # library(gt)
library(gt) # library(flextable)
library(flextable)
# library(freesearcheR) # library(freesearcheR)
``` ```
@ -26,29 +49,17 @@ Research should be free and open with easy access for all. The freesearcheR tool
## Methods ## Methods
Analyses were conducted in R version `r paste(version["major"],version["minor"],sep=".")`. Analyses were conducted in the *freesearcheR* data analysis web-tool based on R version 4.4.1.
## Results ## Results
Below is the baseline characteristics plotted. Below are the baseline characteristics.
```{r} {{< include _table1.md >}}
#| label: tbl-baseline
#| tbl-cap: Baseline characteristics of included data
web_data$table1 |>
gtsummary::as_flex_table() |>
flextable::set_table_properties(width = 1, layout = "autofit")
```
Here are the results from the `r web_data$regression$options$descr`. Below are results from the univariable and multivariable regression analyses.
```{r} {{< include _regression_table.md >}}
#| label: tbl-regression
#| tbl-cap: Regression analysis results
web_data$regression$table|>
gtsummary::as_flex_table() |>
flextable::set_table_properties(width = 1, layout = "autofit")
```
## Discussion ## Discussion

View file

@ -1742,6 +1742,31 @@
], ],
"Hash": "3bcd11943da509341838da9399e18bce" "Hash": "3bcd11943da509341838da9399e18bce"
}, },
"kableExtra": {
"Package": "kableExtra",
"Version": "1.4.0",
"Source": "Repository",
"Repository": "CRAN",
"Requirements": [
"R",
"digest",
"grDevices",
"graphics",
"htmltools",
"knitr",
"magrittr",
"rmarkdown",
"rstudioapi",
"scales",
"stats",
"stringr",
"svglite",
"tools",
"viridisLite",
"xml2"
],
"Hash": "532d16304274c23c8563f94b79351c86"
},
"keyring": { "keyring": {
"Package": "keyring", "Package": "keyring",
"Version": "1.3.2", "Version": "1.3.2",
@ -3104,6 +3129,18 @@
], ],
"Hash": "fe42836742a4f065b3f3f5de81fccab9" "Hash": "fe42836742a4f065b3f3f5de81fccab9"
}, },
"svglite": {
"Package": "svglite",
"Version": "2.1.3",
"Source": "Repository",
"Repository": "CRAN",
"Requirements": [
"R",
"cpp11",
"systemfonts"
],
"Hash": "124a41fdfa23e8691cb744c762f10516"
},
"sys": { "sys": {
"Package": "sys", "Package": "sys",
"Version": "3.4.3", "Version": "3.4.3",