mirror of
https://github.com/agdamsbo/FreesearchR.git
synced 2025-12-15 17:12:09 +01:00
chore: more translatable strings and cleaning
This commit is contained in:
parent
9f9a210c41
commit
be87e97f4d
21 changed files with 757 additions and 879 deletions
|
|
@ -91,6 +91,7 @@ export(missings_validate)
|
|||
export(modal_create_column)
|
||||
export(modal_cut_variable)
|
||||
export(modal_update_factor)
|
||||
export(modal_visual_summary)
|
||||
export(modify_qmd)
|
||||
export(overview_vars)
|
||||
export(pipe_string)
|
||||
|
|
@ -141,6 +142,7 @@ export(validation_ui)
|
|||
export(vectorSelectInput)
|
||||
export(vertical_stacked_bars)
|
||||
export(visual_summary)
|
||||
export(visual_summary_server)
|
||||
export(visual_summary_ui)
|
||||
export(wide2long)
|
||||
export(winbox_create_column)
|
||||
|
|
|
|||
151
R/data-import.R
151
R/data-import.R
|
|
@ -1,151 +0,0 @@
|
|||
data_import_ui <- function(id) {
|
||||
ns <- shiny::NS(id)
|
||||
|
||||
shiny::fluidRow(
|
||||
shiny::column(width = 2),
|
||||
shiny::column(
|
||||
width = 8,
|
||||
shiny::h4("Choose your data source"),
|
||||
shiny::br(),
|
||||
shinyWidgets::radioGroupButtons(
|
||||
inputId = "source",
|
||||
selected = "env",
|
||||
choices = c(
|
||||
"File upload" = "file",
|
||||
"REDCap server export" = "redcap",
|
||||
"Local or sample data" = "env"
|
||||
),
|
||||
width = "100%"
|
||||
),
|
||||
shiny::helpText("Upload a file from your device, get data directly from REDCap or select a sample data set for testing from the app."),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::conditionalPanel(
|
||||
condition = "input.source=='file'",
|
||||
import_file_ui(
|
||||
id = ns("file_import"),
|
||||
layout_params = "dropdown",
|
||||
title = "Choose a datafile to upload",
|
||||
file_extensions = c(".csv", ".tsv", ".txt", ".xls", ".xlsx", ".rds", ".sas7bdat", ".ods", ".dta")
|
||||
)
|
||||
),
|
||||
shiny::conditionalPanel(
|
||||
condition = "input.source=='redcap'",
|
||||
m_redcap_readUI(id = ns("redcap_import"))
|
||||
),
|
||||
shiny::conditionalPanel(
|
||||
condition = "input.source=='env'",
|
||||
datamods::import_globalenv_ui(id = ns("env"), title = NULL)
|
||||
),
|
||||
shiny::conditionalPanel(
|
||||
condition = "input.source=='redcap'",
|
||||
DT::DTOutput(outputId = ns("redcap_prev"))
|
||||
)
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
data_import_server <- function(id) {
|
||||
module <- function(input, output, session) {
|
||||
ns <- session$ns
|
||||
|
||||
rv <- shiny::reactiveValues(
|
||||
data_temp = NULL,
|
||||
code = list()
|
||||
)
|
||||
|
||||
data_file <- import_file_server(
|
||||
id = ns("file_import"),
|
||||
show_data_in = "popup",
|
||||
trigger_return = "change",
|
||||
return_class = "data.frame"
|
||||
)
|
||||
|
||||
shiny::observeEvent(data_file$data(), {
|
||||
shiny::req(data_file$data())
|
||||
|
||||
rv$data_temp <- data_file$data()
|
||||
rv$code <- append_list(data = data_file$code(), list = rv$code, index = "import")
|
||||
})
|
||||
|
||||
data_redcap <- m_redcap_readServer(
|
||||
id = "redcap_import"
|
||||
)
|
||||
|
||||
shiny::observeEvent(data_redcap(), {
|
||||
# rv$data_original <- purrr::pluck(data_redcap(), "data")()
|
||||
rv$data_temp <- data_redcap()
|
||||
})
|
||||
|
||||
from_env <- datamods::import_globalenv_server(
|
||||
id = "env",
|
||||
trigger_return = "change",
|
||||
btn_show_data = FALSE,
|
||||
reset = reactive(input$hidden)
|
||||
)
|
||||
|
||||
shiny::observeEvent(from_env$data(), {
|
||||
shiny::req(from_env$data())
|
||||
|
||||
rv$data_temp <- from_env$data()
|
||||
# rv$code <- append_list(data = from_env$code(),list = rv$code,index = "import")
|
||||
})
|
||||
|
||||
return(list(
|
||||
# status = reactive(temporary_rv$status),
|
||||
# name = reactive(temporary_rv$name),
|
||||
# code = reactive(temporary_rv$code),
|
||||
data = shiny::reactive(rv$data_temp)
|
||||
))
|
||||
|
||||
}
|
||||
|
||||
shiny::moduleServer(
|
||||
id = id,
|
||||
module = module
|
||||
)
|
||||
|
||||
}
|
||||
|
||||
|
||||
#' Test app for the data-import module
|
||||
#'
|
||||
#' @rdname data-import
|
||||
#'
|
||||
#' @examples
|
||||
#' \dontrun{
|
||||
#' data_import_demo_app()
|
||||
#' }
|
||||
data_import_demo_app <- function() {
|
||||
ui <- shiny::fluidPage(
|
||||
data_import_ui("data_import"),
|
||||
toastui::datagridOutput2(outputId = "table"),
|
||||
DT::DTOutput("data_summary")
|
||||
)
|
||||
server <- function(input, output, session) {
|
||||
imported <- shiny::reactive(data_import_server(id = "data_import"))
|
||||
|
||||
# output$data_summary <- DT::renderDataTable(
|
||||
# {
|
||||
# shiny::req(data_val$data)
|
||||
# data_val$data
|
||||
# },
|
||||
# options = list(
|
||||
# scrollX = TRUE,
|
||||
# pageLength = 5
|
||||
# )
|
||||
# )
|
||||
output$table <- toastui::renderDatagrid2({
|
||||
req(imported$data)
|
||||
toastui::datagrid(
|
||||
data = head(imported$data, 5),
|
||||
theme = "striped",
|
||||
colwidths = "guess",
|
||||
minBodyHeight = 250
|
||||
)
|
||||
})
|
||||
|
||||
}
|
||||
shiny::shinyApp(ui, server)
|
||||
}
|
||||
|
|
@ -206,6 +206,9 @@ describe_col_num <- function(x, with_summary = TRUE) {
|
|||
tags$div(
|
||||
i18n$t("Mean:"), round(mean(x, na.rm = TRUE), 2)
|
||||
),
|
||||
tags$div(
|
||||
i18n$t("Median:"), round(median(x, na.rm = TRUE), 2)
|
||||
),
|
||||
tags$div(
|
||||
i18n$t("Max:"), round(max(x, na.rm = TRUE), 2)
|
||||
),
|
||||
|
|
|
|||
|
|
@ -1 +1 @@
|
|||
hosted_version <- function()'v25.9.2-250924'
|
||||
hosted_version <- function()'v25.9.2-250925'
|
||||
|
|
|
|||
|
|
@ -12,20 +12,20 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
|
|||
|
||||
if (isTRUE(title)) {
|
||||
title <- shiny::tags$h4(
|
||||
"Import data from REDCap",
|
||||
i18n$t("Import data from REDCap"),
|
||||
class = "redcap-module-title"
|
||||
)
|
||||
}
|
||||
|
||||
server_ui <- shiny::tagList(
|
||||
shiny::tags$h4("REDCap server"),
|
||||
shiny::tags$h4(i18n$t("REDCap server")),
|
||||
shiny::textInput(
|
||||
inputId = ns("uri"),
|
||||
label = "Web address",
|
||||
label = i18n$t("Web address"),
|
||||
value = if_not_missing(url, "https://redcap.your.institution/"),
|
||||
width = "100%"
|
||||
),
|
||||
shiny::helpText("Format should be either 'https://redcap.your.institution/' or 'https://your.institution/redcap/'"),
|
||||
shiny::helpText(i18n$t("Format should be either 'https://redcap.your.institution/' or 'https://your.institution/redcap/'")),
|
||||
# shiny::textInput(
|
||||
# inputId = ns("api"),
|
||||
# label = "API token",
|
||||
|
|
@ -34,16 +34,16 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
|
|||
# ),
|
||||
shiny::passwordInput(
|
||||
inputId = ns("api"),
|
||||
label = "API token",
|
||||
label = i18n$t("API token"),
|
||||
value = "",
|
||||
width = "100%"
|
||||
),
|
||||
shiny::helpText("The token is a string of 32 numbers and letters."),
|
||||
shiny::helpText(i18n$t("The token is a string of 32 numbers and letters.")),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::actionButton(
|
||||
inputId = ns("data_connect"),
|
||||
label = "Connect",
|
||||
label = i18n$t("Connect"),
|
||||
icon = shiny::icon("link", lib = "glyphicon"),
|
||||
width = "100%",
|
||||
disabled = TRUE
|
||||
|
|
@ -68,13 +68,13 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
|
|||
shiny::uiOutput(outputId = ns("arms")),
|
||||
shiny::textInput(
|
||||
inputId = ns("filter"),
|
||||
label = "Optional filter logic (e.g., [gender] = 'female')"
|
||||
)
|
||||
label = i18n$t("Optional filter logic (e.g., [gender] = 'female')"
|
||||
))
|
||||
)
|
||||
|
||||
params_ui <-
|
||||
shiny::tagList(
|
||||
shiny::tags$h4("Data import parameters"),
|
||||
shiny::tags$h4(i18n$t("Data import parameters")),
|
||||
shiny::tags$div(
|
||||
style = htmltools::css(
|
||||
display = "grid",
|
||||
|
|
@ -100,14 +100,14 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
|
|||
)
|
||||
)
|
||||
),
|
||||
shiny::helpText("Select fields/variables to import and click the funnel to apply optional filters"),
|
||||
shiny::helpText(i18n$t("Select fields/variables to import and click the funnel to apply optional filters")),
|
||||
shiny::tags$br(),
|
||||
shiny::tags$br(),
|
||||
shiny::uiOutput(outputId = ns("data_type")),
|
||||
shiny::uiOutput(outputId = ns("fill")),
|
||||
shiny::actionButton(
|
||||
inputId = ns("data_import"),
|
||||
label = "Import",
|
||||
label = i18n$t("Import"),
|
||||
icon = shiny::icon("download", lib = "glyphicon"),
|
||||
width = "100%",
|
||||
disabled = TRUE
|
||||
|
|
@ -226,11 +226,11 @@ m_redcap_readServer <- function(id) {
|
|||
selector = ns("connect"),
|
||||
status = "success",
|
||||
include_data_alert(
|
||||
see_data_text = "Click to see data dictionary",
|
||||
see_data_text = i18n$t("Click to see data dictionary"),
|
||||
dataIdName = "see_dd",
|
||||
extra = tags$p(
|
||||
tags$b(phosphoricons::ph("check", weight = "bold"), "Connected to server!"),
|
||||
glue::glue("The {data_rv$info$project_title} project is loaded.")
|
||||
tags$b(phosphoricons::ph("check", weight = "bold"), i18n$t("Connected to server!")),
|
||||
glue::glue(i18n$t("The {data_rv$info$project_title} project is loaded."))
|
||||
),
|
||||
btn_show_data = TRUE
|
||||
)
|
||||
|
|
@ -257,10 +257,10 @@ m_redcap_readServer <- function(id) {
|
|||
shiny::observeEvent(input$see_dd, {
|
||||
show_data(
|
||||
purrr::pluck(data_rv$dd_list, "data"),
|
||||
title = "Data dictionary",
|
||||
title = i18n$t("Data dictionary"),
|
||||
type = "modal",
|
||||
show_classes = FALSE,
|
||||
tags$b("Preview:")
|
||||
tags$b(i18n$t("Preview:"))
|
||||
)
|
||||
})
|
||||
|
||||
|
|
@ -268,10 +268,10 @@ m_redcap_readServer <- function(id) {
|
|||
show_data(
|
||||
# purrr::pluck(data_rv$dd_list, "data"),
|
||||
data_rv$data,
|
||||
title = "Imported data set",
|
||||
title = i18n$t("Imported data set"),
|
||||
type = "modal",
|
||||
show_classes = FALSE,
|
||||
tags$b("Preview:")
|
||||
tags$b(i18n$t("Preview:"))
|
||||
)
|
||||
})
|
||||
|
||||
|
|
@ -289,7 +289,7 @@ m_redcap_readServer <- function(id) {
|
|||
shiny::req(data_rv$dd_list)
|
||||
shinyWidgets::virtualSelectInput(
|
||||
inputId = ns("fields"),
|
||||
label = "Select fields/variables to import:",
|
||||
label = i18n$t("Select fields/variables to import:"),
|
||||
choices = purrr::pluck(data_rv$dd_list, "data") |>
|
||||
dplyr::select(field_name, form_name) |>
|
||||
(\(.x){
|
||||
|
|
@ -308,7 +308,7 @@ m_redcap_readServer <- function(id) {
|
|||
if (isTRUE(data_rv$info$has_repeating_instruments_or_events)) {
|
||||
vectorSelectInput(
|
||||
inputId = ns("data_type"),
|
||||
label = "Specify the data format",
|
||||
label = i18n$t("Specify the data format"),
|
||||
choices = c(
|
||||
"Wide data (One row for each subject)" = "wide",
|
||||
"Long data for project with repeating instruments (default REDCap)" = "long"
|
||||
|
|
@ -335,7 +335,7 @@ m_redcap_readServer <- function(id) {
|
|||
if (input$data_type == "long" && isTRUE(any(input$fields %in% data_rv$rep_fields))) {
|
||||
vectorSelectInput(
|
||||
inputId = ns("fill"),
|
||||
label = "Fill missing values?",
|
||||
label = i18n$t("Fill missing values?"),
|
||||
choices = c(
|
||||
"Yes, fill missing, non-repeated values" = "yes",
|
||||
"No, leave the data as is" = "no"
|
||||
|
|
@ -417,7 +417,7 @@ m_redcap_readServer <- function(id) {
|
|||
data_rv$data_message <- imported$raw_text
|
||||
} else {
|
||||
data_rv$data_status <- "success"
|
||||
data_rv$data_message <- "Requested data was retrieved!"
|
||||
data_rv$data_message <- i18n$t("Requested data was retrieved!")
|
||||
|
||||
## The data management below should be separated to allow for changing
|
||||
## "wide"/"long" without re-importing data
|
||||
|
|
@ -452,12 +452,12 @@ m_redcap_readServer <- function(id) {
|
|||
|
||||
if (!any(in_data_check[-1])) {
|
||||
data_rv$data_status <- "warning"
|
||||
data_rv$data_message <- "Data retrieved, but it looks like only the ID was retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access."
|
||||
data_rv$data_message <- i18n$t("Data retrieved, but it looks like only the ID was retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access.")
|
||||
}
|
||||
|
||||
if (!all(in_data_check)) {
|
||||
data_rv$data_status <- "warning"
|
||||
data_rv$data_message <- "Data retrieved, but it looks like not all requested fields were retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access."
|
||||
data_rv$data_message <- i18n$t("Data retrieved, but it looks like not all requested fields were retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access.")
|
||||
}
|
||||
|
||||
data_rv$code <- code
|
||||
|
|
@ -484,7 +484,7 @@ m_redcap_readServer <- function(id) {
|
|||
# data_rv$data_message
|
||||
# ),
|
||||
include_data_alert(
|
||||
see_data_text = "Click to see the imported data",
|
||||
see_data_text = i18n$t("Click to see the imported data"),
|
||||
dataIdName = "see_data",
|
||||
extra = tags$p(
|
||||
tags$b(phosphoricons::ph("check", weight = "bold"), data_rv$data_message)
|
||||
|
|
|
|||
|
|
@ -46,7 +46,7 @@ regression_ui <- function(id, ...) {
|
|||
shiny::tagList(
|
||||
# title = "",
|
||||
bslib::nav_panel(
|
||||
title = "Regression table",
|
||||
title = i18n$t("Regression table"),
|
||||
bslib::layout_sidebar(
|
||||
sidebar = bslib::sidebar(
|
||||
shiny::uiOutput(outputId = ns("data_info"), inline = TRUE),
|
||||
|
|
@ -56,7 +56,7 @@ regression_ui <- function(id, ...) {
|
|||
multiple = FALSE,
|
||||
bslib::accordion_panel(
|
||||
value = "acc_pan_reg",
|
||||
title = "Regression",
|
||||
title = i18n$t("Regression"),
|
||||
icon = bsicons::bs_icon("calculator"),
|
||||
shiny::uiOutput(outputId = ns("outcome_var")),
|
||||
# shiny::selectInput(
|
||||
|
|
@ -71,7 +71,7 @@ regression_ui <- function(id, ...) {
|
|||
shiny::uiOutput(outputId = ns("regression_type")),
|
||||
shiny::radioButtons(
|
||||
inputId = ns("all"),
|
||||
label = "Specify covariables",
|
||||
label = i18n$t("Specify covariables"),
|
||||
inline = TRUE, selected = 2,
|
||||
choiceNames = c(
|
||||
"Yes",
|
||||
|
|
@ -82,15 +82,15 @@ regression_ui <- function(id, ...) {
|
|||
shiny::conditionalPanel(
|
||||
condition = "input.all==1",
|
||||
shiny::uiOutput(outputId = ns("regression_vars")),
|
||||
shiny::helpText("If none are selected, all are included."),
|
||||
shiny::helpText(i18n$t("If none are selected, all are included.")),
|
||||
shiny::tags$br(),
|
||||
ns = ns
|
||||
),
|
||||
bslib::input_task_button(
|
||||
id = ns("load"),
|
||||
label = "Analyse",
|
||||
label = i18n$t("Analyse"),
|
||||
icon = bsicons::bs_icon("pencil"),
|
||||
label_busy = "Working...",
|
||||
label_busy = i18n$t("Working..."),
|
||||
icon_busy = fontawesome::fa_i("arrows-rotate",
|
||||
class = "fa-spin",
|
||||
"aria-hidden" = "true"
|
||||
|
|
@ -98,17 +98,18 @@ regression_ui <- function(id, ...) {
|
|||
type = "secondary",
|
||||
auto_reset = TRUE
|
||||
),
|
||||
shiny::helpText("Press 'Analyse' to create the regression model and after changing parameters."),
|
||||
shiny::helpText(i18n$t("Press 'Analyse' to create the regression model and after changing parameters.")),
|
||||
shiny::tags$br(),
|
||||
shiny::radioButtons(
|
||||
inputId = ns("add_regression_p"),
|
||||
label = "Show p-value",
|
||||
label = i18n$t("Show p-value"),
|
||||
inline = TRUE,
|
||||
selected = "yes",
|
||||
choices = list(
|
||||
"Yes" = "yes",
|
||||
"No" = "no"
|
||||
)
|
||||
choiceNames = c(
|
||||
"Yes",
|
||||
"No"
|
||||
),
|
||||
choiceValues = c("yes", "no")
|
||||
),
|
||||
# shiny::tags$br(),
|
||||
# shiny::radioButtons(
|
||||
|
|
@ -151,7 +152,7 @@ regression_ui <- function(id, ...) {
|
|||
shiny::tagList(
|
||||
shinyWidgets::noUiSliderInput(
|
||||
inputId = ns("plot_height"),
|
||||
label = "Plot height (mm)",
|
||||
label = i18n$t("Plot height (mm)"),
|
||||
min = 50,
|
||||
max = 300,
|
||||
value = 100,
|
||||
|
|
@ -161,7 +162,7 @@ regression_ui <- function(id, ...) {
|
|||
),
|
||||
shinyWidgets::noUiSliderInput(
|
||||
inputId = ns("plot_width"),
|
||||
label = "Plot width (mm)",
|
||||
label = i18n$t("Plot width (mm)"),
|
||||
min = 50,
|
||||
max = 300,
|
||||
value = 100,
|
||||
|
|
@ -171,7 +172,7 @@ regression_ui <- function(id, ...) {
|
|||
),
|
||||
shiny::selectInput(
|
||||
inputId = ns("plot_type"),
|
||||
label = "File format",
|
||||
label = i18n$t("File format"),
|
||||
choices = list(
|
||||
"png",
|
||||
"tiff",
|
||||
|
|
@ -185,7 +186,7 @@ regression_ui <- function(id, ...) {
|
|||
# Button
|
||||
shiny::downloadButton(
|
||||
outputId = ns("download_plot"),
|
||||
label = "Download plot",
|
||||
label = i18n$t("Download plot"),
|
||||
icon = shiny::icon("download")
|
||||
)
|
||||
)
|
||||
|
|
@ -197,7 +198,7 @@ regression_ui <- function(id, ...) {
|
|||
)
|
||||
),
|
||||
bslib::nav_panel(
|
||||
title = "Model checks",
|
||||
title = i18n$t("Model checks"),
|
||||
bslib::layout_sidebar(
|
||||
sidebar = bslib::sidebar(
|
||||
bslib::accordion(
|
||||
|
|
|
|||
|
|
@ -321,11 +321,11 @@ ui_elements <- function(selection) {
|
|||
shiny::tags$br(),
|
||||
shiny::actionButton(
|
||||
inputId = "data_reset",
|
||||
label = "Restore original data",
|
||||
label = i18n$t("Restore original data"),
|
||||
width = "100%"
|
||||
),
|
||||
shiny::tags$br(),
|
||||
shiny::helpText("Reset to original imported dataset. Careful! There is no un-doing."),
|
||||
shiny::helpText(i18n$t("Reset to original imported dataset. Careful! There is no un-doing.")),
|
||||
shiny::tags$br()
|
||||
)
|
||||
# )
|
||||
|
|
@ -344,7 +344,7 @@ ui_elements <- function(selection) {
|
|||
# bslib::navset_bar(
|
||||
# title = "",
|
||||
bslib::nav_panel(
|
||||
title = "Characteristics",
|
||||
title = i18n$t("Characteristics"),
|
||||
icon = bsicons::bs_icon("table"),
|
||||
bslib::layout_sidebar(
|
||||
sidebar = bslib::sidebar(
|
||||
|
|
@ -359,12 +359,12 @@ ui_elements <- function(selection) {
|
|||
title = "Settings",
|
||||
icon = bsicons::bs_icon("table"),
|
||||
shiny::uiOutput("strat_var"),
|
||||
shiny::helpText("Only factor/categorical variables are available for stratification. Go back to the 'Prepare' tab to reclass a variable if it's not on the list."),
|
||||
shiny::helpText(i18n$t("Only factor/categorical variables are available for stratification. Go back to the 'Prepare' tab to reclass a variable if it's not on the list.")),
|
||||
shiny::conditionalPanel(
|
||||
condition = "input.strat_var!='none'",
|
||||
shiny::radioButtons(
|
||||
inputId = "add_p",
|
||||
label = "Compare strata?",
|
||||
label = i18n$t("Compare strata?"),
|
||||
selected = "no",
|
||||
inline = TRUE,
|
||||
choices = list(
|
||||
|
|
@ -378,7 +378,7 @@ ui_elements <- function(selection) {
|
|||
shiny::br(),
|
||||
shiny::actionButton(
|
||||
inputId = "act_eval",
|
||||
label = "Evaluate",
|
||||
label = i18n$t("Evaluate"),
|
||||
width = "100%",
|
||||
icon = shiny::icon("calculator"),
|
||||
disabled = TRUE
|
||||
|
|
@ -390,7 +390,7 @@ ui_elements <- function(selection) {
|
|||
)
|
||||
),
|
||||
bslib::nav_panel(
|
||||
title = "Correlations",
|
||||
title = i18n$t("Correlations"),
|
||||
icon = bsicons::bs_icon("bounding-box"),
|
||||
bslib::layout_sidebar(
|
||||
sidebar = bslib::sidebar(
|
||||
|
|
@ -404,11 +404,11 @@ ui_elements <- function(selection) {
|
|||
title = "Settings",
|
||||
icon = bsicons::bs_icon("bounding-box"),
|
||||
shiny::uiOutput("outcome_var_cor"),
|
||||
shiny::helpText("To avoid evaluating the correlation of the outcome variable, this can be excluded from the plot or select 'none'."),
|
||||
shiny::helpText(i18n$t("To avoid evaluating the correlation of the outcome variable, this can be excluded from the plot or select 'none'.")),
|
||||
shiny::br(),
|
||||
shinyWidgets::noUiSliderInput(
|
||||
inputId = "cor_cutoff",
|
||||
label = "Correlation cut-off",
|
||||
label = i18n$t("Correlation cut-off"),
|
||||
min = 0,
|
||||
max = 1,
|
||||
step = .01,
|
||||
|
|
@ -416,7 +416,7 @@ ui_elements <- function(selection) {
|
|||
format = shinyWidgets::wNumbFormat(decimals = 2),
|
||||
color = datamods:::get_primary_color()
|
||||
),
|
||||
shiny::helpText("Set the cut-off for considered 'highly correlated'.")
|
||||
shiny::helpText(i18n$t("Set the cut-off for considered 'highly correlated'."))
|
||||
)
|
||||
)
|
||||
),
|
||||
|
|
@ -424,7 +424,7 @@ ui_elements <- function(selection) {
|
|||
)
|
||||
),
|
||||
bslib::nav_panel(
|
||||
title = "Missings",
|
||||
title = i18n$t("Missings"),
|
||||
icon = bsicons::bs_icon("x-circle"),
|
||||
bslib::layout_sidebar(
|
||||
sidebar = bslib::sidebar(
|
||||
|
|
@ -437,7 +437,7 @@ ui_elements <- function(selection) {
|
|||
title = "Settings",
|
||||
icon = bsicons::bs_icon("x-circle"),
|
||||
shiny::uiOutput("missings_var"),
|
||||
shiny::helpText("To consider if data is missing by random, choose the outcome/dependent variable, if it has any missings to evaluate if there is a significant difference across other variables depending on missing data or not.")
|
||||
shiny::helpText(i18n$t("To consider if data is missing by random, choose the outcome/dependent variable, if it has any missings to evaluate if there is a significant difference across other variables depending on missing data or not."))
|
||||
)
|
||||
)
|
||||
),
|
||||
|
|
|
|||
|
|
@ -1,10 +1,12 @@
|
|||
#' Data correlations evaluation module
|
||||
#'
|
||||
#' @param id Module id
|
||||
#' @param id id
|
||||
#'
|
||||
#' @name data-missings
|
||||
#' @name visual-summary
|
||||
#' @returns Shiny ui module
|
||||
#' @export
|
||||
#'
|
||||
#' @example examples/visual_summary_demo.R
|
||||
visual_summary_ui <- function(id) {
|
||||
ns <- shiny::NS(id)
|
||||
|
||||
|
|
@ -13,8 +15,17 @@ visual_summary_ui <- function(id) {
|
|||
)
|
||||
}
|
||||
|
||||
#' Visual summary server
|
||||
#'
|
||||
#' @param data_r reactive data
|
||||
#' @param ... passed on to the visual_summary() function
|
||||
#'
|
||||
#' @name visual-summary
|
||||
#' @returns shiny server
|
||||
#' @export
|
||||
#'
|
||||
visual_summary_server <- function(id,
|
||||
data_r=shiny::reactive(NULL),
|
||||
data_r = shiny::reactive(NULL),
|
||||
...) {
|
||||
shiny::moduleServer(
|
||||
id = id,
|
||||
|
|
@ -43,45 +54,26 @@ visual_summary_server <- function(id,
|
|||
# missings_apex_plot(datar(), ...)
|
||||
# })
|
||||
output$visual_plot <- shiny::renderPlot(expr = {
|
||||
visual_summary(data = rv$data,...)
|
||||
visual_summary(data = rv$data, na.label = i18n$t("Missings"), legend.title = i18n$t("Class"), ylab = i18n$t("Observations"), ...)
|
||||
})
|
||||
}
|
||||
)
|
||||
}
|
||||
|
||||
visual_summary_demo_app <- function() {
|
||||
ui <- shiny::fluidPage(
|
||||
shiny::actionButton(
|
||||
inputId = "modal_missings",
|
||||
label = "Visual summary",
|
||||
width = "100%",
|
||||
disabled = FALSE
|
||||
)
|
||||
)
|
||||
server <- function(input, output, session) {
|
||||
data_demo <- mtcars
|
||||
data_demo[sample(1:32, 10), "cyl"] <- NA
|
||||
data_demo[sample(1:32, 8), "vs"] <- NA
|
||||
|
||||
visual_summary_server(id = "data", data = shiny::reactive(data_demo))
|
||||
|
||||
observeEvent(input$modal_missings, {
|
||||
tryCatch(
|
||||
{
|
||||
modal_visual_summary(id = "data")
|
||||
},
|
||||
error = function(err) {
|
||||
showNotification(paste0("We encountered the following error browsing your data: ", err), type = "err")
|
||||
}
|
||||
)
|
||||
})
|
||||
}
|
||||
shiny::shinyApp(ui, server)
|
||||
}
|
||||
|
||||
visual_summary_demo_app()
|
||||
|
||||
|
||||
#' Visual summary modal
|
||||
#'
|
||||
#' @param title title
|
||||
#' @param easyClose easyClose
|
||||
#' @param size modal size
|
||||
#' @param footer modal footer
|
||||
#' @param ... ignored
|
||||
#'
|
||||
#' @name visual-summary
|
||||
#'
|
||||
#' @returns shiny modal
|
||||
#' @export
|
||||
#'
|
||||
modal_visual_summary <- function(id,
|
||||
title = "Visual overview of data classes and missing observations",
|
||||
easyClose = TRUE,
|
||||
|
|
@ -100,9 +92,10 @@ modal_visual_summary <- function(id,
|
|||
|
||||
## Slow with many observations...
|
||||
|
||||
#' Plot missings and class with apexcharter
|
||||
#' Plot missings and class with apexcharter. Not in use with FreesearchR.
|
||||
#'
|
||||
#' @param data data frame
|
||||
#' @name visual-summary
|
||||
#'
|
||||
#' @returns An [apexchart()] `htmlwidget` object.
|
||||
#' @export
|
||||
|
|
@ -157,6 +150,10 @@ missings_apex_plot <- function(data, animation = FALSE, ...) {
|
|||
#'
|
||||
#' @param data data
|
||||
#' @param ... optional arguments passed to data_summary_gather()
|
||||
#' @param legend.title Legend title
|
||||
#' @param ylab Y axis label
|
||||
#'
|
||||
#' @name visual-summary
|
||||
#'
|
||||
#' @returns ggplot2 object
|
||||
#' @export
|
||||
|
|
@ -167,11 +164,15 @@ missings_apex_plot <- function(data, animation = FALSE, ...) {
|
|||
#' data_demo[sample(1:32, 8), "vs"] <- NA
|
||||
#' visual_summary(data_demo)
|
||||
#' visual_summary(data_demo, palette.fun = scales::hue_pal())
|
||||
#' visual_summary(dplyr::storms)
|
||||
#' visual_summary(dplyr::storms, summary.fun = data_type)
|
||||
visual_summary <- function(data, legend.title = "Data class", ...) {
|
||||
#' visual_summary(dplyr::storms, summary.fun = data_type, na.label = "Missings", legend.title = "Class")
|
||||
visual_summary <- function(data, legend.title = NULL, ylab = "Observations", ...) {
|
||||
l <- data_summary_gather(data, ...)
|
||||
|
||||
if (is.null(legend.title)) {
|
||||
legend.title <- l$summary.fun
|
||||
}
|
||||
|
||||
df <- l$data
|
||||
|
||||
df$valueType <- factor(df$valueType, levels = names(l$colors))
|
||||
|
|
@ -185,13 +186,13 @@ visual_summary <- function(data, legend.title = "Data class", ...) {
|
|||
vjust = 1, hjust = 1
|
||||
)) +
|
||||
ggplot2::scale_fill_manual(values = l$colors) +
|
||||
ggplot2::labs(x = "", y = "Observations") +
|
||||
ggplot2::labs(x = "", y = ylab) +
|
||||
ggplot2::scale_y_reverse() +
|
||||
ggplot2::theme(axis.text.x = ggplot2::element_text(hjust = 0.5)) +
|
||||
ggplot2::guides(colour = "none") +
|
||||
ggplot2::guides(fill = ggplot2::guide_legend(title = legend.title)) +
|
||||
# change the limits etc.
|
||||
ggplot2::guides(fill = ggplot2::guide_legend(title = "Type")) +
|
||||
# ggplot2::guides(fill = ggplot2::guide_legend(title = guide.lab)) +
|
||||
# add info about the axes
|
||||
ggplot2::scale_x_discrete(position = "top") +
|
||||
ggplot2::theme(axis.text.x = ggplot2::element_text(hjust = 0)) +
|
||||
|
|
@ -206,16 +207,18 @@ visual_summary <- function(data, legend.title = "Data class", ...) {
|
|||
#' Data summary for printing visual summary
|
||||
#'
|
||||
#' @param data data.frame
|
||||
#' @param fun summary function. Default is "class"
|
||||
#' @param palette.fun optionally use specific palette functions. First argument
|
||||
#' has to be the length.
|
||||
#' @param summary.fun fun for summarising
|
||||
#' @param na.label label for NA
|
||||
#' @param ... overflow
|
||||
#'
|
||||
#' @returns data.frame
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' mtcars |> data_summary_gather()
|
||||
data_summary_gather <- function(data, summary.fun = class, palette.fun = viridisLite::viridis) {
|
||||
data_summary_gather <- function(data, summary.fun = class, palette.fun = viridisLite::viridis, na.label = "NA", ...) {
|
||||
df_plot <- setNames(data, unique_short(names(data))) |>
|
||||
purrr::map_df(\(x){
|
||||
ifelse(is.na(x),
|
||||
|
|
@ -237,12 +240,12 @@ data_summary_gather <- function(data, summary.fun = class, palette.fun = viridis
|
|||
forcats::as_factor() |>
|
||||
as.numeric()
|
||||
|
||||
df_plot$valueType[is.na(df_plot$valueType)] <- "NA"
|
||||
df_plot$valueType[is.na(df_plot$valueType)] <- na.label
|
||||
df_plot$valueType_num[is.na(df_plot$valueType_num)] <- max(df_plot$valueType_num, na.rm = TRUE) + 1
|
||||
|
||||
labels <- setNames(unique(df_plot$valueType_num), unique(df_plot$valueType)) |> sort()
|
||||
|
||||
if (any(df_plot$valueType == "NA")) {
|
||||
if (any(df_plot$valueType == na.label)) {
|
||||
colors <- setNames(c(palette.fun(length(labels) - 1), "#999999"), names(labels))
|
||||
} else {
|
||||
colors <- setNames(palette.fun(length(labels)), names(labels))
|
||||
|
|
@ -260,7 +263,7 @@ data_summary_gather <- function(data, summary.fun = class, palette.fun = viridis
|
|||
}) |>
|
||||
setNames(NULL)
|
||||
|
||||
list(data = df_plot, colors = colors, labels = label_list)
|
||||
list(data = df_plot, colors = colors, labels = label_list, summary.fun = deparse(substitute(summary.fun)))
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
398
app_docker/app.R
398
app_docker/app.R
|
|
@ -1,7 +1,7 @@
|
|||
|
||||
|
||||
########
|
||||
#### Current file: /var/folders/9l/xbc19wxx0g79jdd2sf_0v291mhwh7f/T//RtmpCENEZ9/file6e54cbc3538.R
|
||||
#### Current file: /var/folders/9l/xbc19wxx0g79jdd2sf_0v291mhwh7f/T//RtmpCENEZ9/file6e544614c472.R
|
||||
########
|
||||
|
||||
i18n_path <- here::here("translations")
|
||||
|
|
@ -2523,163 +2523,6 @@ clean_common_axis <- function(p, axis) {
|
|||
}
|
||||
|
||||
|
||||
########
|
||||
#### Current file: /Users/au301842/FreesearchR/R//data-import.R
|
||||
########
|
||||
|
||||
data_import_ui <- function(id) {
|
||||
ns <- shiny::NS(id)
|
||||
|
||||
shiny::fluidRow(
|
||||
shiny::column(width = 2),
|
||||
shiny::column(
|
||||
width = 8,
|
||||
shiny::h4("Choose your data source"),
|
||||
shiny::br(),
|
||||
shinyWidgets::radioGroupButtons(
|
||||
inputId = "source",
|
||||
selected = "env",
|
||||
choices = c(
|
||||
"File upload" = "file",
|
||||
"REDCap server export" = "redcap",
|
||||
"Local or sample data" = "env"
|
||||
),
|
||||
width = "100%"
|
||||
),
|
||||
shiny::helpText("Upload a file from your device, get data directly from REDCap or select a sample data set for testing from the app."),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::conditionalPanel(
|
||||
condition = "input.source=='file'",
|
||||
import_file_ui(
|
||||
id = ns("file_import"),
|
||||
layout_params = "dropdown",
|
||||
title = "Choose a datafile to upload",
|
||||
file_extensions = c(".csv", ".tsv", ".txt", ".xls", ".xlsx", ".rds", ".sas7bdat", ".ods", ".dta")
|
||||
)
|
||||
),
|
||||
shiny::conditionalPanel(
|
||||
condition = "input.source=='redcap'",
|
||||
m_redcap_readUI(id = ns("redcap_import"))
|
||||
),
|
||||
shiny::conditionalPanel(
|
||||
condition = "input.source=='env'",
|
||||
datamods::import_globalenv_ui(id = ns("env"), title = NULL)
|
||||
),
|
||||
shiny::conditionalPanel(
|
||||
condition = "input.source=='redcap'",
|
||||
DT::DTOutput(outputId = ns("redcap_prev"))
|
||||
)
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
data_import_server <- function(id) {
|
||||
module <- function(input, output, session) {
|
||||
ns <- session$ns
|
||||
|
||||
rv <- shiny::reactiveValues(
|
||||
data_temp = NULL,
|
||||
code = list()
|
||||
)
|
||||
|
||||
data_file <- import_file_server(
|
||||
id = ns("file_import"),
|
||||
show_data_in = "popup",
|
||||
trigger_return = "change",
|
||||
return_class = "data.frame"
|
||||
)
|
||||
|
||||
shiny::observeEvent(data_file$data(), {
|
||||
shiny::req(data_file$data())
|
||||
|
||||
rv$data_temp <- data_file$data()
|
||||
rv$code <- append_list(data = data_file$code(), list = rv$code, index = "import")
|
||||
})
|
||||
|
||||
data_redcap <- m_redcap_readServer(
|
||||
id = "redcap_import"
|
||||
)
|
||||
|
||||
shiny::observeEvent(data_redcap(), {
|
||||
# rv$data_original <- purrr::pluck(data_redcap(), "data")()
|
||||
rv$data_temp <- data_redcap()
|
||||
})
|
||||
|
||||
from_env <- datamods::import_globalenv_server(
|
||||
id = "env",
|
||||
trigger_return = "change",
|
||||
btn_show_data = FALSE,
|
||||
reset = reactive(input$hidden)
|
||||
)
|
||||
|
||||
shiny::observeEvent(from_env$data(), {
|
||||
shiny::req(from_env$data())
|
||||
|
||||
rv$data_temp <- from_env$data()
|
||||
# rv$code <- append_list(data = from_env$code(),list = rv$code,index = "import")
|
||||
})
|
||||
|
||||
return(list(
|
||||
# status = reactive(temporary_rv$status),
|
||||
# name = reactive(temporary_rv$name),
|
||||
# code = reactive(temporary_rv$code),
|
||||
data = shiny::reactive(rv$data_temp)
|
||||
))
|
||||
|
||||
}
|
||||
|
||||
shiny::moduleServer(
|
||||
id = id,
|
||||
module = module
|
||||
)
|
||||
|
||||
}
|
||||
|
||||
|
||||
#' Test app for the data-import module
|
||||
#'
|
||||
#' @rdname data-import
|
||||
#'
|
||||
#' @examples
|
||||
#' \dontrun{
|
||||
#' data_import_demo_app()
|
||||
#' }
|
||||
data_import_demo_app <- function() {
|
||||
ui <- shiny::fluidPage(
|
||||
data_import_ui("data_import"),
|
||||
toastui::datagridOutput2(outputId = "table"),
|
||||
DT::DTOutput("data_summary")
|
||||
)
|
||||
server <- function(input, output, session) {
|
||||
imported <- shiny::reactive(data_import_server(id = "data_import"))
|
||||
|
||||
# output$data_summary <- DT::renderDataTable(
|
||||
# {
|
||||
# shiny::req(data_val$data)
|
||||
# data_val$data
|
||||
# },
|
||||
# options = list(
|
||||
# scrollX = TRUE,
|
||||
# pageLength = 5
|
||||
# )
|
||||
# )
|
||||
output$table <- toastui::renderDatagrid2({
|
||||
req(imported$data)
|
||||
toastui::datagrid(
|
||||
data = head(imported$data, 5),
|
||||
theme = "striped",
|
||||
colwidths = "guess",
|
||||
minBodyHeight = 250
|
||||
)
|
||||
})
|
||||
|
||||
}
|
||||
shiny::shinyApp(ui, server)
|
||||
}
|
||||
|
||||
|
||||
########
|
||||
#### Current file: /Users/au301842/FreesearchR/R//data-summary.R
|
||||
########
|
||||
|
|
@ -3290,6 +3133,9 @@ describe_col_num <- function(x, with_summary = TRUE) {
|
|||
tags$div(
|
||||
i18n$t("Mean:"), round(mean(x, na.rm = TRUE), 2)
|
||||
),
|
||||
tags$div(
|
||||
i18n$t("Median:"), round(median(x, na.rm = TRUE), 2)
|
||||
),
|
||||
tags$div(
|
||||
i18n$t("Max:"), round(max(x, na.rm = TRUE), 2)
|
||||
),
|
||||
|
|
@ -4107,7 +3953,7 @@ simple_snake <- function(data){
|
|||
#### Current file: /Users/au301842/FreesearchR/R//hosted_version.R
|
||||
########
|
||||
|
||||
hosted_version <- function()'v25.9.2-250924'
|
||||
hosted_version <- function()'v25.9.2-250925'
|
||||
|
||||
|
||||
########
|
||||
|
|
@ -5703,20 +5549,20 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
|
|||
|
||||
if (isTRUE(title)) {
|
||||
title <- shiny::tags$h4(
|
||||
"Import data from REDCap",
|
||||
i18n$t("Import data from REDCap"),
|
||||
class = "redcap-module-title"
|
||||
)
|
||||
}
|
||||
|
||||
server_ui <- shiny::tagList(
|
||||
shiny::tags$h4("REDCap server"),
|
||||
shiny::tags$h4(i18n$t("REDCap server")),
|
||||
shiny::textInput(
|
||||
inputId = ns("uri"),
|
||||
label = "Web address",
|
||||
label = i18n$t("Web address"),
|
||||
value = if_not_missing(url, "https://redcap.your.institution/"),
|
||||
width = "100%"
|
||||
),
|
||||
shiny::helpText("Format should be either 'https://redcap.your.institution/' or 'https://your.institution/redcap/'"),
|
||||
shiny::helpText(i18n$t("Format should be either 'https://redcap.your.institution/' or 'https://your.institution/redcap/'")),
|
||||
# shiny::textInput(
|
||||
# inputId = ns("api"),
|
||||
# label = "API token",
|
||||
|
|
@ -5725,16 +5571,16 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
|
|||
# ),
|
||||
shiny::passwordInput(
|
||||
inputId = ns("api"),
|
||||
label = "API token",
|
||||
label = i18n$t("API token"),
|
||||
value = "",
|
||||
width = "100%"
|
||||
),
|
||||
shiny::helpText("The token is a string of 32 numbers and letters."),
|
||||
shiny::helpText(i18n$t("The token is a string of 32 numbers and letters.")),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::actionButton(
|
||||
inputId = ns("data_connect"),
|
||||
label = "Connect",
|
||||
label = i18n$t("Connect"),
|
||||
icon = shiny::icon("link", lib = "glyphicon"),
|
||||
width = "100%",
|
||||
disabled = TRUE
|
||||
|
|
@ -5759,13 +5605,13 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
|
|||
shiny::uiOutput(outputId = ns("arms")),
|
||||
shiny::textInput(
|
||||
inputId = ns("filter"),
|
||||
label = "Optional filter logic (e.g., [gender] = 'female')"
|
||||
)
|
||||
label = i18n$t("Optional filter logic (e.g., [gender] = 'female')"
|
||||
))
|
||||
)
|
||||
|
||||
params_ui <-
|
||||
shiny::tagList(
|
||||
shiny::tags$h4("Data import parameters"),
|
||||
shiny::tags$h4(i18n$t("Data import parameters")),
|
||||
shiny::tags$div(
|
||||
style = htmltools::css(
|
||||
display = "grid",
|
||||
|
|
@ -5791,14 +5637,14 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
|
|||
)
|
||||
)
|
||||
),
|
||||
shiny::helpText("Select fields/variables to import and click the funnel to apply optional filters"),
|
||||
shiny::helpText(i18n$t("Select fields/variables to import and click the funnel to apply optional filters")),
|
||||
shiny::tags$br(),
|
||||
shiny::tags$br(),
|
||||
shiny::uiOutput(outputId = ns("data_type")),
|
||||
shiny::uiOutput(outputId = ns("fill")),
|
||||
shiny::actionButton(
|
||||
inputId = ns("data_import"),
|
||||
label = "Import",
|
||||
label = i18n$t("Import"),
|
||||
icon = shiny::icon("download", lib = "glyphicon"),
|
||||
width = "100%",
|
||||
disabled = TRUE
|
||||
|
|
@ -5917,11 +5763,11 @@ m_redcap_readServer <- function(id) {
|
|||
selector = ns("connect"),
|
||||
status = "success",
|
||||
include_data_alert(
|
||||
see_data_text = "Click to see data dictionary",
|
||||
see_data_text = i18n$t("Click to see data dictionary"),
|
||||
dataIdName = "see_dd",
|
||||
extra = tags$p(
|
||||
tags$b(phosphoricons::ph("check", weight = "bold"), "Connected to server!"),
|
||||
glue::glue("The {data_rv$info$project_title} project is loaded.")
|
||||
tags$b(phosphoricons::ph("check", weight = "bold"), i18n$t("Connected to server!")),
|
||||
glue::glue(i18n$t("The {data_rv$info$project_title} project is loaded."))
|
||||
),
|
||||
btn_show_data = TRUE
|
||||
)
|
||||
|
|
@ -5948,10 +5794,10 @@ m_redcap_readServer <- function(id) {
|
|||
shiny::observeEvent(input$see_dd, {
|
||||
show_data(
|
||||
purrr::pluck(data_rv$dd_list, "data"),
|
||||
title = "Data dictionary",
|
||||
title = i18n$t("Data dictionary"),
|
||||
type = "modal",
|
||||
show_classes = FALSE,
|
||||
tags$b("Preview:")
|
||||
tags$b(i18n$t("Preview:"))
|
||||
)
|
||||
})
|
||||
|
||||
|
|
@ -5959,10 +5805,10 @@ m_redcap_readServer <- function(id) {
|
|||
show_data(
|
||||
# purrr::pluck(data_rv$dd_list, "data"),
|
||||
data_rv$data,
|
||||
title = "Imported data set",
|
||||
title = i18n$t("Imported data set"),
|
||||
type = "modal",
|
||||
show_classes = FALSE,
|
||||
tags$b("Preview:")
|
||||
tags$b(i18n$t("Preview:"))
|
||||
)
|
||||
})
|
||||
|
||||
|
|
@ -5980,7 +5826,7 @@ m_redcap_readServer <- function(id) {
|
|||
shiny::req(data_rv$dd_list)
|
||||
shinyWidgets::virtualSelectInput(
|
||||
inputId = ns("fields"),
|
||||
label = "Select fields/variables to import:",
|
||||
label = i18n$t("Select fields/variables to import:"),
|
||||
choices = purrr::pluck(data_rv$dd_list, "data") |>
|
||||
dplyr::select(field_name, form_name) |>
|
||||
(\(.x){
|
||||
|
|
@ -5999,7 +5845,7 @@ m_redcap_readServer <- function(id) {
|
|||
if (isTRUE(data_rv$info$has_repeating_instruments_or_events)) {
|
||||
vectorSelectInput(
|
||||
inputId = ns("data_type"),
|
||||
label = "Specify the data format",
|
||||
label = i18n$t("Specify the data format"),
|
||||
choices = c(
|
||||
"Wide data (One row for each subject)" = "wide",
|
||||
"Long data for project with repeating instruments (default REDCap)" = "long"
|
||||
|
|
@ -6026,7 +5872,7 @@ m_redcap_readServer <- function(id) {
|
|||
if (input$data_type == "long" && isTRUE(any(input$fields %in% data_rv$rep_fields))) {
|
||||
vectorSelectInput(
|
||||
inputId = ns("fill"),
|
||||
label = "Fill missing values?",
|
||||
label = i18n$t("Fill missing values?"),
|
||||
choices = c(
|
||||
"Yes, fill missing, non-repeated values" = "yes",
|
||||
"No, leave the data as is" = "no"
|
||||
|
|
@ -6108,7 +5954,7 @@ m_redcap_readServer <- function(id) {
|
|||
data_rv$data_message <- imported$raw_text
|
||||
} else {
|
||||
data_rv$data_status <- "success"
|
||||
data_rv$data_message <- "Requested data was retrieved!"
|
||||
data_rv$data_message <- i18n$t("Requested data was retrieved!")
|
||||
|
||||
## The data management below should be separated to allow for changing
|
||||
## "wide"/"long" without re-importing data
|
||||
|
|
@ -6143,12 +5989,12 @@ m_redcap_readServer <- function(id) {
|
|||
|
||||
if (!any(in_data_check[-1])) {
|
||||
data_rv$data_status <- "warning"
|
||||
data_rv$data_message <- "Data retrieved, but it looks like only the ID was retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access."
|
||||
data_rv$data_message <- i18n$t("Data retrieved, but it looks like only the ID was retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access.")
|
||||
}
|
||||
|
||||
if (!all(in_data_check)) {
|
||||
data_rv$data_status <- "warning"
|
||||
data_rv$data_message <- "Data retrieved, but it looks like not all requested fields were retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access."
|
||||
data_rv$data_message <- i18n$t("Data retrieved, but it looks like not all requested fields were retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access.")
|
||||
}
|
||||
|
||||
data_rv$code <- code
|
||||
|
|
@ -6175,7 +6021,7 @@ m_redcap_readServer <- function(id) {
|
|||
# data_rv$data_message
|
||||
# ),
|
||||
include_data_alert(
|
||||
see_data_text = "Click to see the imported data",
|
||||
see_data_text = i18n$t("Click to see the imported data"),
|
||||
dataIdName = "see_data",
|
||||
extra = tags$p(
|
||||
tags$b(phosphoricons::ph("check", weight = "bold"), data_rv$data_message)
|
||||
|
|
@ -7515,7 +7361,7 @@ regression_ui <- function(id, ...) {
|
|||
shiny::tagList(
|
||||
# title = "",
|
||||
bslib::nav_panel(
|
||||
title = "Regression table",
|
||||
title = i18n$t("Regression table"),
|
||||
bslib::layout_sidebar(
|
||||
sidebar = bslib::sidebar(
|
||||
shiny::uiOutput(outputId = ns("data_info"), inline = TRUE),
|
||||
|
|
@ -7525,7 +7371,7 @@ regression_ui <- function(id, ...) {
|
|||
multiple = FALSE,
|
||||
bslib::accordion_panel(
|
||||
value = "acc_pan_reg",
|
||||
title = "Regression",
|
||||
title = i18n$t("Regression"),
|
||||
icon = bsicons::bs_icon("calculator"),
|
||||
shiny::uiOutput(outputId = ns("outcome_var")),
|
||||
# shiny::selectInput(
|
||||
|
|
@ -7540,7 +7386,7 @@ regression_ui <- function(id, ...) {
|
|||
shiny::uiOutput(outputId = ns("regression_type")),
|
||||
shiny::radioButtons(
|
||||
inputId = ns("all"),
|
||||
label = "Specify covariables",
|
||||
label = i18n$t("Specify covariables"),
|
||||
inline = TRUE, selected = 2,
|
||||
choiceNames = c(
|
||||
"Yes",
|
||||
|
|
@ -7551,15 +7397,15 @@ regression_ui <- function(id, ...) {
|
|||
shiny::conditionalPanel(
|
||||
condition = "input.all==1",
|
||||
shiny::uiOutput(outputId = ns("regression_vars")),
|
||||
shiny::helpText("If none are selected, all are included."),
|
||||
shiny::helpText(i18n$t("If none are selected, all are included.")),
|
||||
shiny::tags$br(),
|
||||
ns = ns
|
||||
),
|
||||
bslib::input_task_button(
|
||||
id = ns("load"),
|
||||
label = "Analyse",
|
||||
label = i18n$t("Analyse"),
|
||||
icon = bsicons::bs_icon("pencil"),
|
||||
label_busy = "Working...",
|
||||
label_busy = i18n$t("Working..."),
|
||||
icon_busy = fontawesome::fa_i("arrows-rotate",
|
||||
class = "fa-spin",
|
||||
"aria-hidden" = "true"
|
||||
|
|
@ -7567,17 +7413,18 @@ regression_ui <- function(id, ...) {
|
|||
type = "secondary",
|
||||
auto_reset = TRUE
|
||||
),
|
||||
shiny::helpText("Press 'Analyse' to create the regression model and after changing parameters."),
|
||||
shiny::helpText(i18n$t("Press 'Analyse' to create the regression model and after changing parameters.")),
|
||||
shiny::tags$br(),
|
||||
shiny::radioButtons(
|
||||
inputId = ns("add_regression_p"),
|
||||
label = "Show p-value",
|
||||
label = i18n$t("Show p-value"),
|
||||
inline = TRUE,
|
||||
selected = "yes",
|
||||
choices = list(
|
||||
"Yes" = "yes",
|
||||
"No" = "no"
|
||||
)
|
||||
choiceNames = c(
|
||||
"Yes",
|
||||
"No"
|
||||
),
|
||||
choiceValues = c("yes", "no")
|
||||
),
|
||||
# shiny::tags$br(),
|
||||
# shiny::radioButtons(
|
||||
|
|
@ -7620,7 +7467,7 @@ regression_ui <- function(id, ...) {
|
|||
shiny::tagList(
|
||||
shinyWidgets::noUiSliderInput(
|
||||
inputId = ns("plot_height"),
|
||||
label = "Plot height (mm)",
|
||||
label = i18n$t("Plot height (mm)"),
|
||||
min = 50,
|
||||
max = 300,
|
||||
value = 100,
|
||||
|
|
@ -7630,7 +7477,7 @@ regression_ui <- function(id, ...) {
|
|||
),
|
||||
shinyWidgets::noUiSliderInput(
|
||||
inputId = ns("plot_width"),
|
||||
label = "Plot width (mm)",
|
||||
label = i18n$t("Plot width (mm)"),
|
||||
min = 50,
|
||||
max = 300,
|
||||
value = 100,
|
||||
|
|
@ -7640,7 +7487,7 @@ regression_ui <- function(id, ...) {
|
|||
),
|
||||
shiny::selectInput(
|
||||
inputId = ns("plot_type"),
|
||||
label = "File format",
|
||||
label = i18n$t("File format"),
|
||||
choices = list(
|
||||
"png",
|
||||
"tiff",
|
||||
|
|
@ -7654,7 +7501,7 @@ regression_ui <- function(id, ...) {
|
|||
# Button
|
||||
shiny::downloadButton(
|
||||
outputId = ns("download_plot"),
|
||||
label = "Download plot",
|
||||
label = i18n$t("Download plot"),
|
||||
icon = shiny::icon("download")
|
||||
)
|
||||
)
|
||||
|
|
@ -7666,7 +7513,7 @@ regression_ui <- function(id, ...) {
|
|||
)
|
||||
),
|
||||
bslib::nav_panel(
|
||||
title = "Model checks",
|
||||
title = i18n$t("Model checks"),
|
||||
bslib::layout_sidebar(
|
||||
sidebar = bslib::sidebar(
|
||||
bslib::accordion(
|
||||
|
|
@ -8739,11 +8586,11 @@ ui_elements <- function(selection) {
|
|||
shiny::tags$br(),
|
||||
shiny::actionButton(
|
||||
inputId = "data_reset",
|
||||
label = "Restore original data",
|
||||
label = i18n$t("Restore original data"),
|
||||
width = "100%"
|
||||
),
|
||||
shiny::tags$br(),
|
||||
shiny::helpText("Reset to original imported dataset. Careful! There is no un-doing."),
|
||||
shiny::helpText(i18n$t("Reset to original imported dataset. Careful! There is no un-doing.")),
|
||||
shiny::tags$br()
|
||||
)
|
||||
# )
|
||||
|
|
@ -8762,7 +8609,7 @@ ui_elements <- function(selection) {
|
|||
# bslib::navset_bar(
|
||||
# title = "",
|
||||
bslib::nav_panel(
|
||||
title = "Characteristics",
|
||||
title = i18n$t("Characteristics"),
|
||||
icon = bsicons::bs_icon("table"),
|
||||
bslib::layout_sidebar(
|
||||
sidebar = bslib::sidebar(
|
||||
|
|
@ -8777,12 +8624,12 @@ ui_elements <- function(selection) {
|
|||
title = "Settings",
|
||||
icon = bsicons::bs_icon("table"),
|
||||
shiny::uiOutput("strat_var"),
|
||||
shiny::helpText("Only factor/categorical variables are available for stratification. Go back to the 'Prepare' tab to reclass a variable if it's not on the list."),
|
||||
shiny::helpText(i18n$t("Only factor/categorical variables are available for stratification. Go back to the 'Prepare' tab to reclass a variable if it's not on the list.")),
|
||||
shiny::conditionalPanel(
|
||||
condition = "input.strat_var!='none'",
|
||||
shiny::radioButtons(
|
||||
inputId = "add_p",
|
||||
label = "Compare strata?",
|
||||
label = i18n$t("Compare strata?"),
|
||||
selected = "no",
|
||||
inline = TRUE,
|
||||
choices = list(
|
||||
|
|
@ -8796,7 +8643,7 @@ ui_elements <- function(selection) {
|
|||
shiny::br(),
|
||||
shiny::actionButton(
|
||||
inputId = "act_eval",
|
||||
label = "Evaluate",
|
||||
label = i18n$t("Evaluate"),
|
||||
width = "100%",
|
||||
icon = shiny::icon("calculator"),
|
||||
disabled = TRUE
|
||||
|
|
@ -8808,7 +8655,7 @@ ui_elements <- function(selection) {
|
|||
)
|
||||
),
|
||||
bslib::nav_panel(
|
||||
title = "Correlations",
|
||||
title = i18n$t("Correlations"),
|
||||
icon = bsicons::bs_icon("bounding-box"),
|
||||
bslib::layout_sidebar(
|
||||
sidebar = bslib::sidebar(
|
||||
|
|
@ -8822,11 +8669,11 @@ ui_elements <- function(selection) {
|
|||
title = "Settings",
|
||||
icon = bsicons::bs_icon("bounding-box"),
|
||||
shiny::uiOutput("outcome_var_cor"),
|
||||
shiny::helpText("To avoid evaluating the correlation of the outcome variable, this can be excluded from the plot or select 'none'."),
|
||||
shiny::helpText(i18n$t("To avoid evaluating the correlation of the outcome variable, this can be excluded from the plot or select 'none'.")),
|
||||
shiny::br(),
|
||||
shinyWidgets::noUiSliderInput(
|
||||
inputId = "cor_cutoff",
|
||||
label = "Correlation cut-off",
|
||||
label = i18n$t("Correlation cut-off"),
|
||||
min = 0,
|
||||
max = 1,
|
||||
step = .01,
|
||||
|
|
@ -8834,7 +8681,7 @@ ui_elements <- function(selection) {
|
|||
format = shinyWidgets::wNumbFormat(decimals = 2),
|
||||
color = datamods:::get_primary_color()
|
||||
),
|
||||
shiny::helpText("Set the cut-off for considered 'highly correlated'.")
|
||||
shiny::helpText(i18n$t("Set the cut-off for considered 'highly correlated'."))
|
||||
)
|
||||
)
|
||||
),
|
||||
|
|
@ -8842,7 +8689,7 @@ ui_elements <- function(selection) {
|
|||
)
|
||||
),
|
||||
bslib::nav_panel(
|
||||
title = "Missings",
|
||||
title = i18n$t("Missings"),
|
||||
icon = bsicons::bs_icon("x-circle"),
|
||||
bslib::layout_sidebar(
|
||||
sidebar = bslib::sidebar(
|
||||
|
|
@ -8855,7 +8702,7 @@ ui_elements <- function(selection) {
|
|||
title = "Settings",
|
||||
icon = bsicons::bs_icon("x-circle"),
|
||||
shiny::uiOutput("missings_var"),
|
||||
shiny::helpText("To consider if data is missing by random, choose the outcome/dependent variable, if it has any missings to evaluate if there is a significant difference across other variables depending on missing data or not.")
|
||||
shiny::helpText(i18n$t("To consider if data is missing by random, choose the outcome/dependent variable, if it has any missings to evaluate if there is a significant difference across other variables depending on missing data or not."))
|
||||
)
|
||||
)
|
||||
),
|
||||
|
|
@ -10633,11 +10480,13 @@ make_validation_alerts <- function(data) {
|
|||
|
||||
#' Data correlations evaluation module
|
||||
#'
|
||||
#' @param id Module id
|
||||
#' @param id id
|
||||
#'
|
||||
#' @name data-missings
|
||||
#' @name visual-summary
|
||||
#' @returns Shiny ui module
|
||||
#' @export
|
||||
#'
|
||||
#' @example examples/visual_summary_demo.R
|
||||
visual_summary_ui <- function(id) {
|
||||
ns <- shiny::NS(id)
|
||||
|
||||
|
|
@ -10646,8 +10495,17 @@ visual_summary_ui <- function(id) {
|
|||
)
|
||||
}
|
||||
|
||||
#' Visual summary server
|
||||
#'
|
||||
#' @param data_r reactive data
|
||||
#' @param ... passed on to the visual_summary() function
|
||||
#'
|
||||
#' @name visual-summary
|
||||
#' @returns shiny server
|
||||
#' @export
|
||||
#'
|
||||
visual_summary_server <- function(id,
|
||||
data_r=shiny::reactive(NULL),
|
||||
data_r = shiny::reactive(NULL),
|
||||
...) {
|
||||
shiny::moduleServer(
|
||||
id = id,
|
||||
|
|
@ -10676,45 +10534,26 @@ visual_summary_server <- function(id,
|
|||
# missings_apex_plot(datar(), ...)
|
||||
# })
|
||||
output$visual_plot <- shiny::renderPlot(expr = {
|
||||
visual_summary(data = rv$data,...)
|
||||
visual_summary(data = rv$data, na.label = i18n$t("Missings"), legend.title = i18n$t("Class"), ylab = i18n$t("Observations"), ...)
|
||||
})
|
||||
}
|
||||
)
|
||||
}
|
||||
|
||||
visual_summary_demo_app <- function() {
|
||||
ui <- shiny::fluidPage(
|
||||
shiny::actionButton(
|
||||
inputId = "modal_missings",
|
||||
label = "Visual summary",
|
||||
width = "100%",
|
||||
disabled = FALSE
|
||||
)
|
||||
)
|
||||
server <- function(input, output, session) {
|
||||
data_demo <- mtcars
|
||||
data_demo[sample(1:32, 10), "cyl"] <- NA
|
||||
data_demo[sample(1:32, 8), "vs"] <- NA
|
||||
|
||||
visual_summary_server(id = "data", data = shiny::reactive(data_demo))
|
||||
|
||||
observeEvent(input$modal_missings, {
|
||||
tryCatch(
|
||||
{
|
||||
modal_visual_summary(id = "data")
|
||||
},
|
||||
error = function(err) {
|
||||
showNotification(paste0("We encountered the following error browsing your data: ", err), type = "err")
|
||||
}
|
||||
)
|
||||
})
|
||||
}
|
||||
shiny::shinyApp(ui, server)
|
||||
}
|
||||
|
||||
visual_summary_demo_app()
|
||||
|
||||
|
||||
#' Visual summary modal
|
||||
#'
|
||||
#' @param title title
|
||||
#' @param easyClose easyClose
|
||||
#' @param size modal size
|
||||
#' @param footer modal footer
|
||||
#' @param ... ignored
|
||||
#'
|
||||
#' @name visual-summary
|
||||
#'
|
||||
#' @returns shiny modal
|
||||
#' @export
|
||||
#'
|
||||
modal_visual_summary <- function(id,
|
||||
title = "Visual overview of data classes and missing observations",
|
||||
easyClose = TRUE,
|
||||
|
|
@ -10733,9 +10572,10 @@ modal_visual_summary <- function(id,
|
|||
|
||||
## Slow with many observations...
|
||||
|
||||
#' Plot missings and class with apexcharter
|
||||
#' Plot missings and class with apexcharter. Not in use with FreesearchR.
|
||||
#'
|
||||
#' @param data data frame
|
||||
#' @name visual-summary
|
||||
#'
|
||||
#' @returns An [apexchart()] `htmlwidget` object.
|
||||
#' @export
|
||||
|
|
@ -10790,6 +10630,10 @@ missings_apex_plot <- function(data, animation = FALSE, ...) {
|
|||
#'
|
||||
#' @param data data
|
||||
#' @param ... optional arguments passed to data_summary_gather()
|
||||
#' @param legend.title Legend title
|
||||
#' @param ylab Y axis label
|
||||
#'
|
||||
#' @name visual-summary
|
||||
#'
|
||||
#' @returns ggplot2 object
|
||||
#' @export
|
||||
|
|
@ -10800,11 +10644,15 @@ missings_apex_plot <- function(data, animation = FALSE, ...) {
|
|||
#' data_demo[sample(1:32, 8), "vs"] <- NA
|
||||
#' visual_summary(data_demo)
|
||||
#' visual_summary(data_demo, palette.fun = scales::hue_pal())
|
||||
#' visual_summary(dplyr::storms)
|
||||
#' visual_summary(dplyr::storms, summary.fun = data_type)
|
||||
visual_summary <- function(data, legend.title = "Data class", ...) {
|
||||
#' visual_summary(dplyr::storms, summary.fun = data_type, na.label = "Missings", legend.title = "Class")
|
||||
visual_summary <- function(data, legend.title = NULL, ylab = "Observations", ...) {
|
||||
l <- data_summary_gather(data, ...)
|
||||
|
||||
if (is.null(legend.title)) {
|
||||
legend.title <- l$summary.fun
|
||||
}
|
||||
|
||||
df <- l$data
|
||||
|
||||
df$valueType <- factor(df$valueType, levels = names(l$colors))
|
||||
|
|
@ -10818,13 +10666,13 @@ visual_summary <- function(data, legend.title = "Data class", ...) {
|
|||
vjust = 1, hjust = 1
|
||||
)) +
|
||||
ggplot2::scale_fill_manual(values = l$colors) +
|
||||
ggplot2::labs(x = "", y = "Observations") +
|
||||
ggplot2::labs(x = "", y = ylab) +
|
||||
ggplot2::scale_y_reverse() +
|
||||
ggplot2::theme(axis.text.x = ggplot2::element_text(hjust = 0.5)) +
|
||||
ggplot2::guides(colour = "none") +
|
||||
ggplot2::guides(fill = ggplot2::guide_legend(title = legend.title)) +
|
||||
# change the limits etc.
|
||||
ggplot2::guides(fill = ggplot2::guide_legend(title = "Type")) +
|
||||
# ggplot2::guides(fill = ggplot2::guide_legend(title = guide.lab)) +
|
||||
# add info about the axes
|
||||
ggplot2::scale_x_discrete(position = "top") +
|
||||
ggplot2::theme(axis.text.x = ggplot2::element_text(hjust = 0)) +
|
||||
|
|
@ -10839,16 +10687,18 @@ visual_summary <- function(data, legend.title = "Data class", ...) {
|
|||
#' Data summary for printing visual summary
|
||||
#'
|
||||
#' @param data data.frame
|
||||
#' @param fun summary function. Default is "class"
|
||||
#' @param palette.fun optionally use specific palette functions. First argument
|
||||
#' has to be the length.
|
||||
#' @param summary.fun fun for summarising
|
||||
#' @param na.label label for NA
|
||||
#' @param ... overflow
|
||||
#'
|
||||
#' @returns data.frame
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' mtcars |> data_summary_gather()
|
||||
data_summary_gather <- function(data, summary.fun = class, palette.fun = viridisLite::viridis) {
|
||||
data_summary_gather <- function(data, summary.fun = class, palette.fun = viridisLite::viridis, na.label = "NA", ...) {
|
||||
df_plot <- setNames(data, unique_short(names(data))) |>
|
||||
purrr::map_df(\(x){
|
||||
ifelse(is.na(x),
|
||||
|
|
@ -10870,12 +10720,12 @@ data_summary_gather <- function(data, summary.fun = class, palette.fun = viridis
|
|||
forcats::as_factor() |>
|
||||
as.numeric()
|
||||
|
||||
df_plot$valueType[is.na(df_plot$valueType)] <- "NA"
|
||||
df_plot$valueType[is.na(df_plot$valueType)] <- na.label
|
||||
df_plot$valueType_num[is.na(df_plot$valueType_num)] <- max(df_plot$valueType_num, na.rm = TRUE) + 1
|
||||
|
||||
labels <- setNames(unique(df_plot$valueType_num), unique(df_plot$valueType)) |> sort()
|
||||
|
||||
if (any(df_plot$valueType == "NA")) {
|
||||
if (any(df_plot$valueType == na.label)) {
|
||||
colors <- setNames(c(palette.fun(length(labels) - 1), "#999999"), names(labels))
|
||||
} else {
|
||||
colors <- setNames(palette.fun(length(labels)), names(labels))
|
||||
|
|
@ -10893,7 +10743,7 @@ data_summary_gather <- function(data, summary.fun = class, palette.fun = viridis
|
|||
}) |>
|
||||
setNames(NULL)
|
||||
|
||||
list(data = df_plot, colors = colors, labels = label_list)
|
||||
list(data = df_plot, colors = colors, labels = label_list, summary.fun = deparse(substitute(summary.fun)))
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -11442,7 +11292,7 @@ server <- function(input, output, session) {
|
|||
modal_visual_summary(
|
||||
id = "initial_summary",
|
||||
footer = NULL,
|
||||
size = "xl"
|
||||
size = "xl",title = i18n$t("Data classes and missing observations")
|
||||
)
|
||||
},
|
||||
error = function(err) {
|
||||
|
|
@ -11575,8 +11425,10 @@ server <- function(input, output, session) {
|
|||
shinyWidgets::ask_confirmation(
|
||||
cancelOnDismiss = TRUE,
|
||||
inputId = "reset_confirm",
|
||||
title = "Please confirm data reset?",
|
||||
type = "warning"
|
||||
title = i18n$t("Please confirm data reset!"),
|
||||
type = "warning",
|
||||
text = i18n$t("Sure you want to reset data? This cannot be undone."),
|
||||
btn_labels = c(i18n$t("Cancel"), i18n$t("Confirm"))
|
||||
)
|
||||
})
|
||||
|
||||
|
|
@ -11590,14 +11442,14 @@ server <- function(input, output, session) {
|
|||
|
||||
output$data_info <- shiny::renderUI({
|
||||
shiny::req(data_filter())
|
||||
data_description(data_filter(), "The filtered data")
|
||||
data_description(data_filter(), data_text = i18n$t("The filtered data"))
|
||||
})
|
||||
|
||||
######### Create factor
|
||||
|
||||
shiny::observeEvent(
|
||||
input$modal_cut,
|
||||
modal_cut_variable("modal_cut", title = "Create new factor")
|
||||
modal_cut_variable("modal_cut", title = i18n$t("Create new factor"))
|
||||
)
|
||||
|
||||
data_modal_cut <- cut_variable_server(
|
||||
|
|
@ -11614,7 +11466,7 @@ server <- function(input, output, session) {
|
|||
|
||||
shiny::observeEvent(
|
||||
input$modal_update,
|
||||
datamods::modal_update_factor(id = "modal_update", title = "Reorder factor levels")
|
||||
datamods::modal_update_factor(id = "modal_update", title = i18n$t("Reorder factor levels"))
|
||||
)
|
||||
|
||||
data_modal_update <- datamods::update_factor_server(
|
||||
|
|
@ -11634,8 +11486,8 @@ server <- function(input, output, session) {
|
|||
input$modal_column,
|
||||
modal_create_column(
|
||||
id = "modal_column",
|
||||
footer = shiny::markdown("This window is aimed at advanced users and require some *R*-experience!"),
|
||||
title = "Create new variables"
|
||||
footer = shiny::markdown(i18n$t("This window is aimed at advanced users and require some *R*-experience!")),
|
||||
title = i18n$t("Create new variables")
|
||||
)
|
||||
)
|
||||
data_modal_r <- create_column_server(
|
||||
|
|
@ -11673,7 +11525,7 @@ server <- function(input, output, session) {
|
|||
# c("dichotomous", "ordinal", "categorical", "datatime", "continuous")
|
||||
shinyWidgets::virtualSelectInput(
|
||||
inputId = "column_filter",
|
||||
label = "Select data types to include",
|
||||
label = i18n$t("Select data types to include"),
|
||||
selected = unique(data_type(rv$data)),
|
||||
choices = unique(data_type(rv$data)),
|
||||
updateOn = "change",
|
||||
|
|
@ -11878,7 +11730,7 @@ server <- function(input, output, session) {
|
|||
observeEvent(input$modal_browse, {
|
||||
tryCatch(
|
||||
{
|
||||
show_data(REDCapCAST::fct_drop(rv$data_filtered), title = "Uploaded data overview", type = "modal")
|
||||
show_data(REDCapCAST::fct_drop(rv$data_filtered), title = i18n$t("Uploaded data overview"), type = "modal")
|
||||
},
|
||||
error = function(err) {
|
||||
showNotification(paste0("We encountered the following error browsing your data: ", err), type = "err")
|
||||
|
|
@ -11900,7 +11752,7 @@ server <- function(input, output, session) {
|
|||
{
|
||||
modal_visual_summary(
|
||||
id = "visual_overview",
|
||||
footer = "Here is an overview of how your data is interpreted, and where data is missing. Use this information to consider if data is missing at random or if some observations are missing systematically wich may be caused by an observation bias.",
|
||||
footer = i18n$t("Here is an overview of how your data is interpreted, and where data is missing. Use this information to consider if data is missing at random or if some observations are missing systematically wich may be caused by an observation bias."),
|
||||
size = "xl"
|
||||
)
|
||||
},
|
||||
|
|
@ -11952,12 +11804,12 @@ server <- function(input, output, session) {
|
|||
|
||||
output$code_import <- shiny::renderUI({
|
||||
shiny::req(rv$code$import)
|
||||
prismCodeBlock(paste0("#Data import\n", rv$code$import))
|
||||
prismCodeBlock(paste0(i18n$t("#Data import\n"), rv$code$import))
|
||||
})
|
||||
|
||||
output$code_format <- shiny::renderUI({
|
||||
shiny::req(rv$code$format)
|
||||
prismCodeBlock(paste0("#Data import formatting\n", rv$code$format))
|
||||
prismCodeBlock(paste0(i18n$t("#Data import formatting\n"), rv$code$format))
|
||||
})
|
||||
|
||||
output$code_data <- shiny::renderUI({
|
||||
|
|
|
|||
|
|
@ -160,3 +160,62 @@
|
|||
"Missing vs non-missing observations in the variable **'{variabler()}'**","Manglende vs ikke-manglende observationer i variablen **'{variabler()}'**"
|
||||
"There is a significant correlation between {n_nonmcar} variables and missing observations in the outcome variable {outcome}.","There is a significant correlation between {n_nonmcar} variables and missing observations in the outcome variable {outcome}."
|
||||
"There is a total of {p_miss} % missing observations.","Der er i alt {p_miss} % manglende observationer."
|
||||
"Median:","Median:"
|
||||
"Restore original data","Restore original data"
|
||||
"Reset to original imported dataset. Careful! There is no un-doing.","Reset to original imported dataset. Careful! There is no un-doing."
|
||||
"Characteristics","Characteristics"
|
||||
"Only factor/categorical variables are available for stratification. Go back to the 'Prepare' tab to reclass a variable if it's not on the list.","Only factor/categorical variables are available for stratification. Go back to the 'Prepare' tab to reclass a variable if it's not on the list."
|
||||
"Compare strata?","Compare strata?"
|
||||
"Correlations","Correlations"
|
||||
"To avoid evaluating the correlation of the outcome variable, this can be excluded from the plot or select 'none'.","To avoid evaluating the correlation of the outcome variable, this can be excluded from the plot or select 'none'."
|
||||
"Correlation cut-off","Correlation cut-off"
|
||||
"Set the cut-off for considered 'highly correlated'.","Set the cut-off for considered 'highly correlated'."
|
||||
"Missings","Missings"
|
||||
"To consider if data is missing by random, choose the outcome/dependent variable, if it has any missings to evaluate if there is a significant difference across other variables depending on missing data or not.","To consider if data is missing by random, choose the outcome/dependent variable, if it has any missings to evaluate if there is a significant difference across other variables depending on missing data or not."
|
||||
"Class","Class"
|
||||
"Observations","Observations"
|
||||
"Data classes and missing observations","Data classes and missing observations"
|
||||
"Sure you want to reset data? This cannot be undone.","Sure you want to reset data? This cannot be undone."
|
||||
"Cancel","Cancel"
|
||||
"Confirm","Confirm"
|
||||
"The filtered data","The filtered data"
|
||||
"Create new factor","Create new factor"
|
||||
"This window is aimed at advanced users and require some *R*-experience!","This window is aimed at advanced users and require some *R*-experience!"
|
||||
"Create new variables","Create new variables"
|
||||
"Select data types to include","Select data types to include"
|
||||
"Uploaded data overview","Uploaded data overview"
|
||||
"Here is an overview of how your data is interpreted, and where data is missing. Use this information to consider if data is missing at random or if some observations are missing systematically wich may be caused by an observation bias.","Here is an overview of how your data is interpreted, and where data is missing. Use this information to consider if data is missing at random or if some observations are missing systematically wich may be caused by an observation bias."
|
||||
"#Data import\n","#Data import\n"
|
||||
"#Data import formatting\n","#Data import formatting\n"
|
||||
"Specify covariables","Specify covariables"
|
||||
"If none are selected, all are included.","If none are selected, all are included."
|
||||
"Analyse","Analyse"
|
||||
"Working...","Working..."
|
||||
"Press 'Analyse' to create the regression model and after changing parameters.","Press 'Analyse' to create the regression model and after changing parameters."
|
||||
"Show p-value","Show p-value"
|
||||
"Model checks","Model checks"
|
||||
"Please confirm data reset!","Please confirm data reset!"
|
||||
"Import data from REDCap","Import data from REDCap"
|
||||
"REDCap server","REDCap server"
|
||||
"Web address","Web address"
|
||||
"Format should be either 'https://redcap.your.institution/' or 'https://your.institution/redcap/'","Format should be either 'https://redcap.your.institution/' or 'https://your.institution/redcap/'"
|
||||
"API token","API token"
|
||||
"The token is a string of 32 numbers and letters.","The token is a string of 32 numbers and letters."
|
||||
"Connect","Connect"
|
||||
"Data import parameters","Data import parameters"
|
||||
"Select fields/variables to import and click the funnel to apply optional filters","Select fields/variables to import and click the funnel to apply optional filters"
|
||||
"Import","Import"
|
||||
"Click to see data dictionary","Click to see data dictionary"
|
||||
"Connected to server!","Connected to server!"
|
||||
"The {data_rv$info$project_title} project is loaded.","The {data_rv$info$project_title} project is loaded."
|
||||
"Data dictionary","Data dictionary"
|
||||
"Preview:","Preview:"
|
||||
"Imported data set","Imported data set"
|
||||
"Select fields/variables to import:","Select fields/variables to import:"
|
||||
"Specify the data format","Specify the data format"
|
||||
"Fill missing values?","Fill missing values?"
|
||||
"Requested data was retrieved!","Requested data was retrieved!"
|
||||
"Data retrieved, but it looks like only the ID was retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access.","Data retrieved, but it looks like only the ID was retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access."
|
||||
"Data retrieved, but it looks like not all requested fields were retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access.","Data retrieved, but it looks like not all requested fields were retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access."
|
||||
"Click to see the imported data","Click to see the imported data"
|
||||
"Regression table","Regression table"
|
||||
|
|
|
|||
|
|
|
@ -160,3 +160,62 @@
|
|||
"Missing vs non-missing observations in the variable **'{variabler()}'**","Missing vs non-missing observations in the variable **'{variabler()}'**"
|
||||
"There is a significant correlation between {n_nonmcar} variables and missing observations in the outcome variable {outcome}.","There is a significant correlation between {n_nonmcar} variables and missing observations in the outcome variable {outcome}."
|
||||
"There is a total of {p_miss} % missing observations.","There is a total of {p_miss} % missing observations."
|
||||
"Median:","Median:"
|
||||
"Restore original data","Restore original data"
|
||||
"Reset to original imported dataset. Careful! There is no un-doing.","Reset to original imported dataset. Careful! There is no un-doing."
|
||||
"Characteristics","Characteristics"
|
||||
"Only factor/categorical variables are available for stratification. Go back to the 'Prepare' tab to reclass a variable if it's not on the list.","Only factor/categorical variables are available for stratification. Go back to the 'Prepare' tab to reclass a variable if it's not on the list."
|
||||
"Compare strata?","Compare strata?"
|
||||
"Correlations","Correlations"
|
||||
"To avoid evaluating the correlation of the outcome variable, this can be excluded from the plot or select 'none'.","To avoid evaluating the correlation of the outcome variable, this can be excluded from the plot or select 'none'."
|
||||
"Correlation cut-off","Correlation cut-off"
|
||||
"Set the cut-off for considered 'highly correlated'.","Set the cut-off for considered 'highly correlated'."
|
||||
"Missings","Missings"
|
||||
"To consider if data is missing by random, choose the outcome/dependent variable, if it has any missings to evaluate if there is a significant difference across other variables depending on missing data or not.","To consider if data is missing by random, choose the outcome/dependent variable, if it has any missings to evaluate if there is a significant difference across other variables depending on missing data or not."
|
||||
"Class","Class"
|
||||
"Observations","Observations"
|
||||
"Data classes and missing observations","Data classes and missing observations"
|
||||
"Sure you want to reset data? This cannot be undone.","Sure you want to reset data? This cannot be undone."
|
||||
"Cancel","Cancel"
|
||||
"Confirm","Confirm"
|
||||
"The filtered data","The filtered data"
|
||||
"Create new factor","Create new factor"
|
||||
"This window is aimed at advanced users and require some *R*-experience!","This window is aimed at advanced users and require some *R*-experience!"
|
||||
"Create new variables","Create new variables"
|
||||
"Select data types to include","Select data types to include"
|
||||
"Uploaded data overview","Uploaded data overview"
|
||||
"Here is an overview of how your data is interpreted, and where data is missing. Use this information to consider if data is missing at random or if some observations are missing systematically wich may be caused by an observation bias.","Here is an overview of how your data is interpreted, and where data is missing. Use this information to consider if data is missing at random or if some observations are missing systematically wich may be caused by an observation bias."
|
||||
"#Data import\n","#Data import\n"
|
||||
"#Data import formatting\n","#Data import formatting\n"
|
||||
"Specify covariables","Specify covariables"
|
||||
"If none are selected, all are included.","If none are selected, all are included."
|
||||
"Analyse","Analyse"
|
||||
"Working...","Working..."
|
||||
"Press 'Analyse' to create the regression model and after changing parameters.","Press 'Analyse' to create the regression model and after changing parameters."
|
||||
"Show p-value","Show p-value"
|
||||
"Model checks","Model checks"
|
||||
"Please confirm data reset!","Please confirm data reset!"
|
||||
"Import data from REDCap","Import data from REDCap"
|
||||
"REDCap server","REDCap server"
|
||||
"Web address","Web address"
|
||||
"Format should be either 'https://redcap.your.institution/' or 'https://your.institution/redcap/'","Format should be either 'https://redcap.your.institution/' or 'https://your.institution/redcap/'"
|
||||
"API token","API token"
|
||||
"The token is a string of 32 numbers and letters.","The token is a string of 32 numbers and letters."
|
||||
"Connect","Connect"
|
||||
"Data import parameters","Data import parameters"
|
||||
"Select fields/variables to import and click the funnel to apply optional filters","Select fields/variables to import and click the funnel to apply optional filters"
|
||||
"Import","Import"
|
||||
"Click to see data dictionary","Click to see data dictionary"
|
||||
"Connected to server!","Connected to server!"
|
||||
"The {data_rv$info$project_title} project is loaded.","The {data_rv$info$project_title} project is loaded."
|
||||
"Data dictionary","Data dictionary"
|
||||
"Preview:","Preview:"
|
||||
"Imported data set","Imported data set"
|
||||
"Select fields/variables to import:","Select fields/variables to import:"
|
||||
"Specify the data format","Specify the data format"
|
||||
"Fill missing values?","Fill missing values?"
|
||||
"Requested data was retrieved!","Requested data was retrieved!"
|
||||
"Data retrieved, but it looks like only the ID was retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access.","Data retrieved, but it looks like only the ID was retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access."
|
||||
"Data retrieved, but it looks like not all requested fields were retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access.","Data retrieved, but it looks like not all requested fields were retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access."
|
||||
"Click to see the imported data","Click to see the imported data"
|
||||
"Regression table","Regression table"
|
||||
|
|
|
|||
|
32
examples/visual_summary_demo.R
Normal file
32
examples/visual_summary_demo.R
Normal file
|
|
@ -0,0 +1,32 @@
|
|||
visual_summary_demo_app <- function() {
|
||||
ui <- shiny::fluidPage(
|
||||
shiny::actionButton(
|
||||
inputId = "modal_missings",
|
||||
label = "Visual summary",
|
||||
width = "100%",
|
||||
disabled = FALSE
|
||||
)
|
||||
)
|
||||
server <- function(input, output, session) {
|
||||
data_demo <- mtcars
|
||||
data_demo[sample(1:32, 10), "cyl"] <- NA
|
||||
data_demo[sample(1:32, 8), "vs"] <- NA
|
||||
data_demo$gear <- factor(data_demo$gear)
|
||||
|
||||
visual_summary_server(id = "data", data = shiny::reactive(data_demo),summary.fun=class)
|
||||
|
||||
observeEvent(input$modal_missings, {
|
||||
tryCatch(
|
||||
{
|
||||
modal_visual_summary(id = "data")
|
||||
},
|
||||
error = function(err) {
|
||||
showNotification(paste0("We encountered the following error browsing your data: ", err), type = "err")
|
||||
}
|
||||
)
|
||||
})
|
||||
}
|
||||
shiny::shinyApp(ui, server)
|
||||
}
|
||||
|
||||
visual_summary_demo_app()
|
||||
|
|
@ -1,7 +1,7 @@
|
|||
|
||||
|
||||
########
|
||||
#### Current file: /var/folders/9l/xbc19wxx0g79jdd2sf_0v291mhwh7f/T//RtmpCENEZ9/file6e5430b6d378.R
|
||||
#### Current file: /var/folders/9l/xbc19wxx0g79jdd2sf_0v291mhwh7f/T//RtmpCENEZ9/file6e544faf2ed5.R
|
||||
########
|
||||
|
||||
i18n_path <- system.file("translations", package = "FreesearchR")
|
||||
|
|
@ -2523,163 +2523,6 @@ clean_common_axis <- function(p, axis) {
|
|||
}
|
||||
|
||||
|
||||
########
|
||||
#### Current file: /Users/au301842/FreesearchR/R//data-import.R
|
||||
########
|
||||
|
||||
data_import_ui <- function(id) {
|
||||
ns <- shiny::NS(id)
|
||||
|
||||
shiny::fluidRow(
|
||||
shiny::column(width = 2),
|
||||
shiny::column(
|
||||
width = 8,
|
||||
shiny::h4("Choose your data source"),
|
||||
shiny::br(),
|
||||
shinyWidgets::radioGroupButtons(
|
||||
inputId = "source",
|
||||
selected = "env",
|
||||
choices = c(
|
||||
"File upload" = "file",
|
||||
"REDCap server export" = "redcap",
|
||||
"Local or sample data" = "env"
|
||||
),
|
||||
width = "100%"
|
||||
),
|
||||
shiny::helpText("Upload a file from your device, get data directly from REDCap or select a sample data set for testing from the app."),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::conditionalPanel(
|
||||
condition = "input.source=='file'",
|
||||
import_file_ui(
|
||||
id = ns("file_import"),
|
||||
layout_params = "dropdown",
|
||||
title = "Choose a datafile to upload",
|
||||
file_extensions = c(".csv", ".tsv", ".txt", ".xls", ".xlsx", ".rds", ".sas7bdat", ".ods", ".dta")
|
||||
)
|
||||
),
|
||||
shiny::conditionalPanel(
|
||||
condition = "input.source=='redcap'",
|
||||
m_redcap_readUI(id = ns("redcap_import"))
|
||||
),
|
||||
shiny::conditionalPanel(
|
||||
condition = "input.source=='env'",
|
||||
datamods::import_globalenv_ui(id = ns("env"), title = NULL)
|
||||
),
|
||||
shiny::conditionalPanel(
|
||||
condition = "input.source=='redcap'",
|
||||
DT::DTOutput(outputId = ns("redcap_prev"))
|
||||
)
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
data_import_server <- function(id) {
|
||||
module <- function(input, output, session) {
|
||||
ns <- session$ns
|
||||
|
||||
rv <- shiny::reactiveValues(
|
||||
data_temp = NULL,
|
||||
code = list()
|
||||
)
|
||||
|
||||
data_file <- import_file_server(
|
||||
id = ns("file_import"),
|
||||
show_data_in = "popup",
|
||||
trigger_return = "change",
|
||||
return_class = "data.frame"
|
||||
)
|
||||
|
||||
shiny::observeEvent(data_file$data(), {
|
||||
shiny::req(data_file$data())
|
||||
|
||||
rv$data_temp <- data_file$data()
|
||||
rv$code <- append_list(data = data_file$code(), list = rv$code, index = "import")
|
||||
})
|
||||
|
||||
data_redcap <- m_redcap_readServer(
|
||||
id = "redcap_import"
|
||||
)
|
||||
|
||||
shiny::observeEvent(data_redcap(), {
|
||||
# rv$data_original <- purrr::pluck(data_redcap(), "data")()
|
||||
rv$data_temp <- data_redcap()
|
||||
})
|
||||
|
||||
from_env <- datamods::import_globalenv_server(
|
||||
id = "env",
|
||||
trigger_return = "change",
|
||||
btn_show_data = FALSE,
|
||||
reset = reactive(input$hidden)
|
||||
)
|
||||
|
||||
shiny::observeEvent(from_env$data(), {
|
||||
shiny::req(from_env$data())
|
||||
|
||||
rv$data_temp <- from_env$data()
|
||||
# rv$code <- append_list(data = from_env$code(),list = rv$code,index = "import")
|
||||
})
|
||||
|
||||
return(list(
|
||||
# status = reactive(temporary_rv$status),
|
||||
# name = reactive(temporary_rv$name),
|
||||
# code = reactive(temporary_rv$code),
|
||||
data = shiny::reactive(rv$data_temp)
|
||||
))
|
||||
|
||||
}
|
||||
|
||||
shiny::moduleServer(
|
||||
id = id,
|
||||
module = module
|
||||
)
|
||||
|
||||
}
|
||||
|
||||
|
||||
#' Test app for the data-import module
|
||||
#'
|
||||
#' @rdname data-import
|
||||
#'
|
||||
#' @examples
|
||||
#' \dontrun{
|
||||
#' data_import_demo_app()
|
||||
#' }
|
||||
data_import_demo_app <- function() {
|
||||
ui <- shiny::fluidPage(
|
||||
data_import_ui("data_import"),
|
||||
toastui::datagridOutput2(outputId = "table"),
|
||||
DT::DTOutput("data_summary")
|
||||
)
|
||||
server <- function(input, output, session) {
|
||||
imported <- shiny::reactive(data_import_server(id = "data_import"))
|
||||
|
||||
# output$data_summary <- DT::renderDataTable(
|
||||
# {
|
||||
# shiny::req(data_val$data)
|
||||
# data_val$data
|
||||
# },
|
||||
# options = list(
|
||||
# scrollX = TRUE,
|
||||
# pageLength = 5
|
||||
# )
|
||||
# )
|
||||
output$table <- toastui::renderDatagrid2({
|
||||
req(imported$data)
|
||||
toastui::datagrid(
|
||||
data = head(imported$data, 5),
|
||||
theme = "striped",
|
||||
colwidths = "guess",
|
||||
minBodyHeight = 250
|
||||
)
|
||||
})
|
||||
|
||||
}
|
||||
shiny::shinyApp(ui, server)
|
||||
}
|
||||
|
||||
|
||||
########
|
||||
#### Current file: /Users/au301842/FreesearchR/R//data-summary.R
|
||||
########
|
||||
|
|
@ -3290,6 +3133,9 @@ describe_col_num <- function(x, with_summary = TRUE) {
|
|||
tags$div(
|
||||
i18n$t("Mean:"), round(mean(x, na.rm = TRUE), 2)
|
||||
),
|
||||
tags$div(
|
||||
i18n$t("Median:"), round(median(x, na.rm = TRUE), 2)
|
||||
),
|
||||
tags$div(
|
||||
i18n$t("Max:"), round(max(x, na.rm = TRUE), 2)
|
||||
),
|
||||
|
|
@ -4107,7 +3953,7 @@ simple_snake <- function(data){
|
|||
#### Current file: /Users/au301842/FreesearchR/R//hosted_version.R
|
||||
########
|
||||
|
||||
hosted_version <- function()'v25.9.2-250924'
|
||||
hosted_version <- function()'v25.9.2-250925'
|
||||
|
||||
|
||||
########
|
||||
|
|
@ -5703,20 +5549,20 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
|
|||
|
||||
if (isTRUE(title)) {
|
||||
title <- shiny::tags$h4(
|
||||
"Import data from REDCap",
|
||||
i18n$t("Import data from REDCap"),
|
||||
class = "redcap-module-title"
|
||||
)
|
||||
}
|
||||
|
||||
server_ui <- shiny::tagList(
|
||||
shiny::tags$h4("REDCap server"),
|
||||
shiny::tags$h4(i18n$t("REDCap server")),
|
||||
shiny::textInput(
|
||||
inputId = ns("uri"),
|
||||
label = "Web address",
|
||||
label = i18n$t("Web address"),
|
||||
value = if_not_missing(url, "https://redcap.your.institution/"),
|
||||
width = "100%"
|
||||
),
|
||||
shiny::helpText("Format should be either 'https://redcap.your.institution/' or 'https://your.institution/redcap/'"),
|
||||
shiny::helpText(i18n$t("Format should be either 'https://redcap.your.institution/' or 'https://your.institution/redcap/'")),
|
||||
# shiny::textInput(
|
||||
# inputId = ns("api"),
|
||||
# label = "API token",
|
||||
|
|
@ -5725,16 +5571,16 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
|
|||
# ),
|
||||
shiny::passwordInput(
|
||||
inputId = ns("api"),
|
||||
label = "API token",
|
||||
label = i18n$t("API token"),
|
||||
value = "",
|
||||
width = "100%"
|
||||
),
|
||||
shiny::helpText("The token is a string of 32 numbers and letters."),
|
||||
shiny::helpText(i18n$t("The token is a string of 32 numbers and letters.")),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::actionButton(
|
||||
inputId = ns("data_connect"),
|
||||
label = "Connect",
|
||||
label = i18n$t("Connect"),
|
||||
icon = shiny::icon("link", lib = "glyphicon"),
|
||||
width = "100%",
|
||||
disabled = TRUE
|
||||
|
|
@ -5759,13 +5605,13 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
|
|||
shiny::uiOutput(outputId = ns("arms")),
|
||||
shiny::textInput(
|
||||
inputId = ns("filter"),
|
||||
label = "Optional filter logic (e.g., [gender] = 'female')"
|
||||
)
|
||||
label = i18n$t("Optional filter logic (e.g., [gender] = 'female')"
|
||||
))
|
||||
)
|
||||
|
||||
params_ui <-
|
||||
shiny::tagList(
|
||||
shiny::tags$h4("Data import parameters"),
|
||||
shiny::tags$h4(i18n$t("Data import parameters")),
|
||||
shiny::tags$div(
|
||||
style = htmltools::css(
|
||||
display = "grid",
|
||||
|
|
@ -5791,14 +5637,14 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
|
|||
)
|
||||
)
|
||||
),
|
||||
shiny::helpText("Select fields/variables to import and click the funnel to apply optional filters"),
|
||||
shiny::helpText(i18n$t("Select fields/variables to import and click the funnel to apply optional filters")),
|
||||
shiny::tags$br(),
|
||||
shiny::tags$br(),
|
||||
shiny::uiOutput(outputId = ns("data_type")),
|
||||
shiny::uiOutput(outputId = ns("fill")),
|
||||
shiny::actionButton(
|
||||
inputId = ns("data_import"),
|
||||
label = "Import",
|
||||
label = i18n$t("Import"),
|
||||
icon = shiny::icon("download", lib = "glyphicon"),
|
||||
width = "100%",
|
||||
disabled = TRUE
|
||||
|
|
@ -5917,11 +5763,11 @@ m_redcap_readServer <- function(id) {
|
|||
selector = ns("connect"),
|
||||
status = "success",
|
||||
include_data_alert(
|
||||
see_data_text = "Click to see data dictionary",
|
||||
see_data_text = i18n$t("Click to see data dictionary"),
|
||||
dataIdName = "see_dd",
|
||||
extra = tags$p(
|
||||
tags$b(phosphoricons::ph("check", weight = "bold"), "Connected to server!"),
|
||||
glue::glue("The {data_rv$info$project_title} project is loaded.")
|
||||
tags$b(phosphoricons::ph("check", weight = "bold"), i18n$t("Connected to server!")),
|
||||
glue::glue(i18n$t("The {data_rv$info$project_title} project is loaded."))
|
||||
),
|
||||
btn_show_data = TRUE
|
||||
)
|
||||
|
|
@ -5948,10 +5794,10 @@ m_redcap_readServer <- function(id) {
|
|||
shiny::observeEvent(input$see_dd, {
|
||||
show_data(
|
||||
purrr::pluck(data_rv$dd_list, "data"),
|
||||
title = "Data dictionary",
|
||||
title = i18n$t("Data dictionary"),
|
||||
type = "modal",
|
||||
show_classes = FALSE,
|
||||
tags$b("Preview:")
|
||||
tags$b(i18n$t("Preview:"))
|
||||
)
|
||||
})
|
||||
|
||||
|
|
@ -5959,10 +5805,10 @@ m_redcap_readServer <- function(id) {
|
|||
show_data(
|
||||
# purrr::pluck(data_rv$dd_list, "data"),
|
||||
data_rv$data,
|
||||
title = "Imported data set",
|
||||
title = i18n$t("Imported data set"),
|
||||
type = "modal",
|
||||
show_classes = FALSE,
|
||||
tags$b("Preview:")
|
||||
tags$b(i18n$t("Preview:"))
|
||||
)
|
||||
})
|
||||
|
||||
|
|
@ -5980,7 +5826,7 @@ m_redcap_readServer <- function(id) {
|
|||
shiny::req(data_rv$dd_list)
|
||||
shinyWidgets::virtualSelectInput(
|
||||
inputId = ns("fields"),
|
||||
label = "Select fields/variables to import:",
|
||||
label = i18n$t("Select fields/variables to import:"),
|
||||
choices = purrr::pluck(data_rv$dd_list, "data") |>
|
||||
dplyr::select(field_name, form_name) |>
|
||||
(\(.x){
|
||||
|
|
@ -5999,7 +5845,7 @@ m_redcap_readServer <- function(id) {
|
|||
if (isTRUE(data_rv$info$has_repeating_instruments_or_events)) {
|
||||
vectorSelectInput(
|
||||
inputId = ns("data_type"),
|
||||
label = "Specify the data format",
|
||||
label = i18n$t("Specify the data format"),
|
||||
choices = c(
|
||||
"Wide data (One row for each subject)" = "wide",
|
||||
"Long data for project with repeating instruments (default REDCap)" = "long"
|
||||
|
|
@ -6026,7 +5872,7 @@ m_redcap_readServer <- function(id) {
|
|||
if (input$data_type == "long" && isTRUE(any(input$fields %in% data_rv$rep_fields))) {
|
||||
vectorSelectInput(
|
||||
inputId = ns("fill"),
|
||||
label = "Fill missing values?",
|
||||
label = i18n$t("Fill missing values?"),
|
||||
choices = c(
|
||||
"Yes, fill missing, non-repeated values" = "yes",
|
||||
"No, leave the data as is" = "no"
|
||||
|
|
@ -6108,7 +5954,7 @@ m_redcap_readServer <- function(id) {
|
|||
data_rv$data_message <- imported$raw_text
|
||||
} else {
|
||||
data_rv$data_status <- "success"
|
||||
data_rv$data_message <- "Requested data was retrieved!"
|
||||
data_rv$data_message <- i18n$t("Requested data was retrieved!")
|
||||
|
||||
## The data management below should be separated to allow for changing
|
||||
## "wide"/"long" without re-importing data
|
||||
|
|
@ -6143,12 +5989,12 @@ m_redcap_readServer <- function(id) {
|
|||
|
||||
if (!any(in_data_check[-1])) {
|
||||
data_rv$data_status <- "warning"
|
||||
data_rv$data_message <- "Data retrieved, but it looks like only the ID was retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access."
|
||||
data_rv$data_message <- i18n$t("Data retrieved, but it looks like only the ID was retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access.")
|
||||
}
|
||||
|
||||
if (!all(in_data_check)) {
|
||||
data_rv$data_status <- "warning"
|
||||
data_rv$data_message <- "Data retrieved, but it looks like not all requested fields were retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access."
|
||||
data_rv$data_message <- i18n$t("Data retrieved, but it looks like not all requested fields were retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access.")
|
||||
}
|
||||
|
||||
data_rv$code <- code
|
||||
|
|
@ -6175,7 +6021,7 @@ m_redcap_readServer <- function(id) {
|
|||
# data_rv$data_message
|
||||
# ),
|
||||
include_data_alert(
|
||||
see_data_text = "Click to see the imported data",
|
||||
see_data_text = i18n$t("Click to see the imported data"),
|
||||
dataIdName = "see_data",
|
||||
extra = tags$p(
|
||||
tags$b(phosphoricons::ph("check", weight = "bold"), data_rv$data_message)
|
||||
|
|
@ -7515,7 +7361,7 @@ regression_ui <- function(id, ...) {
|
|||
shiny::tagList(
|
||||
# title = "",
|
||||
bslib::nav_panel(
|
||||
title = "Regression table",
|
||||
title = i18n$t("Regression table"),
|
||||
bslib::layout_sidebar(
|
||||
sidebar = bslib::sidebar(
|
||||
shiny::uiOutput(outputId = ns("data_info"), inline = TRUE),
|
||||
|
|
@ -7525,7 +7371,7 @@ regression_ui <- function(id, ...) {
|
|||
multiple = FALSE,
|
||||
bslib::accordion_panel(
|
||||
value = "acc_pan_reg",
|
||||
title = "Regression",
|
||||
title = i18n$t("Regression"),
|
||||
icon = bsicons::bs_icon("calculator"),
|
||||
shiny::uiOutput(outputId = ns("outcome_var")),
|
||||
# shiny::selectInput(
|
||||
|
|
@ -7540,7 +7386,7 @@ regression_ui <- function(id, ...) {
|
|||
shiny::uiOutput(outputId = ns("regression_type")),
|
||||
shiny::radioButtons(
|
||||
inputId = ns("all"),
|
||||
label = "Specify covariables",
|
||||
label = i18n$t("Specify covariables"),
|
||||
inline = TRUE, selected = 2,
|
||||
choiceNames = c(
|
||||
"Yes",
|
||||
|
|
@ -7551,15 +7397,15 @@ regression_ui <- function(id, ...) {
|
|||
shiny::conditionalPanel(
|
||||
condition = "input.all==1",
|
||||
shiny::uiOutput(outputId = ns("regression_vars")),
|
||||
shiny::helpText("If none are selected, all are included."),
|
||||
shiny::helpText(i18n$t("If none are selected, all are included.")),
|
||||
shiny::tags$br(),
|
||||
ns = ns
|
||||
),
|
||||
bslib::input_task_button(
|
||||
id = ns("load"),
|
||||
label = "Analyse",
|
||||
label = i18n$t("Analyse"),
|
||||
icon = bsicons::bs_icon("pencil"),
|
||||
label_busy = "Working...",
|
||||
label_busy = i18n$t("Working..."),
|
||||
icon_busy = fontawesome::fa_i("arrows-rotate",
|
||||
class = "fa-spin",
|
||||
"aria-hidden" = "true"
|
||||
|
|
@ -7567,17 +7413,18 @@ regression_ui <- function(id, ...) {
|
|||
type = "secondary",
|
||||
auto_reset = TRUE
|
||||
),
|
||||
shiny::helpText("Press 'Analyse' to create the regression model and after changing parameters."),
|
||||
shiny::helpText(i18n$t("Press 'Analyse' to create the regression model and after changing parameters.")),
|
||||
shiny::tags$br(),
|
||||
shiny::radioButtons(
|
||||
inputId = ns("add_regression_p"),
|
||||
label = "Show p-value",
|
||||
label = i18n$t("Show p-value"),
|
||||
inline = TRUE,
|
||||
selected = "yes",
|
||||
choices = list(
|
||||
"Yes" = "yes",
|
||||
"No" = "no"
|
||||
)
|
||||
choiceNames = c(
|
||||
"Yes",
|
||||
"No"
|
||||
),
|
||||
choiceValues = c("yes", "no")
|
||||
),
|
||||
# shiny::tags$br(),
|
||||
# shiny::radioButtons(
|
||||
|
|
@ -7620,7 +7467,7 @@ regression_ui <- function(id, ...) {
|
|||
shiny::tagList(
|
||||
shinyWidgets::noUiSliderInput(
|
||||
inputId = ns("plot_height"),
|
||||
label = "Plot height (mm)",
|
||||
label = i18n$t("Plot height (mm)"),
|
||||
min = 50,
|
||||
max = 300,
|
||||
value = 100,
|
||||
|
|
@ -7630,7 +7477,7 @@ regression_ui <- function(id, ...) {
|
|||
),
|
||||
shinyWidgets::noUiSliderInput(
|
||||
inputId = ns("plot_width"),
|
||||
label = "Plot width (mm)",
|
||||
label = i18n$t("Plot width (mm)"),
|
||||
min = 50,
|
||||
max = 300,
|
||||
value = 100,
|
||||
|
|
@ -7640,7 +7487,7 @@ regression_ui <- function(id, ...) {
|
|||
),
|
||||
shiny::selectInput(
|
||||
inputId = ns("plot_type"),
|
||||
label = "File format",
|
||||
label = i18n$t("File format"),
|
||||
choices = list(
|
||||
"png",
|
||||
"tiff",
|
||||
|
|
@ -7654,7 +7501,7 @@ regression_ui <- function(id, ...) {
|
|||
# Button
|
||||
shiny::downloadButton(
|
||||
outputId = ns("download_plot"),
|
||||
label = "Download plot",
|
||||
label = i18n$t("Download plot"),
|
||||
icon = shiny::icon("download")
|
||||
)
|
||||
)
|
||||
|
|
@ -7666,7 +7513,7 @@ regression_ui <- function(id, ...) {
|
|||
)
|
||||
),
|
||||
bslib::nav_panel(
|
||||
title = "Model checks",
|
||||
title = i18n$t("Model checks"),
|
||||
bslib::layout_sidebar(
|
||||
sidebar = bslib::sidebar(
|
||||
bslib::accordion(
|
||||
|
|
@ -8739,11 +8586,11 @@ ui_elements <- function(selection) {
|
|||
shiny::tags$br(),
|
||||
shiny::actionButton(
|
||||
inputId = "data_reset",
|
||||
label = "Restore original data",
|
||||
label = i18n$t("Restore original data"),
|
||||
width = "100%"
|
||||
),
|
||||
shiny::tags$br(),
|
||||
shiny::helpText("Reset to original imported dataset. Careful! There is no un-doing."),
|
||||
shiny::helpText(i18n$t("Reset to original imported dataset. Careful! There is no un-doing.")),
|
||||
shiny::tags$br()
|
||||
)
|
||||
# )
|
||||
|
|
@ -8762,7 +8609,7 @@ ui_elements <- function(selection) {
|
|||
# bslib::navset_bar(
|
||||
# title = "",
|
||||
bslib::nav_panel(
|
||||
title = "Characteristics",
|
||||
title = i18n$t("Characteristics"),
|
||||
icon = bsicons::bs_icon("table"),
|
||||
bslib::layout_sidebar(
|
||||
sidebar = bslib::sidebar(
|
||||
|
|
@ -8777,12 +8624,12 @@ ui_elements <- function(selection) {
|
|||
title = "Settings",
|
||||
icon = bsicons::bs_icon("table"),
|
||||
shiny::uiOutput("strat_var"),
|
||||
shiny::helpText("Only factor/categorical variables are available for stratification. Go back to the 'Prepare' tab to reclass a variable if it's not on the list."),
|
||||
shiny::helpText(i18n$t("Only factor/categorical variables are available for stratification. Go back to the 'Prepare' tab to reclass a variable if it's not on the list.")),
|
||||
shiny::conditionalPanel(
|
||||
condition = "input.strat_var!='none'",
|
||||
shiny::radioButtons(
|
||||
inputId = "add_p",
|
||||
label = "Compare strata?",
|
||||
label = i18n$t("Compare strata?"),
|
||||
selected = "no",
|
||||
inline = TRUE,
|
||||
choices = list(
|
||||
|
|
@ -8796,7 +8643,7 @@ ui_elements <- function(selection) {
|
|||
shiny::br(),
|
||||
shiny::actionButton(
|
||||
inputId = "act_eval",
|
||||
label = "Evaluate",
|
||||
label = i18n$t("Evaluate"),
|
||||
width = "100%",
|
||||
icon = shiny::icon("calculator"),
|
||||
disabled = TRUE
|
||||
|
|
@ -8808,7 +8655,7 @@ ui_elements <- function(selection) {
|
|||
)
|
||||
),
|
||||
bslib::nav_panel(
|
||||
title = "Correlations",
|
||||
title = i18n$t("Correlations"),
|
||||
icon = bsicons::bs_icon("bounding-box"),
|
||||
bslib::layout_sidebar(
|
||||
sidebar = bslib::sidebar(
|
||||
|
|
@ -8822,11 +8669,11 @@ ui_elements <- function(selection) {
|
|||
title = "Settings",
|
||||
icon = bsicons::bs_icon("bounding-box"),
|
||||
shiny::uiOutput("outcome_var_cor"),
|
||||
shiny::helpText("To avoid evaluating the correlation of the outcome variable, this can be excluded from the plot or select 'none'."),
|
||||
shiny::helpText(i18n$t("To avoid evaluating the correlation of the outcome variable, this can be excluded from the plot or select 'none'.")),
|
||||
shiny::br(),
|
||||
shinyWidgets::noUiSliderInput(
|
||||
inputId = "cor_cutoff",
|
||||
label = "Correlation cut-off",
|
||||
label = i18n$t("Correlation cut-off"),
|
||||
min = 0,
|
||||
max = 1,
|
||||
step = .01,
|
||||
|
|
@ -8834,7 +8681,7 @@ ui_elements <- function(selection) {
|
|||
format = shinyWidgets::wNumbFormat(decimals = 2),
|
||||
color = datamods:::get_primary_color()
|
||||
),
|
||||
shiny::helpText("Set the cut-off for considered 'highly correlated'.")
|
||||
shiny::helpText(i18n$t("Set the cut-off for considered 'highly correlated'."))
|
||||
)
|
||||
)
|
||||
),
|
||||
|
|
@ -8842,7 +8689,7 @@ ui_elements <- function(selection) {
|
|||
)
|
||||
),
|
||||
bslib::nav_panel(
|
||||
title = "Missings",
|
||||
title = i18n$t("Missings"),
|
||||
icon = bsicons::bs_icon("x-circle"),
|
||||
bslib::layout_sidebar(
|
||||
sidebar = bslib::sidebar(
|
||||
|
|
@ -8855,7 +8702,7 @@ ui_elements <- function(selection) {
|
|||
title = "Settings",
|
||||
icon = bsicons::bs_icon("x-circle"),
|
||||
shiny::uiOutput("missings_var"),
|
||||
shiny::helpText("To consider if data is missing by random, choose the outcome/dependent variable, if it has any missings to evaluate if there is a significant difference across other variables depending on missing data or not.")
|
||||
shiny::helpText(i18n$t("To consider if data is missing by random, choose the outcome/dependent variable, if it has any missings to evaluate if there is a significant difference across other variables depending on missing data or not."))
|
||||
)
|
||||
)
|
||||
),
|
||||
|
|
@ -10633,11 +10480,13 @@ make_validation_alerts <- function(data) {
|
|||
|
||||
#' Data correlations evaluation module
|
||||
#'
|
||||
#' @param id Module id
|
||||
#' @param id id
|
||||
#'
|
||||
#' @name data-missings
|
||||
#' @name visual-summary
|
||||
#' @returns Shiny ui module
|
||||
#' @export
|
||||
#'
|
||||
#' @example examples/visual_summary_demo.R
|
||||
visual_summary_ui <- function(id) {
|
||||
ns <- shiny::NS(id)
|
||||
|
||||
|
|
@ -10646,8 +10495,17 @@ visual_summary_ui <- function(id) {
|
|||
)
|
||||
}
|
||||
|
||||
#' Visual summary server
|
||||
#'
|
||||
#' @param data_r reactive data
|
||||
#' @param ... passed on to the visual_summary() function
|
||||
#'
|
||||
#' @name visual-summary
|
||||
#' @returns shiny server
|
||||
#' @export
|
||||
#'
|
||||
visual_summary_server <- function(id,
|
||||
data_r=shiny::reactive(NULL),
|
||||
data_r = shiny::reactive(NULL),
|
||||
...) {
|
||||
shiny::moduleServer(
|
||||
id = id,
|
||||
|
|
@ -10676,45 +10534,26 @@ visual_summary_server <- function(id,
|
|||
# missings_apex_plot(datar(), ...)
|
||||
# })
|
||||
output$visual_plot <- shiny::renderPlot(expr = {
|
||||
visual_summary(data = rv$data,...)
|
||||
visual_summary(data = rv$data, na.label = i18n$t("Missings"), legend.title = i18n$t("Class"), ylab = i18n$t("Observations"), ...)
|
||||
})
|
||||
}
|
||||
)
|
||||
}
|
||||
|
||||
visual_summary_demo_app <- function() {
|
||||
ui <- shiny::fluidPage(
|
||||
shiny::actionButton(
|
||||
inputId = "modal_missings",
|
||||
label = "Visual summary",
|
||||
width = "100%",
|
||||
disabled = FALSE
|
||||
)
|
||||
)
|
||||
server <- function(input, output, session) {
|
||||
data_demo <- mtcars
|
||||
data_demo[sample(1:32, 10), "cyl"] <- NA
|
||||
data_demo[sample(1:32, 8), "vs"] <- NA
|
||||
|
||||
visual_summary_server(id = "data", data = shiny::reactive(data_demo))
|
||||
|
||||
observeEvent(input$modal_missings, {
|
||||
tryCatch(
|
||||
{
|
||||
modal_visual_summary(id = "data")
|
||||
},
|
||||
error = function(err) {
|
||||
showNotification(paste0("We encountered the following error browsing your data: ", err), type = "err")
|
||||
}
|
||||
)
|
||||
})
|
||||
}
|
||||
shiny::shinyApp(ui, server)
|
||||
}
|
||||
|
||||
visual_summary_demo_app()
|
||||
|
||||
|
||||
#' Visual summary modal
|
||||
#'
|
||||
#' @param title title
|
||||
#' @param easyClose easyClose
|
||||
#' @param size modal size
|
||||
#' @param footer modal footer
|
||||
#' @param ... ignored
|
||||
#'
|
||||
#' @name visual-summary
|
||||
#'
|
||||
#' @returns shiny modal
|
||||
#' @export
|
||||
#'
|
||||
modal_visual_summary <- function(id,
|
||||
title = "Visual overview of data classes and missing observations",
|
||||
easyClose = TRUE,
|
||||
|
|
@ -10733,9 +10572,10 @@ modal_visual_summary <- function(id,
|
|||
|
||||
## Slow with many observations...
|
||||
|
||||
#' Plot missings and class with apexcharter
|
||||
#' Plot missings and class with apexcharter. Not in use with FreesearchR.
|
||||
#'
|
||||
#' @param data data frame
|
||||
#' @name visual-summary
|
||||
#'
|
||||
#' @returns An [apexchart()] `htmlwidget` object.
|
||||
#' @export
|
||||
|
|
@ -10790,6 +10630,10 @@ missings_apex_plot <- function(data, animation = FALSE, ...) {
|
|||
#'
|
||||
#' @param data data
|
||||
#' @param ... optional arguments passed to data_summary_gather()
|
||||
#' @param legend.title Legend title
|
||||
#' @param ylab Y axis label
|
||||
#'
|
||||
#' @name visual-summary
|
||||
#'
|
||||
#' @returns ggplot2 object
|
||||
#' @export
|
||||
|
|
@ -10800,11 +10644,15 @@ missings_apex_plot <- function(data, animation = FALSE, ...) {
|
|||
#' data_demo[sample(1:32, 8), "vs"] <- NA
|
||||
#' visual_summary(data_demo)
|
||||
#' visual_summary(data_demo, palette.fun = scales::hue_pal())
|
||||
#' visual_summary(dplyr::storms)
|
||||
#' visual_summary(dplyr::storms, summary.fun = data_type)
|
||||
visual_summary <- function(data, legend.title = "Data class", ...) {
|
||||
#' visual_summary(dplyr::storms, summary.fun = data_type, na.label = "Missings", legend.title = "Class")
|
||||
visual_summary <- function(data, legend.title = NULL, ylab = "Observations", ...) {
|
||||
l <- data_summary_gather(data, ...)
|
||||
|
||||
if (is.null(legend.title)) {
|
||||
legend.title <- l$summary.fun
|
||||
}
|
||||
|
||||
df <- l$data
|
||||
|
||||
df$valueType <- factor(df$valueType, levels = names(l$colors))
|
||||
|
|
@ -10818,13 +10666,13 @@ visual_summary <- function(data, legend.title = "Data class", ...) {
|
|||
vjust = 1, hjust = 1
|
||||
)) +
|
||||
ggplot2::scale_fill_manual(values = l$colors) +
|
||||
ggplot2::labs(x = "", y = "Observations") +
|
||||
ggplot2::labs(x = "", y = ylab) +
|
||||
ggplot2::scale_y_reverse() +
|
||||
ggplot2::theme(axis.text.x = ggplot2::element_text(hjust = 0.5)) +
|
||||
ggplot2::guides(colour = "none") +
|
||||
ggplot2::guides(fill = ggplot2::guide_legend(title = legend.title)) +
|
||||
# change the limits etc.
|
||||
ggplot2::guides(fill = ggplot2::guide_legend(title = "Type")) +
|
||||
# ggplot2::guides(fill = ggplot2::guide_legend(title = guide.lab)) +
|
||||
# add info about the axes
|
||||
ggplot2::scale_x_discrete(position = "top") +
|
||||
ggplot2::theme(axis.text.x = ggplot2::element_text(hjust = 0)) +
|
||||
|
|
@ -10839,16 +10687,18 @@ visual_summary <- function(data, legend.title = "Data class", ...) {
|
|||
#' Data summary for printing visual summary
|
||||
#'
|
||||
#' @param data data.frame
|
||||
#' @param fun summary function. Default is "class"
|
||||
#' @param palette.fun optionally use specific palette functions. First argument
|
||||
#' has to be the length.
|
||||
#' @param summary.fun fun for summarising
|
||||
#' @param na.label label for NA
|
||||
#' @param ... overflow
|
||||
#'
|
||||
#' @returns data.frame
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' mtcars |> data_summary_gather()
|
||||
data_summary_gather <- function(data, summary.fun = class, palette.fun = viridisLite::viridis) {
|
||||
data_summary_gather <- function(data, summary.fun = class, palette.fun = viridisLite::viridis, na.label = "NA", ...) {
|
||||
df_plot <- setNames(data, unique_short(names(data))) |>
|
||||
purrr::map_df(\(x){
|
||||
ifelse(is.na(x),
|
||||
|
|
@ -10870,12 +10720,12 @@ data_summary_gather <- function(data, summary.fun = class, palette.fun = viridis
|
|||
forcats::as_factor() |>
|
||||
as.numeric()
|
||||
|
||||
df_plot$valueType[is.na(df_plot$valueType)] <- "NA"
|
||||
df_plot$valueType[is.na(df_plot$valueType)] <- na.label
|
||||
df_plot$valueType_num[is.na(df_plot$valueType_num)] <- max(df_plot$valueType_num, na.rm = TRUE) + 1
|
||||
|
||||
labels <- setNames(unique(df_plot$valueType_num), unique(df_plot$valueType)) |> sort()
|
||||
|
||||
if (any(df_plot$valueType == "NA")) {
|
||||
if (any(df_plot$valueType == na.label)) {
|
||||
colors <- setNames(c(palette.fun(length(labels) - 1), "#999999"), names(labels))
|
||||
} else {
|
||||
colors <- setNames(palette.fun(length(labels)), names(labels))
|
||||
|
|
@ -10893,7 +10743,7 @@ data_summary_gather <- function(data, summary.fun = class, palette.fun = viridis
|
|||
}) |>
|
||||
setNames(NULL)
|
||||
|
||||
list(data = df_plot, colors = colors, labels = label_list)
|
||||
list(data = df_plot, colors = colors, labels = label_list, summary.fun = deparse(substitute(summary.fun)))
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -11442,7 +11292,7 @@ server <- function(input, output, session) {
|
|||
modal_visual_summary(
|
||||
id = "initial_summary",
|
||||
footer = NULL,
|
||||
size = "xl"
|
||||
size = "xl",title = i18n$t("Data classes and missing observations")
|
||||
)
|
||||
},
|
||||
error = function(err) {
|
||||
|
|
@ -11575,8 +11425,10 @@ server <- function(input, output, session) {
|
|||
shinyWidgets::ask_confirmation(
|
||||
cancelOnDismiss = TRUE,
|
||||
inputId = "reset_confirm",
|
||||
title = "Please confirm data reset?",
|
||||
type = "warning"
|
||||
title = i18n$t("Please confirm data reset!"),
|
||||
type = "warning",
|
||||
text = i18n$t("Sure you want to reset data? This cannot be undone."),
|
||||
btn_labels = c(i18n$t("Cancel"), i18n$t("Confirm"))
|
||||
)
|
||||
})
|
||||
|
||||
|
|
@ -11590,14 +11442,14 @@ server <- function(input, output, session) {
|
|||
|
||||
output$data_info <- shiny::renderUI({
|
||||
shiny::req(data_filter())
|
||||
data_description(data_filter(), "The filtered data")
|
||||
data_description(data_filter(), data_text = i18n$t("The filtered data"))
|
||||
})
|
||||
|
||||
######### Create factor
|
||||
|
||||
shiny::observeEvent(
|
||||
input$modal_cut,
|
||||
modal_cut_variable("modal_cut", title = "Create new factor")
|
||||
modal_cut_variable("modal_cut", title = i18n$t("Create new factor"))
|
||||
)
|
||||
|
||||
data_modal_cut <- cut_variable_server(
|
||||
|
|
@ -11614,7 +11466,7 @@ server <- function(input, output, session) {
|
|||
|
||||
shiny::observeEvent(
|
||||
input$modal_update,
|
||||
datamods::modal_update_factor(id = "modal_update", title = "Reorder factor levels")
|
||||
datamods::modal_update_factor(id = "modal_update", title = i18n$t("Reorder factor levels"))
|
||||
)
|
||||
|
||||
data_modal_update <- datamods::update_factor_server(
|
||||
|
|
@ -11634,8 +11486,8 @@ server <- function(input, output, session) {
|
|||
input$modal_column,
|
||||
modal_create_column(
|
||||
id = "modal_column",
|
||||
footer = shiny::markdown("This window is aimed at advanced users and require some *R*-experience!"),
|
||||
title = "Create new variables"
|
||||
footer = shiny::markdown(i18n$t("This window is aimed at advanced users and require some *R*-experience!")),
|
||||
title = i18n$t("Create new variables")
|
||||
)
|
||||
)
|
||||
data_modal_r <- create_column_server(
|
||||
|
|
@ -11673,7 +11525,7 @@ server <- function(input, output, session) {
|
|||
# c("dichotomous", "ordinal", "categorical", "datatime", "continuous")
|
||||
shinyWidgets::virtualSelectInput(
|
||||
inputId = "column_filter",
|
||||
label = "Select data types to include",
|
||||
label = i18n$t("Select data types to include"),
|
||||
selected = unique(data_type(rv$data)),
|
||||
choices = unique(data_type(rv$data)),
|
||||
updateOn = "change",
|
||||
|
|
@ -11878,7 +11730,7 @@ server <- function(input, output, session) {
|
|||
observeEvent(input$modal_browse, {
|
||||
tryCatch(
|
||||
{
|
||||
show_data(REDCapCAST::fct_drop(rv$data_filtered), title = "Uploaded data overview", type = "modal")
|
||||
show_data(REDCapCAST::fct_drop(rv$data_filtered), title = i18n$t("Uploaded data overview"), type = "modal")
|
||||
},
|
||||
error = function(err) {
|
||||
showNotification(paste0("We encountered the following error browsing your data: ", err), type = "err")
|
||||
|
|
@ -11900,7 +11752,7 @@ server <- function(input, output, session) {
|
|||
{
|
||||
modal_visual_summary(
|
||||
id = "visual_overview",
|
||||
footer = "Here is an overview of how your data is interpreted, and where data is missing. Use this information to consider if data is missing at random or if some observations are missing systematically wich may be caused by an observation bias.",
|
||||
footer = i18n$t("Here is an overview of how your data is interpreted, and where data is missing. Use this information to consider if data is missing at random or if some observations are missing systematically wich may be caused by an observation bias."),
|
||||
size = "xl"
|
||||
)
|
||||
},
|
||||
|
|
@ -11952,12 +11804,12 @@ server <- function(input, output, session) {
|
|||
|
||||
output$code_import <- shiny::renderUI({
|
||||
shiny::req(rv$code$import)
|
||||
prismCodeBlock(paste0("#Data import\n", rv$code$import))
|
||||
prismCodeBlock(paste0(i18n$t("#Data import\n"), rv$code$import))
|
||||
})
|
||||
|
||||
output$code_format <- shiny::renderUI({
|
||||
shiny::req(rv$code$format)
|
||||
prismCodeBlock(paste0("#Data import formatting\n", rv$code$format))
|
||||
prismCodeBlock(paste0(i18n$t("#Data import formatting\n"), rv$code$format))
|
||||
})
|
||||
|
||||
output$code_data <- shiny::renderUI({
|
||||
|
|
|
|||
|
|
@ -160,3 +160,62 @@
|
|||
"Missing vs non-missing observations in the variable **'{variabler()}'**","Manglende vs ikke-manglende observationer i variablen **'{variabler()}'**"
|
||||
"There is a significant correlation between {n_nonmcar} variables and missing observations in the outcome variable {outcome}.","There is a significant correlation between {n_nonmcar} variables and missing observations in the outcome variable {outcome}."
|
||||
"There is a total of {p_miss} % missing observations.","Der er i alt {p_miss} % manglende observationer."
|
||||
"Median:","Median:"
|
||||
"Restore original data","Restore original data"
|
||||
"Reset to original imported dataset. Careful! There is no un-doing.","Reset to original imported dataset. Careful! There is no un-doing."
|
||||
"Characteristics","Characteristics"
|
||||
"Only factor/categorical variables are available for stratification. Go back to the 'Prepare' tab to reclass a variable if it's not on the list.","Only factor/categorical variables are available for stratification. Go back to the 'Prepare' tab to reclass a variable if it's not on the list."
|
||||
"Compare strata?","Compare strata?"
|
||||
"Correlations","Correlations"
|
||||
"To avoid evaluating the correlation of the outcome variable, this can be excluded from the plot or select 'none'.","To avoid evaluating the correlation of the outcome variable, this can be excluded from the plot or select 'none'."
|
||||
"Correlation cut-off","Correlation cut-off"
|
||||
"Set the cut-off for considered 'highly correlated'.","Set the cut-off for considered 'highly correlated'."
|
||||
"Missings","Missings"
|
||||
"To consider if data is missing by random, choose the outcome/dependent variable, if it has any missings to evaluate if there is a significant difference across other variables depending on missing data or not.","To consider if data is missing by random, choose the outcome/dependent variable, if it has any missings to evaluate if there is a significant difference across other variables depending on missing data or not."
|
||||
"Class","Class"
|
||||
"Observations","Observations"
|
||||
"Data classes and missing observations","Data classes and missing observations"
|
||||
"Sure you want to reset data? This cannot be undone.","Sure you want to reset data? This cannot be undone."
|
||||
"Cancel","Cancel"
|
||||
"Confirm","Confirm"
|
||||
"The filtered data","The filtered data"
|
||||
"Create new factor","Create new factor"
|
||||
"This window is aimed at advanced users and require some *R*-experience!","This window is aimed at advanced users and require some *R*-experience!"
|
||||
"Create new variables","Create new variables"
|
||||
"Select data types to include","Select data types to include"
|
||||
"Uploaded data overview","Uploaded data overview"
|
||||
"Here is an overview of how your data is interpreted, and where data is missing. Use this information to consider if data is missing at random or if some observations are missing systematically wich may be caused by an observation bias.","Here is an overview of how your data is interpreted, and where data is missing. Use this information to consider if data is missing at random or if some observations are missing systematically wich may be caused by an observation bias."
|
||||
"#Data import\n","#Data import\n"
|
||||
"#Data import formatting\n","#Data import formatting\n"
|
||||
"Specify covariables","Specify covariables"
|
||||
"If none are selected, all are included.","If none are selected, all are included."
|
||||
"Analyse","Analyse"
|
||||
"Working...","Working..."
|
||||
"Press 'Analyse' to create the regression model and after changing parameters.","Press 'Analyse' to create the regression model and after changing parameters."
|
||||
"Show p-value","Show p-value"
|
||||
"Model checks","Model checks"
|
||||
"Please confirm data reset!","Please confirm data reset!"
|
||||
"Import data from REDCap","Import data from REDCap"
|
||||
"REDCap server","REDCap server"
|
||||
"Web address","Web address"
|
||||
"Format should be either 'https://redcap.your.institution/' or 'https://your.institution/redcap/'","Format should be either 'https://redcap.your.institution/' or 'https://your.institution/redcap/'"
|
||||
"API token","API token"
|
||||
"The token is a string of 32 numbers and letters.","The token is a string of 32 numbers and letters."
|
||||
"Connect","Connect"
|
||||
"Data import parameters","Data import parameters"
|
||||
"Select fields/variables to import and click the funnel to apply optional filters","Select fields/variables to import and click the funnel to apply optional filters"
|
||||
"Import","Import"
|
||||
"Click to see data dictionary","Click to see data dictionary"
|
||||
"Connected to server!","Connected to server!"
|
||||
"The {data_rv$info$project_title} project is loaded.","The {data_rv$info$project_title} project is loaded."
|
||||
"Data dictionary","Data dictionary"
|
||||
"Preview:","Preview:"
|
||||
"Imported data set","Imported data set"
|
||||
"Select fields/variables to import:","Select fields/variables to import:"
|
||||
"Specify the data format","Specify the data format"
|
||||
"Fill missing values?","Fill missing values?"
|
||||
"Requested data was retrieved!","Requested data was retrieved!"
|
||||
"Data retrieved, but it looks like only the ID was retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access.","Data retrieved, but it looks like only the ID was retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access."
|
||||
"Data retrieved, but it looks like not all requested fields were retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access.","Data retrieved, but it looks like not all requested fields were retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access."
|
||||
"Click to see the imported data","Click to see the imported data"
|
||||
"Regression table","Regression table"
|
||||
|
|
|
|||
|
|
|
@ -160,3 +160,62 @@
|
|||
"Missing vs non-missing observations in the variable **'{variabler()}'**","Missing vs non-missing observations in the variable **'{variabler()}'**"
|
||||
"There is a significant correlation between {n_nonmcar} variables and missing observations in the outcome variable {outcome}.","There is a significant correlation between {n_nonmcar} variables and missing observations in the outcome variable {outcome}."
|
||||
"There is a total of {p_miss} % missing observations.","There is a total of {p_miss} % missing observations."
|
||||
"Median:","Median:"
|
||||
"Restore original data","Restore original data"
|
||||
"Reset to original imported dataset. Careful! There is no un-doing.","Reset to original imported dataset. Careful! There is no un-doing."
|
||||
"Characteristics","Characteristics"
|
||||
"Only factor/categorical variables are available for stratification. Go back to the 'Prepare' tab to reclass a variable if it's not on the list.","Only factor/categorical variables are available for stratification. Go back to the 'Prepare' tab to reclass a variable if it's not on the list."
|
||||
"Compare strata?","Compare strata?"
|
||||
"Correlations","Correlations"
|
||||
"To avoid evaluating the correlation of the outcome variable, this can be excluded from the plot or select 'none'.","To avoid evaluating the correlation of the outcome variable, this can be excluded from the plot or select 'none'."
|
||||
"Correlation cut-off","Correlation cut-off"
|
||||
"Set the cut-off for considered 'highly correlated'.","Set the cut-off for considered 'highly correlated'."
|
||||
"Missings","Missings"
|
||||
"To consider if data is missing by random, choose the outcome/dependent variable, if it has any missings to evaluate if there is a significant difference across other variables depending on missing data or not.","To consider if data is missing by random, choose the outcome/dependent variable, if it has any missings to evaluate if there is a significant difference across other variables depending on missing data or not."
|
||||
"Class","Class"
|
||||
"Observations","Observations"
|
||||
"Data classes and missing observations","Data classes and missing observations"
|
||||
"Sure you want to reset data? This cannot be undone.","Sure you want to reset data? This cannot be undone."
|
||||
"Cancel","Cancel"
|
||||
"Confirm","Confirm"
|
||||
"The filtered data","The filtered data"
|
||||
"Create new factor","Create new factor"
|
||||
"This window is aimed at advanced users and require some *R*-experience!","This window is aimed at advanced users and require some *R*-experience!"
|
||||
"Create new variables","Create new variables"
|
||||
"Select data types to include","Select data types to include"
|
||||
"Uploaded data overview","Uploaded data overview"
|
||||
"Here is an overview of how your data is interpreted, and where data is missing. Use this information to consider if data is missing at random or if some observations are missing systematically wich may be caused by an observation bias.","Here is an overview of how your data is interpreted, and where data is missing. Use this information to consider if data is missing at random or if some observations are missing systematically wich may be caused by an observation bias."
|
||||
"#Data import\n","#Data import\n"
|
||||
"#Data import formatting\n","#Data import formatting\n"
|
||||
"Specify covariables","Specify covariables"
|
||||
"If none are selected, all are included.","If none are selected, all are included."
|
||||
"Analyse","Analyse"
|
||||
"Working...","Working..."
|
||||
"Press 'Analyse' to create the regression model and after changing parameters.","Press 'Analyse' to create the regression model and after changing parameters."
|
||||
"Show p-value","Show p-value"
|
||||
"Model checks","Model checks"
|
||||
"Please confirm data reset!","Please confirm data reset!"
|
||||
"Import data from REDCap","Import data from REDCap"
|
||||
"REDCap server","REDCap server"
|
||||
"Web address","Web address"
|
||||
"Format should be either 'https://redcap.your.institution/' or 'https://your.institution/redcap/'","Format should be either 'https://redcap.your.institution/' or 'https://your.institution/redcap/'"
|
||||
"API token","API token"
|
||||
"The token is a string of 32 numbers and letters.","The token is a string of 32 numbers and letters."
|
||||
"Connect","Connect"
|
||||
"Data import parameters","Data import parameters"
|
||||
"Select fields/variables to import and click the funnel to apply optional filters","Select fields/variables to import and click the funnel to apply optional filters"
|
||||
"Import","Import"
|
||||
"Click to see data dictionary","Click to see data dictionary"
|
||||
"Connected to server!","Connected to server!"
|
||||
"The {data_rv$info$project_title} project is loaded.","The {data_rv$info$project_title} project is loaded."
|
||||
"Data dictionary","Data dictionary"
|
||||
"Preview:","Preview:"
|
||||
"Imported data set","Imported data set"
|
||||
"Select fields/variables to import:","Select fields/variables to import:"
|
||||
"Specify the data format","Specify the data format"
|
||||
"Fill missing values?","Fill missing values?"
|
||||
"Requested data was retrieved!","Requested data was retrieved!"
|
||||
"Data retrieved, but it looks like only the ID was retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access.","Data retrieved, but it looks like only the ID was retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access."
|
||||
"Data retrieved, but it looks like not all requested fields were retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access.","Data retrieved, but it looks like not all requested fields were retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access."
|
||||
"Click to see the imported data","Click to see the imported data"
|
||||
"Regression table","Regression table"
|
||||
|
|
|
|||
|
|
|
@ -1,16 +0,0 @@
|
|||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/data-import.R
|
||||
\name{data_import_demo_app}
|
||||
\alias{data_import_demo_app}
|
||||
\title{Test app for the data-import module}
|
||||
\usage{
|
||||
data_import_demo_app()
|
||||
}
|
||||
\description{
|
||||
Test app for the data-import module
|
||||
}
|
||||
\examples{
|
||||
\dontrun{
|
||||
data_import_demo_app()
|
||||
}
|
||||
}
|
||||
|
|
@ -1,17 +1,14 @@
|
|||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/missings-module.R, R/visual_summary.R
|
||||
% Please edit documentation in R/missings-module.R
|
||||
\name{data-missings}
|
||||
\alias{data-missings}
|
||||
\alias{data_missings_ui}
|
||||
\alias{data_missings_server}
|
||||
\alias{visual_summary_ui}
|
||||
\title{Data correlations evaluation module}
|
||||
\usage{
|
||||
data_missings_ui(id)
|
||||
|
||||
data_missings_server(id, data, variable, ...)
|
||||
|
||||
visual_summary_ui(id)
|
||||
}
|
||||
\arguments{
|
||||
\item{id}{Module id}
|
||||
|
|
@ -24,11 +21,7 @@ visual_summary_ui(id)
|
|||
Shiny ui module
|
||||
|
||||
shiny server module
|
||||
|
||||
Shiny ui module
|
||||
}
|
||||
\description{
|
||||
Data correlations evaluation module
|
||||
|
||||
Data correlations evaluation module
|
||||
}
|
||||
|
|
|
|||
|
|
@ -7,16 +7,22 @@
|
|||
data_summary_gather(
|
||||
data,
|
||||
summary.fun = class,
|
||||
palette.fun = viridisLite::viridis
|
||||
palette.fun = viridisLite::viridis,
|
||||
na.label = "NA",
|
||||
...
|
||||
)
|
||||
}
|
||||
\arguments{
|
||||
\item{data}{data.frame}
|
||||
|
||||
\item{summary.fun}{fun for summarising}
|
||||
|
||||
\item{palette.fun}{optionally use specific palette functions. First argument
|
||||
has to be the length.}
|
||||
|
||||
\item{fun}{summary function. Default is "class"}
|
||||
\item{na.label}{label for NA}
|
||||
|
||||
\item{...}{overflow}
|
||||
}
|
||||
\value{
|
||||
data.frame
|
||||
|
|
|
|||
|
|
@ -1,26 +0,0 @@
|
|||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/visual_summary.R
|
||||
\name{missings_apex_plot}
|
||||
\alias{missings_apex_plot}
|
||||
\title{Plot missings and class with apexcharter}
|
||||
\usage{
|
||||
missings_apex_plot(data, animation = FALSE, ...)
|
||||
}
|
||||
\arguments{
|
||||
\item{data}{data frame}
|
||||
}
|
||||
\value{
|
||||
An \code{\link[=apexchart]{apexchart()}} \code{htmlwidget} object.
|
||||
}
|
||||
\description{
|
||||
Plot missings and class with apexcharter
|
||||
}
|
||||
\examples{
|
||||
data_demo <- mtcars
|
||||
data_demo[2:4, "cyl"] <- NA
|
||||
rbind(data_demo, data_demo, data_demo, data_demo) |> missings_apex_plot()
|
||||
data_demo |> missings_apex_plot()
|
||||
mtcars |> missings_apex_plot(animation = TRUE)
|
||||
# dplyr::storms |> missings_apex_plot()
|
||||
visdat::vis_dat(dplyr::storms)
|
||||
}
|
||||
119
man/visual-summary.Rd
Normal file
119
man/visual-summary.Rd
Normal file
|
|
@ -0,0 +1,119 @@
|
|||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/visual_summary.R
|
||||
\name{visual-summary}
|
||||
\alias{visual-summary}
|
||||
\alias{visual_summary_ui}
|
||||
\alias{visual_summary_server}
|
||||
\alias{modal_visual_summary}
|
||||
\alias{missings_apex_plot}
|
||||
\alias{visual_summary}
|
||||
\title{Data correlations evaluation module}
|
||||
\usage{
|
||||
visual_summary_ui(id)
|
||||
|
||||
visual_summary_server(id, data_r = shiny::reactive(NULL), ...)
|
||||
|
||||
modal_visual_summary(
|
||||
id,
|
||||
title = "Visual overview of data classes and missing observations",
|
||||
easyClose = TRUE,
|
||||
size = "xl",
|
||||
footer = NULL,
|
||||
...
|
||||
)
|
||||
|
||||
missings_apex_plot(data, animation = FALSE, ...)
|
||||
|
||||
visual_summary(data, legend.title = NULL, ylab = "Observations", ...)
|
||||
}
|
||||
\arguments{
|
||||
\item{id}{id}
|
||||
|
||||
\item{data_r}{reactive data}
|
||||
|
||||
\item{...}{optional arguments passed to data_summary_gather()}
|
||||
|
||||
\item{title}{title}
|
||||
|
||||
\item{easyClose}{easyClose}
|
||||
|
||||
\item{size}{modal size}
|
||||
|
||||
\item{footer}{modal footer}
|
||||
|
||||
\item{data}{data}
|
||||
|
||||
\item{legend.title}{Legend title}
|
||||
|
||||
\item{ylab}{Y axis label}
|
||||
}
|
||||
\value{
|
||||
Shiny ui module
|
||||
|
||||
shiny server
|
||||
|
||||
shiny modal
|
||||
|
||||
An \code{\link[=apexchart]{apexchart()}} \code{htmlwidget} object.
|
||||
|
||||
ggplot2 object
|
||||
}
|
||||
\description{
|
||||
Data correlations evaluation module
|
||||
|
||||
Visual summary server
|
||||
|
||||
Visual summary modal
|
||||
|
||||
Plot missings and class with apexcharter. Not in use with FreesearchR.
|
||||
|
||||
Ggplot2 data summary visualisation based on visdat::vis_dat.
|
||||
}
|
||||
\examples{
|
||||
visual_summary_demo_app <- function() {
|
||||
ui <- shiny::fluidPage(
|
||||
shiny::actionButton(
|
||||
inputId = "modal_missings",
|
||||
label = "Visual summary",
|
||||
width = "100\%",
|
||||
disabled = FALSE
|
||||
)
|
||||
)
|
||||
server <- function(input, output, session) {
|
||||
data_demo <- mtcars
|
||||
data_demo[sample(1:32, 10), "cyl"] <- NA
|
||||
data_demo[sample(1:32, 8), "vs"] <- NA
|
||||
data_demo$gear <- factor(data_demo$gear)
|
||||
|
||||
visual_summary_server(id = "data", data = shiny::reactive(data_demo),summary.fun=class)
|
||||
|
||||
observeEvent(input$modal_missings, {
|
||||
tryCatch(
|
||||
{
|
||||
modal_visual_summary(id = "data")
|
||||
},
|
||||
error = function(err) {
|
||||
showNotification(paste0("We encountered the following error browsing your data: ", err), type = "err")
|
||||
}
|
||||
)
|
||||
})
|
||||
}
|
||||
shiny::shinyApp(ui, server)
|
||||
}
|
||||
|
||||
visual_summary_demo_app()
|
||||
data_demo <- mtcars
|
||||
data_demo[2:4, "cyl"] <- NA
|
||||
rbind(data_demo, data_demo, data_demo, data_demo) |> missings_apex_plot()
|
||||
data_demo |> missings_apex_plot()
|
||||
mtcars |> missings_apex_plot(animation = TRUE)
|
||||
# dplyr::storms |> missings_apex_plot()
|
||||
visdat::vis_dat(dplyr::storms)
|
||||
data_demo <- mtcars
|
||||
data_demo[sample(1:32, 10), "cyl"] <- NA
|
||||
data_demo[sample(1:32, 8), "vs"] <- NA
|
||||
visual_summary(data_demo)
|
||||
visual_summary(data_demo, palette.fun = scales::hue_pal())
|
||||
visual_summary(dplyr::storms, summary.fun = data_type)
|
||||
visual_summary(dplyr::storms, summary.fun = data_type, na.label = "Missings", legend.title = "Class")
|
||||
}
|
||||
|
|
@ -1,28 +0,0 @@
|
|||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/visual_summary.R
|
||||
\name{visual_summary}
|
||||
\alias{visual_summary}
|
||||
\title{Ggplot2 data summary visualisation based on visdat::vis_dat.}
|
||||
\usage{
|
||||
visual_summary(data, legend.title = "Data class", ...)
|
||||
}
|
||||
\arguments{
|
||||
\item{data}{data}
|
||||
|
||||
\item{...}{optional arguments passed to data_summary_gather()}
|
||||
}
|
||||
\value{
|
||||
ggplot2 object
|
||||
}
|
||||
\description{
|
||||
Ggplot2 data summary visualisation based on visdat::vis_dat.
|
||||
}
|
||||
\examples{
|
||||
data_demo <- mtcars
|
||||
data_demo[sample(1:32, 10), "cyl"] <- NA
|
||||
data_demo[sample(1:32, 8), "vs"] <- NA
|
||||
visual_summary(data_demo)
|
||||
visual_summary(data_demo, palette.fun = scales::hue_pal())
|
||||
visual_summary(dplyr::storms)
|
||||
visual_summary(dplyr::storms, summary.fun = data_type)
|
||||
}
|
||||
Loading…
Add table
Reference in a new issue