diff --git a/.Rbuildignore b/.Rbuildignore index 7db599e..50c93d4 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -13,3 +13,5 @@ ^pkgdown$ ^data-raw$ ^CITATION\.cff$ +^app_hosted$ +^app$ diff --git a/.gitignore b/.gitignore index 8e58845..6201650 100644 --- a/.gitignore +++ b/.gitignore @@ -10,3 +10,5 @@ inst/shiny-examples/casting/functions.R functions.R docs inst/doc +app_hosted +app diff --git a/inst/apps/FreesearchR/app.R b/inst/apps/FreesearchR/app.R index 1c7f849..347b471 100644 --- a/inst/apps/FreesearchR/app.R +++ b/inst/apps/FreesearchR/app.R @@ -1,7 +1,7 @@ ######## -#### Current file: /Users/au301842/FreesearchR/inst/apps/FreesearchR/functions.R +#### Current file: /Users/au301842/FreesearchR/app/functions.R ######## @@ -7521,8 +7521,7 @@ regression_server <- function(id, shiny::observeEvent( list( - data_r(), - regression_vars() + data_r() ), { rv$list$regression$tables <- NULL @@ -7537,6 +7536,7 @@ regression_server <- function(id, ## To avoid plotting old models on fail/error rv$list$regression$tables <- NULL + # browser() tryCatch( { parameters <- list( @@ -7572,17 +7572,9 @@ regression_server <- function(id, ) }) - list( - rv$code$import, - rlang::call2(.fn = "select", !!!list(input$import_var), .ns = "dplyr"), - rlang::call2(.fn = "default_parsing", .ns = "FreesearchR") - ) |> - merge_expression() |> - expression_string() - rv$list$regression$tables <- out - rv$list$input <- input + }, warning = function(warn) { showNotification(paste0(warn), type = "warning") @@ -7694,7 +7686,7 @@ regression_server <- function(id, ############################################################################## return(shiny::reactive({ - return(rv$list) + rv$list })) } ) @@ -7880,7 +7872,7 @@ FreesearchR_colors <- function(choose = NULL) { fg = "#000000" ) if (!is.null(choose)) { - out[choose] + unname(out[choose]) } else { out } @@ -9201,7 +9193,17 @@ grepl_fix <- function(data, pattern, type = c("prefix", "infix", "suffix")) { ######## -#### Current file: /Users/au301842/FreesearchR/inst/apps/FreesearchR/ui.R +#### Current file: /Users/au301842/FreesearchR/dev/header_include.R +######## + +header_include <- function(){ + shiny::tags$head( + tags$link(rel = "stylesheet", type = "text/css", href = "style.css")) +} + + +######## +#### Current file: /Users/au301842/FreesearchR/app/ui.R ######## # ns <- NS(id) @@ -9717,10 +9719,7 @@ dark <- custom_theme( ui <- bslib::page_fixed( prismDependencies, prismRDependency, - ## Basic Umami page tracking - shiny::tags$head( - includeHTML(("www/umami-app.html")), - tags$link(rel = "stylesheet", type = "text/css", href = "style.css")), + header_include(), ## This adds the actual favicon ## png and ico versions are kept for compatibility shiny::tags$head(tags$link(rel="shortcut icon", href="favicon.svg")), @@ -9743,7 +9742,7 @@ ui <- bslib::page_fixed( style = "background-color: #14131326; padding: 4px; text-align: center; bottom: 0; width: 100%;", shiny::p( style = "margin: 1", - "Data is only stored for analyses and deleted when the app is closed." + "Data is only stored for analyses and deleted when the app is closed.", shiny::markdown("Consider [running ***FreesearchR*** locally](https://agdamsbo.github.io/FreesearchR/#run-locally-on-your-own-machine) if working with sensitive data.") ), shiny::p( style = "margin: 1; color: #888;", @@ -9754,8 +9753,9 @@ ui <- bslib::page_fixed( ) + ######## -#### Current file: /Users/au301842/FreesearchR/inst/apps/FreesearchR/server.R +#### Current file: /Users/au301842/FreesearchR/app/server.R ######## library(readr) @@ -9839,7 +9839,7 @@ server <- function(input, output, session) { rv <- shiny::reactiveValues( list = list(), - regression = list(), + regression = NULL, ds = NULL, local_temp = NULL, ready = NULL, @@ -10234,7 +10234,7 @@ server <- function(input, output, session) { shiny::req(rv$data_filtered) rv$list$table1 <- NULL - rv$regression <- NULL + # rv$regression <- NULL } ) @@ -10414,6 +10414,22 @@ server <- function(input, output, session) { rv$regression <- regression_server("regression", data = shiny::reactive(rv$list$data)) + # shiny::observeEvent(rv$regression, { + # browser() + # if (shiny::is.reactive(rv$regression)) { + # rv$list$regression <- rv$regression() + # } else { + # rv$list$regression <- rv$regression + # } + # # rv$list$regression <- rv$regression() + # }) + + # output$regression_models <- renderText({ + # req(rv$list$regression) + # browser() + # names(rv$list$regression) + # }) + ############################################################################## ######### ######### Page navigation @@ -10464,6 +10480,7 @@ server <- function(input, output, session) { paste0("report.", input$output_type) }), content = function(file, type = input$output_type) { + # browser() # shiny::req(rv$list$regression) ## Notification is not progressing ## Presumably due to missing @@ -10472,6 +10489,11 @@ server <- function(input, output, session) { format <- ifelse(type == "docx", "word_document", "odt_document") # browser() + # if (shiny::is.reactive(rv$regression)){ + # rv$list$regression <- rv$regression() + # } + + # rv$list$regression <- rv$regression() rv$list$regression <- rv$regression() shiny::withProgress(message = "Generating the report. Hold on for a moment..", { @@ -10525,7 +10547,7 @@ server <- function(input, output, session) { ######## -#### Current file: /Users/au301842/FreesearchR/inst/apps/FreesearchR/launch.R +#### Current file: /Users/au301842/FreesearchR/app/launch.R ######## shinyApp(ui, server) diff --git a/inst/apps/FreesearchR/launch.R b/inst/apps/FreesearchR/launch.R deleted file mode 100644 index 739d778..0000000 --- a/inst/apps/FreesearchR/launch.R +++ /dev/null @@ -1 +0,0 @@ -shinyApp(ui, server) diff --git a/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/FreesearchR.dcf b/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/FreesearchR.dcf deleted file mode 100644 index b42b77a..0000000 --- a/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/FreesearchR.dcf +++ /dev/null @@ -1,10 +0,0 @@ -name: FreesearchR -title: -username: agdamsbo -account: agdamsbo -server: shinyapps.io -hostUrl: https://api.shinyapps.io/v1 -appId: 14600805 -bundleId: 10199884 -url: https://agdamsbo.shinyapps.io/FreesearchR/ -version: 1 diff --git a/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf b/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf deleted file mode 100644 index dd1b961..0000000 --- a/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf +++ /dev/null @@ -1,10 +0,0 @@ -name: freesearcheR -title: -username: agdamsbo -account: agdamsbo -server: shinyapps.io -hostUrl: https://api.shinyapps.io/v1 -appId: 13611288 -bundleId: 10164589 -url: https://agdamsbo.shinyapps.io/freesearcheR/ -version: 1 diff --git a/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/webResearch.dcf b/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/webResearch.dcf deleted file mode 100644 index 6fa449f..0000000 --- a/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/webResearch.dcf +++ /dev/null @@ -1,10 +0,0 @@ -name: webResearch -title: -username: agdamsbo -account: agdamsbo -server: shinyapps.io -hostUrl: https://api.shinyapps.io/v1 -appId: 13276335 -bundleId: 9436643 -url: https://agdamsbo.shinyapps.io/webResearch/ -version: 1 diff --git a/inst/apps/FreesearchR/rsconnect/shinyapps.io/cognitiveindex/freesearcheR_dev.dcf b/inst/apps/FreesearchR/rsconnect/shinyapps.io/cognitiveindex/freesearcheR_dev.dcf deleted file mode 100644 index ab5be8e..0000000 --- a/inst/apps/FreesearchR/rsconnect/shinyapps.io/cognitiveindex/freesearcheR_dev.dcf +++ /dev/null @@ -1,10 +0,0 @@ -name: freesearcheR_dev -title: -username: cognitiveindex -account: cognitiveindex -server: shinyapps.io -hostUrl: https://api.shinyapps.io/v1 -appId: 13786206 -bundleId: 9688582 -url: https://cognitiveindex.shinyapps.io/freesearcheR_dev/ -version: 1 diff --git a/inst/apps/FreesearchR/rsconnect/shinyapps.io/cognitiveindex/freesearcheR_extra.dcf b/inst/apps/FreesearchR/rsconnect/shinyapps.io/cognitiveindex/freesearcheR_extra.dcf deleted file mode 100644 index befa571..0000000 --- a/inst/apps/FreesearchR/rsconnect/shinyapps.io/cognitiveindex/freesearcheR_extra.dcf +++ /dev/null @@ -1,10 +0,0 @@ -name: freesearcheR_extra -title: -username: cognitiveindex -account: cognitiveindex -server: shinyapps.io -hostUrl: https://api.shinyapps.io/v1 -appId: 13622743 -bundleId: 9544828 -url: https://cognitiveindex.shinyapps.io/freesearcheR_extra/ -version: 1 diff --git a/inst/apps/FreesearchR/server.R b/inst/apps/FreesearchR/server.R deleted file mode 100644 index fdc7f4e..0000000 --- a/inst/apps/FreesearchR/server.R +++ /dev/null @@ -1,764 +0,0 @@ -library(readr) -library(MASS) -library(stats) -library(gt) -# library(openxlsx2) -library(haven) -library(readODS) -require(shiny) -library(bslib) -library(assertthat) -library(dplyr) -library(quarto) -library(here) -library(broom) -library(broom.helpers) -# library(REDCapCAST) -library(easystats) -# library(esquisse) -library(patchwork) -library(DHARMa) -library(apexcharter) -library(toastui) -library(datamods) -library(IDEAFilter) -library(shinyWidgets) -library(DT) -library(data.table) -library(gtsummary) -# library(FreesearchR) - -# source("functions.R") - -data(starwars) -data(mtcars) -mtcars_date <- mtcars |> append_column(as.Date(sample(1:365, nrow(mtcars))), "rand_dates") -mtcars_date$date <- as.Date(sample(seq_len(365), nrow(mtcars))) -data(trial) - - -# light <- custom_theme() -# -# dark <- custom_theme(bg = "#000",fg="#fff") - - -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/") - - output$docs_file <- shiny::renderUI({ - # shiny::includeHTML("www/docs.html") - shiny::HTML(readLines("www/docs.html")) - }) - - ############################################################################## - ######### - ######### Night mode (just very popular, not really needed) - ######### - ############################################################################## - - # observeEvent(input$dark_mode,{ - # session$setCurrentTheme( - # if (isTRUE(input$dark_mode)) dark else light - # )}) - - # observe({ - # if(input$dark_mode==TRUE) - # session$setCurrentTheme(bs_theme_update(theme = custom_theme(version = 5))) - # if(input$dark_mode==FALSE) - # session$setCurrentTheme(bs_theme_update(theme = custom_theme(version = 5, bg = "#000",fg="#fff"))) - # }) - - - ############################################################################## - ######### - ######### Setting reactive values - ######### - ############################################################################## - - rv <- shiny::reactiveValues( - list = list(), - regression = list(), - ds = NULL, - local_temp = NULL, - ready = NULL, - test = "no", - data_original = NULL, - data_temp = NULL, - data = NULL, - data_variables = NULL, - data_filtered = NULL, - models = NULL, - code = list() - ) - - ############################################################################## - ######### - ######### Data import section - ######### - ############################################################################## - - data_file <- import_file_server( - id = "file_import", - show_data_in = "popup", - trigger_return = "change", - return_class = "data.frame" - ) - - shiny::observeEvent(data_file$data(), { - shiny::req(data_file$data()) - rv$data_temp <- data_file$data() - rv$code <- modifyList(x = rv$code, list(import = data_file$code())) - }) - - from_redcap <- m_redcap_readServer( - id = "redcap_import" - ) - - shiny::observeEvent(from_redcap$data(), { - rv$data_temp <- from_redcap$data() - rv$code <- modifyList(x = rv$code, list(import = from_redcap$code())) - }) - - ## This is used to ensure the reactive data is retrieved - output$redcap_prev <- DT::renderDT( - { - DT::datatable(head(from_redcap$data(), 5), - caption = "First 5 observations" - ) - }, - server = TRUE - ) - - from_env <- datamods::import_globalenv_server( - id = "env", - trigger_return = "change", - btn_show_data = FALSE, - reset = reactive(input$hidden) - ) - - shiny::observeEvent(from_env$data(), { - shiny::req(from_env$data()) - - rv$data_temp <- from_env$data() - rv$code <- modifyList(x = rv$code, list(import = from_env$name())) - }) - - output$import_var <- shiny::renderUI({ - shiny::req(rv$data_temp) - - preselect <- names(rv$data_temp)[sapply(rv$data_temp, missing_fraction) <= input$complete_cutoff / 100] - - shinyWidgets::virtualSelectInput( - inputId = "import_var", - label = "Select variables to include", - selected = preselect, - choices = names(rv$data_temp), - updateOn = "change", - multiple = TRUE, - search = TRUE, - showValueAsTags = TRUE - ) - }) - - output$data_loaded <- shiny::reactive({ - !is.null(rv$data_temp) - }) - - shiny::observeEvent(input$source, { - rv$data_temp <- NULL - }) - - shiny::outputOptions(output, "data_loaded", suspendWhenHidden = FALSE) - - shiny::observeEvent( - eventExpr = list( - input$import_var, - input$complete_cutoff, - rv$data_temp - ), - handlerExpr = { - shiny::req(rv$data_temp) - shiny::req(input$import_var) - # browser() - temp_data <- rv$data_temp - if (all(input$import_var %in% names(temp_data))) { - temp_data <- temp_data |> dplyr::select(input$import_var) - } - - rv$data_original <- temp_data |> - default_parsing() - - rv$code$import <- rv$code$import |> - expression_string(assign.str = "df <-") - - rv$code$format <- list( - "df", - rlang::expr(dplyr::select(dplyr::all_of(!!input$import_var))), - rlang::call2(.fn = "default_parsing", .ns = "FreesearchR") - ) |> - lapply(expression_string) |> - pipe_string() |> - expression_string(assign.str = "df <-") - - rv$code$filter <- NULL - rv$code$modify <- NULL - }, ignoreNULL = FALSE - ) - - output$data_info_import <- shiny::renderUI({ - shiny::req(rv$data_original) - data_description(rv$data_original) - }) - - ## Activating action buttons on data imported - shiny::observeEvent(rv$data_original, { - if (is.null(rv$data_original) | NROW(rv$data_original) == 0) { - shiny::updateActionButton(inputId = "act_start", disabled = TRUE) - shiny::updateActionButton(inputId = "modal_browse", disabled = TRUE) - shiny::updateActionButton(inputId = "act_eval", disabled = TRUE) - } else { - shiny::updateActionButton(inputId = "act_start", disabled = FALSE) - shiny::updateActionButton(inputId = "modal_browse", disabled = FALSE) - shiny::updateActionButton(inputId = "act_eval", disabled = FALSE) - } - }) - - ############################################################################## - ######### - ######### Data modification section - ######### - ############################################################################## - - shiny::observeEvent( - eventExpr = list( - rv$data_original - ), - handlerExpr = { - shiny::req(rv$data_original) - - rv$data <- rv$data_original - } - ) - - ## For now this solution work, but I would prefer to solve this with the above - shiny::observeEvent(input$reset_confirm, - { - if (isTRUE(input$reset_confirm)) { - shiny::req(rv$data_original) - rv$data <- rv$data_original - rv$code$filter <- NULL - rv$code$variables <- NULL - rv$code$modify <- NULL - } - }, - ignoreNULL = TRUE - ) - - - shiny::observeEvent(input$data_reset, { - shinyWidgets::ask_confirmation( - cancelOnDismiss = TRUE, - inputId = "reset_confirm", - title = "Please confirm data reset?", - type = "warning" - ) - }) - - - ######### - ######### Modifications - ######### - - ## Using modified version of the datamods::cut_variable_server function - ## Further modifications are needed to have cut/bin options based on class of variable - ## Could be defined server-side - - output$data_info <- shiny::renderUI({ - shiny::req(data_filter()) - data_description(data_filter(), "The filtered data") - }) - - ######### Create factor - - shiny::observeEvent( - input$modal_cut, - modal_cut_variable("modal_cut", title = "Create new factor") - ) - - data_modal_cut <- cut_variable_server( - id = "modal_cut", - data_r = shiny::reactive(rv$data) - ) - - shiny::observeEvent(data_modal_cut(), { - rv$data <- data_modal_cut() - rv$code$modify[[length(rv$code$modify) + 1]] <- attr(rv$data, "code") - }) - - ######### Modify factor - - shiny::observeEvent( - input$modal_update, - datamods::modal_update_factor(id = "modal_update", title = "Reorder factor levels") - ) - - data_modal_update <- datamods::update_factor_server( - id = "modal_update", - data_r = reactive(rv$data) - ) - - shiny::observeEvent(data_modal_update(), { - shiny::removeModal() - rv$data <- data_modal_update() - rv$code$modify[[length(rv$code$modify) + 1]] <- attr(rv$data, "code") - }) - - ######### Create column - - shiny::observeEvent( - input$modal_column, - modal_create_column( - id = "modal_column", - footer = shiny::markdown("This window is aimed at advanced users and require some *R*-experience!"), - title = "Create new variables" - ) - ) - data_modal_r <- create_column_server( - id = "modal_column", - data_r = reactive(rv$data) - ) - shiny::observeEvent( - data_modal_r(), - { - rv$data <- data_modal_r() - rv$code$modify[[length(rv$code$modify) + 1]] <- attr(rv$data, "code") - } - ) - - ######### Subset, rename, reclass - - updated_data <- update_variables_server( - id = "modal_variables", - data = shiny::reactive(rv$data), - return_data_on_init = FALSE - ) - - shiny::observeEvent(updated_data(), { - rv$data <- updated_data() - rv$code$modify[[length(rv$code$modify) + 1]] <- attr(rv$data, "code") - }) - - ### Column filter - ### Completely implemented, but it takes a little considering where in the - ### data flow to implement, as it will act destructively on previous - ### manipulations - - output$column_filter <- shiny::renderUI({ - shiny::req(rv$data) - # c("dichotomous", "ordinal", "categorical", "datatime", "continuous") - shinyWidgets::virtualSelectInput( - inputId = "column_filter", - label = "Select variable types to include", - selected = unique(data_type(rv$data)), - choices = unique(data_type(rv$data)), - updateOn = "change", - multiple = TRUE, - search = FALSE, - showValueAsTags = TRUE - ) - }) - - shiny::observe({ - # shiny::req(input$column_filter) - out <- data_type_filter(rv$data, input$column_filter) - rv$data_variables <- out - if (!is.null(input$column_filter)) { - rv$code$variables <- attr(out, "code") - } - # rv$code$modify[[length(rv$code$modify) + 1]] <- attr(rv$data, "code") - }) - - - ######### Data filter - # IDEAFilter has the least cluttered UI, but might have a License issue - # Consider using shinyDataFilter, though not on CRAN - data_filter <- IDEAFilter::IDEAFilter("data_filter", - data = shiny::reactive(rv$data_variables), - verbose = TRUE - ) - - shiny::observeEvent( - list( - shiny::reactive(rv$data_variables), - shiny::reactive(rv$data_original), - data_filter(), - # regression_vars(), - input$complete_cutoff - ), - { - ### Save filtered data - rv$data_filtered <- data_filter() - - ### Save filtered data - ### without empty factor levels - rv$list$data <- data_filter() |> - REDCapCAST::fct_drop() |> - (\(.x){ - .x[!sapply(.x, is.character)] - })() - - ## This looks messy!! But it works as intended for now - - out <- gsub( - "filter", "dplyr::filter", - gsub( - "\\s{2,}", " ", - paste0( - capture.output(attr(rv$data_filtered, "code")), - collapse = " " - ) - ) - ) - - out <- strsplit(out, "%>%") |> - unlist() |> - (\(.x){ - paste(c("df <- df", .x[-1], "REDCapCAST::fct_drop()"), - collapse = "|> \n " - ) - })() - - rv$code <- append_list(data = out, list = rv$code, index = "filter") - } - ) - - ######### Data preview - - ### Overview - - data_summary_server( - id = "data_summary", - data = shiny::reactive({ - rv$data_filtered - }), - color.main = "#2A004E", - color.sec = "#C62300", - pagination = 10 - ) - - observeEvent(input$modal_browse, { - show_data(REDCapCAST::fct_drop(rv$data_filtered), title = "Uploaded data overview", type = "modal") - }) - - output$original_str <- renderPrint({ - str(rv$data_original) - }) - - output$modified_str <- renderPrint({ - str(as.data.frame(rv$data_filtered) |> - REDCapCAST::set_attr( - label = NULL, - attr = "code" - )) - }) - - ## Evaluation table/plots reset on data change - ## This does not work (!?) - shiny::observeEvent( - list( - rv$data_filtered - ), - { - shiny::req(rv$data_filtered) - - rv$list$table1 <- NULL - rv$regression <- NULL - } - ) - - - ############################################################################## - ######### - ######### Code export - ######### - ############################################################################## - - ## This really should be collapsed to only one call, but I'll leave it for now - ## as a working example of dynamically defining outputs and rendering. - - # output$code_import <- shiny::renderPrint({ - # shiny::req(rv$code$import) - # cat(c("#Data import\n", rv$code$import)) - # }) - - output$code_import <- shiny::renderUI({ - prismCodeBlock(paste0("#Data import\n", rv$code$import)) - }) - - output$code_import <- shiny::renderUI({ - prismCodeBlock(paste0("#Data import formatting\n", rv$code$format)) - }) - - output$code_data <- shiny::renderUI({ - shiny::req(rv$code$modify) - # browser() - ## This will create three lines for each modification - # ls <- rv$code$modify - ## This will remove all non-unique entries - # ls <- rv$code$modify |> unique() - ## This will only remove all non-repeating entries - ls <- rv$code$modify[!is_identical_to_previous(rv$code$modify)] - - out <- ls |> - lapply(expression_string) |> - pipe_string() |> - expression_string(assign.str = "df <- df |>\n") - - prismCodeBlock(paste0("#Data modifications\n", out)) - }) - - output$code_variables <- shiny::renderUI({ - shiny::req(rv$code$variables) - out <- expression_string(rv$code$variables, assign.str = "df <- df |>\n") - prismCodeBlock(paste0("#Variables filter\n", out)) - }) - - output$code_filter <- shiny::renderUI({ - shiny::req(rv$code$filter) - prismCodeBlock(paste0("#Data filter\n", rv$code$filter)) - }) - - output$code_table1 <- shiny::renderUI({ - shiny::req(rv$code$table1) - prismCodeBlock(paste0("#Data characteristics table\n", rv$code$table1)) - }) - - - ## Just a note to self - ## This is a very rewarding couple of lines marking new insights to dynamically rendering code - shiny::observe({ - shiny::req(rv$regression) - rv$regression()$regression$models |> purrr::imap(\(.x, .i){ - output[[paste0("code_", tolower(.i))]] <- shiny::renderUI({ - prismCodeBlock(paste0(paste("#", .i, "regression model\n"), .x$code_table)) - }) - }) - }) - - - ############################################################################## - ######### - ######### Data analyses Inputs - ######### - ############################################################################## - - output$strat_var <- shiny::renderUI({ - columnSelectInput( - inputId = "strat_var", - selected = "none", - label = "Select variable to stratify baseline", - data = shiny::reactive(rv$data_filtered)(), - col_subset = c( - "none", - names(rv$data_filtered)[unlist(lapply(rv$data_filtered, data_type)) %in% c("dichotomous", "categorical", "ordinal")] - ) - ) - }) - - ############################################################################## - ######### - ######### Descriptive evaluations - ######### - ############################################################################## - - - output$data_info_nochar <- shiny::renderUI({ - shiny::req(rv$list$data) - data_description(rv$list$data, data_text = "The dataset without text variables") - }) - - shiny::observeEvent( - list( - input$act_eval - ), - { - shiny::req(input$strat_var) - shiny::req(rv$list$data) - - parameters <- list( - by.var = input$strat_var, - add.p = input$add_p == "yes", - add.overall = TRUE - ) - - shiny::withProgress(message = "Creating the table. Hold on for a moment..", { - rv$list$table1 <- rlang::exec(create_baseline, !!!append_list(rv$list$data, parameters, "data")) - }) - - rv$code$table1 <- glue::glue("FreesearchR::create_baseline(data,{list2str(parameters)})") - } - ) - - output$outcome_var_cor <- shiny::renderUI({ - columnSelectInput( - inputId = "outcome_var_cor", - selected = "none", - data = rv$list$data, - label = "Select outcome variable", - col_subset = c( - "none", - colnames(rv$list$data) - ), - multiple = FALSE - ) - }) - - output$table1 <- gt::render_gt({ - if (!is.null(rv$list$table1)) { - rv$list$table1 |> - gtsummary::as_gt() |> - gt::tab_header(gt::md("**Table 1: Baseline Characteristics**")) - } else { - return(NULL) - } - }) - - data_correlations_server( - id = "correlations", - data = shiny::reactive({ - shiny::req(rv$list$data) - out <- rv$list$data - if (!is.null(input$outcome_var_cor) && input$outcome_var_cor != "none") { - out <- out[!names(out) %in% input$outcome_var_cor] - } - out - }), - cutoff = shiny::reactive(input$cor_cutoff) - ) - - ############################################################################## - ######### - ######### Data visuals - ######### - ############################################################################## - - pl <- data_visuals_server("visuals", data = shiny::reactive(rv$list$data)) - - ############################################################################## - ######### - ######### Regression model analyses - ######### - ############################################################################## - - rv$regression <- regression_server("regression", data = shiny::reactive(rv$list$data)) - - ############################################################################## - ######### - ######### Page navigation - ######### - ############################################################################## - - shiny::observeEvent(input$act_start, { - bslib::nav_select(id = "main_panel", selected = "Data") - }) - - ############################################################################## - ######### - ######### Reactivity - ######### - ############################################################################## - - output$uploaded <- shiny::reactive({ - if (is.null(rv$ds)) { - "no" - } else { - "yes" - } - }) - - shiny::outputOptions(output, "uploaded", suspendWhenHidden = FALSE) - - output$ready <- shiny::reactive({ - if (is.null(rv$ready)) { - "no" - } else { - "yes" - } - }) - - shiny::outputOptions(output, "ready", suspendWhenHidden = FALSE) - - ############################################################################## - ######### - ######### Downloads - ######### - ############################################################################## - - # 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 = shiny::reactive({ - paste0("report.", input$output_type) - }), - content = function(file, type = input$output_type) { - # shiny::req(rv$list$regression) - ## Notification is not progressing - ## Presumably due to missing - # browser() - # Simplified for .rmd output attempt - format <- ifelse(type == "docx", "word_document", "odt_document") - - # browser() - rv$list$regression <- rv$regression() - - shiny::withProgress(message = "Generating the report. Hold on for a moment..", { - tryCatch( - { - rv$list |> - write_rmd( - output_format = format, - input = file.path(getwd(), "www/report.rmd") - ) - }, - error = function(err) { - showNotification(paste0("We encountered the following error creating your report: ", err), type = "err") - } - ) - }) - file.rename(paste0("www/report.", type), file) - } - ) - - output$data_modified <- downloadHandler( - filename = shiny::reactive({ - paste0("modified_data.", input$data_type) - }), - content = function(file, type = input$data_type) { - if (type == "rds") { - readr::write_rds(rv$list$data, file = file) - } else if (type == "dta") { - haven::write_dta(as.data.frame(rv$list$data), path = file) - } else if (type == "csv") { - readr::write_csv(rv$list$data, file = file) - } - } - ) - - ############################################################################## - ######### - ######### Clearing the session on end - ######### - ############################################################################## - - 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/FreesearchR/ui.R b/inst/apps/FreesearchR/ui.R index 3e79294..d1a7259 100644 --- a/inst/apps/FreesearchR/ui.R +++ b/inst/apps/FreesearchR/ui.R @@ -508,13 +508,10 @@ dark <- custom_theme( # Fonts to consider: # https://webdesignerdepot.com/17-open-source-fonts-youll-actually-love/ -ui <- bslib::page_fixed( +ui_list <- shiny::tagList( prismDependencies, prismRDependency, - ## Basic Umami page tracking - shiny::tags$head( - includeHTML(("www/umami-app.html")), - tags$link(rel = "stylesheet", type = "text/css", href = "style.css")), + header_include(), ## This adds the actual favicon ## png and ico versions are kept for compatibility shiny::tags$head(tags$link(rel="shortcut icon", href="favicon.svg")), @@ -546,3 +543,12 @@ ui <- bslib::page_fixed( ) ) ) + +# ui_list <- shiny::tagAppendChild(ui_list,list( +# ## Basic Umami page tracking +# shiny::tags$head(includeHTML("www/umami-app.html")) +# # shiny::tags$head(shiny::tags$script(rel="defer", src="https://analytics.gdamsbo.dk/script.js", "data-website-id"="e7d4e13a-5824-4778-bbc0-8f92fb08303a")) +# )) + +ui <- do.call( + bslib::page_fixed,ui_list) diff --git a/inst/apps/FreesearchR/www/umami-app.html b/inst/apps/FreesearchR/www/umami-app.html deleted file mode 100644 index 1270d51..0000000 --- a/inst/apps/FreesearchR/www/umami-app.html +++ /dev/null @@ -1 +0,0 @@ -