Compare commits

..

No commits in common. "41c855a71c4f5d14bd8be47c0546c189916cf3e0" and "4213487a77b5ec0d7f0849703340fe61246c0cd1" have entirely different histories.

28 changed files with 211 additions and 329 deletions

View file

@ -8,7 +8,7 @@ message: 'To cite package "FreesearchR" in publications use:'
type: software type: software
license: AGPL-3.0-or-later license: AGPL-3.0-or-later
title: 'FreesearchR: Easy data analysis for clinicians' title: 'FreesearchR: Easy data analysis for clinicians'
version: 26.4.2 version: 26.4.1
doi: 10.5281/zenodo.14527429 doi: 10.5281/zenodo.14527429
identifiers: identifiers:
- type: url - type: url

View file

@ -1,6 +1,6 @@
Package: FreesearchR Package: FreesearchR
Title: Easy data analysis for clinicians Title: Easy data analysis for clinicians
Version: 26.4.2 Version: 26.4.1
Authors@R: c( Authors@R: c(
person("Andreas Gammelgaard", "Damsbo",email="agdamsbo@clin.au.dk", role = c("aut", "cre"), person("Andreas Gammelgaard", "Damsbo",email="agdamsbo@clin.au.dk", role = c("aut", "cre"),
comment = c(ORCID = "0000-0002-7559-1154")), comment = c(ORCID = "0000-0002-7559-1154")),

View file

@ -116,7 +116,6 @@ export(modify_qmd)
export(names2val) export(names2val)
export(overview_vars) export(overview_vars)
export(pipe_string) export(pipe_string)
export(plot_bar)
export(plot_bar_single) export(plot_bar_single)
export(plot_box) export(plot_box)
export(plot_box_single) export(plot_box_single)

View file

@ -1,7 +1,3 @@
# FreesearchR 26.4.2
Bug fixes and revised color choices.
# FreesearchR 26.4.1 # FreesearchR 26.4.1
Minor adjustments and bug fixes including streamlining icon use to only use phosphoricons across the app. Minor adjustments and bug fixes including streamlining icon use to only use phosphoricons across the app.

View file

@ -1 +1 @@
app_version <- function()'26.4.2' app_version <- function()'26.4.1'

View file

@ -76,7 +76,7 @@ create_column_ui <- function(id) {
actionButton( actionButton(
inputId = ns("compute"), inputId = ns("compute"),
label = tagList( label = tagList(
phosphoricons::ph("pencil",weight = "bold"), i18n$t("Create column") phosphoricons::ph("pencil"), i18n$t("Create column")
), ),
class = "btn-outline-primary", class = "btn-outline-primary",
width = "100%" width = "100%"
@ -84,7 +84,7 @@ create_column_ui <- function(id) {
actionButton( actionButton(
inputId = ns("remove"), inputId = ns("remove"),
label = tagList( label = tagList(
phosphoricons::ph("x-circle",weight = "bold"), phosphoricons::ph("x-circle"),
i18n$t("Cancel") i18n$t("Cancel")
), ),
class = "btn-outline-danger", class = "btn-outline-danger",

View file

@ -64,7 +64,7 @@ cut_variable_ui <- function(id) {
toastui::datagridOutput2(outputId = ns("count")), toastui::datagridOutput2(outputId = ns("count")),
actionButton( actionButton(
inputId = ns("create"), inputId = ns("create"),
label = tagList(phosphoricons::ph("scissors",weight = "bold"), i18n$t("Create factor variable")), label = tagList(phosphoricons::ph("scissors"), i18n$t("Create factor variable")),
class = "btn-outline-primary float-end" class = "btn-outline-primary float-end"
), ),
tags$div(class = "clearfix") tags$div(class = "clearfix")

View file

@ -38,7 +38,7 @@ data_visuals_ui <- function(id, tab_title = "Plots", ...) {
inputId = ns("act_plot"), inputId = ns("act_plot"),
label = i18n$t("Plot"), label = i18n$t("Plot"),
width = "100%", width = "100%",
icon = phosphoricons::ph("paint-brush",weight = "bold"), icon = phosphoricons::ph("paint-brush"),
# icon = shiny::icon("palette"), # icon = shiny::icon("palette"),
disabled = FALSE disabled = FALSE
), ),
@ -243,8 +243,7 @@ data_visuals_server <- function(id,
colorSelectInput( colorSelectInput(
inputId = ns("color_palette"), inputId = ns("color_palette"),
label = i18n$t("Choose color palette"), label = i18n$t("Choose color palette"),
choices = palettes, choices = palettes
previews = 5
) )
}) })
@ -722,7 +721,6 @@ wrap_plot_list <- function(data,
guides = "collect", guides = "collect",
axes = "collect", axes = "collect",
axis_titles = "collect", axis_titles = "collect",
y.axis.percentage = FALSE,
...) { ...) {
if (ggplot2::is_ggplot(data[[1]])) { if (ggplot2::is_ggplot(data[[1]])) {
if (length(data) > 1) { if (length(data) > 1) {
@ -736,7 +734,7 @@ wrap_plot_list <- function(data,
.x .x
} }
})() |> })() |>
align_axes(percentage=y.axis.percentage) |> align_axes() |>
patchwork::wrap_plots(guides = guides, patchwork::wrap_plots(guides = guides,
axes = axes, axes = axes,
axis_titles = axis_titles, axis_titles = axis_titles,
@ -781,8 +779,7 @@ wrap_plot_list <- function(data,
#' #'
align_axes <- function(..., align_axes <- function(...,
x.axis = TRUE, x.axis = TRUE,
y.axis = TRUE, y.axis = TRUE) {
percentage = FALSE) {
# https://stackoverflow.com/questions/62818776/get-axis-limits-from-ggplot-object # https://stackoverflow.com/questions/62818776/get-axis-limits-from-ggplot-object
# https://github.com/thomasp85/patchwork/blob/main/R/plot_multipage.R#L150 # https://github.com/thomasp85/patchwork/blob/main/R/plot_multipage.R#L150
if (ggplot2::is_ggplot(..1)) { if (ggplot2::is_ggplot(..1)) {
@ -800,7 +797,7 @@ align_axes <- function(...,
xr <- clean_common_axis(p, "x") xr <- clean_common_axis(p, "x")
suppressWarnings({ suppressWarnings({
p_out <- purrr::map(p, \(.x) { purrr::map(p, \(.x) {
out <- .x out <- .x
if (isTRUE(x.axis)) { if (isTRUE(x.axis)) {
out <- out + ggplot2::xlim(xr) out <- out + ggplot2::xlim(xr)
@ -811,15 +808,6 @@ align_axes <- function(...,
out out
}) })
}) })
if(isTRUE(percentage)){
lapply(p_out,\(.x){
.x+
ggplot2::scale_y_continuous(labels = scales::percent)
})
} else {
p_out
}
} }
#' Extract and clean axis ranges #' Extract and clean axis ranges

View file

@ -254,12 +254,12 @@ color_choices <- function() {
"Perceptual (blue-yellow)" = "viridis", "Perceptual (blue-yellow)" = "viridis",
"Perceptual (fire)" = "plasma", "Perceptual (fire)" = "plasma",
"Colour-blind friendly" = "Okabe-Ito", "Colour-blind friendly" = "Okabe-Ito",
"Diverging (red-yellow-green)"= "RdYlGn",
"Diverging (red-blue)" = "RdBu",
"Sequential (blues)" = "Blues",
"Qualitative (paired)" = "Paired",
"Qualitative (bold)" = "Dark 2", "Qualitative (bold)" = "Dark 2",
"Rainbow" = "Spectral", "Qualitative (paired)" = "Paired",
"Generic" = "Set1" "Sequential (blues)" = "Blues",
"Diverging (red-blue)" = "RdBu",
"Tableau style" = "Tableau 10",
"Pastel" = "Pastel 1",
"Rainbow" = "rainbow"
) )
} }

View file

@ -1 +1 @@
hosted_version <- function()'v26.4.2-260410' hosted_version <- function()'v26.4.1-260402'

View file

@ -714,7 +714,7 @@ make_success_alert <- function(data,
i18n$t("Data ready to be imported!") i18n$t("Data ready to be imported!")
), ),
sprintf( sprintf(
i18n$t("The data set has %s obs. in %s variables."), i18n$t("Data has %s obs. of %s variables."),
nrow(data), nrow(data),
ncol(data) ncol(data)
), ),
@ -725,7 +725,7 @@ make_success_alert <- function(data,
i18n$t("Data successfully imported!") i18n$t("Data successfully imported!")
), ),
sprintf( sprintf(
i18n$t("The data set has %s obs. in %s variables."), i18n$t("Data has %s obs. of %s variables."),
nrow(data), nrow(data),
ncol(data) ncol(data)
), ),

View file

@ -37,7 +37,7 @@ data_missings_ui <- function(id, ...) {
inputId = ns("act_miss"), inputId = ns("act_miss"),
label = i18n$t("Evaluate"), label = i18n$t("Evaluate"),
width = "100%", width = "100%",
icon = phosphoricons::ph("calculator",weight = "bold"), icon = phosphoricons::ph("calculator"),
# icon = shiny::icon("calculator"), # icon = shiny::icon("calculator"),
disabled = TRUE disabled = TRUE
) )

View file

@ -1,29 +1,5 @@
#' Title plot_bar <- function(data, pri, sec, ter = NULL, style = c("stack", "dodge", "fill"),
#' color.palette = "viridis", max_level = 30, ...) {
#' @name data-plots
#'
#' @param style barplot style passed to geom_bar position argument.
#' One of c("stack", "dodge", "fill")
#'
#' @returns ggplot list object
#' @export
#'
#' @examples
#' mtcars |>
#' dplyr::mutate(cyl = factor(cyl), am = factor(am)) |>
#' plot_bar(pri = "cyl", sec = "am", style = "fill")
#'
#' mtcars |>
#' dplyr::mutate(dplyr::across(tidyselect::all_of(c("cyl","am","gear")),factor)) |>
#' plot_bar(pri = "cyl", sec = "gear", ter = "am", style = "stack",color.palette="turbo")
plot_bar <- function(data,
pri,
sec = NULL,
ter = NULL,
style = c("stack", "dodge", "fill"),
color.palette = "viridis",
max_level = 30,
...) {
style <- match.arg(style) style <- match.arg(style)
if (!is.null(ter)) { if (!is.null(ter)) {
@ -32,7 +8,7 @@ plot_bar <- function(data,
ds <- list(data) ds <- list(data)
} }
out <- lapply(ds, \(.ds) { out <- lapply(ds, \(.ds){
plot_bar_single( plot_bar_single(
data = .ds, data = .ds,
pri = pri, pri = pri,
@ -43,10 +19,7 @@ plot_bar <- function(data,
) )
}) })
wrap_plot_list(out, wrap_plot_list(out, title = glue::glue(i18n$t("Grouped by {get_label(data,ter)}")), ...)
title = glue::glue(i18n$t("Grouped by {get_label(data,ter)}")),
y.axis.percentage = TRUE,
...)
} }
@ -68,11 +41,7 @@ plot_bar <- function(data,
#' mtcars |> #' mtcars |>
#' dplyr::mutate(cyl = factor(cyl), am = factor(am)) |> #' dplyr::mutate(cyl = factor(cyl), am = factor(am)) |>
#' plot_bar_single(pri = "cyl", style = "stack",color.palette="turbo") #' plot_bar_single(pri = "cyl", style = "stack",color.palette="turbo")
plot_bar_single <- function(data, plot_bar_single <- function(data, pri, sec = NULL, style = c("stack", "dodge", "fill"), max_level = 30,
pri,
sec = NULL,
style = c("stack", "dodge", "fill"),
max_level = 30,
color.palette = "viridis") { color.palette = "viridis") {
style <- match.arg(style) style <- match.arg(style)
@ -82,11 +51,16 @@ plot_bar_single <- function(data,
p_data <- as.data.frame(table(data[c(pri, sec)])) |> p_data <- as.data.frame(table(data[c(pri, sec)])) |>
dplyr::mutate(dplyr::across(tidyselect::any_of(c(pri, sec)), forcats::as_factor), dplyr::mutate(dplyr::across(tidyselect::any_of(c(pri, sec)), forcats::as_factor),
p = Freq / NROW(data)) p = Freq / NROW(data)
)
if (nrow(p_data) > max_level) { if (nrow(p_data) > max_level) {
p_data <- sort_by(p_data, p_data[["Freq"]], decreasing = TRUE) |> p_data <- sort_by(
p_data,
p_data[["Freq"]],
decreasing = TRUE
) |>
head(max_level) head(max_level)
} }
@ -99,31 +73,39 @@ plot_bar_single <- function(data,
fill <- pri fill <- pri
} }
p <- ggplot2::ggplot(p_data, ggplot2::aes(x = .data[[pri]], y = p, fill = .data[[fill]])) + p <- ggplot2::ggplot(
p_data,
ggplot2::aes(
x = .data[[pri]],
y = p,
fill = .data[[fill]]
)
) +
ggplot2::geom_bar(position = style, stat = "identity") + ggplot2::geom_bar(position = style, stat = "identity") +
scale_fill_generate(palette = color.palette) + ggplot2::scale_y_continuous(labels = scales::percent) +
ggplot2::xlab(get_label(data, pri)) + scale_fill_generate(palette=color.palette) +
ggplot2::guides(fill = ggplot2::guide_legend(title = get_label(data, fill))) ggplot2::ylab("Percentage") +
ggplot2::xlab(get_label(data,pri))+
ggplot2::guides(fill = ggplot2::guide_legend(title = get_label(data,fill)))
## To handle large number of levels and long level names ## To handle large number of levels and long level names
if (nrow(p_data) > 10 | if (nrow(p_data) > 10 | any(nchar(as.character(p_data[[pri]])) > 6)) {
any(nchar(as.character(p_data[[pri]])) > 6)) {
p <- p + p <- p +
# ggplot2::guides(fill = "none") + # ggplot2::guides(fill = "none") +
ggplot2::theme(axis.text.x = ggplot2::element_text( ggplot2::theme(
axis.text.x = ggplot2::element_text(
angle = 90, angle = 90,
vjust = 1, vjust = 1, hjust = 1
hjust = 1 ))+
)) + ggplot2::theme(
ggplot2::theme(axis.text.x = ggplot2::element_text(vjust = 0.5)) axis.text.x = ggplot2::element_text(vjust = 0.5)
)
if (is.null(sec)) { if (is.null(sec)){
p <- p + p <- p +
ggplot2::guides(fill = "none") ggplot2::guides(fill = "none")
} }
} }
p + p
ggplot2::scale_y_continuous(labels = scales::percent) +
ggplot2::ylab("Percentage")
} }

View file

@ -50,7 +50,7 @@ string_split_ui <- function(id) {
), ),
actionButton( actionButton(
inputId = ns("create"), inputId = ns("create"),
label = tagList(phosphoricons::ph("pencil",weight = "bold"), i18n$t("Apply split")), label = tagList(phosphoricons::ph("pencil"), i18n$t("Apply split")),
class = "btn-outline-primary float-end" class = "btn-outline-primary float-end"
), ),
tags$div(class = "clearfix") tags$div(class = "clearfix")

Binary file not shown.

View file

@ -124,7 +124,7 @@ ui_elements <- function(selection) {
inputId = "modal_initial_view", inputId = "modal_initial_view",
label = i18n$t("Quick overview"), label = i18n$t("Quick overview"),
width = "100%", width = "100%",
icon = phosphoricons::ph("binoculars",weight = "bold"), icon = phosphoricons::ph("binoculars"),
# icon = shiny::icon("binoculars"), # icon = shiny::icon("binoculars"),
disabled = FALSE disabled = FALSE
), ),
@ -169,7 +169,7 @@ ui_elements <- function(selection) {
inputId = "act_start", inputId = "act_start",
label = i18n$t("Let's begin!"), label = i18n$t("Let's begin!"),
width = "100%", width = "100%",
icon = phosphoricons::ph("play",weight = "bold"), icon = phosphoricons::ph("play"),
# icon = shiny::icon("play"), # icon = shiny::icon("play"),
disabled = TRUE disabled = TRUE
), ),
@ -460,7 +460,7 @@ ui_elements <- function(selection) {
inputId = "act_eval", inputId = "act_eval",
label = i18n$t("Evaluate"), label = i18n$t("Evaluate"),
width = "100%", width = "100%",
icon = phosphoricons::ph("calculator",weight = "bold"), icon = phosphoricons::ph("calculator"),
# icon = shiny::icon("calculator"), # icon = shiny::icon("calculator"),
disabled = TRUE disabled = TRUE
), ),

View file

@ -44,7 +44,7 @@ update_factor_ui <- function(id) {
actionButton( actionButton(
disabled = TRUE, disabled = TRUE,
inputId = ns("drop_levels"), inputId = ns("drop_levels"),
label = tagList(phosphoricons::ph("trash",weight = "bold"), i18n$t("Drop empty")), label = tagList(phosphoricons::ph("trash"), i18n$t("Drop empty")),
class = "btn-outline-primary mb-3", class = "btn-outline-primary mb-3",
width = "100%" width = "100%"
) )
@ -55,7 +55,7 @@ update_factor_ui <- function(id) {
actionButton( actionButton(
inputId = ns("sort_levels"), inputId = ns("sort_levels"),
label = tagList( label = tagList(
phosphoricons::ph("sort-ascending",weight = "bold"), phosphoricons::ph("sort-ascending"),
i18n$t("Sort by levels") i18n$t("Sort by levels")
), ),
class = "btn-outline-primary mb-3", class = "btn-outline-primary mb-3",
@ -68,7 +68,7 @@ update_factor_ui <- function(id) {
actionButton( actionButton(
inputId = ns("sort_occurrences"), inputId = ns("sort_occurrences"),
label = tagList( label = tagList(
phosphoricons::ph("sort-ascending",weight = "bold"), phosphoricons::ph("sort-ascending"),
i18n$t("Sort by count") i18n$t("Sort by count")
), ),
class = "btn-outline-primary mb-3", class = "btn-outline-primary mb-3",
@ -92,7 +92,7 @@ update_factor_ui <- function(id) {
actionButton( actionButton(
inputId = ns("create"), inputId = ns("create"),
label = tagList( label = tagList(
phosphoricons::ph("arrow-clockwise",weight = "bold"), phosphoricons::ph("arrow-clockwise"),
i18n$t("Update factor variable") i18n$t("Update factor variable")
), ),
class = "btn-outline-primary" class = "btn-outline-primary"

View file

@ -30,7 +30,7 @@ update_variables_ui <- function(id, title = "") {
placement = "bottom-end", placement = "bottom-end",
shiny::actionButton( shiny::actionButton(
inputId = ns("settings"), inputId = ns("settings"),
label = phosphoricons::ph("gear",weight = "bold"), label = phosphoricons::ph("gear"),
class = "pull-right float-right" class = "pull-right float-right"
), ),
shinyWidgets::textInputIcon( shinyWidgets::textInputIcon(
@ -75,7 +75,7 @@ update_variables_ui <- function(id, title = "") {
shiny::actionButton( shiny::actionButton(
inputId = ns("validate"), inputId = ns("validate"),
label = htmltools::tagList( label = htmltools::tagList(
phosphoricons::ph("arrow-circle-right", title = i18n$t("Apply changes"),weight = "bold"), phosphoricons::ph("arrow-circle-right", title = i18n$t("Apply changes")),
i18n$t("Apply changes") i18n$t("Apply changes")
), ),
width = "100%" width = "100%"

View file

@ -4,18 +4,18 @@
|setting |value | |setting |value |
|:-----------|:------------------------------------------| |:-----------|:------------------------------------------|
|version |R version 4.5.2 (2025-10-31) | |version |R version 4.5.2 (2025-10-31) |
|os |macOS Tahoe 26.4.1 | |os |macOS Tahoe 26.4 |
|system |aarch64, darwin20 | |system |aarch64, darwin20 |
|ui |RStudio | |ui |RStudio |
|language |(EN) | |language |(EN) |
|collate |en_US.UTF-8 | |collate |en_US.UTF-8 |
|ctype |en_US.UTF-8 | |ctype |en_US.UTF-8 |
|tz |Europe/Copenhagen | |tz |Europe/Copenhagen |
|date |2026-04-10 | |date |2026-04-01 |
|rstudio |2026.01.1+403 Apple Blossom (desktop) | |rstudio |2026.01.1+403 Apple Blossom (desktop) |
|pandoc |3.6.4 @ /opt/homebrew/bin/ (via rmarkdown) | |pandoc |3.6.4 @ /opt/homebrew/bin/ (via rmarkdown) |
|quarto |1.7.30 @ /usr/local/bin/quarto | |quarto |1.7.30 @ /usr/local/bin/quarto |
|FreesearchR |26.4.2.260410 | |FreesearchR |26.4.1.260401 |
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -83,7 +83,7 @@
|foreach |1.5.2 |2022-02-02 |CRAN (R 4.5.0) | |foreach |1.5.2 |2022-02-02 |CRAN (R 4.5.0) |
|foreign |0.8-91 |2026-01-29 |CRAN (R 4.5.2) | |foreign |0.8-91 |2026-01-29 |CRAN (R 4.5.2) |
|Formula |1.2-5 |2023-02-24 |CRAN (R 4.5.0) | |Formula |1.2-5 |2023-02-24 |CRAN (R 4.5.0) |
|FreesearchR |26.4.2 |NA |NA | |FreesearchR |26.4.1 |NA |NA |
|fs |1.6.7 |2026-03-06 |CRAN (R 4.5.2) | |fs |1.6.7 |2026-03-06 |CRAN (R 4.5.2) |
|gdtools |0.5.0 |2026-02-09 |CRAN (R 4.5.2) | |gdtools |0.5.0 |2026-02-09 |CRAN (R 4.5.2) |
|generics |0.1.4 |2025-05-09 |CRAN (R 4.5.0) | |generics |0.1.4 |2025-05-09 |CRAN (R 4.5.0) |
@ -147,6 +147,7 @@
|pkgload |1.5.0 |2026-02-03 |CRAN (R 4.5.2) | |pkgload |1.5.0 |2026-02-03 |CRAN (R 4.5.2) |
|plyr |1.8.9 |2023-10-02 |CRAN (R 4.5.0) | |plyr |1.8.9 |2023-10-02 |CRAN (R 4.5.0) |
|polyclip |1.10-7 |2024-07-23 |CRAN (R 4.5.0) | |polyclip |1.10-7 |2024-07-23 |CRAN (R 4.5.0) |
|polylabelr |1.0.0 |2026-01-19 |CRAN (R 4.5.2) |
|pracma |2.4.6 |2025-10-22 |CRAN (R 4.5.0) | |pracma |2.4.6 |2025-10-22 |CRAN (R 4.5.0) |
|processx |3.8.6 |2025-02-21 |CRAN (R 4.5.0) | |processx |3.8.6 |2025-02-21 |CRAN (R 4.5.0) |
|promises |1.5.0 |2025-11-01 |CRAN (R 4.5.0) | |promises |1.5.0 |2025-11-01 |CRAN (R 4.5.0) |

View file

@ -1,7 +1,7 @@
######## ########
#### Current file: /var/folders/9l/xbc19wxx0g79jdd2sf_0v291mhwh7f/T//RtmprUCGcI/file4761ae70bf7.R #### Current file: /var/folders/9l/xbc19wxx0g79jdd2sf_0v291mhwh7f/T//RtmpmlTuE8/file8be05102425f.R
######## ########
i18n_path <- here::here("translations") i18n_path <- here::here("translations")
@ -64,7 +64,7 @@ i18n$set_translation_language("en")
#### Current file: /Users/au301842/FreesearchR/R//app_version.R #### Current file: /Users/au301842/FreesearchR/R//app_version.R
######## ########
app_version <- function()'26.4.2' app_version <- function()'26.4.1'
######## ########
@ -512,7 +512,7 @@ create_column_ui <- function(id) {
actionButton( actionButton(
inputId = ns("compute"), inputId = ns("compute"),
label = tagList( label = tagList(
phosphoricons::ph("pencil",weight = "bold"), i18n$t("Create column") phosphoricons::ph("pencil"), i18n$t("Create column")
), ),
class = "btn-outline-primary", class = "btn-outline-primary",
width = "100%" width = "100%"
@ -520,7 +520,7 @@ create_column_ui <- function(id) {
actionButton( actionButton(
inputId = ns("remove"), inputId = ns("remove"),
label = tagList( label = tagList(
phosphoricons::ph("x-circle",weight = "bold"), phosphoricons::ph("x-circle"),
i18n$t("Cancel") i18n$t("Cancel")
), ),
class = "btn-outline-danger", class = "btn-outline-danger",
@ -1568,7 +1568,7 @@ cut_variable_ui <- function(id) {
toastui::datagridOutput2(outputId = ns("count")), toastui::datagridOutput2(outputId = ns("count")),
actionButton( actionButton(
inputId = ns("create"), inputId = ns("create"),
label = tagList(phosphoricons::ph("scissors",weight = "bold"), i18n$t("Create factor variable")), label = tagList(phosphoricons::ph("scissors"), i18n$t("Create factor variable")),
class = "btn-outline-primary float-end" class = "btn-outline-primary float-end"
), ),
tags$div(class = "clearfix") tags$div(class = "clearfix")
@ -2175,7 +2175,7 @@ data_visuals_ui <- function(id, tab_title = "Plots", ...) {
inputId = ns("act_plot"), inputId = ns("act_plot"),
label = i18n$t("Plot"), label = i18n$t("Plot"),
width = "100%", width = "100%",
icon = phosphoricons::ph("paint-brush",weight = "bold"), icon = phosphoricons::ph("paint-brush"),
# icon = shiny::icon("palette"), # icon = shiny::icon("palette"),
disabled = FALSE disabled = FALSE
), ),
@ -2380,8 +2380,7 @@ data_visuals_server <- function(id,
colorSelectInput( colorSelectInput(
inputId = ns("color_palette"), inputId = ns("color_palette"),
label = i18n$t("Choose color palette"), label = i18n$t("Choose color palette"),
choices = palettes, choices = palettes
previews = 5
) )
}) })
@ -2859,7 +2858,6 @@ wrap_plot_list <- function(data,
guides = "collect", guides = "collect",
axes = "collect", axes = "collect",
axis_titles = "collect", axis_titles = "collect",
y.axis.percentage = FALSE,
...) { ...) {
if (ggplot2::is_ggplot(data[[1]])) { if (ggplot2::is_ggplot(data[[1]])) {
if (length(data) > 1) { if (length(data) > 1) {
@ -2873,7 +2871,7 @@ wrap_plot_list <- function(data,
.x .x
} }
})() |> })() |>
align_axes(percentage=y.axis.percentage) |> align_axes() |>
patchwork::wrap_plots(guides = guides, patchwork::wrap_plots(guides = guides,
axes = axes, axes = axes,
axis_titles = axis_titles, axis_titles = axis_titles,
@ -2918,8 +2916,7 @@ wrap_plot_list <- function(data,
#' #'
align_axes <- function(..., align_axes <- function(...,
x.axis = TRUE, x.axis = TRUE,
y.axis = TRUE, y.axis = TRUE) {
percentage = FALSE) {
# https://stackoverflow.com/questions/62818776/get-axis-limits-from-ggplot-object # https://stackoverflow.com/questions/62818776/get-axis-limits-from-ggplot-object
# https://github.com/thomasp85/patchwork/blob/main/R/plot_multipage.R#L150 # https://github.com/thomasp85/patchwork/blob/main/R/plot_multipage.R#L150
if (ggplot2::is_ggplot(..1)) { if (ggplot2::is_ggplot(..1)) {
@ -2937,7 +2934,7 @@ align_axes <- function(...,
xr <- clean_common_axis(p, "x") xr <- clean_common_axis(p, "x")
suppressWarnings({ suppressWarnings({
p_out <- purrr::map(p, \(.x) { purrr::map(p, \(.x) {
out <- .x out <- .x
if (isTRUE(x.axis)) { if (isTRUE(x.axis)) {
out <- out + ggplot2::xlim(xr) out <- out + ggplot2::xlim(xr)
@ -2948,15 +2945,6 @@ align_axes <- function(...,
out out
}) })
}) })
if(isTRUE(percentage)){
lapply(p_out,\(.x){
.x+
ggplot2::scale_y_continuous(labels = scales::percent)
})
} else {
p_out
}
} }
#' Extract and clean axis ranges #' Extract and clean axis ranges
@ -4043,13 +4031,13 @@ color_choices <- function() {
"Perceptual (blue-yellow)" = "viridis", "Perceptual (blue-yellow)" = "viridis",
"Perceptual (fire)" = "plasma", "Perceptual (fire)" = "plasma",
"Colour-blind friendly" = "Okabe-Ito", "Colour-blind friendly" = "Okabe-Ito",
"Diverging (red-yellow-green)"= "RdYlGn",
"Diverging (red-blue)" = "RdBu",
"Sequential (blues)" = "Blues",
"Qualitative (paired)" = "Paired",
"Qualitative (bold)" = "Dark 2", "Qualitative (bold)" = "Dark 2",
"Rainbow" = "Spectral", "Qualitative (paired)" = "Paired",
"Generic" = "Set1" "Sequential (blues)" = "Blues",
"Diverging (red-blue)" = "RdBu",
"Tableau style" = "Tableau 10",
"Pastel" = "Pastel 1",
"Rainbow" = "rainbow"
) )
} }
@ -4957,7 +4945,7 @@ apply_idea_filter <- function(filtered_reactive, df_target, env = parent.frame()
#### Current file: /Users/au301842/FreesearchR/R//hosted_version.R #### Current file: /Users/au301842/FreesearchR/R//hosted_version.R
######## ########
hosted_version <- function()'v26.4.2-260410' hosted_version <- function()'v26.4.1-260402'
######## ########
@ -6097,7 +6085,7 @@ make_success_alert <- function(data,
i18n$t("Data ready to be imported!") i18n$t("Data ready to be imported!")
), ),
sprintf( sprintf(
i18n$t("The data set has %s obs. in %s variables."), i18n$t("Data has %s obs. of %s variables."),
nrow(data), nrow(data),
ncol(data) ncol(data)
), ),
@ -6108,7 +6096,7 @@ make_success_alert <- function(data,
i18n$t("Data successfully imported!") i18n$t("Data successfully imported!")
), ),
sprintf( sprintf(
i18n$t("The data set has %s obs. in %s variables."), i18n$t("Data has %s obs. of %s variables."),
nrow(data), nrow(data),
ncol(data) ncol(data)
), ),
@ -6593,7 +6581,7 @@ data_missings_ui <- function(id, ...) {
inputId = ns("act_miss"), inputId = ns("act_miss"),
label = i18n$t("Evaluate"), label = i18n$t("Evaluate"),
width = "100%", width = "100%",
icon = phosphoricons::ph("calculator",weight = "bold"), icon = phosphoricons::ph("calculator"),
# icon = shiny::icon("calculator"), # icon = shiny::icon("calculator"),
disabled = TRUE disabled = TRUE
) )
@ -6930,32 +6918,8 @@ missings_logic_across <- function(data, exclude = NULL) {
#### Current file: /Users/au301842/FreesearchR/R//plot_bar.R #### Current file: /Users/au301842/FreesearchR/R//plot_bar.R
######## ########
#' Title plot_bar <- function(data, pri, sec, ter = NULL, style = c("stack", "dodge", "fill"),
#' color.palette = "viridis", max_level = 30, ...) {
#' @name data-plots
#'
#' @param style barplot style passed to geom_bar position argument.
#' One of c("stack", "dodge", "fill")
#'
#' @returns ggplot list object
#' @export
#'
#' @examples
#' mtcars |>
#' dplyr::mutate(cyl = factor(cyl), am = factor(am)) |>
#' plot_bar(pri = "cyl", sec = "am", style = "fill")
#'
#' mtcars |>
#' dplyr::mutate(dplyr::across(tidyselect::all_of(c("cyl","am","gear")),factor)) |>
#' plot_bar(pri = "cyl", sec = "gear", ter = "am", style = "stack",color.palette="turbo")
plot_bar <- function(data,
pri,
sec = NULL,
ter = NULL,
style = c("stack", "dodge", "fill"),
color.palette = "viridis",
max_level = 30,
...) {
style <- match.arg(style) style <- match.arg(style)
if (!is.null(ter)) { if (!is.null(ter)) {
@ -6964,7 +6928,7 @@ plot_bar <- function(data,
ds <- list(data) ds <- list(data)
} }
out <- lapply(ds, \(.ds) { out <- lapply(ds, \(.ds){
plot_bar_single( plot_bar_single(
data = .ds, data = .ds,
pri = pri, pri = pri,
@ -6975,10 +6939,7 @@ plot_bar <- function(data,
) )
}) })
wrap_plot_list(out, wrap_plot_list(out, title = glue::glue(i18n$t("Grouped by {get_label(data,ter)}")), ...)
title = glue::glue(i18n$t("Grouped by {get_label(data,ter)}")),
y.axis.percentage = TRUE,
...)
} }
@ -7000,11 +6961,7 @@ plot_bar <- function(data,
#' mtcars |> #' mtcars |>
#' dplyr::mutate(cyl = factor(cyl), am = factor(am)) |> #' dplyr::mutate(cyl = factor(cyl), am = factor(am)) |>
#' plot_bar_single(pri = "cyl", style = "stack",color.palette="turbo") #' plot_bar_single(pri = "cyl", style = "stack",color.palette="turbo")
plot_bar_single <- function(data, plot_bar_single <- function(data, pri, sec = NULL, style = c("stack", "dodge", "fill"), max_level = 30,
pri,
sec = NULL,
style = c("stack", "dodge", "fill"),
max_level = 30,
color.palette = "viridis") { color.palette = "viridis") {
style <- match.arg(style) style <- match.arg(style)
@ -7014,11 +6971,16 @@ plot_bar_single <- function(data,
p_data <- as.data.frame(table(data[c(pri, sec)])) |> p_data <- as.data.frame(table(data[c(pri, sec)])) |>
dplyr::mutate(dplyr::across(tidyselect::any_of(c(pri, sec)), forcats::as_factor), dplyr::mutate(dplyr::across(tidyselect::any_of(c(pri, sec)), forcats::as_factor),
p = Freq / NROW(data)) p = Freq / NROW(data)
)
if (nrow(p_data) > max_level) { if (nrow(p_data) > max_level) {
p_data <- sort_by(p_data, p_data[["Freq"]], decreasing = TRUE) |> p_data <- sort_by(
p_data,
p_data[["Freq"]],
decreasing = TRUE
) |>
head(max_level) head(max_level)
} }
@ -7031,33 +6993,41 @@ plot_bar_single <- function(data,
fill <- pri fill <- pri
} }
p <- ggplot2::ggplot(p_data, ggplot2::aes(x = .data[[pri]], y = p, fill = .data[[fill]])) + p <- ggplot2::ggplot(
p_data,
ggplot2::aes(
x = .data[[pri]],
y = p,
fill = .data[[fill]]
)
) +
ggplot2::geom_bar(position = style, stat = "identity") + ggplot2::geom_bar(position = style, stat = "identity") +
scale_fill_generate(palette = color.palette) + ggplot2::scale_y_continuous(labels = scales::percent) +
ggplot2::xlab(get_label(data, pri)) + scale_fill_generate(palette=color.palette) +
ggplot2::guides(fill = ggplot2::guide_legend(title = get_label(data, fill))) ggplot2::ylab("Percentage") +
ggplot2::xlab(get_label(data,pri))+
ggplot2::guides(fill = ggplot2::guide_legend(title = get_label(data,fill)))
## To handle large number of levels and long level names ## To handle large number of levels and long level names
if (nrow(p_data) > 10 | if (nrow(p_data) > 10 | any(nchar(as.character(p_data[[pri]])) > 6)) {
any(nchar(as.character(p_data[[pri]])) > 6)) {
p <- p + p <- p +
# ggplot2::guides(fill = "none") + # ggplot2::guides(fill = "none") +
ggplot2::theme(axis.text.x = ggplot2::element_text( ggplot2::theme(
axis.text.x = ggplot2::element_text(
angle = 90, angle = 90,
vjust = 1, vjust = 1, hjust = 1
hjust = 1 ))+
)) + ggplot2::theme(
ggplot2::theme(axis.text.x = ggplot2::element_text(vjust = 0.5)) axis.text.x = ggplot2::element_text(vjust = 0.5)
)
if (is.null(sec)) { if (is.null(sec)){
p <- p + p <- p +
ggplot2::guides(fill = "none") ggplot2::guides(fill = "none")
} }
} }
p + p
ggplot2::scale_y_continuous(labels = scales::percent) +
ggplot2::ylab("Percentage")
} }
@ -10995,7 +10965,7 @@ string_split_ui <- function(id) {
), ),
actionButton( actionButton(
inputId = ns("create"), inputId = ns("create"),
label = tagList(phosphoricons::ph("pencil",weight = "bold"), i18n$t("Apply split")), label = tagList(phosphoricons::ph("pencil"), i18n$t("Apply split")),
class = "btn-outline-primary float-end" class = "btn-outline-primary float-end"
), ),
tags$div(class = "clearfix") tags$div(class = "clearfix")
@ -11880,7 +11850,7 @@ ui_elements <- function(selection) {
inputId = "modal_initial_view", inputId = "modal_initial_view",
label = i18n$t("Quick overview"), label = i18n$t("Quick overview"),
width = "100%", width = "100%",
icon = phosphoricons::ph("binoculars",weight = "bold"), icon = phosphoricons::ph("binoculars"),
# icon = shiny::icon("binoculars"), # icon = shiny::icon("binoculars"),
disabled = FALSE disabled = FALSE
), ),
@ -11925,7 +11895,7 @@ ui_elements <- function(selection) {
inputId = "act_start", inputId = "act_start",
label = i18n$t("Let's begin!"), label = i18n$t("Let's begin!"),
width = "100%", width = "100%",
icon = phosphoricons::ph("play",weight = "bold"), icon = phosphoricons::ph("play"),
# icon = shiny::icon("play"), # icon = shiny::icon("play"),
disabled = TRUE disabled = TRUE
), ),
@ -12216,7 +12186,7 @@ ui_elements <- function(selection) {
inputId = "act_eval", inputId = "act_eval",
label = i18n$t("Evaluate"), label = i18n$t("Evaluate"),
width = "100%", width = "100%",
icon = phosphoricons::ph("calculator",weight = "bold"), icon = phosphoricons::ph("calculator"),
# icon = shiny::icon("calculator"), # icon = shiny::icon("calculator"),
disabled = TRUE disabled = TRUE
), ),
@ -12527,7 +12497,7 @@ update_factor_ui <- function(id) {
actionButton( actionButton(
disabled = TRUE, disabled = TRUE,
inputId = ns("drop_levels"), inputId = ns("drop_levels"),
label = tagList(phosphoricons::ph("trash",weight = "bold"), i18n$t("Drop empty")), label = tagList(phosphoricons::ph("trash"), i18n$t("Drop empty")),
class = "btn-outline-primary mb-3", class = "btn-outline-primary mb-3",
width = "100%" width = "100%"
) )
@ -12538,7 +12508,7 @@ update_factor_ui <- function(id) {
actionButton( actionButton(
inputId = ns("sort_levels"), inputId = ns("sort_levels"),
label = tagList( label = tagList(
phosphoricons::ph("sort-ascending",weight = "bold"), phosphoricons::ph("sort-ascending"),
i18n$t("Sort by levels") i18n$t("Sort by levels")
), ),
class = "btn-outline-primary mb-3", class = "btn-outline-primary mb-3",
@ -12551,7 +12521,7 @@ update_factor_ui <- function(id) {
actionButton( actionButton(
inputId = ns("sort_occurrences"), inputId = ns("sort_occurrences"),
label = tagList( label = tagList(
phosphoricons::ph("sort-ascending",weight = "bold"), phosphoricons::ph("sort-ascending"),
i18n$t("Sort by count") i18n$t("Sort by count")
), ),
class = "btn-outline-primary mb-3", class = "btn-outline-primary mb-3",
@ -12575,7 +12545,7 @@ update_factor_ui <- function(id) {
actionButton( actionButton(
inputId = ns("create"), inputId = ns("create"),
label = tagList( label = tagList(
phosphoricons::ph("arrow-clockwise",weight = "bold"), phosphoricons::ph("arrow-clockwise"),
i18n$t("Update factor variable") i18n$t("Update factor variable")
), ),
class = "btn-outline-primary" class = "btn-outline-primary"
@ -12927,7 +12897,7 @@ update_variables_ui <- function(id, title = "") {
placement = "bottom-end", placement = "bottom-end",
shiny::actionButton( shiny::actionButton(
inputId = ns("settings"), inputId = ns("settings"),
label = phosphoricons::ph("gear",weight = "bold"), label = phosphoricons::ph("gear"),
class = "pull-right float-right" class = "pull-right float-right"
), ),
shinyWidgets::textInputIcon( shinyWidgets::textInputIcon(
@ -12972,7 +12942,7 @@ update_variables_ui <- function(id, title = "") {
shiny::actionButton( shiny::actionButton(
inputId = ns("validate"), inputId = ns("validate"),
label = htmltools::tagList( label = htmltools::tagList(
phosphoricons::ph("arrow-circle-right", title = i18n$t("Apply changes"),weight = "bold"), phosphoricons::ph("arrow-circle-right", title = i18n$t("Apply changes")),
i18n$t("Apply changes") i18n$t("Apply changes")
), ),
width = "100%" width = "100%"

View file

@ -275,6 +275,7 @@
"Select a dataset from your environment or sample dataset from a package.","Vælg et datasæt fra din kørende session eller vælg træningsdata." "Select a dataset from your environment or sample dataset from a package.","Vælg et datasæt fra din kørende session eller vælg træningsdata."
"Select a sample dataset from a package.","Vælg et træningsdatasæt." "Select a sample dataset from a package.","Vælg et træningsdatasæt."
"Data ready to be imported!","Data er klar til at blive importeret!" "Data ready to be imported!","Data er klar til at blive importeret!"
"Data has %s obs. of %s variables.","Data har %s obs. på %s variabler."
"Data successfully imported!","Data successfully imported!" "Data successfully imported!","Data successfully imported!"
"Click to see data","Klik for at se data" "Click to see data","Klik for at se data"
"No data present.","Ingen data tilstede." "No data present.","Ingen data tilstede."
@ -319,4 +320,3 @@
"Likert diagram","Likert diagram" "Likert diagram","Likert diagram"
"Modify factor","Modify factor" "Modify factor","Modify factor"
"Create factor/categorical variable from other variables.","Create factor/categorical variable from other variables." "Create factor/categorical variable from other variables.","Create factor/categorical variable from other variables."
"The data set has %s obs. in %s variables.","The data set has %s obs. in %s variables."

1 en da
275 Select a dataset from your environment or sample dataset from a package. Vælg et datasæt fra din kørende session eller vælg træningsdata.
276 Select a sample dataset from a package. Vælg et træningsdatasæt.
277 Data ready to be imported! Data er klar til at blive importeret!
278 Data has %s obs. of %s variables. Data har %s obs. på %s variabler.
279 Data successfully imported! Data successfully imported!
280 Click to see data Klik for at se data
281 No data present. Ingen data tilstede.
320 Likert diagram Likert diagram
321 Modify factor Modify factor
322 Create factor/categorical variable from other variables. Create factor/categorical variable from other variables.
The data set has %s obs. in %s variables. The data set has %s obs. in %s variables.

View file

@ -275,6 +275,7 @@
"Select a dataset from your environment or sample dataset from a package.","Select a dataset from your environment or sample dataset from a package." "Select a dataset from your environment or sample dataset from a package.","Select a dataset from your environment or sample dataset from a package."
"Select a sample dataset from a package.","Select a sample dataset from a package." "Select a sample dataset from a package.","Select a sample dataset from a package."
"Data ready to be imported!","Data ready to be imported!" "Data ready to be imported!","Data ready to be imported!"
"Data has %s obs. of %s variables.","Data has %s obs. of %s variables."
"Data successfully imported!","Data successfully imported!" "Data successfully imported!","Data successfully imported!"
"Click to see data","Click to see data" "Click to see data","Click to see data"
"No data present.","No data present." "No data present.","No data present."
@ -319,4 +320,3 @@
"Likert diagram","Likert diagram" "Likert diagram","Likert diagram"
"Modify factor","Modify factor" "Modify factor","Modify factor"
"Create factor/categorical variable from other variables.","Create factor/categorical variable from other variables." "Create factor/categorical variable from other variables.","Create factor/categorical variable from other variables."
"The data set has %s obs. in %s variables.","The data set has %s obs. in %s variables."

1 en sw
275 Select a dataset from your environment or sample dataset from a package. Select a dataset from your environment or sample dataset from a package.
276 Select a sample dataset from a package. Select a sample dataset from a package.
277 Data ready to be imported! Data ready to be imported!
278 Data has %s obs. of %s variables. Data has %s obs. of %s variables.
279 Data successfully imported! Data successfully imported!
280 Click to see data Click to see data
281 No data present. No data present.
320 Likert diagram Likert diagram
321 Modify factor Modify factor
322 Create factor/categorical variable from other variables. Create factor/categorical variable from other variables.
The data set has %s obs. in %s variables. The data set has %s obs. in %s variables.

View file

@ -1,7 +1,7 @@
######## ########
#### Current file: /var/folders/9l/xbc19wxx0g79jdd2sf_0v291mhwh7f/T//RtmprUCGcI/file47614d090a4c.R #### Current file: /var/folders/9l/xbc19wxx0g79jdd2sf_0v291mhwh7f/T//RtmpmlTuE8/file8be0207bfdc2.R
######## ########
i18n_path <- system.file("translations", package = "FreesearchR") i18n_path <- system.file("translations", package = "FreesearchR")
@ -64,7 +64,7 @@ i18n$set_translation_language("en")
#### Current file: /Users/au301842/FreesearchR/R//app_version.R #### Current file: /Users/au301842/FreesearchR/R//app_version.R
######## ########
app_version <- function()'26.4.2' app_version <- function()'26.4.1'
######## ########
@ -512,7 +512,7 @@ create_column_ui <- function(id) {
actionButton( actionButton(
inputId = ns("compute"), inputId = ns("compute"),
label = tagList( label = tagList(
phosphoricons::ph("pencil",weight = "bold"), i18n$t("Create column") phosphoricons::ph("pencil"), i18n$t("Create column")
), ),
class = "btn-outline-primary", class = "btn-outline-primary",
width = "100%" width = "100%"
@ -520,7 +520,7 @@ create_column_ui <- function(id) {
actionButton( actionButton(
inputId = ns("remove"), inputId = ns("remove"),
label = tagList( label = tagList(
phosphoricons::ph("x-circle",weight = "bold"), phosphoricons::ph("x-circle"),
i18n$t("Cancel") i18n$t("Cancel")
), ),
class = "btn-outline-danger", class = "btn-outline-danger",
@ -1568,7 +1568,7 @@ cut_variable_ui <- function(id) {
toastui::datagridOutput2(outputId = ns("count")), toastui::datagridOutput2(outputId = ns("count")),
actionButton( actionButton(
inputId = ns("create"), inputId = ns("create"),
label = tagList(phosphoricons::ph("scissors",weight = "bold"), i18n$t("Create factor variable")), label = tagList(phosphoricons::ph("scissors"), i18n$t("Create factor variable")),
class = "btn-outline-primary float-end" class = "btn-outline-primary float-end"
), ),
tags$div(class = "clearfix") tags$div(class = "clearfix")
@ -2175,7 +2175,7 @@ data_visuals_ui <- function(id, tab_title = "Plots", ...) {
inputId = ns("act_plot"), inputId = ns("act_plot"),
label = i18n$t("Plot"), label = i18n$t("Plot"),
width = "100%", width = "100%",
icon = phosphoricons::ph("paint-brush",weight = "bold"), icon = phosphoricons::ph("paint-brush"),
# icon = shiny::icon("palette"), # icon = shiny::icon("palette"),
disabled = FALSE disabled = FALSE
), ),
@ -2380,8 +2380,7 @@ data_visuals_server <- function(id,
colorSelectInput( colorSelectInput(
inputId = ns("color_palette"), inputId = ns("color_palette"),
label = i18n$t("Choose color palette"), label = i18n$t("Choose color palette"),
choices = palettes, choices = palettes
previews = 5
) )
}) })
@ -2859,7 +2858,6 @@ wrap_plot_list <- function(data,
guides = "collect", guides = "collect",
axes = "collect", axes = "collect",
axis_titles = "collect", axis_titles = "collect",
y.axis.percentage = FALSE,
...) { ...) {
if (ggplot2::is_ggplot(data[[1]])) { if (ggplot2::is_ggplot(data[[1]])) {
if (length(data) > 1) { if (length(data) > 1) {
@ -2873,7 +2871,7 @@ wrap_plot_list <- function(data,
.x .x
} }
})() |> })() |>
align_axes(percentage=y.axis.percentage) |> align_axes() |>
patchwork::wrap_plots(guides = guides, patchwork::wrap_plots(guides = guides,
axes = axes, axes = axes,
axis_titles = axis_titles, axis_titles = axis_titles,
@ -2918,8 +2916,7 @@ wrap_plot_list <- function(data,
#' #'
align_axes <- function(..., align_axes <- function(...,
x.axis = TRUE, x.axis = TRUE,
y.axis = TRUE, y.axis = TRUE) {
percentage = FALSE) {
# https://stackoverflow.com/questions/62818776/get-axis-limits-from-ggplot-object # https://stackoverflow.com/questions/62818776/get-axis-limits-from-ggplot-object
# https://github.com/thomasp85/patchwork/blob/main/R/plot_multipage.R#L150 # https://github.com/thomasp85/patchwork/blob/main/R/plot_multipage.R#L150
if (ggplot2::is_ggplot(..1)) { if (ggplot2::is_ggplot(..1)) {
@ -2937,7 +2934,7 @@ align_axes <- function(...,
xr <- clean_common_axis(p, "x") xr <- clean_common_axis(p, "x")
suppressWarnings({ suppressWarnings({
p_out <- purrr::map(p, \(.x) { purrr::map(p, \(.x) {
out <- .x out <- .x
if (isTRUE(x.axis)) { if (isTRUE(x.axis)) {
out <- out + ggplot2::xlim(xr) out <- out + ggplot2::xlim(xr)
@ -2948,15 +2945,6 @@ align_axes <- function(...,
out out
}) })
}) })
if(isTRUE(percentage)){
lapply(p_out,\(.x){
.x+
ggplot2::scale_y_continuous(labels = scales::percent)
})
} else {
p_out
}
} }
#' Extract and clean axis ranges #' Extract and clean axis ranges
@ -4043,13 +4031,13 @@ color_choices <- function() {
"Perceptual (blue-yellow)" = "viridis", "Perceptual (blue-yellow)" = "viridis",
"Perceptual (fire)" = "plasma", "Perceptual (fire)" = "plasma",
"Colour-blind friendly" = "Okabe-Ito", "Colour-blind friendly" = "Okabe-Ito",
"Diverging (red-yellow-green)"= "RdYlGn",
"Diverging (red-blue)" = "RdBu",
"Sequential (blues)" = "Blues",
"Qualitative (paired)" = "Paired",
"Qualitative (bold)" = "Dark 2", "Qualitative (bold)" = "Dark 2",
"Rainbow" = "Spectral", "Qualitative (paired)" = "Paired",
"Generic" = "Set1" "Sequential (blues)" = "Blues",
"Diverging (red-blue)" = "RdBu",
"Tableau style" = "Tableau 10",
"Pastel" = "Pastel 1",
"Rainbow" = "rainbow"
) )
} }
@ -4957,7 +4945,7 @@ apply_idea_filter <- function(filtered_reactive, df_target, env = parent.frame()
#### Current file: /Users/au301842/FreesearchR/R//hosted_version.R #### Current file: /Users/au301842/FreesearchR/R//hosted_version.R
######## ########
hosted_version <- function()'v26.4.2-260410' hosted_version <- function()'v26.4.1-260402'
######## ########
@ -6097,7 +6085,7 @@ make_success_alert <- function(data,
i18n$t("Data ready to be imported!") i18n$t("Data ready to be imported!")
), ),
sprintf( sprintf(
i18n$t("The data set has %s obs. in %s variables."), i18n$t("Data has %s obs. of %s variables."),
nrow(data), nrow(data),
ncol(data) ncol(data)
), ),
@ -6108,7 +6096,7 @@ make_success_alert <- function(data,
i18n$t("Data successfully imported!") i18n$t("Data successfully imported!")
), ),
sprintf( sprintf(
i18n$t("The data set has %s obs. in %s variables."), i18n$t("Data has %s obs. of %s variables."),
nrow(data), nrow(data),
ncol(data) ncol(data)
), ),
@ -6593,7 +6581,7 @@ data_missings_ui <- function(id, ...) {
inputId = ns("act_miss"), inputId = ns("act_miss"),
label = i18n$t("Evaluate"), label = i18n$t("Evaluate"),
width = "100%", width = "100%",
icon = phosphoricons::ph("calculator",weight = "bold"), icon = phosphoricons::ph("calculator"),
# icon = shiny::icon("calculator"), # icon = shiny::icon("calculator"),
disabled = TRUE disabled = TRUE
) )
@ -6930,32 +6918,8 @@ missings_logic_across <- function(data, exclude = NULL) {
#### Current file: /Users/au301842/FreesearchR/R//plot_bar.R #### Current file: /Users/au301842/FreesearchR/R//plot_bar.R
######## ########
#' Title plot_bar <- function(data, pri, sec, ter = NULL, style = c("stack", "dodge", "fill"),
#' color.palette = "viridis", max_level = 30, ...) {
#' @name data-plots
#'
#' @param style barplot style passed to geom_bar position argument.
#' One of c("stack", "dodge", "fill")
#'
#' @returns ggplot list object
#' @export
#'
#' @examples
#' mtcars |>
#' dplyr::mutate(cyl = factor(cyl), am = factor(am)) |>
#' plot_bar(pri = "cyl", sec = "am", style = "fill")
#'
#' mtcars |>
#' dplyr::mutate(dplyr::across(tidyselect::all_of(c("cyl","am","gear")),factor)) |>
#' plot_bar(pri = "cyl", sec = "gear", ter = "am", style = "stack",color.palette="turbo")
plot_bar <- function(data,
pri,
sec = NULL,
ter = NULL,
style = c("stack", "dodge", "fill"),
color.palette = "viridis",
max_level = 30,
...) {
style <- match.arg(style) style <- match.arg(style)
if (!is.null(ter)) { if (!is.null(ter)) {
@ -6964,7 +6928,7 @@ plot_bar <- function(data,
ds <- list(data) ds <- list(data)
} }
out <- lapply(ds, \(.ds) { out <- lapply(ds, \(.ds){
plot_bar_single( plot_bar_single(
data = .ds, data = .ds,
pri = pri, pri = pri,
@ -6975,10 +6939,7 @@ plot_bar <- function(data,
) )
}) })
wrap_plot_list(out, wrap_plot_list(out, title = glue::glue(i18n$t("Grouped by {get_label(data,ter)}")), ...)
title = glue::glue(i18n$t("Grouped by {get_label(data,ter)}")),
y.axis.percentage = TRUE,
...)
} }
@ -7000,11 +6961,7 @@ plot_bar <- function(data,
#' mtcars |> #' mtcars |>
#' dplyr::mutate(cyl = factor(cyl), am = factor(am)) |> #' dplyr::mutate(cyl = factor(cyl), am = factor(am)) |>
#' plot_bar_single(pri = "cyl", style = "stack",color.palette="turbo") #' plot_bar_single(pri = "cyl", style = "stack",color.palette="turbo")
plot_bar_single <- function(data, plot_bar_single <- function(data, pri, sec = NULL, style = c("stack", "dodge", "fill"), max_level = 30,
pri,
sec = NULL,
style = c("stack", "dodge", "fill"),
max_level = 30,
color.palette = "viridis") { color.palette = "viridis") {
style <- match.arg(style) style <- match.arg(style)
@ -7014,11 +6971,16 @@ plot_bar_single <- function(data,
p_data <- as.data.frame(table(data[c(pri, sec)])) |> p_data <- as.data.frame(table(data[c(pri, sec)])) |>
dplyr::mutate(dplyr::across(tidyselect::any_of(c(pri, sec)), forcats::as_factor), dplyr::mutate(dplyr::across(tidyselect::any_of(c(pri, sec)), forcats::as_factor),
p = Freq / NROW(data)) p = Freq / NROW(data)
)
if (nrow(p_data) > max_level) { if (nrow(p_data) > max_level) {
p_data <- sort_by(p_data, p_data[["Freq"]], decreasing = TRUE) |> p_data <- sort_by(
p_data,
p_data[["Freq"]],
decreasing = TRUE
) |>
head(max_level) head(max_level)
} }
@ -7031,33 +6993,41 @@ plot_bar_single <- function(data,
fill <- pri fill <- pri
} }
p <- ggplot2::ggplot(p_data, ggplot2::aes(x = .data[[pri]], y = p, fill = .data[[fill]])) + p <- ggplot2::ggplot(
p_data,
ggplot2::aes(
x = .data[[pri]],
y = p,
fill = .data[[fill]]
)
) +
ggplot2::geom_bar(position = style, stat = "identity") + ggplot2::geom_bar(position = style, stat = "identity") +
scale_fill_generate(palette = color.palette) + ggplot2::scale_y_continuous(labels = scales::percent) +
ggplot2::xlab(get_label(data, pri)) + scale_fill_generate(palette=color.palette) +
ggplot2::guides(fill = ggplot2::guide_legend(title = get_label(data, fill))) ggplot2::ylab("Percentage") +
ggplot2::xlab(get_label(data,pri))+
ggplot2::guides(fill = ggplot2::guide_legend(title = get_label(data,fill)))
## To handle large number of levels and long level names ## To handle large number of levels and long level names
if (nrow(p_data) > 10 | if (nrow(p_data) > 10 | any(nchar(as.character(p_data[[pri]])) > 6)) {
any(nchar(as.character(p_data[[pri]])) > 6)) {
p <- p + p <- p +
# ggplot2::guides(fill = "none") + # ggplot2::guides(fill = "none") +
ggplot2::theme(axis.text.x = ggplot2::element_text( ggplot2::theme(
axis.text.x = ggplot2::element_text(
angle = 90, angle = 90,
vjust = 1, vjust = 1, hjust = 1
hjust = 1 ))+
)) + ggplot2::theme(
ggplot2::theme(axis.text.x = ggplot2::element_text(vjust = 0.5)) axis.text.x = ggplot2::element_text(vjust = 0.5)
)
if (is.null(sec)) { if (is.null(sec)){
p <- p + p <- p +
ggplot2::guides(fill = "none") ggplot2::guides(fill = "none")
} }
} }
p + p
ggplot2::scale_y_continuous(labels = scales::percent) +
ggplot2::ylab("Percentage")
} }
@ -10995,7 +10965,7 @@ string_split_ui <- function(id) {
), ),
actionButton( actionButton(
inputId = ns("create"), inputId = ns("create"),
label = tagList(phosphoricons::ph("pencil",weight = "bold"), i18n$t("Apply split")), label = tagList(phosphoricons::ph("pencil"), i18n$t("Apply split")),
class = "btn-outline-primary float-end" class = "btn-outline-primary float-end"
), ),
tags$div(class = "clearfix") tags$div(class = "clearfix")
@ -11880,7 +11850,7 @@ ui_elements <- function(selection) {
inputId = "modal_initial_view", inputId = "modal_initial_view",
label = i18n$t("Quick overview"), label = i18n$t("Quick overview"),
width = "100%", width = "100%",
icon = phosphoricons::ph("binoculars",weight = "bold"), icon = phosphoricons::ph("binoculars"),
# icon = shiny::icon("binoculars"), # icon = shiny::icon("binoculars"),
disabled = FALSE disabled = FALSE
), ),
@ -11925,7 +11895,7 @@ ui_elements <- function(selection) {
inputId = "act_start", inputId = "act_start",
label = i18n$t("Let's begin!"), label = i18n$t("Let's begin!"),
width = "100%", width = "100%",
icon = phosphoricons::ph("play",weight = "bold"), icon = phosphoricons::ph("play"),
# icon = shiny::icon("play"), # icon = shiny::icon("play"),
disabled = TRUE disabled = TRUE
), ),
@ -12216,7 +12186,7 @@ ui_elements <- function(selection) {
inputId = "act_eval", inputId = "act_eval",
label = i18n$t("Evaluate"), label = i18n$t("Evaluate"),
width = "100%", width = "100%",
icon = phosphoricons::ph("calculator",weight = "bold"), icon = phosphoricons::ph("calculator"),
# icon = shiny::icon("calculator"), # icon = shiny::icon("calculator"),
disabled = TRUE disabled = TRUE
), ),
@ -12527,7 +12497,7 @@ update_factor_ui <- function(id) {
actionButton( actionButton(
disabled = TRUE, disabled = TRUE,
inputId = ns("drop_levels"), inputId = ns("drop_levels"),
label = tagList(phosphoricons::ph("trash",weight = "bold"), i18n$t("Drop empty")), label = tagList(phosphoricons::ph("trash"), i18n$t("Drop empty")),
class = "btn-outline-primary mb-3", class = "btn-outline-primary mb-3",
width = "100%" width = "100%"
) )
@ -12538,7 +12508,7 @@ update_factor_ui <- function(id) {
actionButton( actionButton(
inputId = ns("sort_levels"), inputId = ns("sort_levels"),
label = tagList( label = tagList(
phosphoricons::ph("sort-ascending",weight = "bold"), phosphoricons::ph("sort-ascending"),
i18n$t("Sort by levels") i18n$t("Sort by levels")
), ),
class = "btn-outline-primary mb-3", class = "btn-outline-primary mb-3",
@ -12551,7 +12521,7 @@ update_factor_ui <- function(id) {
actionButton( actionButton(
inputId = ns("sort_occurrences"), inputId = ns("sort_occurrences"),
label = tagList( label = tagList(
phosphoricons::ph("sort-ascending",weight = "bold"), phosphoricons::ph("sort-ascending"),
i18n$t("Sort by count") i18n$t("Sort by count")
), ),
class = "btn-outline-primary mb-3", class = "btn-outline-primary mb-3",
@ -12575,7 +12545,7 @@ update_factor_ui <- function(id) {
actionButton( actionButton(
inputId = ns("create"), inputId = ns("create"),
label = tagList( label = tagList(
phosphoricons::ph("arrow-clockwise",weight = "bold"), phosphoricons::ph("arrow-clockwise"),
i18n$t("Update factor variable") i18n$t("Update factor variable")
), ),
class = "btn-outline-primary" class = "btn-outline-primary"
@ -12927,7 +12897,7 @@ update_variables_ui <- function(id, title = "") {
placement = "bottom-end", placement = "bottom-end",
shiny::actionButton( shiny::actionButton(
inputId = ns("settings"), inputId = ns("settings"),
label = phosphoricons::ph("gear",weight = "bold"), label = phosphoricons::ph("gear"),
class = "pull-right float-right" class = "pull-right float-right"
), ),
shinyWidgets::textInputIcon( shinyWidgets::textInputIcon(
@ -12972,7 +12942,7 @@ update_variables_ui <- function(id, title = "") {
shiny::actionButton( shiny::actionButton(
inputId = ns("validate"), inputId = ns("validate"),
label = htmltools::tagList( label = htmltools::tagList(
phosphoricons::ph("arrow-circle-right", title = i18n$t("Apply changes"),weight = "bold"), phosphoricons::ph("arrow-circle-right", title = i18n$t("Apply changes")),
i18n$t("Apply changes") i18n$t("Apply changes")
), ),
width = "100%" width = "100%"

View file

@ -275,6 +275,7 @@
"Select a dataset from your environment or sample dataset from a package.","Vælg et datasæt fra din kørende session eller vælg træningsdata." "Select a dataset from your environment or sample dataset from a package.","Vælg et datasæt fra din kørende session eller vælg træningsdata."
"Select a sample dataset from a package.","Vælg et træningsdatasæt." "Select a sample dataset from a package.","Vælg et træningsdatasæt."
"Data ready to be imported!","Data er klar til at blive importeret!" "Data ready to be imported!","Data er klar til at blive importeret!"
"Data has %s obs. of %s variables.","Data har %s obs. på %s variabler."
"Data successfully imported!","Data successfully imported!" "Data successfully imported!","Data successfully imported!"
"Click to see data","Klik for at se data" "Click to see data","Klik for at se data"
"No data present.","Ingen data tilstede." "No data present.","Ingen data tilstede."
@ -319,4 +320,3 @@
"Likert diagram","Likert diagram" "Likert diagram","Likert diagram"
"Modify factor","Modify factor" "Modify factor","Modify factor"
"Create factor/categorical variable from other variables.","Create factor/categorical variable from other variables." "Create factor/categorical variable from other variables.","Create factor/categorical variable from other variables."
"The data set has %s obs. in %s variables.","The data set has %s obs. in %s variables."

1 en da
275 Select a dataset from your environment or sample dataset from a package. Vælg et datasæt fra din kørende session eller vælg træningsdata.
276 Select a sample dataset from a package. Vælg et træningsdatasæt.
277 Data ready to be imported! Data er klar til at blive importeret!
278 Data has %s obs. of %s variables. Data har %s obs. på %s variabler.
279 Data successfully imported! Data successfully imported!
280 Click to see data Klik for at se data
281 No data present. Ingen data tilstede.
320 Likert diagram Likert diagram
321 Modify factor Modify factor
322 Create factor/categorical variable from other variables. Create factor/categorical variable from other variables.
The data set has %s obs. in %s variables. The data set has %s obs. in %s variables.

View file

@ -275,6 +275,7 @@
"Select a dataset from your environment or sample dataset from a package.","Select a dataset from your environment or sample dataset from a package." "Select a dataset from your environment or sample dataset from a package.","Select a dataset from your environment or sample dataset from a package."
"Select a sample dataset from a package.","Select a sample dataset from a package." "Select a sample dataset from a package.","Select a sample dataset from a package."
"Data ready to be imported!","Data ready to be imported!" "Data ready to be imported!","Data ready to be imported!"
"Data has %s obs. of %s variables.","Data has %s obs. of %s variables."
"Data successfully imported!","Data successfully imported!" "Data successfully imported!","Data successfully imported!"
"Click to see data","Click to see data" "Click to see data","Click to see data"
"No data present.","No data present." "No data present.","No data present."
@ -319,4 +320,3 @@
"Likert diagram","Likert diagram" "Likert diagram","Likert diagram"
"Modify factor","Modify factor" "Modify factor","Modify factor"
"Create factor/categorical variable from other variables.","Create factor/categorical variable from other variables." "Create factor/categorical variable from other variables.","Create factor/categorical variable from other variables."
"The data set has %s obs. in %s variables.","The data set has %s obs. in %s variables."

1 en sw
275 Select a dataset from your environment or sample dataset from a package. Select a dataset from your environment or sample dataset from a package.
276 Select a sample dataset from a package. Select a sample dataset from a package.
277 Data ready to be imported! Data ready to be imported!
278 Data has %s obs. of %s variables. Data has %s obs. of %s variables.
279 Data successfully imported! Data successfully imported!
280 Click to see data Click to see data
281 No data present. No data present.
320 Likert diagram Likert diagram
321 Modify factor Modify factor
322 Create factor/categorical variable from other variables. Create factor/categorical variable from other variables.
The data set has %s obs. in %s variables. The data set has %s obs. in %s variables.

View file

@ -4,7 +4,7 @@
\alias{align_axes} \alias{align_axes}
\title{Aligns axes between plots} \title{Aligns axes between plots}
\usage{ \usage{
align_axes(..., x.axis = TRUE, y.axis = TRUE, percentage = FALSE) align_axes(..., x.axis = TRUE, y.axis = TRUE)
} }
\arguments{ \arguments{
\item{...}{ggplot2 objects or list of ggplot2 objects} \item{...}{ggplot2 objects or list of ggplot2 objects}

View file

@ -7,7 +7,6 @@
\alias{data_visuals_ui} \alias{data_visuals_ui}
\alias{data_visuals_server} \alias{data_visuals_server}
\alias{create_plot} \alias{create_plot}
\alias{plot_bar}
\alias{plot_bar_single} \alias{plot_bar_single}
\alias{plot_box} \alias{plot_box}
\alias{plot_box_single} \alias{plot_box_single}
@ -26,17 +25,6 @@ data_visuals_server(id, data, palettes, ...)
create_plot(data, type, pri, sec, ter = NULL, color.palette = "viridis", ...) create_plot(data, type, pri, sec, ter = NULL, color.palette = "viridis", ...)
plot_bar(
data,
pri,
sec = NULL,
ter = NULL,
style = c("stack", "dodge", "fill"),
color.palette = "viridis",
max_level = 30,
...
)
plot_bar_single( plot_bar_single(
data, data,
pri, pri,
@ -103,8 +91,6 @@ shiny server module
ggplot2 object ggplot2 object
ggplot list object
ggplot object ggplot object
ggplot2 object ggplot2 object
@ -130,8 +116,6 @@ Data correlations evaluation module
Wrapper to create plot based on provided type Wrapper to create plot based on provided type
Title
Single vertical barplot Single vertical barplot
Beautiful box plot(s) Beautiful box plot(s)
@ -154,13 +138,6 @@ Beautiful violin plot
} }
\examples{ \examples{
create_plot(mtcars, "plot_violin", "mpg", "cyl") |> attributes() create_plot(mtcars, "plot_violin", "mpg", "cyl") |> attributes()
mtcars |>
dplyr::mutate(cyl = factor(cyl), am = factor(am)) |>
plot_bar(pri = "cyl", sec = "am", style = "fill")
mtcars |>
dplyr::mutate(dplyr::across(tidyselect::all_of(c("cyl","am","gear")),factor)) |>
plot_bar(pri = "cyl", sec = "gear", ter = "am", style = "stack",color.palette="turbo")
mtcars |> mtcars |>
dplyr::mutate(cyl = factor(cyl), am = factor(am)) |> dplyr::mutate(cyl = factor(cyl), am = factor(am)) |>
plot_bar_single(pri = "cyl", sec = "am", style = "fill") plot_bar_single(pri = "cyl", sec = "am", style = "fill")

View file

@ -12,7 +12,6 @@ wrap_plot_list(
guides = "collect", guides = "collect",
axes = "collect", axes = "collect",
axis_titles = "collect", axis_titles = "collect",
y.axis.percentage = FALSE,
... ...
) )
} }