andreas/FreesearchR
1
0
Fork 0
mirror of https://github.com/agdamsbo/FreesearchR.git synced 2025-09-12 09:59:39 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions 1

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

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

5
DESCRIPTION
View file

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

12
R/helpers.R
View file

@ -29,19 +29,23 @@ getfun <- function(x) {
#' @return output file name
#' @export
#'
write_quarto <- function(data, ...) {
write_quarto <- function(data,...) {
# 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)
# 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
## Ref: https://github.com/quarto-dev/quarto-cli/discussions/4041
## Outputs to the same as the .qmd file
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

9
R/regression_model.R
View file

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

5
R/regression_table.R
View file

@ -11,7 +11,7 @@
#'
#' @examples
#' \dontrun{
#' gtsummary::trial |>
#' tbl <- gtsummary::trial |>
#' regression_model(
#' outcome.str = "stage",
#' fun = "MASS::polr"
@ -140,3 +140,6 @@ tbl_merge <- function(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"))

50
inst/apps/data_analysis_modules/app.R
View file

@ -1139,19 +1139,23 @@ getfun <- function(x) {
#' @return output file name
#' @export
#'
write_quarto <- function(data, ...) {
write_quarto <- function(data,...) {
# 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)
# 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
## Ref: https://github.com/quarto-dev/quarto-cli/discussions/4041
## Outputs to the same as the .qmd file
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
########
@ -1984,7 +1995,8 @@ supported_functions <- function() {
out.type = "continuous",
fun = "stats::lm",
args.list = NULL,
formula.str = "{outcome.str}~{paste(vars,collapse='+')}"
formula.str = "{outcome.str}~{paste(vars,collapse='+')}",
table.fun = "gtsummary::tbl_regression"
),
glm = list(
descr = "Logistic regression model",
@ -1992,7 +2004,8 @@ supported_functions <- function() {
out.type = "dichotomous",
fun = "stats::glm",
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(
descr = "Ordinal logistic regression model",
@ -2003,7 +2016,8 @@ supported_functions <- function() {
Hess = TRUE,
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
#' \dontrun{
#' gtsummary::trial |>
#' tbl <- gtsummary::trial |>
#' regression_model(
#' outcome.str = "stage",
#' 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
@ -3736,7 +3753,7 @@ ui_elements <- list(
label = "Download report",
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::h4("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(MASS)
library(stats)
library(gtsummary)
library(gt)
library(openxlsx2)
library(haven)
@ -3895,6 +3911,7 @@ library(data.table)
library(IDEAFilter)
library(shinyWidgets)
library(DT)
library(gtsummary)
# library(freesearcheR)
# source("functions.R")
@ -4411,6 +4428,9 @@ server <- function(input, output, session) {
.x
}
})()
gtsummary::as_kable(rv$list$table1) |>
readr::write_lines(file="./www/_table1.md")
}
)
@ -4453,7 +4473,7 @@ server <- function(input, output, session) {
# browser()
rv$list$regression$options <- get_fun_options(input$regression_type) |>
rv$list$regression$params <- get_fun_options(input$regression_type) |>
(\(.x){
.x[[1]]
})()
@ -4542,6 +4562,9 @@ server <- function(input, output, session) {
rv$list$regression$table <- out |>
tbl_merge()
gtsummary::as_kable(rv$list$regression$table) |>
readr::write_lines(file="./www/_regression_table.md")
rv$list$input <- input
},
warning = function(warn) {
@ -4559,7 +4582,7 @@ server <- function(input, output, session) {
shiny::req(rv$list$regression$table)
rv$list$regression$table |>
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")
})
##############################################################################
#########
######### Reactivity
@ -4634,7 +4656,7 @@ server <- function(input, output, session) {
paste0("report.", input$output_type)
}),
content = function(file, type = input$output_type) {
shiny::req(rv$list$regression)
# shiny::req(rv$list$regression)
## Notification is not progressing
## Presumably due to missing
shiny::withProgress(message = "Generating the report. Hold on for a moment..", {

2
inst/apps/data_analysis_modules/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf
View file

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

15
inst/apps/data_analysis_modules/server.R
View file

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

2
inst/apps/data_analysis_modules/ui.R
View file

@ -389,7 +389,7 @@ ui_elements <- list(
label = "Download report",
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::h4("Data"),
shiny::helpText("Choose your favourite output data format to download the modified data."),

61
inst/apps/data_analysis_modules/www/report.qmd
View file

@ -1,22 +1,45 @@
---
format:
html:
embed-resources: true
title: "freesearcheR analysis results"
date: today
format: docx
author: freesearcheR Tool
toc: true
toc: false
execute:
echo: false
params:
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)
library(gtsummary)
library(gt)
library(flextable)
# library(gt)
# library(flextable)
# library(freesearcheR)
```
@ -26,29 +49,17 @@ Research should be free and open with easy access for all. The freesearcheR tool
## 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
Below is the baseline characteristics plotted.
Below are the baseline characteristics.
```{r}
#| 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")
```
{{< include _table1.md >}}
Here are the results from the `r web_data$regression$options$descr`.
Below are results from the univariable and multivariable regression analyses.
```{r}
#| label: tbl-regression
#| tbl-cap: Regression analysis results
web_data$regression$table|>
gtsummary::as_flex_table() |>
flextable::set_table_properties(width = 1, layout = "autofit")
```
{{< include _regression_table.md >}}
## Discussion

37
renv.lock
View file

@ -1742,6 +1742,31 @@
],
"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": {
"Package": "keyring",
"Version": "1.3.2",
@ -3104,6 +3129,18 @@
],
"Hash": "fe42836742a4f065b3f3f5de81fccab9"
},
"svglite": {
"Package": "svglite",
"Version": "2.1.3",
"Source": "Repository",
"Repository": "CRAN",
"Requirements": [
"R",
"cpp11",
"systemfonts"
],
"Hash": "124a41fdfa23e8691cb744c762f10516"
},
"sys": {
"Package": "sys",
"Version": "3.4.3",