mirror of
https://github.com/agdamsbo/FreesearchR.git
synced 2025-12-15 17:12:09 +01:00
feat: direct table download
This commit is contained in:
parent
2a580965e3
commit
f4f433ee84
2 changed files with 145 additions and 7 deletions
|
|
@ -19,7 +19,7 @@ data_missings_ui <- function(id, ...) {
|
|||
bslib::accordion_panel(
|
||||
value = "acc_pan_mis",
|
||||
title = "Settings",
|
||||
icon = bsicons::bs_icon("x-circle"),
|
||||
icon = bsicons::bs_icon("gear"),
|
||||
shiny::uiOutput(ns("missings_method")),
|
||||
shiny::uiOutput(ns("missings_var")),
|
||||
shiny::helpText(i18n$t("Evaluate missingness by either comparing missing values across variables (optionally grouped by af categorical or dichotomous variable) or compare variables grouped by the missing status (missing or not) of an outcome variable. If there is a significant difference i the missingness, this may cause a bias in you data and should be considered carefully interpreting the data and analyses as data may not be missing at random.")),
|
||||
|
|
@ -31,6 +31,16 @@ data_missings_ui <- function(id, ...) {
|
|||
icon = shiny::icon("calculator"),
|
||||
disabled = FALSE
|
||||
)
|
||||
),
|
||||
do.call(
|
||||
bslib::accordion_panel,
|
||||
c(
|
||||
list(
|
||||
title = "Download",
|
||||
icon = bsicons::bs_icon("file-earmark-arrow-down")
|
||||
),
|
||||
table_download_ui(id = ns("tbl_dwn"), title = NULL)
|
||||
)
|
||||
)
|
||||
)
|
||||
),
|
||||
|
|
@ -133,10 +143,10 @@ data_missings_server <- function(id,
|
|||
tryCatch(
|
||||
{
|
||||
shiny::withProgress(message = i18n$t("Calculating. Hold tight for a moment.."), {
|
||||
out <- do.call(
|
||||
compare_missings,
|
||||
modifyList(parameters, list(data = df_tbl))
|
||||
)
|
||||
out <- do.call(
|
||||
compare_missings,
|
||||
modifyList(parameters, list(data = df_tbl))
|
||||
)
|
||||
})
|
||||
},
|
||||
error = function(err) {
|
||||
|
|
@ -204,6 +214,13 @@ data_missings_server <- function(id,
|
|||
}
|
||||
)
|
||||
|
||||
|
||||
table_download_server(
|
||||
id = "tbl_dwn",
|
||||
data = shiny::reactive(rv$table),
|
||||
file_name = "missings_table"
|
||||
)
|
||||
|
||||
return(shiny::reactive(rv$table))
|
||||
}
|
||||
)
|
||||
|
|
@ -218,7 +235,8 @@ missing_demo_app <- function() {
|
|||
title = i18n$t("Missings"),
|
||||
icon = bsicons::bs_icon("x-circle")
|
||||
),
|
||||
data_missings_ui(id = "data")
|
||||
data_missings_ui(id = "data"),
|
||||
gt::gt_output("table_p")
|
||||
)
|
||||
)
|
||||
server <- function(input, output, session) {
|
||||
|
|
@ -226,7 +244,15 @@ missing_demo_app <- function() {
|
|||
data_demo[sample(1:32, 10), "cyl"] <- NA
|
||||
data_demo[sample(1:32, 8), "vs"] <- NA
|
||||
|
||||
data_missings_server(id = "data", data = data_demo)
|
||||
rv <- shiny::reactiveValues(
|
||||
table = NULL
|
||||
)
|
||||
|
||||
rv$table <- data_missings_server(id = "data", data = data_demo)
|
||||
|
||||
output$table_p <- gt::render_gt({
|
||||
rv$table
|
||||
})
|
||||
|
||||
# visual_summary_server(id = "visual", data = data_demo)
|
||||
|
||||
|
|
|
|||
112
R/table-download-module.R
Normal file
112
R/table-download-module.R
Normal file
|
|
@ -0,0 +1,112 @@
|
|||
table_download_ui <- function(id, title = "Table", ...) {
|
||||
ns <- shiny::NS(id)
|
||||
shiny::tagList(
|
||||
shiny::h4(title),
|
||||
shiny::helpText(i18n$t("Choose your favourite output file format for further work, and download, when the analyses are done.")),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::selectInput(
|
||||
inputId = ns("output_format"),
|
||||
label = "Output format",
|
||||
selected = NULL,
|
||||
choices = list(
|
||||
"MS Word" = "docx",
|
||||
"Open document format" = "rtf"
|
||||
)
|
||||
),
|
||||
shiny::br(),
|
||||
shiny::uiOutput(ns("download_button_container")),
|
||||
# shiny::downloadButton(
|
||||
# outputId = ns("act_table"),
|
||||
# label = "Download table",
|
||||
# icon = shiny::icon("download")
|
||||
# ),
|
||||
shiny::br()
|
||||
)
|
||||
}
|
||||
|
||||
table_download_server <- function(id, data, file_name = "table", ...) {
|
||||
shiny::moduleServer(
|
||||
id = id,
|
||||
module = function(input, output, session) {
|
||||
ns <- session$ns
|
||||
|
||||
output$download_button_container <- shiny::renderUI({
|
||||
# Check if data exists and is valid
|
||||
if (!is.null(data()) && (inherits(data(), "gt_tbl") || inherits(data(), "gtsummary"))) {
|
||||
shiny::downloadButton(
|
||||
outputId = ns("act_table"),
|
||||
label = i18n$t("Download table"),
|
||||
icon = shiny::icon("download")
|
||||
)
|
||||
} else {
|
||||
# Return NULL to show nothing
|
||||
NULL
|
||||
}
|
||||
})
|
||||
|
||||
|
||||
output$act_table <- shiny::downloadHandler(
|
||||
filename = function() {
|
||||
paste0("report.", input$output_format)
|
||||
},
|
||||
content = function(file) {
|
||||
shiny::req(data())
|
||||
type <- input$output_format
|
||||
table <- data()
|
||||
|
||||
shiny::withProgress(message = i18n$t("Generating the report. Hold on for a moment.."), {
|
||||
tryCatch(
|
||||
{
|
||||
# browser()
|
||||
if (inherits(table, "gtsummary")) {
|
||||
table <- gtsummary::as_gt(table)
|
||||
}
|
||||
out <- gt::gtsave(
|
||||
data = table,
|
||||
filename = file # Save to the file path provided by downloadHandler
|
||||
)
|
||||
if (type == "docx") {
|
||||
out |> doconv::docx_update()
|
||||
} else {
|
||||
out
|
||||
}
|
||||
},
|
||||
error = function(err) {
|
||||
shiny::showNotification(paste0(i18n$t("Error: "), err), type = "error")
|
||||
}
|
||||
)
|
||||
})
|
||||
}
|
||||
)
|
||||
}
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
# In your UI
|
||||
table_download_demo <- function() {
|
||||
ui <- fluidPage(
|
||||
table_download_ui(id = "my_table", title = "Download Results")
|
||||
)
|
||||
|
||||
# In your server
|
||||
server <- function(input, output, session) {
|
||||
# Your data as a reactive
|
||||
my_table_data <- reactive({
|
||||
# This should return a gt or gtsummary table
|
||||
mtcars |>
|
||||
gt::gt() |>
|
||||
gt::tab_header("My Table")
|
||||
})
|
||||
|
||||
# Call the module server - THIS IS CRITICAL
|
||||
table_download_server(
|
||||
id = "my_table", # Must match the UI id
|
||||
data = my_table_data # Pass the reactive (without parentheses)
|
||||
)
|
||||
}
|
||||
shiny::shinyApp(ui, server)
|
||||
}
|
||||
|
||||
# table_download_demo()
|
||||
Loading…
Add table
Reference in a new issue