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

updated translation strings
Some checks failed
pkgdown.yaml / pkgdown (push) Has been cancelled
Details

Browse source
This commit is contained in:
Andreas Gammelgaard Damsbo 2025-09-11 15:21:04 +02:00
commit 136480ca3d
No known key found for this signature in database
7 changed files with 184 additions and 80 deletions
Download patch file Download diff file Expand all files Collapse all files

87
inst/apps/FreesearchR/app.R
View file

@ -228,9 +228,13 @@ data_correlations_ui <- function(id, ...) {
#'
#' @param id id
#' @param data data
#' @param color.main main color
#' @param color.sec secondary color
#' @param include.class character vector of classes to include. Default is NULL
#' @param cutoff numeric
#' @param warning_str Character string. Exposed to allow dynamic translations
#' @param warning_no_str Character string. Exposed to allow dynamic translations
#' @param and_strCharacter string. Exposed to allow dynamic translations
#' @param ... arguments passed to toastui::datagrid
#'
#' @name data-correlations
@ -240,6 +244,9 @@ data_correlations_server <- function(id,
data,
include.class = NULL,
cutoff = .7,
warning_str = i18n$t("The following variable pairs are highly correlated: {sentence_paste(.x,and_str)}.\nConsider excluding one {more}from the dataset to ensure variables are independent."),
warning_no_str = i18n$t("No variables have a correlation measure above the threshold."),
and_str = i18n$t("and"),
...) {
shiny::moduleServer(
id = id,
@ -271,17 +278,17 @@ data_correlations_server <- function(id,
shiny::req(cutoff)
pairs <- correlation_pairs(rv$data(), threshold = cutoff())
more <- ifelse(nrow(pairs) > 1, "from each pair ", "")
more <- ifelse(nrow(pairs) > 1, i18n$t("from each pair"), "")
if (nrow(pairs) == 0) {
out <- glue::glue("No variables have a correlation measure above the threshold.")
out <- glue::glue(warning_no_str)
} else {
out <- pairs |>
apply(1, \(.x){
glue::glue("'{.x[1]}'x'{.x[2]}'({round(as.numeric(.x[3]),2)})")
glue::glue("'{.x[1]}'x'{.x[2]}' ({round(as.numeric(.x[3]),2)})")
}) |>
(\(.x){
glue::glue("The following variable pairs are highly correlated: {sentence_paste(.x)}.\nConsider excluding one {more}from the dataset to ensure variables are independent.")
glue::glue(warning_str)
})()
}
out
@ -1633,7 +1640,7 @@ data_visuals_ui <- function(id, tab_title = "Plots", ...) {
title = "Creating plot",
icon = bsicons::bs_icon("graph-up"),
shiny::uiOutput(outputId = ns("primary")),
shiny::helpText('Only non-text variables are available for plotting. Go the "Data" to reclass data to plot.'),
shiny::helpText(i18n$t('Only non-text variables are available for plotting. Go the "Data" to reclass data to plot.')),
shiny::tags$br(),
shiny::uiOutput(outputId = ns("type")),
shiny::uiOutput(outputId = ns("secondary")),
@ -1641,19 +1648,19 @@ data_visuals_ui <- function(id, tab_title = "Plots", ...) {
shiny::br(),
shiny::actionButton(
inputId = ns("act_plot"),
label = "Plot",
label = i18n$t("Plot"),
width = "100%",
icon = shiny::icon("palette"),
disabled = FALSE
),
shiny::helpText('Adjust settings, then press "Plot".')
shiny::helpText(i18n$t('Adjust settings, then press "Plot".'))
),
bslib::accordion_panel(
title = "Download",
icon = bsicons::bs_icon("download"),
shinyWidgets::noUiSliderInput(
inputId = ns("height_slide"),
label = "Plot height (mm)",
label = i18n$t("Plot height (mm)"),
min = 50,
max = 300,
value = 100,
@ -1671,7 +1678,7 @@ data_visuals_ui <- function(id, tab_title = "Plots", ...) {
# ),
shinyWidgets::noUiSliderInput(
inputId = ns("width"),
label = "Plot width (mm)",
label = i18n$t("Plot width (mm)"),
min = 50,
max = 300,
value = 100,
@ -1681,7 +1688,7 @@ data_visuals_ui <- function(id, tab_title = "Plots", ...) {
),
shiny::selectInput(
inputId = ns("plot_type"),
label = "File format",
label = i18n$t("File format"),
choices = list(
"png",
"tiff",
@ -1695,7 +1702,7 @@ data_visuals_ui <- function(id, tab_title = "Plots", ...) {
# Button
shiny::downloadButton(
outputId = ns("download_plot"),
label = "Download plot",
label = i18n$t("Download plot"),
icon = shiny::icon("download")
)
)
@ -1838,8 +1845,8 @@ data_visuals_server <- function(id,
inputId = ns("primary"),
col_subset = names(data())[sapply(data(), data_type) != "text"],
data = data,
placeholder = "Select variable",
label = "Response variable",
placeholder = i18n$t("Select variable"),
label = i18n$t("Response variable"),
multiple = FALSE
)
})
@ -1876,7 +1883,7 @@ data_visuals_server <- function(id,
vectorSelectInput(
inputId = ns("type"),
selected = NULL,
label = shiny::h4("Plot type"),
label = shiny::h4(i18n$t("Plot type")),
choices = Reduce(c, plots_named),
multiple = FALSE
)
@ -1904,12 +1911,12 @@ data_visuals_server <- function(id,
inputId = ns("secondary"),
data = data,
selected = cols[1],
placeholder = "Please select",
label = if (isTRUE(rv$plot.params()[["secondary.multi"]])) "Additional variables" else "Secondary variable",
placeholder = i18n$t("Please select"),
label = if (isTRUE(rv$plot.params()[["secondary.multi"]])) i18n$t("Additional variables") else i18n$t("Secondary variable"),
multiple = rv$plot.params()[["secondary.multi"]],
maxItems = rv$plot.params()[["secondary.max"]],
col_subset = cols,
none_label = "No variable"
none_label = i18n$t("No variable")
)
})
@ -1918,8 +1925,8 @@ data_visuals_server <- function(id,
columnSelectInput(
inputId = ns("tertiary"),
data = data,
placeholder = "Please select",
label = "Grouping variable",
placeholder = i18n$t("Please select"),
label = i18n$t("Grouping variable"),
multiple = FALSE,
col_subset = c(
"none",
@ -1932,7 +1939,7 @@ data_visuals_server <- function(id,
input$secondary
)
),
none_label = "No stratification"
none_label = i18n$t("No stratification")
)
})
@ -1948,7 +1955,7 @@ data_visuals_server <- function(id,
ter = input$tertiary
)
shiny::withProgress(message = "Drawing the plot. Hold tight for a moment..", {
shiny::withProgress(message = i18n$t("Drawing the plot. Hold tight for a moment.."), {
rv$plot <- rlang::exec(
create_plot,
!!!append_list(
@ -1975,7 +1982,7 @@ data_visuals_server <- function(id,
output$code_plot <- shiny::renderUI({
shiny::req(rv$code)
prismCodeBlock(paste0("#Plotting\n", rv$code))
prismCodeBlock(paste0(i18n$t("#Plotting\n"), rv$code))
})
shiny::observeEvent(
@ -2020,7 +2027,7 @@ data_visuals_server <- function(id,
plot <- rv$plot[[1]]
}
# browser()
shiny::withProgress(message = "Drawing the plot. Hold on for a moment..", {
shiny::withProgress(message = i18n$t("Drawing the plot. Hold on for a moment.."), {
ggplot2::ggsave(
filename = file,
plot = plot,
@ -2099,8 +2106,8 @@ supported_plots <- function() {
list(
plot_hbars = list(
fun = "plot_hbars",
descr = "Stacked horizontal bars",
note = "A classical way of visualising the distribution of an ordinal scale like the modified Ranking Scale and known as Grotta bars",
descr = i18n$t("Stacked horizontal bars"),
note = i18n$t("A classical way of visualising the distribution of an ordinal scale like the modified Ranking Scale and known as Grotta bars"),
primary.type = c("dichotomous", "categorical"),
secondary.type = c("dichotomous", "categorical"),
secondary.multi = FALSE,
@ -2109,8 +2116,8 @@ supported_plots <- function() {
),
plot_violin = list(
fun = "plot_violin",
descr = "Violin plot",
note = "A modern alternative to the classic boxplot to visualise data distribution",
descr = i18n$t("Violin plot"),
note = i18n$t("A modern alternative to the classic boxplot to visualise data distribution"),
primary.type = c("datatime", "continuous", "dichotomous", "categorical"),
secondary.type = c("dichotomous", "categorical"),
secondary.multi = FALSE,
@ -2127,8 +2134,8 @@ supported_plots <- function() {
# ),
plot_sankey = list(
fun = "plot_sankey",
descr = "Sankey plot",
note = "A way of visualising change between groups",
descr = i18n$t("Sankey plot"),
note = i18n$t("A way of visualising change between groups"),
primary.type = c("dichotomous", "categorical"),
secondary.type = c("dichotomous", "categorical"),
secondary.multi = FALSE,
@ -2137,8 +2144,8 @@ supported_plots <- function() {
),
plot_scatter = list(
fun = "plot_scatter",
descr = "Scatter plot",
note = "A classic way of showing the association between to variables",
descr = i18n$t("Scatter plot"),
note = i18n$t("A classic way of showing the association between to variables"),
primary.type = c("datatime", "continuous"),
secondary.type = c("datatime", "continuous", "categorical"),
secondary.multi = FALSE,
@ -2147,8 +2154,8 @@ supported_plots <- function() {
),
plot_box = list(
fun = "plot_box",
descr = "Box plot",
note = "A classic way to plot data distribution by groups",
descr = i18n$t("Box plot"),
note = i18n$t("A classic way to plot data distribution by groups"),
primary.type = c("datatime", "continuous", "dichotomous", "categorical"),
secondary.type = c("dichotomous", "categorical"),
secondary.multi = FALSE,
@ -2157,8 +2164,8 @@ supported_plots <- function() {
),
plot_euler = list(
fun = "plot_euler",
descr = "Euler diagram",
note = "Generate area-proportional Euler diagrams to display set relationships",
descr = i18n$t("Euler diagram"),
note = i18n$t("Generate area-proportional Euler diagrams to display set relationships"),
primary.type = c("dichotomous", "categorical"),
secondary.type = c("dichotomous", "categorical"),
secondary.multi = TRUE,
@ -4061,7 +4068,7 @@ simple_snake <- function(data){
#### Current file: /Users/au301842/FreesearchR/R//hosted_version.R
########
hosted_version <- function()'v25.8.3-250910'
hosted_version <- function()'v25.8.3-250911'
########
@ -11583,7 +11590,11 @@ server <- function(input, output, session) {
)
shiny::observeEvent(
list(
rv_validations$var_filter,
rv_validations$obs_filter,
rv_validations$missings
),
{
validation_server(
id = "validation_all",