andreas/FreesearchR
1
0
Fork 0
mirror of https://github.com/agdamsbo/FreesearchR.git synced 2026-06-19 04:27:30 +02:00
Code Issues Projects Releases Packages Wiki Activity

chore: more translatable strings and cleaning

Browse source
This commit is contained in:
Andreas Gammelgaard Damsbo 2025-09-25 10:07:19 +02:00
commit be87e97f4d
No known key found for this signature in database
21 changed files with 757 additions and 879 deletions
Download patch file Download diff file Expand all files Collapse all files

151
R/data-import.R
View file

@ -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)
}

3
R/datagrid-infos-mod.R
View file

@ -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)
),

2
R/hosted_version.R
View file

@ -1 +1 @@
hosted_version <- function()'v25.9.2-250924'
hosted_version <- function()'v25.9.2-250925'

52
R/redcap_read_shiny_module.R
View file

@ -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)

35
R/regression-module.R
View file

@ -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(

24
R/ui_elements.R
View file

@ -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."))
)
)
),

95
R/visual_summary.R
View file

@ -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)))
}