diff --git a/DESCRIPTION b/DESCRIPTION index 76cfb3c..e0fbcf8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: freesearcheR Title: Browser Based Data Analysis -Version: 24.12.1 +Version: 25.1.1 Authors@R: person("Andreas Gammelgaard", "Damsbo", , "agdamsbo@clin.au.dk", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-7559-1154")) @@ -49,7 +49,10 @@ Imports: shinyWidgets, classInt, htmltools, - rlang + rlang, + data.table, + apexcharter, + teal.modules.general Suggests: styler, devtools, diff --git a/NEWS.md b/NEWS.md index 7d845fb..3746cf2 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,12 @@ +# freesearcheR 25.1.1 + +* UI tweaks. + +* NEW: Option to set class as `hms` using the `{hms}` package. + +* NEW: summary grid with sparklines. + + # freesearcheR 24.12.1 * Initial release for Zenodo. diff --git a/R/data-summary.R b/R/data-summary.R new file mode 100644 index 0000000..3ee861f --- /dev/null +++ b/R/data-summary.R @@ -0,0 +1,237 @@ +data_summary_ui <- function(id) { + ns <- NS(id) + + toastui::datagridOutput(outputId = "tbl_summary") +} + + +data_summary_server <- function(id, + data) { + shiny::moduleServer( + id = id, + module = function(input, output, session) { + ns <- session$ns + + data_r <- shiny::reactive({ + if (shiny::is.reactive(data)) { + data() + } else { + data + } + }) + + output$tbl_summary <- shiny::reactive({ + toastui::renderDatagrid( + data_r() |> + overview_vars() |> + create_overview_datagrid() |> + add_sparkline( + column = "vals" + ) + ) + }) + } + ) +} + +#' Add sparkline to datagrid +#' +#' @param grid grid +#' @param column clumn to transform +#' +#' @returns datagrid +#' @export +#' +#' @examples +#' grid <- mtcars |> +#' default_parsing() |> +#' overview_vars() |> +#' toastui::datagrid() |> +#' add_sparkline() +#' grid +add_sparkline <- function(grid, column = "vals", color.main = "#2a8484", color.sec = "#84EF84") { + out <- toastui::grid_sparkline( + grid = grid, + column = column, + renderer = function(data) { + data_cl <- class(data) + if (identical(data_cl, "factor")) { + type <- "column" + s <- summary(data) + ds <- data.frame(x = names(s), y = s) + horizontal <- FALSE + } else if (any(c("numeric", "integer") %in% data_cl)) { + if (length(unique(data)) == length(data)) { + type <- "line" + ds <- data.frame(x = NA, y = NA) + horizontal <- FALSE + } else { + type <- "box" + ds <- data.frame(x = 1, y = data) + horizontal <- TRUE + } + } else if (any(c("Date", "POSIXct", "POSIXt", "hms", "difftime") %in% data_cl)) { + type <- "line" + ds <- data.frame(x = seq_along(data), y = data) + horizontal <- FALSE + } else { + type <- "line" + ds <- data.frame(x = NA, y = NA) + horizontal <- FALSE + } + apexcharter::apex( + ds, + apexcharter::aes(x, y), + type = type, + auto_update = TRUE + ) |> + apexcharter::ax_chart(sparkline = list(enabled = TRUE)) |> + apexcharter::ax_plotOptions( + boxPlot = apexcharter::boxplot_opts(color.upper = color.sec, color.lower = color.main), + bar = apexcharter::bar_opts(horizontal = horizontal) + ) |> + apexcharter::ax_colors( + c(color.main, color.sec) + ) + } + ) + + toastui::grid_columns( + grid = out, + columns = column, + minWidth = 200 + ) +} + +#' Create a data overview data.frame ready for sparklines +#' +#' @param data data +#' +#' @returns data.frame +#' @export +#' +#' @examples +#' mtcars |> overview_vars() +overview_vars <- function(data) { + data <- as.data.frame(data) + + dplyr::tibble( + class = get_classes(data), + name = names(data), + n_missing = unname(colSums(is.na(data))), + p_complete = 1 - n_missing / nrow(data), + n_unique = get_n_unique(data), + vals = as.list(data) + ) +} + +#' Create a data overview datagrid +#' +#' @param data data +#' +#' @returns datagrid +#' @export +#' +#' @examples +#' mtcars |> +#' overview_vars() |> +#' create_overview_datagrid() +create_overview_datagrid <- function(data) { + # browser() + gridTheme <- getOption("datagrid.theme") + if (length(gridTheme) < 1) { + datamods:::apply_grid_theme() + } + on.exit(toastui::reset_grid_theme()) + + col.names <- names(data) + + std_names <- c( + "Name" = "name", + "Class" = "class", + "Missing" = "n_missing", + "Complete" = "p_complete", + "Unique" = "n_unique", + "Plot" = "vals" + ) + + headers <- lapply(col.names, \(.x){ + if (.x %in% std_names) { + names(std_names)[match(.x, std_names)] + } else { + .x + } + }) |> unlist() + + grid <- toastui::datagrid( + data = data, + theme = "default", + colwidths = "auto" + ) + + grid <- toastui::grid_columns( + grid = grid, + columns = col.names, + header = headers, + resizable = TRUE, + width = 80 + ) + + grid <- add_class_icon( + grid = grid, + column = "class" + ) + + # grid <- toastui::grid_format( + # grid = grid, + # "p_complete", + # formatter = toastui::JS("function(obj) {return (obj.value*100).toFixed(0) + '%';}") + # ) + + return(grid) +} + +#' Convert class grid column to icon +#' +#' @param grid grid +#' @param column column +#' +#' @returns datagrid +#' @export +#' +#' @examples +add_class_icon <- function(grid, column = "class") { + out <- toastui::grid_format( + grid = grid, + column = column, + formatter = function(value) { + lapply( + X = value, + FUN = function(x) { + if (identical(x, "numeric")) { + shiny::icon("chart-line") + } else if (identical(x, "factor")) { + shiny::icon("chart-column") + } else if (identical(x, "integer")) { + shiny::icon("arrow-down-1-9") + } else if (identical(x, "character")) { + shiny::icon("arrow-down-a-z") + } else if (any(c("Date", "POSIXct", "POSIXt") %in% x)) { + shiny::icon("calendar-days") + } else if ("hms" %in% x) { + shiny::icon("clock") + } else { + shiny::icon("table") + } + } + ) + } + ) + + toastui::grid_columns( + grid = out, + header = NULL, + columns = column, + width = 60 + ) +} diff --git a/R/file-import-module.R b/R/file-import-module.R index 6d6305d..8210fc8 100644 --- a/R/file-import-module.R +++ b/R/file-import-module.R @@ -1,125 +1,125 @@ -#' #' Shiny UI module to load a data file -#' #' -#' #' @param id id -#' #' -#' #' @return shiny UI -#' #' @export -#' #' -#' m_datafileUI <- function(id) { -#' ns <- shiny::NS(id) -#' shiny::tagList( -#' shiny::fileInput( -#' inputId = ns("file"), -#' label = "Upload a file", -#' multiple = FALSE, -#' accept = c( -#' ".csv", -#' ".xlsx", -#' ".xls", -#' ".dta", -#' ".ods", -#' ".rds" -#' ) -#' ), -#' shiny::h4("Parameter specifications"), -#' shiny::helpText(shiny::em("Select the desired variables and press 'Submit'")), -#' shiny::uiOutput(ns("include_vars")), -#' DT::DTOutput(ns("data_input")), -#' shiny::actionButton(ns("submit"), "Submit") -#' ) -#' } +#' Shiny UI module to load a data file #' -#' m_datafileServer <- function(id, output.format = "df") { -#' shiny::moduleServer(id, function(input, output, session, ...) { -#' ns <- shiny::NS(id) -#' ds <- shiny::reactive({ -#' REDCapCAST::read_input(input$file$datapath) |> REDCapCAST::parse_data() -#' }) +#' @param id id #' -#' output$include_vars <- shiny::renderUI({ -#' shiny::req(input$file) -#' shiny::selectizeInput( -#' inputId = ns("include_vars"), -#' selected = NULL, -#' label = "Covariables to include", -#' choices = colnames(ds()), -#' multiple = TRUE -#' ) -#' }) +#' @return shiny UI +#' @export #' -#' base_vars <- shiny::reactive({ -#' if (is.null(input$include_vars)) { -#' out <- colnames(ds()) -#' } else { -#' out <- input$include_vars -#' } -#' out -#' }) -#' -#' output$data_input <- -#' DT::renderDT({ -#' shiny::req(input$file) -#' ds()[base_vars()] -#' }) -#' -#' shiny::eventReactive(input$submit, { -#' # shiny::req(input$file) -#' -#' data <- shiny::isolate({ -#' ds()[base_vars()] -#' }) -#' -#' file_export(data, -#' output.format = output.format, -#' tools::file_path_sans_ext(input$file$name) -#' ) -#' }) -#' }) -#' } -#' -#' -#' -#' -#' -#' file_app <- function() { -#' ui <- shiny::fluidPage( -#' m_datafileUI("data"), -#' # DT::DTOutput(outputId = "redcap_prev") -#' toastui::datagridOutput2(outputId = "redcap_prev") -#' ) -#' server <- function(input, output, session) { -#' m_datafileServer("data", output.format = "list") -#' } -#' shiny::shinyApp(ui, server) -#' } -#' -#' file_app() -#' -#' tdm_data_upload <- teal::teal_data_module( -#' ui <- function(id) { -#' shiny::fluidPage( -#' m_datafileUI(id) -#' ) -#' }, -#' server = function(id) { -#' m_datafileServer(id, output.format = "teal") -#' } -#' ) -#' -#' tdm_data_read <- teal::teal_data_module( -#' ui <- function(id) { -#' shiny::fluidPage( -#' m_redcap_readUI(id = "redcap") -#' ) -#' }, -#' server = function(id) { -#' moduleServer( -#' id, -#' function(input, output, session) { -#' ns <- session$ns -#' -#' m_redcap_readServer(id = "redcap", output.format = "teal") -#' } -#' ) -#' } -#' ) +m_datafileUI <- function(id) { + ns <- shiny::NS(id) + shiny::tagList( + shiny::fileInput( + inputId = ns("file"), + label = "Upload a file", + multiple = FALSE, + accept = c( + ".csv", + ".xlsx", + ".xls", + ".dta", + ".ods", + ".rds" + ) + ), + shiny::h4("Parameter specifications"), + shiny::helpText(shiny::em("Select the desired variables and press 'Submit'")), + shiny::uiOutput(ns("include_vars")), + DT::DTOutput(ns("data_input")), + shiny::actionButton(ns("submit"), "Submit") + ) +} + +m_datafileServer <- function(id, output.format = "df") { + shiny::moduleServer(id, function(input, output, session, ...) { + ns <- shiny::NS(id) + ds <- shiny::reactive({ + REDCapCAST::read_input(input$file$datapath) |> REDCapCAST::parse_data() + }) + + output$include_vars <- shiny::renderUI({ + shiny::req(input$file) + shiny::selectizeInput( + inputId = ns("include_vars"), + selected = NULL, + label = "Covariables to include", + choices = colnames(ds()), + multiple = TRUE + ) + }) + + base_vars <- shiny::reactive({ + if (is.null(input$include_vars)) { + out <- colnames(ds()) + } else { + out <- input$include_vars + } + out + }) + + output$data_input <- + DT::renderDT({ + shiny::req(input$file) + ds()[base_vars()] + }) + + shiny::eventReactive(input$submit, { + # shiny::req(input$file) + + data <- shiny::isolate({ + ds()[base_vars()] + }) + + file_export(data, + output.format = output.format, + tools::file_path_sans_ext(input$file$name) + ) + }) + }) +} + + + + + +file_app <- function() { + ui <- shiny::fluidPage( + m_datafileUI("data"), + # DT::DTOutput(outputId = "redcap_prev") + toastui::datagridOutput2(outputId = "redcap_prev") + ) + server <- function(input, output, session) { + m_datafileServer("data", output.format = "list") + } + shiny::shinyApp(ui, server) +} + +file_app() + +tdm_data_upload <- teal::teal_data_module( + ui <- function(id) { + shiny::fluidPage( + m_datafileUI(id) + ) + }, + server = function(id) { + m_datafileServer(id, output.format = "teal") + } +) + +tdm_data_read <- teal::teal_data_module( + ui <- function(id) { + shiny::fluidPage( + m_redcap_readUI(id = "redcap") + ) + }, + server = function(id) { + moduleServer( + id, + function(input, output, session) { + ns <- session$ns + + m_redcap_readServer(id = "redcap", output.format = "teal") + } + ) + } +) diff --git a/R/helpers.R b/R/helpers.R index 95e21b2..3baed74 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -148,7 +148,7 @@ file_export <- function(data, output.format = c("df", "teal", "list"), filename, teal_data(), { assign(name, value |> - dplyr::bind_cols() |> + dplyr::bind_cols(.name_repair = "unique_quiet") |> default_parsing()) }, value = data, @@ -185,8 +185,42 @@ file_export <- function(data, output.format = c("df", "teal", "list"), filename, #' default_parsing() |> #' str() default_parsing <- function(data) { - data |> + name_labels <- lapply(data,\(.x) REDCapCAST::get_attr(.x,attr = "label")) + + out <- data |> REDCapCAST::parse_data() |> REDCapCAST::as_factor() |> REDCapCAST::numchar2fct() + + purrr::map2(out,name_labels,\(.x,.l){ + if (!(is.na(.l) | .l=="")) { + REDCapCAST::set_attr(.x, .l, attr = "label") + } else { + attr(x = .x, which = "label") <- NULL + .x + } + # REDCapCAST::set_attr(data = .x, label = .l,attr = "label", overwrite = FALSE) + }) |> dplyr::bind_cols() +} + +#' Remove NA labels +#' +#' @param data data +#' +#' @returns data.frame +#' @export +#' +#' @examples +#' ds <- mtcars |> lapply(\(.x) REDCapCAST::set_attr(.x,label=NA,attr = "label")) +#' ds |> remove_na_attr() |> str() +remove_na_attr <- function(data,attr="label"){ + out <- data |> lapply(\(.x){ + ls <- REDCapCAST::get_attr(data = .x,attr = attr) + if (is.na(ls) | ls == ""){ + attr(x = .x, which = attr) <- NULL + } + .x + }) + + dplyr::bind_cols(out) } diff --git a/R/redcap_read_shiny_module.R b/R/redcap_read_shiny_module.R index 061a6e7..bdcfb4c 100644 --- a/R/redcap_read_shiny_module.R +++ b/R/redcap_read_shiny_module.R @@ -10,8 +10,8 @@ m_redcap_readUI <- function(id, include_title = TRUE) { ns <- shiny::NS(id) - server_ui <- shiny::column( - width = 6, + server_ui <- shiny::tagList( + # width = 6, shiny::tags$h4("REDCap server information"), shiny::textInput( inputId = ns("uri"), @@ -27,8 +27,8 @@ m_redcap_readUI <- function(id, include_title = TRUE) { params_ui <- - shiny::column( - width = 6, + shiny::tagList( + # width = 6, shiny::tags$h4("Data import parameters"), shiny::helpText("Options here will show, when API and uri are typed"), shiny::uiOutput(outputId = ns("fields")), @@ -63,9 +63,14 @@ m_redcap_readUI <- function(id, include_title = TRUE) { shiny::fluidPage( if (include_title) shiny::tags$h3("Import data from REDCap"), - fluidRow( + bslib::layout_columns( server_ui, - params_ui), + params_ui, + col_widths = bslib::breakpoints( + sm = c(12, 12), + md = c(12, 12) + ) + ), shiny::column( width = 12, # shiny::actionButton(inputId = ns("import"), label = "Import"), @@ -75,8 +80,8 @@ m_redcap_readUI <- function(id, include_title = TRUE) { icon = shiny::icon("download", lib = "glyphicon"), label_busy = "Just a minute...", icon_busy = fontawesome::fa_i("arrows-rotate", - class = "fa-spin", - "aria-hidden" = "true" + class = "fa-spin", + "aria-hidden" = "true" ), type = "primary", auto_reset = TRUE @@ -194,7 +199,7 @@ m_redcap_readServer <- function(id, output.format = c("df", "teal", "list")) { # browser() data.df <- dd()[, c(1, 2, 4, 5, 6, 8)] DT::datatable(data.df, - caption = "Subset of data dictionary" + caption = "Subset of data dictionary" ) }, server = TRUE @@ -241,8 +246,8 @@ m_redcap_readServer <- function(id, output.format = c("df", "teal", "list")) { REDCapCAST::suffix2label() out_object <- file_export(redcap_data, - output.format = output.format, - filename = name() + output.format = output.format, + filename = name() ) if (output.format == "list") { @@ -270,7 +275,6 @@ m_redcap_readServer <- function(id, output.format = c("df", "teal", "list")) { #' #' @rdname redcap_read_shiny_module tdm_redcap_read <- teal::teal_data_module( - ui <- function(id) { shiny::fluidPage( m_redcap_readUI(id) @@ -305,7 +309,7 @@ redcap_app <- function() { ) ) server <- function(input, output, session) { - data_val <- shiny::reactiveValues(data=NULL) + data_val <- shiny::reactiveValues(data = NULL) ds <- m_redcap_readServer("data", output.format = "df") # output$redcap_prev <- DT::renderDT( @@ -328,8 +332,9 @@ redcap_app <- function() { }) filtered_data <- IDEAFilter::IDEAFilter("data_filter", - data = ds, - verbose = FALSE) + data = ds, + verbose = FALSE + ) # filtered_data <- shiny::reactive({ # IDEAFilter::IDEAFilter("data_filter", diff --git a/R/regression_model.R b/R/regression_model.R index d9d4529..d9f6255 100644 --- a/R/regression_model.R +++ b/R/regression_model.R @@ -71,7 +71,7 @@ regression_model <- function(data, .x } }) |> - dplyr::bind_cols() + dplyr::bind_cols(.name_repair = "unique_quiet") if (is.null(fun)) auto.mode <- TRUE diff --git a/R/sparkline_h_minimal.R b/R/sparkline_h_minimal.R new file mode 100644 index 0000000..8632d9b --- /dev/null +++ b/R/sparkline_h_minimal.R @@ -0,0 +1,34 @@ +# dependencies +library(apexcharter) +library(toastui) + +spark_data <- mtcars |> + (\(.x){ + dplyr::tibble( + name = names(.x), + vals = as.list(.x) + ) + })() + +ui <- fluidPage( + toastui::datagridOutput("tbl") +) + +server <- function(input, output) { + output$tbl <- toastui::renderDatagrid( + spark_data |> + toastui::datagrid() |> + toastui::grid_sparkline( + column = "vals", + renderer = function(data) { + apex(data.frame(x = 1, y = data), aes(x, y), type = "box") |> + ax_chart(sparkline = list(enabled = TRUE)) |> + ax_plotOptions( + bar = bar_opts(horizontal=TRUE) + ) + } + ) + ) +} + +shinyApp(ui = ui, server = server) diff --git a/R/update-variables-ext.R b/R/update-variables-ext.R new file mode 100644 index 0000000..b1247ee --- /dev/null +++ b/R/update-variables-ext.R @@ -0,0 +1,707 @@ +library(data.table) +library(rlang) + + +#' Select, rename and convert variables +#' +#' @param id Module id. See [shiny::moduleServer()]. +#' @param title Module's title, if `TRUE` use the default title, +#' use \code{NULL} for no title or a `shiny.tag` for a custom one. +#' +#' @return A [shiny::reactive()] function returning the updated data. +#' @export +#' +#' @name update-variables +#' +#' @example examples/variables.R +update_variables_ui <- function(id, title = TRUE) { + ns <- NS(id) + if (isTRUE(title)) { + title <- htmltools::tags$h4( + i18n("Update & select variables"), + class = "datamods-title" + ) + } + htmltools::tags$div( + class = "datamods-update", + shinyWidgets::html_dependency_pretty(), + title, + htmltools::tags$div( + style = "min-height: 25px;", + htmltools::tags$div( + shiny::uiOutput(outputId = ns("data_info"), inline = TRUE), + shiny::tagAppendAttributes( + shinyWidgets::dropMenu( + placement = "bottom-end", + shiny::actionButton( + inputId = ns("settings"), + label = phosphoricons::ph("gear"), + class = "pull-right float-right" + ), + shinyWidgets::textInputIcon( + inputId = ns("format"), + label = i18n("Date format:"), + value = "%Y-%m-%d", + icon = list(phosphoricons::ph("clock")) + ), + shinyWidgets::textInputIcon( + inputId = ns("origin"), + label = i18n("Date to use as origin to convert date/datetime:"), + value = "1970-01-01", + icon = list(phosphoricons::ph("calendar")) + ), + shinyWidgets::textInputIcon( + inputId = ns("dec"), + label = i18n("Decimal separator:"), + value = ".", + icon = list("0.00") + ) + ), + style = "display: inline;" + ) + ), + htmltools::tags$br(), + toastui::datagridOutput(outputId = ns("table")) + ), + htmltools::tags$br(), + htmltools::tags$div( + id = ns("update-placeholder"), + shinyWidgets::alert( + id = ns("update-result"), + status = "info", + phosphoricons::ph("info"), + datamods::i18n(paste( + "Select, rename and convert variables in table above,", + "then apply changes by clicking button below." + )) + ) + ), + shiny::actionButton( + inputId = ns("validate"), + label = htmltools::tagList( + phosphoricons::ph("arrow-circle-right", title = i18n("Apply changes")), + datamods::i18n("Apply changes") + ), + width = "100%" + ) + ) +} + +#' @export +#' +#' @param id Module's ID +#' @param data a \code{data.frame} or a \code{reactive} function returning a \code{data.frame}. +#' @param height Height for the table. +#' @param return_data_on_init Return initial data when module is called. +#' @param try_silent logical: should the report of error messages be suppressed? +#' +#' @rdname update-variables +#' +update_variables_server <- function(id, + data, + height = NULL, + return_data_on_init = FALSE, + try_silent = FALSE) { + shiny::moduleServer( + id = id, + module = function(input, output, session) { + ns <- session$ns + updated_data <- shiny::reactiveValues(x = NULL) + + data_r <- shiny::reactive({ + if (shiny::is.reactive(data)) { + data() + } else { + data + } + }) + + output$data_info <- shiny::renderUI({ + shiny::req(data_r()) + data <- data_r() + sprintf(i18n("Data has %s observations and %s variables."), nrow(data), ncol(data)) + }) + + variables_r <- shiny::reactive({ + shiny::validate( + shiny::need(data(), i18n("No data to display.")) + ) + data <- data_r() + if (isTRUE(return_data_on_init)) { + updated_data$x <- data + } else { + updated_data$x <- NULL + } + summary_vars(data) + }) + + output$table <- toastui::renderDatagrid({ + shiny::req(variables_r()) + # browser() + variables <- variables_r() + + # variables <- variables |> + # dplyr::mutate(vals=as.list(dplyr::as_tibble(data_r()))) + + # variables <- variables |> + # dplyr::mutate(n_id=seq_len(nrow(variables))) + + update_variables_datagrid( + variables, + height = height, + selectionId = ns("row_selected"), + buttonId = "validate" + ) + }) + + shiny::observeEvent(input$validate, + { + updated_data$list_rename <- NULL + updated_data$list_select <- NULL + updated_data$list_mutate <- NULL + updated_data$list_relabel <- NULL + data <- data_r() + new_selections <- input$row_selected + if (length(new_selections) < 1) { + new_selections <- seq_along(data) + } + # browser() + data_inputs <- data.table::as.data.table(input$table_data) + data.table::setorderv(data_inputs, "rowKey") + + old_names <- data_inputs$name + new_names <- data_inputs$name_toset + new_names[new_names == "New name"] <- NA + new_names[is.na(new_names)] <- old_names[is.na(new_names)] + new_names[new_names == ""] <- old_names[new_names == ""] + + old_label <- data_inputs$label + new_label <- data_inputs$label_toset + new_label[new_label == "New label"] <- "" + new_label[is.na(new_label)] <- old_label[is.na(new_label)] + new_label[new_label == ""] <- old_label[new_label == ""] + + new_classes <- data_inputs$class_toset + new_classes[new_classes == "Select"] <- NA + + # browser() + data_sv <- variables_r() + vars_to_change <- get_vars_to_convert(data_sv, setNames(as.list(new_classes), old_names)) + + res_update <- try( + { + # convert + if (nrow(vars_to_change) > 0) { + data <- convert_to( + data = data, + variable = vars_to_change$name, + new_class = vars_to_change$class_to_set, + origin = input$origin, + format = input$format, + dec = input$dec + ) + } + list_mutate <- attr(data, "code_03_convert") + + # rename + list_rename <- setNames( + as.list(old_names), + unlist(new_names, use.names = FALSE) + ) + list_rename <- list_rename[names(list_rename) != unlist(list_rename, use.names = FALSE)] + names(data) <- unlist(new_names, use.names = FALSE) + + # relabel + list_relabel <- as.list(new_label) + data <- purrr::map2( + data, list_relabel, + \(.data, .label){ + if (!(is.na(.label) | .label == "")) { + REDCapCAST::set_attr(.data, .label, attr = "label") + } else { + attr(x = .data, which = "label") <- NULL + .data + } + } + ) |> dplyr::bind_cols(.name_repair = "unique_quiet") + + # select + list_select <- setdiff(names(data), names(data)[new_selections]) + data <- data[, new_selections, drop = FALSE] + }, + silent = try_silent + ) + + if (inherits(res_update, "try-error")) { + datamods:::insert_error(selector = "update") + } else { + datamods:::insert_alert( + selector = ns("update"), + status = "success", + tags$b(phosphoricons::ph("check"), datamods::i18n("Data successfully updated!")) + ) + updated_data$x <- data + updated_data$list_rename <- list_rename + updated_data$list_select <- list_select + updated_data$list_mutate <- list_mutate + updated_data$list_relabel <- list_relabel + } + }, + ignoreNULL = TRUE, + ignoreInit = TRUE + ) + + return(shiny::reactive({ + data <- updated_data$x + code <- list() + if (!is.null(data) && shiny::isTruthy(updated_data$list_mutate) && length(updated_data$list_mutate) > 0) { + code <- c(code, list(rlang::call2("mutate", !!!updated_data$list_mutate))) + } + if (!is.null(data) && shiny::isTruthy(updated_data$list_rename) && length(updated_data$list_rename) > 0) { + code <- c(code, list(rlang::call2("rename", !!!updated_data$list_rename))) + } + if (!is.null(data) && shiny::isTruthy(updated_data$list_select) && length(updated_data$list_select) > 0) { + code <- c(code, list(rlang::expr(select(-any_of(c(!!!updated_data$list_select)))))) + } + if (!is.null(data) && shiny::isTruthy(updated_data$list_relabel) && length(updated_data$list_relabel) > 0) { + code <- c(code, list(rlang::call2("purrr::map2(list_relabel, + function(.data,.label){ + REDCapCAST::set_attr(.data,.label,attr = 'label') + }) |> dplyr::bind_cols(.name_repair = 'unique_quiet')"))) + } + if (length(code) > 0) { + attr(data, "code") <- Reduce( + f = function(x, y) rlang::expr(!!x %>% !!y), + x = code + ) + } + return(data) + })) + } + ) +} + + + + + + +# utils ------------------------------------------------------------------- + + +#' Get variables classes from a \code{data.frame} +#' +#' @param data a \code{data.frame} +#' +#' @return a \code{character} vector as same length as number of variables +#' @noRd +#' +#' @examples +#' +#' get_classes(mtcars) +get_classes <- function(data) { + classes <- lapply( + X = data, + FUN = function(x) { + paste(class(x), collapse = ", ") + } + ) + unlist(classes, use.names = FALSE) +} + + +#' Get count of unique values in variables of \code{data.frame} +#' +#' @param data a \code{data.frame} +#' +#' @return a \code{numeric} vector as same length as number of variables +#' @noRd +#' +#' +#' @examples +#' get_n_unique(mtcars) +get_n_unique <- function(data) { + u <- lapply(data, FUN = function(x) { + if (is.atomic(x)) { + data.table::uniqueN(x) + } else { + NA_integer_ + } + }) + unlist(u, use.names = FALSE) +} + + + +#' Add padding 0 to a vector +#' +#' @param x a \code{vector} +#' +#' @return a \code{character} vector +#' @noRd +#' +#' @examples +#' +#' pad0(1:10) +#' pad0(c(1, 15, 150, NA)) +pad0 <- function(x) { + NAs <- which(is.na(x)) + x <- formatC(x, width = max(nchar(as.character(x)), na.rm = TRUE), flag = "0") + x[NAs] <- NA + x +} + +#' Variables summary +#' +#' @param data a \code{data.frame} +#' +#' @return a \code{data.frame} +#' @noRd +#' +#' @examples +#' +#' summary_vars(iris) +#' summary_vars(mtcars) +summary_vars <- function(data) { + data <- as.data.frame(data) + datsum <- dplyr::tibble( + name = names(data), + label = lapply(data, \(.x) REDCapCAST::get_attr(.x, "label")) |> unlist(), + class = get_classes(data), + # n_missing = unname(colSums(is.na(data))), + # p_complete = 1 - n_missing / nrow(data), + n_unique = get_n_unique(data) + ) + + datsum +} + +add_var_toset <- function(data, var_name, default = "") { + datanames <- names(data) + datanames <- append( + x = datanames, + values = paste0(var_name, "_toset"), + after = which(datanames == var_name) + ) + data[[paste0(var_name, "_toset")]] <- default + data[, datanames] +} + +#' @importFrom toastui datagrid grid_columns grid_format grid_style_column +#' grid_style_column grid_editor grid_editor_opts grid_selection_row +#' @examples +#' mtcars |> +#' summary_vars() |> +#' update_variables_datagrid() +#' +update_variables_datagrid <- function(data, height = NULL, selectionId = NULL, buttonId = NULL) { + # browser() + data <- add_var_toset(data, "name", "New name") + data <- add_var_toset(data, "class", "Select") + data <- add_var_toset(data, "label", "New label") + + gridTheme <- getOption("datagrid.theme") + if (length(gridTheme) < 1) { + datamods:::apply_grid_theme() + } + on.exit(toastui::reset_grid_theme()) + + col.names <- names(data) + + std_names <- c( + "name", "name_toset", "label", "label_toset", "class", "class_toset", "n_missing", "p_complete", "n_unique" + ) |> + setNames(c( + "Name", "New name", "Label", "New label", "Class", "New class", "Missing", "Complete", "Unique" + )) + + headers <- lapply(col.names, \(.x){ + if (.x %in% std_names) { + names(std_names)[match(.x, std_names)] + } else { + .x + } + }) |> unlist() + + grid <- toastui::datagrid( + data = data, + theme = "default", + colwidths = NULL + ) + grid <- toastui::grid_columns( + grid = grid, + columns = col.names, + header = headers, + minWidth = 100 + ) + + # grid <- toastui::grid_format( + # grid = grid, + # "p_complete", + # formatter = toastui::JS("function(obj) {return (obj.value*100).toFixed(0) + '%';}") + # ) + grid <- toastui::grid_style_column( + grid = grid, + column = "name_toset", + fontStyle = "italic" + ) + grid <- toastui::grid_style_column( + grid = grid, + column = "label_toset", + fontStyle = "italic" + ) + grid <- toastui::grid_style_column( + grid = grid, + column = "class_toset", + fontStyle = "italic" + ) + + # grid <- toastui::grid_columns( + # grid = grid, + # columns = "name_toset", + # editor = list(type = "text"), + # validation = toastui::validateOpts() + # ) + # + # grid <- toastui::grid_columns( + # grid = grid, + # columns = "label_toset", + # editor = list(type = "text"), + # validation = toastui::validateOpts() + # ) + # + # grid <- toastui::grid_columns( + # grid = grid, + # columns = "class_toset", + # editor = list( + # type = "radio", + # options = list( + # instantApply = TRUE, + # listItems = lapply( + # X = c("Select", "character", "factor", "numeric", "integer", "date", "datetime", "hms"), + # FUN = function(x) { + # list(text = x, value = x) + # } + # ) + # ) + # ), + # validation = toastui::validateOpts() + # ) + + grid <- toastui::grid_editor( + grid = grid, + column = "name_toset", + type = "text" + ) + grid <- toastui::grid_editor( + grid = grid, + column = "label_toset", + type = "text" + ) + grid <- toastui::grid_editor( + grid = grid, + column = "class_toset", + type = "select", + choices = c("Select new class", "character", "factor", "numeric", "integer", "date", "datetime", "hms") + ) + grid <- toastui::grid_editor_opts( + grid = grid, + editingEvent = "click", + actionButtonId = NULL, + session = NULL + ) + grid <- toastui::grid_selection_row( + grid = grid, + inputId = selectionId, + type = "checkbox", + return = "index" + ) + + return(grid) +} + + + +#' Convert a variable to specific new class +#' +#' @param data A \code{data.frame} +#' @param variable Name of the variable to convert +#' @param new_class Class to set +#' @param ... Other arguments passed on to methods. +#' +#' @return A \code{data.frame} +#' @noRd +#' +#' @importFrom utils type.convert +#' @importFrom rlang sym expr +#' +#' @examples +#' dat <- data.frame( +#' v1 = month.name, +#' v2 = month.abb, +#' v3 = 1:12, +#' v4 = as.numeric(Sys.Date() + 0:11), +#' v5 = as.character(Sys.Date() + 0:11), +#' v6 = as.factor(c("a", "a", "b", "a", "b", "a", "a", "b", "a", "b", "b", "a")), +#' v7 = as.character(11:22), +#' stringsAsFactors = FALSE +#' ) +#' +#' str(dat) +#' +#' str(convert_to(dat, "v3", "character")) +#' str(convert_to(dat, "v6", "character")) +#' str(convert_to(dat, "v7", "numeric")) +#' str(convert_to(dat, "v4", "date", origin = "1970-01-01")) +#' str(convert_to(dat, "v5", "date")) +#' +#' str(convert_to(dat, c("v1", "v3"), c("factor", "character"))) +#' +#' str(convert_to(dat, c("v1", "v3", "v4"), c("factor", "character", "date"), origin = "1970-01-01")) +#' +convert_to <- function(data, + variable, + new_class = c("character", "factor", "numeric", "integer", "date", "datetime", "hms"), + ...) { + new_class <- match.arg(new_class, several.ok = TRUE) + stopifnot(length(new_class) == length(variable)) + args <- list(...) + if (length(variable) > 1) { + for (i in seq_along(variable)) { + data <- convert_to(data, variable[i], new_class[i], ...) + } + return(data) + } + if (identical(new_class, "character")) { + data[[variable]] <- as.character(x = data[[variable]], ...) + attr(data, "code_03_convert") <- c( + attr(data, "code_03_convert"), + setNames(list(expr(as.character(!!sym(variable)))), variable) + ) + } else if (identical(new_class, "factor")) { + data[[variable]] <- as.factor(x = data[[variable]]) + attr(data, "code_03_convert") <- c( + attr(data, "code_03_convert"), + setNames(list(expr(as.factor(!!sym(variable)))), variable) + ) + } else if (identical(new_class, "numeric")) { + data[[variable]] <- as.numeric(type.convert(data[[variable]], as.is = TRUE, ...)) + attr(data, "code_03_convert") <- c( + attr(data, "code_03_convert"), + setNames(list(expr(as.numeric(!!sym(variable)))), variable) + ) + } else if (identical(new_class, "integer")) { + data[[variable]] <- as.integer(x = data[[variable]], ...) + attr(data, "code_03_convert") <- c( + attr(data, "code_03_convert"), + setNames(list(expr(as.integer(!!sym(variable)))), variable) + ) + } else if (identical(new_class, "date")) { + data[[variable]] <- as.Date(x = data[[variable]], ...) + attr(data, "code_03_convert") <- c( + attr(data, "code_03_convert"), + setNames(list(expr(as.Date(!!sym(variable), origin = !!args$origin))), variable) + ) + } else if (identical(new_class, "datetime")) { + data[[variable]] <- as.POSIXct(x = data[[variable]], ...) + attr(data, "code_03_convert") <- c( + attr(data, "code_03_convert"), + setNames(list(expr(as.POSIXct(!!sym(variable)))), variable) + ) + } else if (identical(new_class, "hms")) { + data[[variable]] <- hms::as_hms(x = data[[variable]]) + attr(data, "code_03_convert") <- c( + attr(data, "code_03_convert"), + setNames(list(expr(hms::as_hms(!!sym(variable)))), variable) + ) + } + return(data) +} + + + + + + + + +#' Get variable(s) to convert +#' +#' @param vars Output of [summary_vars()] +#' @param classes_input List of inputs containing new classes +#' +#' @return a `data.table`. +#' @noRd +#' +#' @importFrom data.table data.table as.data.table +#' +#' @examples +#' # 2 variables to convert +#' new_classes <- list( +#' "Sepal.Length" = "numeric", +#' "Sepal.Width" = "numeric", +#' "Petal.Length" = "character", +#' "Petal.Width" = "numeric", +#' "Species" = "character" +#' ) +#' get_vars_to_convert(summary_vars(iris), new_classes) +#' +#' +#' # No changes +#' new_classes <- list( +#' "Sepal.Length" = "numeric", +#' "Sepal.Width" = "numeric", +#' "Petal.Length" = "numeric", +#' "Petal.Width" = "numeric", +#' "Species" = "factor" +#' ) +#' get_vars_to_convert(summary_vars(iris), new_classes) +#' +#' # Not set = NA or "" +#' new_classes <- list( +#' "Sepal.Length" = NA, +#' "Sepal.Width" = NA, +#' "Petal.Length" = NA, +#' "Petal.Width" = NA, +#' "Species" = NA +#' ) +#' get_vars_to_convert(summary_vars(iris), new_classes) +#' +#' # Set for one var +#' new_classes <- list( +#' "Sepal.Length" = "", +#' "Sepal.Width" = "", +#' "Petal.Length" = "", +#' "Petal.Width" = "", +#' "Species" = "character" +#' ) +#' get_vars_to_convert(summary_vars(iris), new_classes) +#' +#' new_classes <- list( +#' "mpg" = "character", +#' "cyl" = "numeric", +#' "disp" = "character", +#' "hp" = "numeric", +#' "drat" = "character", +#' "wt" = "character", +#' "qsec" = "numeric", +#' "vs" = "character", +#' "am" = "numeric", +#' "gear" = "character", +#' "carb" = "integer" +#' ) +#' get_vars_to_convert(summary_vars(mtcars), new_classes) +get_vars_to_convert <- function(vars, classes_input) { + vars <- data.table::as.data.table(vars) + classes_input <- data.table::data.table( + name = names(classes_input), + class_to_set = unlist(classes_input, use.names = FALSE), + stringsAsFactors = FALSE + ) + classes_input <- classes_input[!is.na(class_to_set) & class_to_set != ""] + classes_df <- merge(x = vars, y = classes_input, by = "name") + classes_df <- classes_df[!is.na(class_to_set)] + classes_df[class != class_to_set] +} + + diff --git a/inst/apps/data_analysis_modules/app.R b/inst/apps/data_analysis_modules/app.R index eb6b180..7978bc1 100644 --- a/inst/apps/data_analysis_modules/app.R +++ b/inst/apps/data_analysis_modules/app.R @@ -1,13 +1,13 @@ ######## -#### Current file: /Users/au301842/freesearcheR/inst/apps/data_analysis_modules/functions.R +#### Current file: /Users/au301842/freesearcheR/inst/apps/data_analysis_modules/functions.R ######## ######## -#### Current file: R//baseline_table.R +#### Current file: R//baseline_table.R ######## @@ -35,7 +35,7 @@ baseline_table <- function(data, fun.args = NULL, fun = gtsummary::tbl_summary, ######## -#### Current file: R//cut-variable-dates.R +#### Current file: R//cut-variable-dates.R ######## library(datamods) @@ -677,7 +677,250 @@ plot_histogram <- function(data, column, bins = 30, breaks = NULL, color = "#112 ######## -#### Current file: R//file-import-module.R +#### Current file: R//data-summary.R +######## + +data_summary_ui <- function(id) { + ns <- NS(id) + + toastui::datagridOutput(outputId = "tbl_summary") +} + + +data_summary_server <- function(id, + data) { + shiny::moduleServer( + id = id, + module = function(input, output, session) { + ns <- session$ns + + data_r <- shiny::reactive({ + if (shiny::is.reactive(data)) { + data() + } else { + data + } + }) + + output$tbl_summary <- shiny::reactive({ + toastui::renderDatagrid( + data_r() |> + overview_vars() |> + create_overview_datagrid() |> + add_sparkline( + column = "vals" + ) + ) + }) + } + ) +} + + + + + + + + + + + + + + + + +add_sparkline <- function(grid, column = "vals", color.main = "#2a8484", color.sec = "#84EF84") { + out <- toastui::grid_sparkline( + grid = grid, + column = column, + renderer = function(data) { + data_cl <- class(data) + if (identical(data_cl, "factor")) { + type <- "column" + s <- summary(data) + ds <- data.frame(x = names(s), y = s) + horizontal <- FALSE + } else if (any(c("numeric", "integer") %in% data_cl)) { + if (length(unique(data)) == length(data)) { + type <- "line" + ds <- data.frame(x = NA, y = NA) + horizontal <- FALSE + } else { + type <- "box" + ds <- data.frame(x = 1, y = data) + horizontal <- TRUE + } + } else if (any(c("Date", "POSIXct", "POSIXt", "hms", "difftime") %in% data_cl)) { + type <- "line" + ds <- data.frame(x = seq_along(data), y = data) + horizontal <- FALSE + } else { + type <- "line" + ds <- data.frame(x = NA, y = NA) + horizontal <- FALSE + } + apexcharter::apex( + ds, + apexcharter::aes(x, y), + type = type, + auto_update = TRUE + ) |> + apexcharter::ax_chart(sparkline = list(enabled = TRUE)) |> + apexcharter::ax_plotOptions( + boxPlot = apexcharter::boxplot_opts(color.upper = color.sec, color.lower = color.main), + bar = apexcharter::bar_opts(horizontal = horizontal) + ) |> + apexcharter::ax_colors( + c(color.main, color.sec) + ) + } + ) + + toastui::grid_columns( + grid = out, + columns = column, + minWidth = 200 + ) +} + + + + + + + + + + +overview_vars <- function(data) { + data <- as.data.frame(data) + + dplyr::tibble( + class = get_classes(data), + name = names(data), + n_missing = unname(colSums(is.na(data))), + p_complete = 1 - n_missing / nrow(data), + n_unique = get_n_unique(data), + vals = as.list(data) + ) +} + + + + + + + + + + + + +create_overview_datagrid <- function(data) { + # browser() + gridTheme <- getOption("datagrid.theme") + if (length(gridTheme) < 1) { + datamods:::apply_grid_theme() + } + on.exit(toastui::reset_grid_theme()) + + col.names <- names(data) + + std_names <- c( + "Name" = "name", + "Class" = "class", + "Missing" = "n_missing", + "Complete" = "p_complete", + "Unique" = "n_unique", + "Plot" = "vals" + ) + + headers <- lapply(col.names, \(.x){ + if (.x %in% std_names) { + names(std_names)[match(.x, std_names)] + } else { + .x + } + }) |> unlist() + + grid <- toastui::datagrid( + data = data, + theme = "default", + colwidths = "auto" + ) + + grid <- toastui::grid_columns( + grid = grid, + columns = col.names, + header = headers, + resizable = TRUE, + width = 80 + ) + + grid <- add_class_icon( + grid = grid, + column = "class" + ) + + # grid <- toastui::grid_format( + # grid = grid, + # "p_complete", + # formatter = toastui::JS("function(obj) {return (obj.value*100).toFixed(0) + '%';}") + # ) + + return(grid) +} + + + + + + + + + + +add_class_icon <- function(grid, column = "class") { + out <- toastui::grid_format( + grid = grid, + column = column, + formatter = function(value) { + lapply( + X = value, + FUN = function(x) { + if (identical(x, "numeric")) { + shiny::icon("chart-line") + } else if (identical(x, "factor")) { + shiny::icon("chart-column") + } else if (identical(x, "integer")) { + shiny::icon("arrow-down-1-9") + } else if (identical(x, "character")) { + shiny::icon("arrow-down-a-z") + } else if (any(c("Date", "POSIXct", "POSIXt") %in% x)) { + shiny::icon("calendar-days") + } else if ("hms" %in% x) { + shiny::icon("clock") + } else { + shiny::icon("table") + } + } + ) + } + ) + + toastui::grid_columns( + grid = out, + header = NULL, + columns = column, + width = 60 + ) +} + + +######## +#### Current file: R//file-import-module.R ######## @@ -687,128 +930,128 @@ plot_histogram <- function(data, column, bins = 30, breaks = NULL, color = "#112 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +m_datafileUI <- function(id) { + ns <- shiny::NS(id) + shiny::tagList( + shiny::fileInput( + inputId = ns("file"), + label = "Upload a file", + multiple = FALSE, + accept = c( + ".csv", + ".xlsx", + ".xls", + ".dta", + ".ods", + ".rds" + ) + ), + shiny::h4("Parameter specifications"), + shiny::helpText(shiny::em("Select the desired variables and press 'Submit'")), + shiny::uiOutput(ns("include_vars")), + DT::DTOutput(ns("data_input")), + shiny::actionButton(ns("submit"), "Submit") + ) +} + +m_datafileServer <- function(id, output.format = "df") { + shiny::moduleServer(id, function(input, output, session, ...) { + ns <- shiny::NS(id) + ds <- shiny::reactive({ + REDCapCAST::read_input(input$file$datapath) |> REDCapCAST::parse_data() + }) + + output$include_vars <- shiny::renderUI({ + shiny::req(input$file) + shiny::selectizeInput( + inputId = ns("include_vars"), + selected = NULL, + label = "Covariables to include", + choices = colnames(ds()), + multiple = TRUE + ) + }) + + base_vars <- shiny::reactive({ + if (is.null(input$include_vars)) { + out <- colnames(ds()) + } else { + out <- input$include_vars + } + out + }) + + output$data_input <- + DT::renderDT({ + shiny::req(input$file) + ds()[base_vars()] + }) + + shiny::eventReactive(input$submit, { + # shiny::req(input$file) + + data <- shiny::isolate({ + ds()[base_vars()] + }) + + file_export(data, + output.format = output.format, + tools::file_path_sans_ext(input$file$name) + ) + }) + }) +} + + + + + +file_app <- function() { + ui <- shiny::fluidPage( + m_datafileUI("data"), + # DT::DTOutput(outputId = "redcap_prev") + toastui::datagridOutput2(outputId = "redcap_prev") + ) + server <- function(input, output, session) { + m_datafileServer("data", output.format = "list") + } + shiny::shinyApp(ui, server) +} + +file_app() + +tdm_data_upload <- teal::teal_data_module( + ui <- function(id) { + shiny::fluidPage( + m_datafileUI(id) + ) + }, + server = function(id) { + m_datafileServer(id, output.format = "teal") + } +) + +tdm_data_read <- teal::teal_data_module( + ui <- function(id) { + shiny::fluidPage( + m_redcap_readUI(id = "redcap") + ) + }, + server = function(id) { + moduleServer( + id, + function(input, output, session) { + ns <- session$ns + + m_redcap_readServer(id = "redcap", output.format = "teal") + } + ) + } +) ######## -#### Current file: R//helpers.R +#### Current file: R//helpers.R ######## @@ -961,7 +1204,7 @@ file_export <- function(data, output.format = c("df", "teal", "list"), filename, teal_data(), { assign(name, value |> - dplyr::bind_cols() |> + dplyr::bind_cols(.name_repair = "unique_quiet") |> default_parsing()) }, value = data, @@ -998,15 +1241,49 @@ file_export <- function(data, output.format = c("df", "teal", "list"), filename, default_parsing <- function(data) { - data |> + name_labels <- lapply(data,\(.x) REDCapCAST::get_attr(.x,attr = "label")) + + out <- data |> REDCapCAST::parse_data() |> REDCapCAST::as_factor() |> REDCapCAST::numchar2fct() + + purrr::map2(out,name_labels,\(.x,.l){ + if (!(is.na(.l) | .l=="")) { + REDCapCAST::set_attr(.x, .l, attr = "label") + } else { + attr(x = .x, which = "label") <- NULL + .x + } + # REDCapCAST::set_attr(data = .x, label = .l,attr = "label", overwrite = FALSE) + }) |> dplyr::bind_cols() +} + + + + + + + + + + + +remove_na_attr <- function(data,attr="label"){ + out <- data |> lapply(\(.x){ + ls <- REDCapCAST::get_attr(data = .x,attr = attr) + if (is.na(ls) | ls == ""){ + attr(x = .x, which = attr) <- NULL + } + .x + }) + + dplyr::bind_cols(out) } ######## -#### Current file: R//redcap_read_shiny_module.R +#### Current file: R//redcap_read_shiny_module.R ######## @@ -1021,8 +1298,8 @@ default_parsing <- function(data) { m_redcap_readUI <- function(id, include_title = TRUE) { ns <- shiny::NS(id) - server_ui <- shiny::column( - width = 6, + server_ui <- shiny::tagList( + # width = 6, shiny::tags$h4("REDCap server information"), shiny::textInput( inputId = ns("uri"), @@ -1038,8 +1315,8 @@ m_redcap_readUI <- function(id, include_title = TRUE) { params_ui <- - shiny::column( - width = 6, + shiny::tagList( + # width = 6, shiny::tags$h4("Data import parameters"), shiny::helpText("Options here will show, when API and uri are typed"), shiny::uiOutput(outputId = ns("fields")), @@ -1074,9 +1351,14 @@ m_redcap_readUI <- function(id, include_title = TRUE) { shiny::fluidPage( if (include_title) shiny::tags$h3("Import data from REDCap"), - fluidRow( + bslib::layout_columns( server_ui, - params_ui), + params_ui, + col_widths = bslib::breakpoints( + sm = c(12, 12), + md = c(12, 12) + ) + ), shiny::column( width = 12, # shiny::actionButton(inputId = ns("import"), label = "Import"), @@ -1086,8 +1368,8 @@ m_redcap_readUI <- function(id, include_title = TRUE) { icon = shiny::icon("download", lib = "glyphicon"), label_busy = "Just a minute...", icon_busy = fontawesome::fa_i("arrows-rotate", - class = "fa-spin", - "aria-hidden" = "true" + class = "fa-spin", + "aria-hidden" = "true" ), type = "primary", auto_reset = TRUE @@ -1205,7 +1487,7 @@ m_redcap_readServer <- function(id, output.format = c("df", "teal", "list")) { # browser() data.df <- dd()[, c(1, 2, 4, 5, 6, 8)] DT::datatable(data.df, - caption = "Subset of data dictionary" + caption = "Subset of data dictionary" ) }, server = TRUE @@ -1252,8 +1534,8 @@ m_redcap_readServer <- function(id, output.format = c("df", "teal", "list")) { REDCapCAST::suffix2label() out_object <- file_export(redcap_data, - output.format = output.format, - filename = name() + output.format = output.format, + filename = name() ) if (output.format == "list") { @@ -1281,7 +1563,6 @@ m_redcap_readServer <- function(id, output.format = c("df", "teal", "list")) { tdm_redcap_read <- teal::teal_data_module( - ui <- function(id) { shiny::fluidPage( m_redcap_readUI(id) @@ -1316,7 +1597,7 @@ redcap_app <- function() { ) ) server <- function(input, output, session) { - data_val <- shiny::reactiveValues(data=NULL) + data_val <- shiny::reactiveValues(data = NULL) ds <- m_redcap_readServer("data", output.format = "df") # output$redcap_prev <- DT::renderDT( @@ -1339,8 +1620,9 @@ redcap_app <- function() { }) filtered_data <- IDEAFilter::IDEAFilter("data_filter", - data = ds, - verbose = FALSE) + data = ds, + verbose = FALSE + ) # filtered_data <- shiny::reactive({ # IDEAFilter::IDEAFilter("data_filter", @@ -1376,7 +1658,7 @@ redcap_app <- function() { ######## -#### Current file: R//regression_model.R +#### Current file: R//regression_model.R ######## @@ -1452,7 +1734,7 @@ regression_model <- function(data, .x } }) |> - dplyr::bind_cols() + dplyr::bind_cols(.name_repair = "unique_quiet") if (is.null(fun)) auto.mode <- TRUE @@ -1586,7 +1868,7 @@ regression_model_uv <- function(data, ######## -#### Current file: R//regression_table.R +#### Current file: R//regression_table.R ######## @@ -1734,7 +2016,7 @@ tbl_merge <- function(data) { ######## -#### Current file: R//report.R +#### Current file: R//report.R ######## @@ -1821,7 +2103,7 @@ modify_qmd <- function(file, format) { ######## -#### Current file: R//shiny_freesearcheR.R +#### Current file: R//shiny_freesearcheR.R ######## @@ -1852,7 +2134,47 @@ shiny_freesearcheR <- function(...) { ######## -#### Current file: R//theme.R +#### Current file: R//sparkline_h_minimal.R +######## + +# dependencies +library(apexcharter) +library(toastui) + +spark_data <- mtcars |> + (\(.x){ + dplyr::tibble( + name = names(.x), + vals = as.list(.x) + ) + })() + +ui <- fluidPage( + toastui::datagridOutput("tbl") +) + +server <- function(input, output) { + output$tbl <- toastui::renderDatagrid( + spark_data |> + toastui::datagrid() |> + toastui::grid_sparkline( + column = "vals", + renderer = function(data) { + apex(data.frame(x = 1, y = data), aes(x, y), type = "box") |> + ax_chart(sparkline = list(enabled = TRUE)) |> + ax_plotOptions( + bar = bar_opts(horizontal=TRUE) + ) + } + ) + ) +} + +shinyApp(ui = ui, server = server) + + +######## +#### Current file: R//theme.R ######## @@ -1893,12 +2215,735 @@ custom_theme <- function(..., ######## -#### Current file: /Users/au301842/freesearcheR/inst/apps/data_analysis_modules/ui.R +#### Current file: R//update-variables-ext.R +######## + +library(data.table) +library(rlang) + + + + + + + + + + + + + + +update_variables_ui <- function(id, title = TRUE) { + ns <- NS(id) + if (isTRUE(title)) { + title <- htmltools::tags$h4( + i18n("Update & select variables"), + class = "datamods-title" + ) + } + htmltools::tags$div( + class = "datamods-update", + shinyWidgets::html_dependency_pretty(), + title, + htmltools::tags$div( + style = "min-height: 25px;", + htmltools::tags$div( + shiny::uiOutput(outputId = ns("data_info"), inline = TRUE), + shiny::tagAppendAttributes( + shinyWidgets::dropMenu( + placement = "bottom-end", + shiny::actionButton( + inputId = ns("settings"), + label = phosphoricons::ph("gear"), + class = "pull-right float-right" + ), + shinyWidgets::textInputIcon( + inputId = ns("format"), + label = i18n("Date format:"), + value = "%Y-%m-%d", + icon = list(phosphoricons::ph("clock")) + ), + shinyWidgets::textInputIcon( + inputId = ns("origin"), + label = i18n("Date to use as origin to convert date/datetime:"), + value = "1970-01-01", + icon = list(phosphoricons::ph("calendar")) + ), + shinyWidgets::textInputIcon( + inputId = ns("dec"), + label = i18n("Decimal separator:"), + value = ".", + icon = list("0.00") + ) + ), + style = "display: inline;" + ) + ), + htmltools::tags$br(), + toastui::datagridOutput(outputId = ns("table")) + ), + htmltools::tags$br(), + htmltools::tags$div( + id = ns("update-placeholder"), + shinyWidgets::alert( + id = ns("update-result"), + status = "info", + phosphoricons::ph("info"), + datamods::i18n(paste( + "Select, rename and convert variables in table above,", + "then apply changes by clicking button below." + )) + ) + ), + shiny::actionButton( + inputId = ns("validate"), + label = htmltools::tagList( + phosphoricons::ph("arrow-circle-right", title = i18n("Apply changes")), + datamods::i18n("Apply changes") + ), + width = "100%" + ) + ) +} + + + + + + + + + + + +update_variables_server <- function(id, + data, + height = NULL, + return_data_on_init = FALSE, + try_silent = FALSE) { + shiny::moduleServer( + id = id, + module = function(input, output, session) { + ns <- session$ns + updated_data <- shiny::reactiveValues(x = NULL) + + data_r <- shiny::reactive({ + if (shiny::is.reactive(data)) { + data() + } else { + data + } + }) + + output$data_info <- shiny::renderUI({ + shiny::req(data_r()) + data <- data_r() + sprintf(i18n("Data has %s observations and %s variables."), nrow(data), ncol(data)) + }) + + variables_r <- shiny::reactive({ + shiny::validate( + shiny::need(data(), i18n("No data to display.")) + ) + data <- data_r() + if (isTRUE(return_data_on_init)) { + updated_data$x <- data + } else { + updated_data$x <- NULL + } + summary_vars(data) + }) + + output$table <- toastui::renderDatagrid({ + shiny::req(variables_r()) + # browser() + variables <- variables_r() + + # variables <- variables |> + # dplyr::mutate(vals=as.list(dplyr::as_tibble(data_r()))) + + # variables <- variables |> + # dplyr::mutate(n_id=seq_len(nrow(variables))) + + update_variables_datagrid( + variables, + height = height, + selectionId = ns("row_selected"), + buttonId = "validate" + ) + }) + + shiny::observeEvent(input$validate, + { + updated_data$list_rename <- NULL + updated_data$list_select <- NULL + updated_data$list_mutate <- NULL + updated_data$list_relabel <- NULL + data <- data_r() + new_selections <- input$row_selected + if (length(new_selections) < 1) { + new_selections <- seq_along(data) + } + # browser() + data_inputs <- data.table::as.data.table(input$table_data) + data.table::setorderv(data_inputs, "rowKey") + + old_names <- data_inputs$name + new_names <- data_inputs$name_toset + new_names[new_names == "New name"] <- NA + new_names[is.na(new_names)] <- old_names[is.na(new_names)] + new_names[new_names == ""] <- old_names[new_names == ""] + + old_label <- data_inputs$label + new_label <- data_inputs$label_toset + new_label[new_label == "New label"] <- "" + new_label[is.na(new_label)] <- old_label[is.na(new_label)] + new_label[new_label == ""] <- old_label[new_label == ""] + + new_classes <- data_inputs$class_toset + new_classes[new_classes == "Select"] <- NA + + # browser() + data_sv <- variables_r() + vars_to_change <- get_vars_to_convert(data_sv, setNames(as.list(new_classes), old_names)) + + res_update <- try( + { + # convert + if (nrow(vars_to_change) > 0) { + data <- convert_to( + data = data, + variable = vars_to_change$name, + new_class = vars_to_change$class_to_set, + origin = input$origin, + format = input$format, + dec = input$dec + ) + } + list_mutate <- attr(data, "code_03_convert") + + # rename + list_rename <- setNames( + as.list(old_names), + unlist(new_names, use.names = FALSE) + ) + list_rename <- list_rename[names(list_rename) != unlist(list_rename, use.names = FALSE)] + names(data) <- unlist(new_names, use.names = FALSE) + + # relabel + list_relabel <- as.list(new_label) + data <- purrr::map2( + data, list_relabel, + \(.data, .label){ + if (!(is.na(.label) | .label == "")) { + REDCapCAST::set_attr(.data, .label, attr = "label") + } else { + attr(x = .data, which = "label") <- NULL + .data + } + } + ) |> dplyr::bind_cols(.name_repair = "unique_quiet") + + # select + list_select <- setdiff(names(data), names(data)[new_selections]) + data <- data[, new_selections, drop = FALSE] + }, + silent = try_silent + ) + + if (inherits(res_update, "try-error")) { + datamods:::insert_error(selector = "update") + } else { + datamods:::insert_alert( + selector = ns("update"), + status = "success", + tags$b(phosphoricons::ph("check"), datamods::i18n("Data successfully updated!")) + ) + updated_data$x <- data + updated_data$list_rename <- list_rename + updated_data$list_select <- list_select + updated_data$list_mutate <- list_mutate + updated_data$list_relabel <- list_relabel + } + }, + ignoreNULL = TRUE, + ignoreInit = TRUE + ) + + return(shiny::reactive({ + data <- updated_data$x + code <- list() + if (!is.null(data) && shiny::isTruthy(updated_data$list_mutate) && length(updated_data$list_mutate) > 0) { + code <- c(code, list(rlang::call2("mutate", !!!updated_data$list_mutate))) + } + if (!is.null(data) && shiny::isTruthy(updated_data$list_rename) && length(updated_data$list_rename) > 0) { + code <- c(code, list(rlang::call2("rename", !!!updated_data$list_rename))) + } + if (!is.null(data) && shiny::isTruthy(updated_data$list_select) && length(updated_data$list_select) > 0) { + code <- c(code, list(rlang::expr(select(-any_of(c(!!!updated_data$list_select)))))) + } + if (!is.null(data) && shiny::isTruthy(updated_data$list_relabel) && length(updated_data$list_relabel) > 0) { + code <- c(code, list(rlang::call2("purrr::map2(list_relabel, + function(.data,.label){ + REDCapCAST::set_attr(.data,.label,attr = 'label') + }) |> dplyr::bind_cols(.name_repair = 'unique_quiet')"))) + } + if (length(code) > 0) { + attr(data, "code") <- Reduce( + f = function(x, y) rlang::expr(!!x %>% !!y), + x = code + ) + } + return(data) + })) + } + ) +} + + + + + + +# utils ------------------------------------------------------------------- + + + + + + + + + + + + +get_classes <- function(data) { + classes <- lapply( + X = data, + FUN = function(x) { + paste(class(x), collapse = ", ") + } + ) + unlist(classes, use.names = FALSE) +} + + + + + + + + + + + + +get_n_unique <- function(data) { + u <- lapply(data, FUN = function(x) { + if (is.atomic(x)) { + data.table::uniqueN(x) + } else { + NA_integer_ + } + }) + unlist(u, use.names = FALSE) +} + + + + + + + + + + + + + + +pad0 <- function(x) { + NAs <- which(is.na(x)) + x <- formatC(x, width = max(nchar(as.character(x)), na.rm = TRUE), flag = "0") + x[NAs] <- NA + x +} + + + + + + + + + + + + +summary_vars <- function(data) { + data <- as.data.frame(data) + datsum <- dplyr::tibble( + name = names(data), + label = lapply(data, \(.x) REDCapCAST::get_attr(.x, "label")) |> unlist(), + class = get_classes(data), + # n_missing = unname(colSums(is.na(data))), + # p_complete = 1 - n_missing / nrow(data), + n_unique = get_n_unique(data) + ) + + datsum +} + +add_var_toset <- function(data, var_name, default = "") { + datanames <- names(data) + datanames <- append( + x = datanames, + values = paste0(var_name, "_toset"), + after = which(datanames == var_name) + ) + data[[paste0(var_name, "_toset")]] <- default + data[, datanames] +} + + + + + + + + +update_variables_datagrid <- function(data, height = NULL, selectionId = NULL, buttonId = NULL) { + # browser() + data <- add_var_toset(data, "name", "New name") + data <- add_var_toset(data, "class", "Select") + data <- add_var_toset(data, "label", "New label") + + gridTheme <- getOption("datagrid.theme") + if (length(gridTheme) < 1) { + datamods:::apply_grid_theme() + } + on.exit(toastui::reset_grid_theme()) + + col.names <- names(data) + + std_names <- c( + "name", "name_toset", "label", "label_toset", "class", "class_toset", "n_missing", "p_complete", "n_unique" + ) |> + setNames(c( + "Name", "New name", "Label", "New label", "Class", "New class", "Missing", "Complete", "Unique" + )) + + headers <- lapply(col.names, \(.x){ + if (.x %in% std_names) { + names(std_names)[match(.x, std_names)] + } else { + .x + } + }) |> unlist() + + grid <- toastui::datagrid( + data = data, + theme = "default", + colwidths = NULL + ) + grid <- toastui::grid_columns( + grid = grid, + columns = col.names, + header = headers, + minWidth = 100 + ) + + # grid <- toastui::grid_format( + # grid = grid, + # "p_complete", + # formatter = toastui::JS("function(obj) {return (obj.value*100).toFixed(0) + '%';}") + # ) + grid <- toastui::grid_style_column( + grid = grid, + column = "name_toset", + fontStyle = "italic" + ) + grid <- toastui::grid_style_column( + grid = grid, + column = "label_toset", + fontStyle = "italic" + ) + grid <- toastui::grid_style_column( + grid = grid, + column = "class_toset", + fontStyle = "italic" + ) + + # grid <- toastui::grid_columns( + # grid = grid, + # columns = "name_toset", + # editor = list(type = "text"), + # validation = toastui::validateOpts() + # ) + # + # grid <- toastui::grid_columns( + # grid = grid, + # columns = "label_toset", + # editor = list(type = "text"), + # validation = toastui::validateOpts() + # ) + # + # grid <- toastui::grid_columns( + # grid = grid, + # columns = "class_toset", + # editor = list( + # type = "radio", + # options = list( + # instantApply = TRUE, + # listItems = lapply( + # X = c("Select", "character", "factor", "numeric", "integer", "date", "datetime", "hms"), + # FUN = function(x) { + # list(text = x, value = x) + # } + # ) + # ) + # ), + # validation = toastui::validateOpts() + # ) + + grid <- toastui::grid_editor( + grid = grid, + column = "name_toset", + type = "text" + ) + grid <- toastui::grid_editor( + grid = grid, + column = "label_toset", + type = "text" + ) + grid <- toastui::grid_editor( + grid = grid, + column = "class_toset", + type = "select", + choices = c("Select new class", "character", "factor", "numeric", "integer", "date", "datetime", "hms") + ) + grid <- toastui::grid_editor_opts( + grid = grid, + editingEvent = "click", + actionButtonId = NULL, + session = NULL + ) + grid <- toastui::grid_selection_row( + grid = grid, + inputId = selectionId, + type = "checkbox", + return = "index" + ) + + return(grid) +} + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +convert_to <- function(data, + variable, + new_class = c("character", "factor", "numeric", "integer", "date", "datetime", "hms"), + ...) { + new_class <- match.arg(new_class, several.ok = TRUE) + stopifnot(length(new_class) == length(variable)) + args <- list(...) + if (length(variable) > 1) { + for (i in seq_along(variable)) { + data <- convert_to(data, variable[i], new_class[i], ...) + } + return(data) + } + if (identical(new_class, "character")) { + data[[variable]] <- as.character(x = data[[variable]], ...) + attr(data, "code_03_convert") <- c( + attr(data, "code_03_convert"), + setNames(list(expr(as.character(!!sym(variable)))), variable) + ) + } else if (identical(new_class, "factor")) { + data[[variable]] <- as.factor(x = data[[variable]]) + attr(data, "code_03_convert") <- c( + attr(data, "code_03_convert"), + setNames(list(expr(as.factor(!!sym(variable)))), variable) + ) + } else if (identical(new_class, "numeric")) { + data[[variable]] <- as.numeric(type.convert(data[[variable]], as.is = TRUE, ...)) + attr(data, "code_03_convert") <- c( + attr(data, "code_03_convert"), + setNames(list(expr(as.numeric(!!sym(variable)))), variable) + ) + } else if (identical(new_class, "integer")) { + data[[variable]] <- as.integer(x = data[[variable]], ...) + attr(data, "code_03_convert") <- c( + attr(data, "code_03_convert"), + setNames(list(expr(as.integer(!!sym(variable)))), variable) + ) + } else if (identical(new_class, "date")) { + data[[variable]] <- as.Date(x = data[[variable]], ...) + attr(data, "code_03_convert") <- c( + attr(data, "code_03_convert"), + setNames(list(expr(as.Date(!!sym(variable), origin = !!args$origin))), variable) + ) + } else if (identical(new_class, "datetime")) { + data[[variable]] <- as.POSIXct(x = data[[variable]], ...) + attr(data, "code_03_convert") <- c( + attr(data, "code_03_convert"), + setNames(list(expr(as.POSIXct(!!sym(variable)))), variable) + ) + } else if (identical(new_class, "hms")) { + data[[variable]] <- hms::as_hms(x = data[[variable]]) + attr(data, "code_03_convert") <- c( + attr(data, "code_03_convert"), + setNames(list(expr(hms::as_hms(!!sym(variable)))), variable) + ) + } + return(data) +} + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +get_vars_to_convert <- function(vars, classes_input) { + vars <- data.table::as.data.table(vars) + classes_input <- data.table::data.table( + name = names(classes_input), + class_to_set = unlist(classes_input, use.names = FALSE), + stringsAsFactors = FALSE + ) + classes_input <- classes_input[!is.na(class_to_set) & class_to_set != ""] + classes_df <- merge(x = vars, y = classes_input, by = "name") + classes_df <- classes_df[!is.na(class_to_set)] + classes_df[class != class_to_set] +} + + + + +######## +#### Current file: /Users/au301842/freesearcheR/inst/apps/data_analysis_modules/ui.R ######## # ns <- NS(id) ui_elements <- list( + ############################################################################## + ######### + ######### Home panel + ######### + ############################################################################## + "home" = bslib::nav_panel( + title = "freesearcheR", + shiny::markdown(readLines("www/intro.md")), + icon = shiny::icon("home") + ), ############################################################################## ######### ######### Import panel @@ -1906,70 +2951,61 @@ ui_elements <- list( ############################################################################## "import" = bslib::nav_panel( title = "Import", - shiny::fluidRow( - column( - width = 6, - shiny::h4("Choose your data source"), - # shiny::conditionalPanel( - # condition = "output.has_input=='yes'", - # # Input: Select a file ---- - # shiny::helpText("Analyses are performed on provided data") + shiny::tagList( + shiny::h4("Choose your data source"), + # shiny::conditionalPanel( + # condition = "output.has_input=='yes'", + # # Input: Select a file ---- + # shiny::helpText("Analyses are performed on provided data") + # ), + # shiny::conditionalPanel( + # condition = "output.has_input=='no'", + # Input: Select a file ---- + shinyWidgets::radioGroupButtons( + inputId = "source", + selected = "env", + # label = "Choice: ", + choices = c( + "File upload" = "file", + "REDCap server" = "redcap", + "Local data" = "env" + ), + # checkIcon = list( + # yes = icon("square-check"), + # no = icon("square") # ), - # shiny::conditionalPanel( - # condition = "output.has_input=='no'", - # Input: Select a file ---- - shinyWidgets::radioGroupButtons( - inputId = "source", - # label = "Choice: ", - choices = c( - "File upload" = "file", - "REDCap server" = "redcap", - "Local data" = "env" - ), - # checkIcon = list( - # yes = icon("square-check"), - # no = icon("square") - # ), - width = "100%" - ), - shiny::conditionalPanel( - condition = "input.source=='file'", - datamods::import_file_ui("file_import", - title = "Choose a datafile to upload", - file_extensions = c(".csv", ".txt", ".xls", ".xlsx", ".rds", ".fst", ".sas7bdat", ".sav", ".ods", ".dta") - ) - ), - shiny::conditionalPanel( - condition = "input.source=='redcap'", - m_redcap_readUI("redcap_import") - ), - shiny::conditionalPanel( - condition = "input.source=='env'", - import_globalenv_ui(id = "env", title = NULL) - ) - - - # ) + width = "100%" ), - column( - width = 6, - shiny::markdown(readLines("www/intro.md")) - ) - ), - shiny::conditionalPanel( - condition = "input.source=='redcap'", - DT::DTOutput(outputId = "redcap_prev") - ), - shiny::br(), - shiny::actionButton( - inputId = "act_start", - label = "Start", - width = "100%", - icon = shiny::icon("play") - ), - shiny::helpText('After importing, hit "Start" or navigate to the desired tab.'), - shiny::br(), - shiny::br() + shiny::conditionalPanel( + condition = "input.source=='file'", + datamods::import_file_ui("file_import", + title = "Choose a datafile to upload", + file_extensions = c(".csv", ".txt", ".xls", ".xlsx", ".rds", ".fst", ".sas7bdat", ".sav", ".ods", ".dta") + ) + ), + shiny::conditionalPanel( + condition = "input.source=='redcap'", + m_redcap_readUI("redcap_import") + ), + shiny::conditionalPanel( + condition = "input.source=='env'", + import_globalenv_ui(id = "env", title = NULL) + ), + shiny::conditionalPanel( + condition = "input.source=='redcap'", + DT::DTOutput(outputId = "redcap_prev") + ), + shiny::br(), + shiny::actionButton( + inputId = "act_start", + label = "Start", + width = "100%", + icon = shiny::icon("play") + ), + shiny::helpText('After importing, hit "Start" or navigate to the desired tab.'), + shiny::br(), + shiny::br() + ) ), ############################################################################## ######### @@ -1977,47 +3013,24 @@ ui_elements <- list( ######### ############################################################################## "overview" = - # bslib::nav_panel_hidden( + # bslib::nav_panel_hidden( bslib::nav_panel( # value = "overview", - title = "Modifications", + title = "Data", bslib::navset_bar( fillable = TRUE, - # bslib::nav_panel( - # title = "Edit", - # datamods::edit_data_ui(id = "edit_data") - # ), - # bslib::nav_panel( - # title = "Overview", - # DT::DTOutput(outputId = "table") - # ), bslib::nav_panel( - title = "Rename and select", - tags$h3("Select, rename and convert variables"), + title = "Summary & filter", + tags$h3("Data summary and filtering"), fluidRow( - column( - width = 6, - # radioButtons(), - shiny::actionButton("data_reset", "Restore original data"), - shiny::tags$br(), - shiny::helpText("Reset to original imported dataset"), - shiny::tags$br(), - datamods::update_variables_ui("vars_update") - ), - column( - width = 6, - tags$b("Original data:"), - # verbatimTextOutput("original"), - verbatimTextOutput("original_str"), - tags$b("Modified data:"), - # verbatimTextOutput("modified"), - verbatimTextOutput("modified_str") + shiny::column( + width = 9, + shiny::tags$p( + "Below is a short summary table of the provided data. + On the right hand side you have the option to create filters. + At the bottom you'll find a raw overview of the original vs the modified data.") ) - ) - ), - bslib::nav_panel( - title = "Filter and modify", - shinyWidgets::html_dependency_winbox(), + ), fluidRow( # column( # width = 3, @@ -2034,23 +3047,117 @@ ui_elements <- list( # verbatimTextOutput(outputId = "filtered_code") # ), shiny::column( - width = 8, - toastui::datagridOutput(outputId = "table_mod"), + width = 9, + toastui::datagridOutput(outputId = "tbl_overview"), + # data_summary_ui(id = "data_summary"), shiny::tags$b("Reproducible code:"), shiny::verbatimTextOutput(outputId = "filtered_code") ), shiny::column( - width = 4, - shiny::actionButton("modal_cut", "Create factor from a variable"), + width = 3, + IDEAFilter::IDEAFilter_ui("data_filter") # , + # shiny::actionButton("save_filter", "Apply the filter") + ) + ), + fluidRow( + column( + width = 6, + tags$b("Original data:"), + # verbatimTextOutput("original"), + verbatimTextOutput("original_str") + ), + column( + width = 6, + tags$b("Modified data:"), + # verbatimTextOutput("modified"), + verbatimTextOutput("modified_str") + ) + ) + ), + # bslib::nav_panel( + # title = "Overview", + # DT::DTOutput(outputId = "table") + # ), + bslib::nav_panel( + title = "Modify", + tags$h3("Subset, rename and convert variables"), + fluidRow( + shiny::column( + width = 9, + shiny::tags$p("Below, you can subset the data (by not selecting the variables to exclude on applying changes), rename variables, set new labels (for nicer tables in the analysis report) and change variable classes. + Italic text can be edited/changed. + On the right, you can create and modify factor/categorical variables as well as resetting the data to the originally imported data.") + ) + ), + fluidRow( + shiny::column( + width = 9, + update_variables_ui("vars_update") + ), + shiny::column( + width = 3, + shiny::actionButton("modal_cut", "Create factor variable"), + shiny::tags$br(), + shiny::helpText("Create factor/categorical variable from an other value."), shiny::tags$br(), shiny::tags$br(), shiny::actionButton("modal_update", "Reorder factor levels"), shiny::tags$br(), + shiny::helpText("Reorder the levels of factor/categorical variables."), shiny::tags$br(), - IDEAFilter::IDEAFilter_ui("data_filter") # , + shiny::tags$br(), + shiny::actionButton("data_reset", "Restore original data"), + shiny::tags$br(), + shiny::helpText("Reset to original imported dataset. Careful! There is no un-doing."), + shiny::tags$br() # , + # shiny::tags$br(), + # shiny::tags$br(), + # IDEAFilter::IDEAFilter_ui("data_filter") # , # shiny::actionButton("save_filter", "Apply the filter") ) + # datamods::update_variables_ui("vars_update") ) + ), + bslib::nav_panel( + title = "Browser", + tags$h3("Browse the provided data"), + shiny::tags$p( + "Below is a data table with all the modified data provided to browse and understand data." + ), + shinyWidgets::html_dependency_winbox(), + # fluidRow( + # column( + # width = 3, + # shiny::uiOutput("filter_vars"), + # shiny::conditionalPanel( + # condition = "(typeof input.filter_vars !== 'undefined' && input.filter_vars.length > 0)", + # datamods::filter_data_ui("filtering", max_height = "500px") + # ) + # ), + # column( + # width = 9, + # DT::DTOutput(outputId = "filtered_table"), + # tags$b("Code dplyr:"), + # verbatimTextOutput(outputId = "filtered_code") + # ), + # shiny::column( + # width = 8, + toastui::datagridOutput(outputId = "table_mod") # , + # shiny::tags$b("Reproducible code:"), + # shiny::verbatimTextOutput(outputId = "filtered_code") + # ), + # shiny::column( + # width = 4, + # shiny::actionButton("modal_cut", "Create factor from a variable"), + # shiny::tags$br(), + # shiny::tags$br(), + # shiny::actionButton("modal_update", "Reorder factor levels")#, + # # shiny::tags$br(), + # # shiny::tags$br(), + # # IDEAFilter::IDEAFilter_ui("data_filter") # , + # # shiny::actionButton("save_filter", "Apply the filter") + # ) + # ) ) @@ -2068,7 +3175,7 @@ ui_elements <- list( ######### ############################################################################## "analyze" = - # bslib::nav_panel_hidden( + # bslib::nav_panel_hidden( bslib::nav_panel( # value = "analyze", title = "Analyses", @@ -2079,6 +3186,20 @@ ui_elements <- list( sidebar = bslib::sidebar( shiny::helpText(em("Please specify relevant settings for your data, and press 'Analyse'")), shiny::uiOutput("outcome_var"), + shiny::radioButtons( + inputId = "all", + label = "Specify covariables", + inline = TRUE, selected = 2, + choiceNames = c( + "Yes", + "No" + ), + choiceValues = c(1, 2) + ), + shiny::conditionalPanel( + condition = "input.all==1", + shiny::uiOutput("include_vars") + ), shiny::uiOutput("strat_var"), shiny::conditionalPanel( condition = "input.strat_var!='none'", @@ -2094,20 +3215,6 @@ ui_elements <- list( ), shiny::helpText("Option to perform statistical comparisons between strata in baseline table.") ), - shiny::radioButtons( - inputId = "all", - label = "Specify covariables", - inline = TRUE, selected = 2, - choiceNames = c( - "Yes", - "No" - ), - choiceValues = c(1, 2) - ), - shiny::conditionalPanel( - condition = "input.all==1", - shiny::uiOutput("include_vars") - ), shiny::radioButtons( inputId = "specify_factors", label = "Specify categorical variables?", @@ -2128,8 +3235,8 @@ ui_elements <- list( icon = shiny::icon("pencil", lib = "glyphicon"), label_busy = "Working...", icon_busy = fontawesome::fa_i("arrows-rotate", - class = "fa-spin", - "aria-hidden" = "true" + class = "fa-spin", + "aria-hidden" = "true" ), type = "secondary", auto_reset = TRUE @@ -2156,13 +3263,29 @@ ui_elements <- list( # Button shiny::downloadButton( outputId = "report", - label = "Download", + 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.") - ## https://github.com/quarto-dev/quarto-cli/issues/7151 - # ) - # ) + 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("Download data"), + shiny::helpText("Choose your favourite output data format to download the modified data."), + shiny::selectInput( + inputId = "data_type", + label = "Data format", + selected = NULL, + choices = list( + "R" = "rds", + "stata" = "dta" + ) + ), + shiny::br(), + # Button + shiny::downloadButton( + outputId = "data_modified", + label = "Download data", + icon = shiny::icon("download") + ) ), bslib::nav_panel( title = "Baseline characteristics", @@ -2201,28 +3324,39 @@ dark <- custom_theme( # Fonts to consider: # https://webdesignerdepot.com/17-open-source-fonts-youll-actually-love/ -ui <- bslib::page_fluid( +ui <- bslib::page_fixed( + shiny::tags$style( + type = "text/css", + # add the name of the tab you want to use as title in data-value + shiny::HTML( + ".container-fluid > .nav > li > + a[data-value='freesearcheR'] {font-size: 28px}" + ) + ), title = "freesearcheR", theme = light, shiny::useBusyIndicators(), - bslib::page_navbar(title = "freesearcheR", + bslib::page_navbar( + # title = "freesearcheR", id = "main_panel", # header = shiny::tags$header(shiny::p("Data is only stored temporarily for analysis and deleted immediately afterwards.")), + ui_elements$home, ui_elements$import, ui_elements$overview, ui_elements$analyze, ui_elements$docs, # bslib::nav_spacer(), # bslib::nav_item(shinyWidgets::circleButton(inputId = "mode", icon = icon("moon"),status = "primary")), - fillable = TRUE, + fillable = FALSE, footer = shiny::tags$footer( 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 immediately afterwards."), + "Data is only stored for analyses and deleted immediately afterwards." + ), shiny::p( style = "margin: 1; color: #888;", - "Andreas G Damsbo | AGPLv3 license | ", shiny::tags$a("Source on Github", href = "https://github.com/agdamsbo/freesearcheR/", target="_blank", rel="noopener noreferrer") + "Andreas G Damsbo | AGPLv3 license | ", shiny::tags$a("Source on Github", href = "https://github.com/agdamsbo/freesearcheR/", target = "_blank", rel = "noopener noreferrer") ), ) ) @@ -2230,7 +3364,7 @@ ui <- bslib::page_fluid( ######## -#### Current file: /Users/au301842/freesearcheR/inst/apps/data_analysis_modules/server.R +#### Current file: /Users/au301842/freesearcheR/inst/apps/data_analysis_modules/server.R ######## library(readr) @@ -2253,8 +3387,10 @@ library(broom.helpers) library(easystats) library(patchwork) library(DHARMa) -library(datamods) +library(apexcharter) library(toastui) +library(datamods) +library(data.table) library(IDEAFilter) library(shinyWidgets) library(DT) @@ -2274,9 +3410,9 @@ server <- function(input, output, session) { ## everything else. files.to.keep <- list.files("www/") - output$docs_file <- renderUI({ + output$docs_file <- shiny::renderUI({ # shiny::includeHTML("www/docs.html") - HTML(readLines("www/docs.html")) + shiny::HTML(readLines("www/docs.html")) }) ############################################################################## @@ -2371,17 +3507,35 @@ server <- function(input, output, session) { rv$data_original <- from_env$data() }) + ############################################################################## ######### ######### Data modification section ######### ############################################################################## - ######### Modifications - shiny::observeEvent(rv$data_original, rv$data <- rv$data_original |> default_parsing()) shiny::observeEvent(input$data_reset, rv$data <- rv$data_original |> default_parsing()) + ######### Overview + + output$tbl_overview <- toastui::renderDatagrid( + data_filter() |> + overview_vars() |> + create_overview_datagrid()|> + add_sparkline( + column = "vals", + color.main = "#2A004E", + color.sec = "#C62300" + ) + ) + + # data_summary_server(id = "data_summary", + # data = data_filter()) + + ######### 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 @@ -2422,7 +3576,8 @@ server <- function(input, output, session) { attr(rv$data, "code") }) - updated_data <- datamods::update_variables_server( + # updated_data <- datamods::update_variables_server( + updated_data <- update_variables_server( id = "vars_update", data = reactive(rv$data), return_data_on_init = FALSE @@ -2436,7 +3591,7 @@ server <- function(input, output, session) { str(rv$data) }) - observeEvent(updated_data(), { + shiny::observeEvent(updated_data(), { rv$data <- updated_data() }) @@ -2543,10 +3698,6 @@ server <- function(input, output, session) { # gt::gt() # }) - shiny::observeEvent(input$act_start, { - bslib::nav_select(id = "main_panel", selected = "Modifications") - }) - shiny::observeEvent( { input$load @@ -2561,7 +3712,8 @@ server <- function(input, output, session) { data <- data_filter() |> dplyr::mutate(dplyr::across(dplyr::where(is.character), as.factor)) |> REDCapCAST::fct_drop.data.frame() |> - factorize(vars = input$factor_vars) + factorize(vars = input$factor_vars) |> + remove_na_attr() if (input$strat_var == "none") { by.var <- NULL @@ -2714,7 +3866,22 @@ server <- function(input, output, session) { # ) # }) + ############################################################################## + ######### + ######### Page navigation + ######### + ############################################################################## + shiny::observeEvent(input$act_start, { + bslib::nav_select(id = "main_panel", selected = "Modifications") + }) + + + ############################################################################## + ######### + ######### Reactivity + ######### + ############################################################################## output$uploaded <- shiny::reactive({ if (is.null(rv$ds)) { @@ -2747,6 +3914,12 @@ server <- function(input, output, session) { # shiny::outputOptions(output, "has_input", 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 @@ -2768,6 +3941,26 @@ server <- function(input, output, session) { } ) + 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 { + haven::write_dta(as.data.frame(rv$list$data),path = file) + } + + } + ) + + ############################################################################## + ######### + ######### Clearing the session on end + ######### + ############################################################################## + session$onSessionEnded(function() { cat("Session Ended\n") files <- list.files("www/") @@ -2780,7 +3973,7 @@ server <- function(input, output, session) { ######## -#### Current file: /Users/au301842/freesearcheR/inst/apps/data_analysis_modules/launch.R +#### Current file: /Users/au301842/freesearcheR/inst/apps/data_analysis_modules/launch.R ######## shinyApp(ui, server) diff --git a/inst/apps/data_analysis_modules/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf b/inst/apps/data_analysis_modules/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf index 07d9f7c..93a22a8 100644 --- a/inst/apps/data_analysis_modules/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf +++ b/inst/apps/data_analysis_modules/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf @@ -5,6 +5,6 @@ account: agdamsbo server: shinyapps.io hostUrl: https://api.shinyapps.io/v1 appId: 13611288 -bundleId: 9546880 +bundleId: 9641114 url: https://agdamsbo.shinyapps.io/freesearcheR/ version: 1 diff --git a/inst/apps/data_analysis_modules/server.R b/inst/apps/data_analysis_modules/server.R index 43a14bc..42503fe 100644 --- a/inst/apps/data_analysis_modules/server.R +++ b/inst/apps/data_analysis_modules/server.R @@ -18,8 +18,10 @@ library(broom.helpers) library(easystats) library(patchwork) library(DHARMa) -library(datamods) +library(apexcharter) library(toastui) +library(datamods) +library(data.table) library(IDEAFilter) library(shinyWidgets) library(DT) @@ -39,9 +41,9 @@ server <- function(input, output, session) { ## everything else. files.to.keep <- list.files("www/") - output$docs_file <- renderUI({ + output$docs_file <- shiny::renderUI({ # shiny::includeHTML("www/docs.html") - HTML(readLines("www/docs.html")) + shiny::HTML(readLines("www/docs.html")) }) ############################################################################## @@ -136,17 +138,35 @@ server <- function(input, output, session) { rv$data_original <- from_env$data() }) + ############################################################################## ######### ######### Data modification section ######### ############################################################################## - ######### Modifications - shiny::observeEvent(rv$data_original, rv$data <- rv$data_original |> default_parsing()) shiny::observeEvent(input$data_reset, rv$data <- rv$data_original |> default_parsing()) + ######### Overview + + output$tbl_overview <- toastui::renderDatagrid( + data_filter() |> + overview_vars() |> + create_overview_datagrid()|> + add_sparkline( + column = "vals", + color.main = "#2A004E", + color.sec = "#C62300" + ) + ) + + # data_summary_server(id = "data_summary", + # data = data_filter()) + + ######### 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 @@ -187,7 +207,8 @@ server <- function(input, output, session) { attr(rv$data, "code") }) - updated_data <- datamods::update_variables_server( + # updated_data <- datamods::update_variables_server( + updated_data <- update_variables_server( id = "vars_update", data = reactive(rv$data), return_data_on_init = FALSE @@ -201,7 +222,7 @@ server <- function(input, output, session) { str(rv$data) }) - observeEvent(updated_data(), { + shiny::observeEvent(updated_data(), { rv$data <- updated_data() }) @@ -308,10 +329,6 @@ server <- function(input, output, session) { # gt::gt() # }) - shiny::observeEvent(input$act_start, { - bslib::nav_select(id = "main_panel", selected = "Modifications") - }) - shiny::observeEvent( { input$load @@ -326,7 +343,8 @@ server <- function(input, output, session) { data <- data_filter() |> dplyr::mutate(dplyr::across(dplyr::where(is.character), as.factor)) |> REDCapCAST::fct_drop.data.frame() |> - factorize(vars = input$factor_vars) + factorize(vars = input$factor_vars) |> + remove_na_attr() if (input$strat_var == "none") { by.var <- NULL @@ -479,7 +497,22 @@ server <- function(input, output, session) { # ) # }) + ############################################################################## + ######### + ######### Page navigation + ######### + ############################################################################## + shiny::observeEvent(input$act_start, { + bslib::nav_select(id = "main_panel", selected = "Modifications") + }) + + + ############################################################################## + ######### + ######### Reactivity + ######### + ############################################################################## output$uploaded <- shiny::reactive({ if (is.null(rv$ds)) { @@ -512,6 +545,12 @@ server <- function(input, output, session) { # shiny::outputOptions(output, "has_input", 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 @@ -533,6 +572,26 @@ server <- function(input, output, session) { } ) + 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 { + haven::write_dta(as.data.frame(rv$list$data),path = file) + } + + } + ) + + ############################################################################## + ######### + ######### Clearing the session on end + ######### + ############################################################################## + session$onSessionEnded(function() { cat("Session Ended\n") files <- list.files("www/") diff --git a/inst/apps/data_analysis_modules/ui.R b/inst/apps/data_analysis_modules/ui.R index 7471e72..3f76cfc 100644 --- a/inst/apps/data_analysis_modules/ui.R +++ b/inst/apps/data_analysis_modules/ui.R @@ -1,6 +1,16 @@ # ns <- NS(id) ui_elements <- list( + ############################################################################## + ######### + ######### Home panel + ######### + ############################################################################## + "home" = bslib::nav_panel( + title = "freesearcheR", + shiny::markdown(readLines("www/intro.md")), + icon = shiny::icon("home") + ), ############################################################################## ######### ######### Import panel @@ -8,70 +18,61 @@ ui_elements <- list( ############################################################################## "import" = bslib::nav_panel( title = "Import", - shiny::fluidRow( - column( - width = 6, - shiny::h4("Choose your data source"), - # shiny::conditionalPanel( - # condition = "output.has_input=='yes'", - # # Input: Select a file ---- - # shiny::helpText("Analyses are performed on provided data") + shiny::tagList( + shiny::h4("Choose your data source"), + # shiny::conditionalPanel( + # condition = "output.has_input=='yes'", + # # Input: Select a file ---- + # shiny::helpText("Analyses are performed on provided data") + # ), + # shiny::conditionalPanel( + # condition = "output.has_input=='no'", + # Input: Select a file ---- + shinyWidgets::radioGroupButtons( + inputId = "source", + selected = "env", + # label = "Choice: ", + choices = c( + "File upload" = "file", + "REDCap server" = "redcap", + "Local data" = "env" + ), + # checkIcon = list( + # yes = icon("square-check"), + # no = icon("square") # ), - # shiny::conditionalPanel( - # condition = "output.has_input=='no'", - # Input: Select a file ---- - shinyWidgets::radioGroupButtons( - inputId = "source", - # label = "Choice: ", - choices = c( - "File upload" = "file", - "REDCap server" = "redcap", - "Local data" = "env" - ), - # checkIcon = list( - # yes = icon("square-check"), - # no = icon("square") - # ), - width = "100%" - ), - shiny::conditionalPanel( - condition = "input.source=='file'", - datamods::import_file_ui("file_import", - title = "Choose a datafile to upload", - file_extensions = c(".csv", ".txt", ".xls", ".xlsx", ".rds", ".fst", ".sas7bdat", ".sav", ".ods", ".dta") - ) - ), - shiny::conditionalPanel( - condition = "input.source=='redcap'", - m_redcap_readUI("redcap_import") - ), - shiny::conditionalPanel( - condition = "input.source=='env'", - import_globalenv_ui(id = "env", title = NULL) - ) - - - # ) + width = "100%" ), - column( - width = 6, - shiny::markdown(readLines("www/intro.md")) - ) - ), - shiny::conditionalPanel( - condition = "input.source=='redcap'", - DT::DTOutput(outputId = "redcap_prev") - ), - shiny::br(), - shiny::actionButton( - inputId = "act_start", - label = "Start", - width = "100%", - icon = shiny::icon("play") - ), - shiny::helpText('After importing, hit "Start" or navigate to the desired tab.'), - shiny::br(), - shiny::br() + shiny::conditionalPanel( + condition = "input.source=='file'", + datamods::import_file_ui("file_import", + title = "Choose a datafile to upload", + file_extensions = c(".csv", ".txt", ".xls", ".xlsx", ".rds", ".fst", ".sas7bdat", ".sav", ".ods", ".dta") + ) + ), + shiny::conditionalPanel( + condition = "input.source=='redcap'", + m_redcap_readUI("redcap_import") + ), + shiny::conditionalPanel( + condition = "input.source=='env'", + import_globalenv_ui(id = "env", title = NULL) + ), + shiny::conditionalPanel( + condition = "input.source=='redcap'", + DT::DTOutput(outputId = "redcap_prev") + ), + shiny::br(), + shiny::actionButton( + inputId = "act_start", + label = "Start", + width = "100%", + icon = shiny::icon("play") + ), + shiny::helpText('After importing, hit "Start" or navigate to the desired tab.'), + shiny::br(), + shiny::br() + ) ), ############################################################################## ######### @@ -79,47 +80,24 @@ ui_elements <- list( ######### ############################################################################## "overview" = - # bslib::nav_panel_hidden( + # bslib::nav_panel_hidden( bslib::nav_panel( # value = "overview", - title = "Modifications", + title = "Data", bslib::navset_bar( fillable = TRUE, - # bslib::nav_panel( - # title = "Edit", - # datamods::edit_data_ui(id = "edit_data") - # ), - # bslib::nav_panel( - # title = "Overview", - # DT::DTOutput(outputId = "table") - # ), bslib::nav_panel( - title = "Rename and select", - tags$h3("Select, rename and convert variables"), + title = "Summary & filter", + tags$h3("Data summary and filtering"), fluidRow( - column( - width = 6, - # radioButtons(), - shiny::actionButton("data_reset", "Restore original data"), - shiny::tags$br(), - shiny::helpText("Reset to original imported dataset"), - shiny::tags$br(), - datamods::update_variables_ui("vars_update") - ), - column( - width = 6, - tags$b("Original data:"), - # verbatimTextOutput("original"), - verbatimTextOutput("original_str"), - tags$b("Modified data:"), - # verbatimTextOutput("modified"), - verbatimTextOutput("modified_str") + shiny::column( + width = 9, + shiny::tags$p( + "Below is a short summary table of the provided data. + On the right hand side you have the option to create filters. + At the bottom you'll find a raw overview of the original vs the modified data.") ) - ) - ), - bslib::nav_panel( - title = "Filter and modify", - shinyWidgets::html_dependency_winbox(), + ), fluidRow( # column( # width = 3, @@ -136,23 +114,117 @@ ui_elements <- list( # verbatimTextOutput(outputId = "filtered_code") # ), shiny::column( - width = 8, - toastui::datagridOutput(outputId = "table_mod"), + width = 9, + toastui::datagridOutput(outputId = "tbl_overview"), + # data_summary_ui(id = "data_summary"), shiny::tags$b("Reproducible code:"), shiny::verbatimTextOutput(outputId = "filtered_code") ), shiny::column( - width = 4, - shiny::actionButton("modal_cut", "Create factor from a variable"), + width = 3, + IDEAFilter::IDEAFilter_ui("data_filter") # , + # shiny::actionButton("save_filter", "Apply the filter") + ) + ), + fluidRow( + column( + width = 6, + tags$b("Original data:"), + # verbatimTextOutput("original"), + verbatimTextOutput("original_str") + ), + column( + width = 6, + tags$b("Modified data:"), + # verbatimTextOutput("modified"), + verbatimTextOutput("modified_str") + ) + ) + ), + # bslib::nav_panel( + # title = "Overview", + # DT::DTOutput(outputId = "table") + # ), + bslib::nav_panel( + title = "Modify", + tags$h3("Subset, rename and convert variables"), + fluidRow( + shiny::column( + width = 9, + shiny::tags$p("Below, you can subset the data (by not selecting the variables to exclude on applying changes), rename variables, set new labels (for nicer tables in the analysis report) and change variable classes. + Italic text can be edited/changed. + On the right, you can create and modify factor/categorical variables as well as resetting the data to the originally imported data.") + ) + ), + fluidRow( + shiny::column( + width = 9, + update_variables_ui("vars_update") + ), + shiny::column( + width = 3, + shiny::actionButton("modal_cut", "Create factor variable"), + shiny::tags$br(), + shiny::helpText("Create factor/categorical variable from an other value."), shiny::tags$br(), shiny::tags$br(), shiny::actionButton("modal_update", "Reorder factor levels"), shiny::tags$br(), + shiny::helpText("Reorder the levels of factor/categorical variables."), shiny::tags$br(), - IDEAFilter::IDEAFilter_ui("data_filter") # , + shiny::tags$br(), + shiny::actionButton("data_reset", "Restore original data"), + shiny::tags$br(), + shiny::helpText("Reset to original imported dataset. Careful! There is no un-doing."), + shiny::tags$br() # , + # shiny::tags$br(), + # shiny::tags$br(), + # IDEAFilter::IDEAFilter_ui("data_filter") # , # shiny::actionButton("save_filter", "Apply the filter") ) + # datamods::update_variables_ui("vars_update") ) + ), + bslib::nav_panel( + title = "Browser", + tags$h3("Browse the provided data"), + shiny::tags$p( + "Below is a data table with all the modified data provided to browse and understand data." + ), + shinyWidgets::html_dependency_winbox(), + # fluidRow( + # column( + # width = 3, + # shiny::uiOutput("filter_vars"), + # shiny::conditionalPanel( + # condition = "(typeof input.filter_vars !== 'undefined' && input.filter_vars.length > 0)", + # datamods::filter_data_ui("filtering", max_height = "500px") + # ) + # ), + # column( + # width = 9, + # DT::DTOutput(outputId = "filtered_table"), + # tags$b("Code dplyr:"), + # verbatimTextOutput(outputId = "filtered_code") + # ), + # shiny::column( + # width = 8, + toastui::datagridOutput(outputId = "table_mod") # , + # shiny::tags$b("Reproducible code:"), + # shiny::verbatimTextOutput(outputId = "filtered_code") + # ), + # shiny::column( + # width = 4, + # shiny::actionButton("modal_cut", "Create factor from a variable"), + # shiny::tags$br(), + # shiny::tags$br(), + # shiny::actionButton("modal_update", "Reorder factor levels")#, + # # shiny::tags$br(), + # # shiny::tags$br(), + # # IDEAFilter::IDEAFilter_ui("data_filter") # , + # # shiny::actionButton("save_filter", "Apply the filter") + # ) + # ) ) @@ -170,7 +242,7 @@ ui_elements <- list( ######### ############################################################################## "analyze" = - # bslib::nav_panel_hidden( + # bslib::nav_panel_hidden( bslib::nav_panel( # value = "analyze", title = "Analyses", @@ -181,6 +253,20 @@ ui_elements <- list( sidebar = bslib::sidebar( shiny::helpText(em("Please specify relevant settings for your data, and press 'Analyse'")), shiny::uiOutput("outcome_var"), + shiny::radioButtons( + inputId = "all", + label = "Specify covariables", + inline = TRUE, selected = 2, + choiceNames = c( + "Yes", + "No" + ), + choiceValues = c(1, 2) + ), + shiny::conditionalPanel( + condition = "input.all==1", + shiny::uiOutput("include_vars") + ), shiny::uiOutput("strat_var"), shiny::conditionalPanel( condition = "input.strat_var!='none'", @@ -196,20 +282,6 @@ ui_elements <- list( ), shiny::helpText("Option to perform statistical comparisons between strata in baseline table.") ), - shiny::radioButtons( - inputId = "all", - label = "Specify covariables", - inline = TRUE, selected = 2, - choiceNames = c( - "Yes", - "No" - ), - choiceValues = c(1, 2) - ), - shiny::conditionalPanel( - condition = "input.all==1", - shiny::uiOutput("include_vars") - ), shiny::radioButtons( inputId = "specify_factors", label = "Specify categorical variables?", @@ -230,8 +302,8 @@ ui_elements <- list( icon = shiny::icon("pencil", lib = "glyphicon"), label_busy = "Working...", icon_busy = fontawesome::fa_i("arrows-rotate", - class = "fa-spin", - "aria-hidden" = "true" + class = "fa-spin", + "aria-hidden" = "true" ), type = "secondary", auto_reset = TRUE @@ -258,13 +330,29 @@ ui_elements <- list( # Button shiny::downloadButton( outputId = "report", - label = "Download", + 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.") - ## https://github.com/quarto-dev/quarto-cli/issues/7151 - # ) - # ) + 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("Download data"), + shiny::helpText("Choose your favourite output data format to download the modified data."), + shiny::selectInput( + inputId = "data_type", + label = "Data format", + selected = NULL, + choices = list( + "R" = "rds", + "stata" = "dta" + ) + ), + shiny::br(), + # Button + shiny::downloadButton( + outputId = "data_modified", + label = "Download data", + icon = shiny::icon("download") + ) ), bslib::nav_panel( title = "Baseline characteristics", @@ -303,28 +391,39 @@ dark <- custom_theme( # Fonts to consider: # https://webdesignerdepot.com/17-open-source-fonts-youll-actually-love/ -ui <- bslib::page_fluid( +ui <- bslib::page_fixed( + shiny::tags$style( + type = "text/css", + # add the name of the tab you want to use as title in data-value + shiny::HTML( + ".container-fluid > .nav > li > + a[data-value='freesearcheR'] {font-size: 28px}" + ) + ), title = "freesearcheR", theme = light, shiny::useBusyIndicators(), - bslib::page_navbar(title = "freesearcheR", + bslib::page_navbar( + # title = "freesearcheR", id = "main_panel", # header = shiny::tags$header(shiny::p("Data is only stored temporarily for analysis and deleted immediately afterwards.")), + ui_elements$home, ui_elements$import, ui_elements$overview, ui_elements$analyze, ui_elements$docs, # bslib::nav_spacer(), # bslib::nav_item(shinyWidgets::circleButton(inputId = "mode", icon = icon("moon"),status = "primary")), - fillable = TRUE, + fillable = FALSE, footer = shiny::tags$footer( 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 immediately afterwards."), + "Data is only stored for analyses and deleted immediately afterwards." + ), shiny::p( style = "margin: 1; color: #888;", - "Andreas G Damsbo | AGPLv3 license | ", shiny::tags$a("Source on Github", href = "https://github.com/agdamsbo/freesearcheR/", target="_blank", rel="noopener noreferrer") + "Andreas G Damsbo | AGPLv3 license | ", shiny::tags$a("Source on Github", href = "https://github.com/agdamsbo/freesearcheR/", target = "_blank", rel = "noopener noreferrer") ), ) ) diff --git a/inst/apps/data_analysis_modules/www/docs.html b/inst/apps/data_analysis_modules/www/docs.html index f81c0e8..9c2ae4b 100644 --- a/inst/apps/data_analysis_modules/www/docs.html +++ b/inst/apps/data_analysis_modules/www/docs.html @@ -56,7 +56,7 @@ margin: 0 0.8em 0.2em -1em; vertical-align: middle;

    • -

    • +

    • diff --git a/inst/apps/data_analysis_modules/www/docs.qmd b/inst/apps/data_analysis_modules/www/docs.qmd index aced028..58b5a30 100644 --- a/inst/apps/data_analysis_modules/www/docs.qmd +++ b/inst/apps/data_analysis_modules/www/docs.qmd @@ -36,7 +36,7 @@ Contributions are very welcome. If you find anything odd, or you think of featur - [ ] Plot regression analyses results -- [ ] Export modified data +- [x] Export modified data. 2025-01-09 - [ ] Include reproducible code for all steps diff --git a/inst/apps/data_analysis_modules/www/intro.html b/inst/apps/data_analysis_modules/www/intro.html new file mode 100644 index 0000000..cea20b0 --- /dev/null +++ b/inst/apps/data_analysis_modules/www/intro.html @@ -0,0 +1,432 @@ + + + + + + + + + + + + + +intro + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    + + + + + + + +
    +

    Welcome

    +

    This is the freesearchR web data analysis +tool. We intend the freesearchR to be a +powerful and free tool for easy data evaluation and analysis at the +hands of the clinician.

    +

    By intention, this tool has been designed to be simple to use with a +minimum of mandatory options to keep the workflow streamlined, while +also including a few options to go even further.

    +

    There are four simple steps to go through:

    +
      +

    1. “Import +data” (a spreadsheet/file on your machine, direct export from a +REDCap server, or a local file provided with a package) to get +started.

      2. +

    2. An optional step of data modification (change variable +classes and creating categorical variables (factors) from numeric or +time data)

      3. +

    3. Data analysis of cross-sectionally designed studies (more study +designs are planned to be included)

      +
        +

      • Classic baseline charactieristics (options to stratify and +compare variables)

        • +

      • Linear, dichotomous or ordinal logistic regression will be used +depending on specified outcome variable

        • +

      • Evaluation of model assumptions

        • +
      4. +

    4. Export the the analyses results as for MS Word or LibreOffice.

      5. +
    +
    + + + + +
    + + + + + + + + + + + + + + + diff --git a/inst/apps/data_analysis_modules/www/intro.md b/inst/apps/data_analysis_modules/www/intro.md index d758d3e..38c436e 100644 --- a/inst/apps/data_analysis_modules/www/intro.md +++ b/inst/apps/data_analysis_modules/www/intro.md @@ -1,12 +1,12 @@ # Welcome -This is the ***freesearchR*** web data analysis tool. We intend the ***freesearchR*** to be a powerful and free tool for easy data evaluation and analysis at the hands of the clinician. +This is the ***freesearcheR*** web data analysis tool. We intend the ***freesearcheR*** to be a powerful and free tool for easy data evaluation and analysis at the hands of the clinician. By intention, this tool has been designed to be simple to use with a minimum of mandatory options to keep the workflow streamlined, while also including a few options to go even further. -There are four simple steps to go through: +There are four simple steps to go through (see corresponding tabs in the top): -1. Import data (a spreadsheet/file on your machine, direct export from a REDCap server, or a local file provided with a package). +1. Import data (a spreadsheet/file on your machine, direct export from a REDCap server, or a local file provided with a package) to get started. 2. An *optional* step of data modification (change variable classes and creating categorical variables (factors) from numeric or time data) @@ -18,4 +18,4 @@ There are four simple steps to go through: - Evaluation of model assumptions -4. Export the the analyses results as for MS Word or [LibreOffice](https://www.libreoffice.org/). +4. Export the the analyses results for MS Word or [LibreOffice](https://www.libreoffice.org/) as well as the data with preserved metadata. diff --git a/inst/apps/teal_test/app.R b/inst/apps/teal_test/app.R index d729897..24292d9 100644 --- a/inst/apps/teal_test/app.R +++ b/inst/apps/teal_test/app.R @@ -97,9 +97,9 @@ footer <- tags$p( # redcap_browser_app <- teal_init(data = tdm_data_upload) app <- teal::init( - # data=tdm_data_read, + data=tdm_data_read, # data = tdm_data_upload, - data = tdm_redcap_read, + # data = tdm_redcap_read, filter = filters, modules = modules( tm_data_table("Data Table"), diff --git a/renv.lock b/renv.lock index 15e502d..f46112e 100644 --- a/renv.lock +++ b/renv.lock @@ -57,6 +57,27 @@ ], "Hash": "64ff3427f559ce3f2597a4fe13255cb6" }, + "Deriv": { + "Package": "Deriv", + "Version": "4.1.6", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "methods" + ], + "Hash": "cd52c065c9e687c60c56b51f10f7bcd3" + }, + "Formula": { + "Package": "Formula", + "Version": "1.2-5", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "stats" + ], + "Hash": "7a29697b75e027767a53fde6c903eca7" + }, "IDEAFilter": { "Package": "IDEAFilter", "Version": "0.2.0", @@ -117,6 +138,19 @@ ], "Hash": "5122bb14d8736372411f955e1b16bc8a" }, + "MatrixModels": { + "Package": "MatrixModels", + "Version": "0.5-3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "Matrix", + "R", + "methods", + "stats" + ], + "Hash": "0776bf7526869e0286b0463cb72fb211" + }, "R.cache": { "Package": "R.cache", "Version": "0.16.0", @@ -280,6 +314,20 @@ ], "Hash": "a9e2118c664c2cd694f03de074e8d4b3" }, + "SparseM": { + "Package": "SparseM", + "Version": "1.84-2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "graphics", + "methods", + "stats", + "utils" + ], + "Hash": "e78499cbcbbca98200254bd171379165" + }, "V8": { "Package": "V8", "Version": "6.0.0", @@ -293,6 +341,18 @@ ], "Hash": "6603bfcbc7883a5fed41fb13042a3899" }, + "abind": { + "Package": "abind", + "Version": "1.4-8", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "methods", + "utils" + ], + "Hash": "2288423bb0f20a457800d7fc47f6aa54" + }, "ape": { "Package": "ape", "Version": "5.8-1", @@ -312,6 +372,23 @@ ], "Hash": "54e5b03e928da23e75dc5bb633648d27" }, + "apexcharter": { + "Package": "apexcharter", + "Version": "0.4.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "ggplot2", + "htmltools", + "htmlwidgets", + "jsonlite", + "magrittr", + "rlang", + "shiny" + ], + "Hash": "4bad120b4c71a078d8637f9cbe1eb1df" + }, "askpass": { "Package": "askpass", "Version": "1.2.1", @@ -534,6 +611,41 @@ ], "Hash": "d7e13f49c19103ece9e58ad2d83a7354" }, + "car": { + "Package": "car", + "Version": "3.1-3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "Formula", + "MASS", + "R", + "abind", + "carData", + "grDevices", + "graphics", + "lme4", + "mgcv", + "nlme", + "nnet", + "pbkrtest", + "quantreg", + "scales", + "stats", + "utils" + ], + "Hash": "82067bf302d1440b730437693a86406a" + }, + "carData": { + "Package": "carData", + "Version": "3.0-5", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "ac6cdb8552c61bd36b0e54d07cf2aab7" + }, "cards": { "Package": "cards", "Version": "0.4.0", @@ -688,6 +800,23 @@ ], "Hash": "8b6512d8f60685736ee3bafdc292190d" }, + "cowplot": { + "Package": "cowplot", + "Version": "1.1.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "ggplot2", + "grDevices", + "grid", + "gtable", + "methods", + "rlang", + "scales" + ], + "Hash": "8ef2084dd7d28847b374e55440e4f8cb" + }, "cpp11": { "Package": "cpp11", "Version": "0.5.1", @@ -794,6 +923,30 @@ ], "Hash": "33698c4b3127fc9f506654607fb73676" }, + "doBy": { + "Package": "doBy", + "Version": "4.6.24", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "Deriv", + "MASS", + "Matrix", + "R", + "boot", + "broom", + "cowplot", + "dplyr", + "ggplot2", + "methods", + "microbenchmark", + "modelr", + "rlang", + "tibble", + "tidyr" + ], + "Hash": "8ddf795104defe53c5392a588888ec68" + }, "doParallel": { "Package": "doParallel", "Version": "1.0.17", @@ -886,6 +1039,34 @@ ], "Hash": "b289af101f62cb7b46c53d1a45ed5198" }, + "emmeans": { + "Package": "emmeans", + "Version": "1.10.6", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "estimability", + "graphics", + "methods", + "mvtnorm", + "numDeriv", + "stats", + "utils" + ], + "Hash": "6b0c6fcbdbefe525d2ee713f95880f90" + }, + "estimability": { + "Package": "estimability", + "Version": "1.5.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "stats" + ], + "Hash": "21ec52af13afbcab1cb317567b639b0a" + }, "evaluate": { "Package": "evaluate", "Version": "1.0.1", @@ -1141,6 +1322,25 @@ ], "Hash": "14b3b3b923944afb9542dbef4c68bf4b" }, + "ggmosaic": { + "Package": "ggmosaic", + "Version": "0.3.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "dplyr", + "ggplot2", + "ggrepel", + "plotly", + "productplots", + "purrr", + "rlang", + "scales", + "tidyr" + ], + "Hash": "9c716443a2b821aa997c5675386bd34b" + }, "ggplot2": { "Package": "ggplot2", "Version": "3.5.1", @@ -1166,6 +1366,22 @@ ], "Hash": "44c6a2f8202d5b7e878ea274b1092426" }, + "ggrepel": { + "Package": "ggrepel", + "Version": "0.9.6", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "Rcpp", + "ggplot2", + "grid", + "rlang", + "scales", + "withr" + ], + "Hash": "3d4156850acc1161f2f24bc61c9217c1" + }, "glue": { "Package": "glue", "Version": "1.8.0", @@ -1177,6 +1393,20 @@ ], "Hash": "5899f1eaa825580172bb56c08266f37c" }, + "gridExtra": { + "Package": "gridExtra", + "Version": "2.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "grDevices", + "graphics", + "grid", + "gtable", + "utils" + ], + "Hash": "7d7f283939f563670a697165b2cf5560" + }, "gt": { "Package": "gt", "Version": "0.11.1", @@ -1652,6 +1882,18 @@ ], "Hash": "110ee9d83b496279960e162ac97764ce" }, + "microbenchmark": { + "Package": "microbenchmark", + "Version": "1.5.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "graphics", + "stats" + ], + "Hash": "f9d226d88d4087d817d4e616626ce8e5" + }, "mime": { "Package": "mime", "Version": "0.12", @@ -1703,6 +1945,24 @@ ], "Hash": "f519814037d08eee1343c2e7b5992cc4" }, + "modelr": { + "Package": "modelr", + "Version": "0.1.11", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "broom", + "magrittr", + "purrr", + "rlang", + "tibble", + "tidyr", + "tidyselect", + "vctrs" + ], + "Hash": "4f50122dc256b1b6996a4703fecea821" + }, "munsell": { "Package": "munsell", "Version": "0.5.1", @@ -1714,6 +1974,17 @@ ], "Hash": "4fd8900853b746af55b81fda99da7695" }, + "mvtnorm": { + "Package": "mvtnorm", + "Version": "1.3-2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "stats" + ], + "Hash": "9e8405eacb262c0a939e121650247f4b" + }, "nlme": { "Package": "nlme", "Version": "3.1-166", @@ -1735,6 +2006,28 @@ "Repository": "CRAN", "Hash": "27550641889a3abf3aec4d91186311ec" }, + "nnet": { + "Package": "nnet", + "Version": "7.3-19", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "stats", + "utils" + ], + "Hash": "2c797b46eea7fb58ede195bc0b1f1138" + }, + "numDeriv": { + "Package": "numDeriv", + "Version": "2016.8-1.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "df58958f293b166e4ab885ebcad90e02" + }, "officer": { "Package": "officer", "Version": "0.6.7", @@ -1838,6 +2131,24 @@ ], "Hash": "e23fb9ecb1258207bcb763d78d513439" }, + "pbkrtest": { + "Package": "pbkrtest", + "Version": "0.5.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "MASS", + "Matrix", + "R", + "broom", + "doBy", + "dplyr", + "lme4", + "methods", + "numDeriv" + ], + "Hash": "938e6bbc4ac57534f8b43224506a8966" + }, "pbmcapply": { "Package": "pbmcapply", "Version": "1.5.1", @@ -1981,6 +2292,17 @@ ], "Hash": "0c90a7d71988856bad2a2a45dd871bb9" }, + "productplots": { + "Package": "productplots", + "Version": "0.1.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "ggplot2", + "plyr" + ], + "Hash": "75630cc31052ba299a52bb1adbf59fae" + }, "progress": { "Package": "progress", "Version": "1.2.3", @@ -2094,6 +2416,24 @@ ], "Hash": "a22b3777f51fd005a7cd4c2bccc385ae" }, + "quantreg": { + "Package": "quantreg", + "Version": "5.99.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "MASS", + "Matrix", + "MatrixModels", + "R", + "SparseM", + "graphics", + "methods", + "stats", + "survival" + ], + "Hash": "c48844cd7961de506a1b4d22b2e082c7" + }, "quarto": { "Package": "quarto", "Version": "1.4.4", @@ -2484,6 +2824,22 @@ ], "Hash": "836c3464fb0f2ea865ed4c35dcdc1eda" }, + "shinyTree": { + "Package": "shinyTree", + "Version": "0.3.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "htmlwidgets", + "jsonlite", + "methods", + "promises", + "shiny", + "stringr" + ], + "Hash": "0493a0d70f834cb251fe4523eb17b82c" + }, "shinyWidgets": { "Package": "shinyWidgets", "Version": "0.8.7", @@ -2542,6 +2898,19 @@ ], "Hash": "802e4786b353a4bb27116957558548d5" }, + "shinyvalidate": { + "Package": "shinyvalidate", + "Version": "0.1.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "glue", + "htmltools", + "rlang", + "shiny" + ], + "Hash": "fe6e75a1c1722b2d23cb4d4dbe1006df" + }, "sodium": { "Package": "sodium", "Version": "1.4.0", @@ -2619,6 +2988,22 @@ ], "Hash": "93a2b1beac2437bdcc4724f8bf867e2c" }, + "survival": { + "Package": "survival", + "Version": "3.8-3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "Matrix", + "R", + "graphics", + "methods", + "splines", + "stats", + "utils" + ], + "Hash": "fe42836742a4f065b3f3f5de81fccab9" + }, "sys": { "Package": "sys", "Version": "3.4.3", @@ -2714,6 +3099,44 @@ ], "Hash": "b5d3366368999eb2262c2a646a1f0c87" }, + "teal.modules.general": { + "Package": "teal.modules.general", + "Version": "0.3.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "DT", + "R", + "checkmate", + "dplyr", + "forcats", + "ggmosaic", + "ggplot2", + "grid", + "logger", + "scales", + "shiny", + "shinyTree", + "shinyWidgets", + "shinyjs", + "shinyvalidate", + "stats", + "stringr", + "teal", + "teal.code", + "teal.data", + "teal.logger", + "teal.reporter", + "teal.transform", + "teal.widgets", + "tern", + "tibble", + "tidyr", + "tools", + "utils" + ], + "Hash": "f54d7bc27cd048cec3a842f980c74e9b" + }, "teal.reporter": { "Package": "teal.reporter", "Version": "0.3.1", @@ -2766,6 +3189,31 @@ ], "Hash": "a29de94bc89bad9a12a914c17e8269f1" }, + "teal.transform": { + "Package": "teal.transform", + "Version": "0.5.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "checkmate", + "dplyr", + "lifecycle", + "logger", + "methods", + "rlang", + "shiny", + "shinyjs", + "shinyvalidate", + "stats", + "teal.data", + "teal.logger", + "teal.widgets", + "tidyr", + "tidyselect" + ], + "Hash": "988a30f3f0f20b2633b41103a8eb4e56" + }, "teal.widgets": { "Package": "teal.widgets", "Version": "0.4.2", @@ -2789,6 +3237,42 @@ ], "Hash": "46a99bbdcd97f8f25070ad23c3b23ad9" }, + "tern": { + "Package": "tern", + "Version": "0.9.6", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "MASS", + "R", + "Rdpack", + "broom", + "car", + "checkmate", + "cowplot", + "dplyr", + "emmeans", + "forcats", + "formatters", + "ggplot2", + "grid", + "gridExtra", + "gtable", + "labeling", + "lifecycle", + "magrittr", + "methods", + "rlang", + "rtables", + "scales", + "stats", + "survival", + "tibble", + "tidyr", + "utils" + ], + "Hash": "35fe86bc358b15525217e775f5318d33" + }, "textshaping": { "Package": "textshaping", "Version": "0.4.1",