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

new version

Browse source
This commit is contained in:
Andreas Gammelgaard Damsbo 2026-04-10 21:47:36 +02:00
commit 41c855a71c
No known key found for this signature in database
4 changed files with 196 additions and 136 deletions
Download patch file Download diff file Expand all files Collapse all files

162
app_docker/app.R
View file

@ -1,7 +1,7 @@
######## ########
#### Current file: /var/folders/9l/xbc19wxx0g79jdd2sf_0v291mhwh7f/T//RtmpmlTuE8/file8be05102425f.R #### Current file: /var/folders/9l/xbc19wxx0g79jdd2sf_0v291mhwh7f/T//RtmprUCGcI/file4761ae70bf7.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.1' app_version <- function()'26.4.2'
######## ########
@ -512,7 +512,7 @@ create_column_ui <- function(id) {
actionButton( actionButton(
inputId = ns("compute"), inputId = ns("compute"),
label = tagList( label = tagList(
phosphoricons::ph("pencil"), i18n$t("Create column") phosphoricons::ph("pencil",weight = "bold"), 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"), phosphoricons::ph("x-circle",weight = "bold"),
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"), i18n$t("Create factor variable")), label = tagList(phosphoricons::ph("scissors",weight = "bold"), 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"), icon = phosphoricons::ph("paint-brush",weight = "bold"),
# icon = shiny::icon("palette"), # icon = shiny::icon("palette"),
disabled = FALSE disabled = FALSE
), ),
@ -2380,7 +2380,8 @@ 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
) )
}) })
@ -2858,6 +2859,7 @@ 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) {
@ -2871,7 +2873,7 @@ wrap_plot_list <- function(data,
.x .x
} }
})() |> })() |>
align_axes() |> align_axes(percentage=y.axis.percentage) |>
patchwork::wrap_plots(guides = guides, patchwork::wrap_plots(guides = guides,
axes = axes, axes = axes,
axis_titles = axis_titles, axis_titles = axis_titles,
@ -2916,7 +2918,8 @@ 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)) {
@ -2934,7 +2937,7 @@ align_axes <- function(...,
xr <- clean_common_axis(p, "x") xr <- clean_common_axis(p, "x")
suppressWarnings({ suppressWarnings({
purrr::map(p, \(.x) { p_out <- 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)
@ -2945,6 +2948,15 @@ 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
@ -4031,13 +4043,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",
"Qualitative (bold)" = "Dark 2", "Diverging (red-yellow-green)"= "RdYlGn",
"Qualitative (paired)" = "Paired",
"Sequential (blues)" = "Blues",
"Diverging (red-blue)" = "RdBu", "Diverging (red-blue)" = "RdBu",
"Tableau style" = "Tableau 10", "Sequential (blues)" = "Blues",
"Pastel" = "Pastel 1", "Qualitative (paired)" = "Paired",
"Rainbow" = "rainbow" "Qualitative (bold)" = "Dark 2",
"Rainbow" = "Spectral",
"Generic" = "Set1"
) )
} }
@ -4945,7 +4957,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.1-260402' hosted_version <- function()'v26.4.2-260410'
######## ########
@ -6085,7 +6097,7 @@ make_success_alert <- function(data,
i18n$t("Data ready to be imported!") i18n$t("Data ready to be imported!")
), ),
sprintf( sprintf(
i18n$t("Data has %s obs. of %s variables."), i18n$t("The data set has %s obs. in %s variables."),
nrow(data), nrow(data),
ncol(data) ncol(data)
), ),
@ -6096,7 +6108,7 @@ make_success_alert <- function(data,
i18n$t("Data successfully imported!") i18n$t("Data successfully imported!")
), ),
sprintf( sprintf(
i18n$t("Data has %s obs. of %s variables."), i18n$t("The data set has %s obs. in %s variables."),
nrow(data), nrow(data),
ncol(data) ncol(data)
), ),
@ -6581,7 +6593,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"), icon = phosphoricons::ph("calculator",weight = "bold"),
# icon = shiny::icon("calculator"), # icon = shiny::icon("calculator"),
disabled = TRUE disabled = TRUE
) )
@ -6918,8 +6930,32 @@ 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
######## ########
plot_bar <- function(data, pri, sec, ter = NULL, style = c("stack", "dodge", "fill"), #' Title
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)) {
@ -6928,7 +6964,7 @@ plot_bar <- function(data, pri, sec, ter = NULL, style = c("stack", "dodge", "fi
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,
@ -6939,7 +6975,10 @@ plot_bar <- function(data, pri, sec, ter = NULL, style = c("stack", "dodge", "fi
) )
}) })
wrap_plot_list(out, title = glue::glue(i18n$t("Grouped by {get_label(data,ter)}")), ...) wrap_plot_list(out,
title = glue::glue(i18n$t("Grouped by {get_label(data,ter)}")),
y.axis.percentage = TRUE,
...)
} }
@ -6961,7 +7000,11 @@ plot_bar <- function(data, pri, sec, ter = NULL, style = c("stack", "dodge", "fi
#' 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, pri, sec = NULL, style = c("stack", "dodge", "fill"), max_level = 30, plot_bar_single <- function(data,
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)
@ -6971,16 +7014,11 @@ plot_bar_single <- function(data, pri, sec = NULL, style = c("stack", "dodge", "
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 <- sort_by(p_data, p_data[["Freq"]], decreasing = TRUE) |>
p_data,
p_data[["Freq"]],
decreasing = TRUE
) |>
head(max_level) head(max_level)
} }
@ -6993,41 +7031,33 @@ plot_bar_single <- function(data, pri, sec = NULL, style = c("stack", "dodge", "
fill <- pri fill <- pri
} }
p <- ggplot2::ggplot( p <- ggplot2::ggplot(p_data, ggplot2::aes(x = .data[[pri]], y = p, fill = .data[[fill]])) +
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") +
ggplot2::scale_y_continuous(labels = scales::percent) + scale_fill_generate(palette = color.palette) +
scale_fill_generate(palette=color.palette) + ggplot2::xlab(get_label(data, pri)) +
ggplot2::ylab("Percentage") + ggplot2::guides(fill = ggplot2::guide_legend(title = get_label(data, fill)))
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 | any(nchar(as.character(p_data[[pri]])) > 6)) { if (nrow(p_data) > 10 |
any(nchar(as.character(p_data[[pri]])) > 6)) {
p <- p + p <- p +
# ggplot2::guides(fill = "none") + # ggplot2::guides(fill = "none") +
ggplot2::theme( ggplot2::theme(axis.text.x = ggplot2::element_text(
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")
} }
@ -10965,7 +10995,7 @@ string_split_ui <- function(id) {
), ),
actionButton( actionButton(
inputId = ns("create"), inputId = ns("create"),
label = tagList(phosphoricons::ph("pencil"), i18n$t("Apply split")), label = tagList(phosphoricons::ph("pencil",weight = "bold"), i18n$t("Apply split")),
class = "btn-outline-primary float-end" class = "btn-outline-primary float-end"
), ),
tags$div(class = "clearfix") tags$div(class = "clearfix")
@ -11850,7 +11880,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"), icon = phosphoricons::ph("binoculars",weight = "bold"),
# icon = shiny::icon("binoculars"), # icon = shiny::icon("binoculars"),
disabled = FALSE disabled = FALSE
), ),
@ -11895,7 +11925,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"), icon = phosphoricons::ph("play",weight = "bold"),
# icon = shiny::icon("play"), # icon = shiny::icon("play"),
disabled = TRUE disabled = TRUE
), ),
@ -12186,7 +12216,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"), icon = phosphoricons::ph("calculator",weight = "bold"),
# icon = shiny::icon("calculator"), # icon = shiny::icon("calculator"),
disabled = TRUE disabled = TRUE
), ),
@ -12497,7 +12527,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"), i18n$t("Drop empty")), label = tagList(phosphoricons::ph("trash",weight = "bold"), i18n$t("Drop empty")),
class = "btn-outline-primary mb-3", class = "btn-outline-primary mb-3",
width = "100%" width = "100%"
) )
@ -12508,7 +12538,7 @@ update_factor_ui <- function(id) {
actionButton( actionButton(
inputId = ns("sort_levels"), inputId = ns("sort_levels"),
label = tagList( label = tagList(
phosphoricons::ph("sort-ascending"), phosphoricons::ph("sort-ascending",weight = "bold"),
i18n$t("Sort by levels") i18n$t("Sort by levels")
), ),
class = "btn-outline-primary mb-3", class = "btn-outline-primary mb-3",
@ -12521,7 +12551,7 @@ update_factor_ui <- function(id) {
actionButton( actionButton(
inputId = ns("sort_occurrences"), inputId = ns("sort_occurrences"),
label = tagList( label = tagList(
phosphoricons::ph("sort-ascending"), phosphoricons::ph("sort-ascending",weight = "bold"),
i18n$t("Sort by count") i18n$t("Sort by count")
), ),
class = "btn-outline-primary mb-3", class = "btn-outline-primary mb-3",
@ -12545,7 +12575,7 @@ update_factor_ui <- function(id) {
actionButton( actionButton(
inputId = ns("create"), inputId = ns("create"),
label = tagList( label = tagList(
phosphoricons::ph("arrow-clockwise"), phosphoricons::ph("arrow-clockwise",weight = "bold"),
i18n$t("Update factor variable") i18n$t("Update factor variable")
), ),
class = "btn-outline-primary" class = "btn-outline-primary"
@ -12897,7 +12927,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"), label = phosphoricons::ph("gear",weight = "bold"),
class = "pull-right float-right" class = "pull-right float-right"
), ),
shinyWidgets::textInputIcon( shinyWidgets::textInputIcon(
@ -12942,7 +12972,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")), phosphoricons::ph("arrow-circle-right", title = i18n$t("Apply changes"),weight = "bold"),
i18n$t("Apply changes") i18n$t("Apply changes")
), ),
width = "100%" width = "100%"

2
app_docker/translations/translation_da.csv
View file

@ -275,7 +275,6 @@
"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."
@ -320,3 +319,4 @@
"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!
Data has %s obs. of %s variables. Data har %s obs. på %s variabler.
278 Data successfully imported! Data successfully imported!
279 Click to see data Klik for at se data
280 No data present. Ingen data tilstede.
319 Likert diagram Likert diagram
320 Modify factor Modify factor
321 Create factor/categorical variable from other variables. Create factor/categorical variable from other variables.
322 The data set has %s obs. in %s variables. The data set has %s obs. in %s variables.

2
app_docker/translations/translation_sw.csv
View file

@ -275,7 +275,6 @@
"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."
@ -320,3 +319,4 @@
"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!
Data has %s obs. of %s variables. Data has %s obs. of %s variables.
278 Data successfully imported! Data successfully imported!
279 Click to see data Click to see data
280 No data present. No data present.
319 Likert diagram Likert diagram
320 Modify factor Modify factor
321 Create factor/categorical variable from other variables. Create factor/categorical variable from other variables.
322 The data set has %s obs. in %s variables. The data set has %s obs. in %s variables.

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

@ -1,7 +1,7 @@
######## ########
#### Current file: /var/folders/9l/xbc19wxx0g79jdd2sf_0v291mhwh7f/T//RtmpmlTuE8/file8be0207bfdc2.R #### Current file: /var/folders/9l/xbc19wxx0g79jdd2sf_0v291mhwh7f/T//RtmprUCGcI/file47614d090a4c.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.1' app_version <- function()'26.4.2'
######## ########
@ -512,7 +512,7 @@ create_column_ui <- function(id) {
actionButton( actionButton(
inputId = ns("compute"), inputId = ns("compute"),
label = tagList( label = tagList(
phosphoricons::ph("pencil"), i18n$t("Create column") phosphoricons::ph("pencil",weight = "bold"), 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"), phosphoricons::ph("x-circle",weight = "bold"),
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"), i18n$t("Create factor variable")), label = tagList(phosphoricons::ph("scissors",weight = "bold"), 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"), icon = phosphoricons::ph("paint-brush",weight = "bold"),
# icon = shiny::icon("palette"), # icon = shiny::icon("palette"),
disabled = FALSE disabled = FALSE
), ),
@ -2380,7 +2380,8 @@ 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
) )
}) })
@ -2858,6 +2859,7 @@ 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) {
@ -2871,7 +2873,7 @@ wrap_plot_list <- function(data,
.x .x
} }
})() |> })() |>
align_axes() |> align_axes(percentage=y.axis.percentage) |>
patchwork::wrap_plots(guides = guides, patchwork::wrap_plots(guides = guides,
axes = axes, axes = axes,
axis_titles = axis_titles, axis_titles = axis_titles,
@ -2916,7 +2918,8 @@ 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)) {
@ -2934,7 +2937,7 @@ align_axes <- function(...,
xr <- clean_common_axis(p, "x") xr <- clean_common_axis(p, "x")
suppressWarnings({ suppressWarnings({
purrr::map(p, \(.x) { p_out <- 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)
@ -2945,6 +2948,15 @@ 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
@ -4031,13 +4043,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",
"Qualitative (bold)" = "Dark 2", "Diverging (red-yellow-green)"= "RdYlGn",
"Qualitative (paired)" = "Paired",
"Sequential (blues)" = "Blues",
"Diverging (red-blue)" = "RdBu", "Diverging (red-blue)" = "RdBu",
"Tableau style" = "Tableau 10", "Sequential (blues)" = "Blues",
"Pastel" = "Pastel 1", "Qualitative (paired)" = "Paired",
"Rainbow" = "rainbow" "Qualitative (bold)" = "Dark 2",
"Rainbow" = "Spectral",
"Generic" = "Set1"
) )
} }
@ -4945,7 +4957,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.1-260402' hosted_version <- function()'v26.4.2-260410'
######## ########
@ -6085,7 +6097,7 @@ make_success_alert <- function(data,
i18n$t("Data ready to be imported!") i18n$t("Data ready to be imported!")
), ),
sprintf( sprintf(
i18n$t("Data has %s obs. of %s variables."), i18n$t("The data set has %s obs. in %s variables."),
nrow(data), nrow(data),
ncol(data) ncol(data)
), ),
@ -6096,7 +6108,7 @@ make_success_alert <- function(data,
i18n$t("Data successfully imported!") i18n$t("Data successfully imported!")
), ),
sprintf( sprintf(
i18n$t("Data has %s obs. of %s variables."), i18n$t("The data set has %s obs. in %s variables."),
nrow(data), nrow(data),
ncol(data) ncol(data)
), ),
@ -6581,7 +6593,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"), icon = phosphoricons::ph("calculator",weight = "bold"),
# icon = shiny::icon("calculator"), # icon = shiny::icon("calculator"),
disabled = TRUE disabled = TRUE
) )
@ -6918,8 +6930,32 @@ 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
######## ########
plot_bar <- function(data, pri, sec, ter = NULL, style = c("stack", "dodge", "fill"), #' Title
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)) {
@ -6928,7 +6964,7 @@ plot_bar <- function(data, pri, sec, ter = NULL, style = c("stack", "dodge", "fi
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,
@ -6939,7 +6975,10 @@ plot_bar <- function(data, pri, sec, ter = NULL, style = c("stack", "dodge", "fi
) )
}) })
wrap_plot_list(out, title = glue::glue(i18n$t("Grouped by {get_label(data,ter)}")), ...) wrap_plot_list(out,
title = glue::glue(i18n$t("Grouped by {get_label(data,ter)}")),
y.axis.percentage = TRUE,
...)
} }
@ -6961,7 +7000,11 @@ plot_bar <- function(data, pri, sec, ter = NULL, style = c("stack", "dodge", "fi
#' 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, pri, sec = NULL, style = c("stack", "dodge", "fill"), max_level = 30, plot_bar_single <- function(data,
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)
@ -6971,16 +7014,11 @@ plot_bar_single <- function(data, pri, sec = NULL, style = c("stack", "dodge", "
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 <- sort_by(p_data, p_data[["Freq"]], decreasing = TRUE) |>
p_data,
p_data[["Freq"]],
decreasing = TRUE
) |>
head(max_level) head(max_level)
} }
@ -6993,41 +7031,33 @@ plot_bar_single <- function(data, pri, sec = NULL, style = c("stack", "dodge", "
fill <- pri fill <- pri
} }
p <- ggplot2::ggplot( p <- ggplot2::ggplot(p_data, ggplot2::aes(x = .data[[pri]], y = p, fill = .data[[fill]])) +
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") +
ggplot2::scale_y_continuous(labels = scales::percent) + scale_fill_generate(palette = color.palette) +
scale_fill_generate(palette=color.palette) + ggplot2::xlab(get_label(data, pri)) +
ggplot2::ylab("Percentage") + ggplot2::guides(fill = ggplot2::guide_legend(title = get_label(data, fill)))
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 | any(nchar(as.character(p_data[[pri]])) > 6)) { if (nrow(p_data) > 10 |
any(nchar(as.character(p_data[[pri]])) > 6)) {
p <- p + p <- p +
# ggplot2::guides(fill = "none") + # ggplot2::guides(fill = "none") +
ggplot2::theme( ggplot2::theme(axis.text.x = ggplot2::element_text(
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")
} }
@ -10965,7 +10995,7 @@ string_split_ui <- function(id) {
), ),
actionButton( actionButton(
inputId = ns("create"), inputId = ns("create"),
label = tagList(phosphoricons::ph("pencil"), i18n$t("Apply split")), label = tagList(phosphoricons::ph("pencil",weight = "bold"), i18n$t("Apply split")),
class = "btn-outline-primary float-end" class = "btn-outline-primary float-end"
), ),
tags$div(class = "clearfix") tags$div(class = "clearfix")
@ -11850,7 +11880,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"), icon = phosphoricons::ph("binoculars",weight = "bold"),
# icon = shiny::icon("binoculars"), # icon = shiny::icon("binoculars"),
disabled = FALSE disabled = FALSE
), ),
@ -11895,7 +11925,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"), icon = phosphoricons::ph("play",weight = "bold"),
# icon = shiny::icon("play"), # icon = shiny::icon("play"),
disabled = TRUE disabled = TRUE
), ),
@ -12186,7 +12216,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"), icon = phosphoricons::ph("calculator",weight = "bold"),
# icon = shiny::icon("calculator"), # icon = shiny::icon("calculator"),
disabled = TRUE disabled = TRUE
), ),
@ -12497,7 +12527,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"), i18n$t("Drop empty")), label = tagList(phosphoricons::ph("trash",weight = "bold"), i18n$t("Drop empty")),
class = "btn-outline-primary mb-3", class = "btn-outline-primary mb-3",
width = "100%" width = "100%"
) )
@ -12508,7 +12538,7 @@ update_factor_ui <- function(id) {
actionButton( actionButton(
inputId = ns("sort_levels"), inputId = ns("sort_levels"),
label = tagList( label = tagList(
phosphoricons::ph("sort-ascending"), phosphoricons::ph("sort-ascending",weight = "bold"),
i18n$t("Sort by levels") i18n$t("Sort by levels")
), ),
class = "btn-outline-primary mb-3", class = "btn-outline-primary mb-3",
@ -12521,7 +12551,7 @@ update_factor_ui <- function(id) {
actionButton( actionButton(
inputId = ns("sort_occurrences"), inputId = ns("sort_occurrences"),
label = tagList( label = tagList(
phosphoricons::ph("sort-ascending"), phosphoricons::ph("sort-ascending",weight = "bold"),
i18n$t("Sort by count") i18n$t("Sort by count")
), ),
class = "btn-outline-primary mb-3", class = "btn-outline-primary mb-3",
@ -12545,7 +12575,7 @@ update_factor_ui <- function(id) {
actionButton( actionButton(
inputId = ns("create"), inputId = ns("create"),
label = tagList( label = tagList(
phosphoricons::ph("arrow-clockwise"), phosphoricons::ph("arrow-clockwise",weight = "bold"),
i18n$t("Update factor variable") i18n$t("Update factor variable")
), ),
class = "btn-outline-primary" class = "btn-outline-primary"
@ -12897,7 +12927,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"), label = phosphoricons::ph("gear",weight = "bold"),
class = "pull-right float-right" class = "pull-right float-right"
), ),
shinyWidgets::textInputIcon( shinyWidgets::textInputIcon(
@ -12942,7 +12972,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")), phosphoricons::ph("arrow-circle-right", title = i18n$t("Apply changes"),weight = "bold"),
i18n$t("Apply changes") i18n$t("Apply changes")
), ),
width = "100%" width = "100%"