From 32f299880d442a7c71bfbffe0f5bd6ebfe37f036 Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Wed, 11 Mar 2026 10:17:42 +0100 Subject: [PATCH 1/3] fix: keeps labels modifying factors and creates new factors correctly --- CITATION.cff | 2 +- DESCRIPTION | 3 +- NAMESPACE | 5 + NEWS.md | 8 ++ R/app_version.R | 2 +- R/hosted_version.R | 2 +- R/missings-module.R | 22 +-- R/sysdata.rda | Bin 2707 -> 2838 bytes R/update-factor-ext.R | 11 +- R/utils-labels.R | 114 +++++++++++++++ SESSION.md | 20 ++- app_docker/app.R | 159 +++++++++++++++++---- app_docker/translations/translation_da.csv | 2 +- app_docker/translations/translation_sw.csv | 2 +- inst/apps/FreesearchR/app.R | 159 +++++++++++++++++---- inst/translations/translation_da.csv | 2 +- inst/translations/translation_sw.csv | 2 +- man/apply_labels.Rd | 21 +++ man/extract_labels.Rd | 17 +++ man/label_report.Rd | 19 +++ man/restore_labels.Rd | 20 +++ man/with_labels.Rd | 21 +++ tests/testthat/test-utils-labels.R | 143 ++++++++++++++++++ 23 files changed, 676 insertions(+), 80 deletions(-) create mode 100644 R/utils-labels.R create mode 100644 man/apply_labels.Rd create mode 100644 man/extract_labels.Rd create mode 100644 man/label_report.Rd create mode 100644 man/restore_labels.Rd create mode 100644 man/with_labels.Rd create mode 100644 tests/testthat/test-utils-labels.R diff --git a/CITATION.cff b/CITATION.cff index aec07b9e..6d5ebe92 100644 --- a/CITATION.cff +++ b/CITATION.cff @@ -8,7 +8,7 @@ message: 'To cite package "FreesearchR" in publications use:' type: software license: AGPL-3.0-or-later title: 'FreesearchR: Easy data analysis for clinicians' -version: 26.3.1 +version: 26.3.2 doi: 10.5281/zenodo.14527429 identifiers: - type: url diff --git a/DESCRIPTION b/DESCRIPTION index 1a810014..1c5d410d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: FreesearchR Title: Easy data analysis for clinicians -Version: 26.3.1 +Version: 26.3.2 Authors@R: c( person("Andreas Gammelgaard", "Damsbo",email="agdamsbo@clin.au.dk", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-7559-1154")), @@ -139,6 +139,7 @@ Collate: 'ui_elements.R' 'update-factor-ext.R' 'update-variables-ext.R' + 'utils-labels.R' 'validation.R' 'visual_summary.R' 'wide2long.R' diff --git a/NAMESPACE b/NAMESPACE index 420954d7..e7e642c1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -14,6 +14,7 @@ export(all_but) export(allowed_operations) export(append_column) export(append_list) +export(apply_labels) export(argsstring2list) export(baseline_table) export(class_icons) @@ -53,6 +54,7 @@ export(default_parsing) export(detect_delimiter) export(drop_empty_event) export(expression_string) +export(extract_labels) export(factor_new_levels_labels) export(factorize) export(file_export) @@ -85,6 +87,7 @@ export(is_identical_to_previous) export(is_splittable) export(is_valid_redcap_url) export(is_valid_token) +export(label_report) export(launch_FreesearchR) export(limit_data_size) export(limit_log) @@ -134,6 +137,7 @@ export(remove_empty_attr) export(remove_empty_cols) export(remove_nested_list) export(repeated_instruments) +export(restore_labels) export(sankey_ready) export(selectInputIcon) export(separate_string) @@ -167,6 +171,7 @@ export(visual_summary_ui) export(wide2long) export(winbox_create_column) export(winbox_update_factor) +export(with_labels) export(wrap_plot_list) export(write_quarto) importFrom(classInt,classIntervals) diff --git a/NEWS.md b/NEWS.md index e11b622b..6f50a612 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,11 @@ +# FreesearchR 26.3.2 + +*FIX* Updating factor levels always created new factor. + +*FIX* Label stripping behavior updating factors is fixed. + +*NEW* New with_labels() function (and helpers) added to allow easy preservation of labels. + # FreesearchR 26.3.1 *FIX* ~~Include font files for static loading without dependency on Google.~~ Kept webfonts from google as local fonts are not working for now. diff --git a/R/app_version.R b/R/app_version.R index 1a1ca529..a87c4470 100644 --- a/R/app_version.R +++ b/R/app_version.R @@ -1 +1 @@ -app_version <- function()'26.3.1' +app_version <- function()'26.3.2' diff --git a/R/hosted_version.R b/R/hosted_version.R index b4e35b45..771bd124 100644 --- a/R/hosted_version.R +++ b/R/hosted_version.R @@ -1 +1 @@ -hosted_version <- function()'v26.3.1-260302' +hosted_version <- function()'v26.3.2-260311' diff --git a/R/missings-module.R b/R/missings-module.R index 25d250ee..8b9c1f50 100644 --- a/R/missings-module.R +++ b/R/missings-module.R @@ -351,29 +351,17 @@ compare_missings <- function(data, #' ## missings_logic_across() |> #' ## gtsummary::tbl_summary() missings_logic_across <- function(data, exclude = NULL) { - # This function includes a approach way to preserve variable labels + # This function includes a way to preserve variable labels + with_labels(data,{ names(data) |> lapply(\(.x) { - # browser() - # Saving original labels - lab <- REDCapCAST::get_attr(data[[.x]], attr = "label") if (!.x %in% exclude) { - out <- is.na(data[[.x]]) + is.na(data[[.x]]) } else { - out <- data[[.x]] - } - if (!is.na(lab)) { - # Restoring original labels, if not NA - REDCapCAST::set_attr( - data = out, - label = lab, - attr = "label", - overwrite = TRUE - ) - } else { - out + data[[.x]] } }) |> dplyr::bind_cols(.name_repair = "unique_quiet") |> setNames(names(data)) + }) } diff --git a/R/sysdata.rda b/R/sysdata.rda index c3a997792d79a7772ab823f7407ed73345fdeffe..e7ce41066e6125ce50acf9792d07bde50c433502 100644 GIT binary patch literal 2838 zcmV+x3+ePiT4*^jL0KkKSq}>Kv;Z5Gf5QL&Xaz!l|KNXb-@w2B|L{Nn00;;H;0(VP zyxy2^4+E$Yk3a_^f%CqCi3i9UQ1H~m6A05mFp~+QV?{j*JkwOr*&qW!qee`{2C3j8 z36(vmlS#3uJfq4000001kN^Wy$)J>?4^g9K2198BAOVm8k%0ptkOZ1YNh#`&)b%us zpQQk39-slEBPM_V0iXcNh?_+8n9-r3GGGHyfCOYFnoS+%fZ05U-Y7DNxe_sid>n*HyLfA6<%vHyqL_xaW#XwC)n z&i6#kK2@MgN*Rl4f#Z@23V*!c9Gsi!}9 zX(V$r<&Fa7YrN{M|2M@L3-Knb*0OCI!_r@i-U|-7CSRSk&!VlYt6_&0%i|{ojSBoQ z>uhjYxLcz_$%cI#lXeDh>!?0wpT2Lc&~K#Eo>dayO>wcxT5p%f<9aF2Q z_2^}8sM%ASvs9;q5jRm1m^Fh#Q$;wNA0={RyN#s6-We~HE=-$QwLzB68J`Zv68#%$ zu)>S+)w%VoEf8Gs0Lu{q>2{tg_3-DK0BuACPJn_75kv?Q5*t*2D%oWUs)yc3_ zs49xVMnP0j5r`@>C<-hTMNwD_B8sXCqA2?QpT_N;JgU5YeDop<1s^p4<9!`;`Wu|X zM=JqmMWsa<(Yvd9&YJ5&a)sT6yWFpAZpU_YX~w(ShLUNCBm=5qU^a$b7M`a^4b;h5 z5h#E)iF)OmaW~q@wi`~l*I3)FZm|x{Q8`MGp&*dRjKdJgS`u_lv?Mq#lW#2>piL0Y z8O$9RPQ;b9Mgl5GZ890WPSz7l;=SeC2X(#Jwl6OdV#z8F_nC%8vk>i!fVNa?3<<0d z)Ys>wLU2*CUkQW4D`nY6qJP0V%7}|@AfHj~3hA4}KK)hI328fF_6;wpbD3-Qp zwRG4*_ibA=WwT0@uH10xn6b>v>hl7p5T2o4B!R8lXDCxv@}Sc)StXED zYYy(FVo{2=>Fr>kWeHb9iM?sI?V{U{Nv)iEyj_N->#K}c1gpNe)*ait>b%2QMwHM< z0|rR~*_5ud_jhF2oV;~h$(!xX2BPmU#U_wqG?0*tu^0_IK52G|-`&@nOZun*aRp#P zWB@`T=1E-4w5=;f+z9~5F|2~K*b*Rn&%KH9+Nj4MC54jMlu}V9WyCA&HGg0P*Ju=y z2tpAdsulJdl;fPmAZy&xOG*V{ORTnY=Mg6eDP=7|PTtvQ%Jq&iKNb zX0uENem7GBQkJB#6pBgUn3!8XPEkSc0w=`pxIkke5l~|Z-QAc57K%d4V9#cgCq13~ z26klP53OOZFD~yCO%$c5)U~7K$s`QK6H>ymjHrmUX+eX7P)0Pt3ZA#80)$EH+FOa9 zWIbG<^1`kzfp4Kf4cG!6JPUz~7ZE^GlvIrhz=ES~2|^8Ln>cWQNT)Kg!LraQ9x2+o zMJa5emp-<&1xFe&g;u3wG>?X`Jw^r~j9=GF*oqxBc%3sBDJ$|kxN!%Kg*Us3APW-8 zs0~Q!WT!?cdWtYC%SX3DlPoF?Cx4~hS{BhO3qTeUHo{gw765^g5RYvNZLPCEt-($j~^kp>I2qYc>#k9jK zt;^jnrwEDn8ZnbOW^(}~q*8K%$kcSAV1hwa1YLdPthi41oB%-}vb1nPAhWetN+7M5 z)?uHkfBqAQ$45D;`g=V7zsPa=1$_uzU?&iui82(R2!BNLr2LxMb zaJc(#%Atea-_mrg&~W7hkfY{T#;rH+r$b}7|2MyfUNXRiu+m;b%hO=Ega!bk=vfYp zQ=Zq5sn-dK6>&AHm78TcN?Xd=w;bp~&Iv}typpz}gHDZoJOfo&-^FDytAa;vu~P#6 z9@H8!;3h%K`>@0XjWXm-X|?6{km~a`iui7v;$i(g>Q!q5C?pA9w~Rv^!&CW{_Kfm? z-DT~&60f@u8cJP`lU{7&RPXI> zE^IHhLkg@yHbL5XcCq7H{K!S|YJ{{c7eca?G7ljQ5RBCa)PEMu{WpI4nU%`lQy6mkjR6SUD|bmS-kgmy`<28Q7=!lsqnb||GAsw83yyp)cTok; z=VnO1A->6-5(zP_S21gskumH*h~jM_(B$LeQ}WN$e3cH87m+>8tPau!36MoiK_)(e z6)U8ip4776Lp#53M!{egYI&EauYlU zqnW|9B-dBG7Va82ZQUOds40fLw9aoGVpTX!zVBsWrJBol%CNq^#;*60u)PN&$Lld= z`YX<3j9$zoy=4fv=7)n#NtKjY0JAy>Xe(xAi$4DYS%M?HH0ru-gzP4Ul+0^tGCKkV%H8aK@qput+@F67+2iX(*O2iibD olSR^xYtii%N(M??%dc?%fP3h8>qdxZ^dJ0P$rRy2Ks+nj&=-tQ!vFvP literal 2707 zcmV;E3T*X4T4*^jL0KkKSr~8qkpLO%f5iX)Xaz!l|KNXb-@w2B|L{Nn00IaB;0zxZ zIgD-|4gjfap-B`M-yc;}6#HPQ6g4scLsJQ+Mw$~K$V{ebq|n6EKpGyS)Hb7O2Brum zfS8&Tc&3^*pa3)g00000H9R2{spR|6c{~T^EL_^Cn&HX69|G3SS0i1ZRN~io87DJ27CsIOq)Jq($-;qYz>UY z1g~Tmzd4iO@f9c$JTufvQIfx}3~i?P9>=GJ!$~EEY1x*sVlTkl?~|aF0`Ms))S_i9 z$Dq6(@K$Y^Il9?Auy%#I(+w+O7B2Fty8KxR)NK;Ifkd-BHz!SIaNOXmEqvTqsasT~ z?ltaGLvK=vsoeJzC06cC%#DmM8)lk7gGkM{xx55pqcr6oC#9U6=SX^6%d6*1JLR${ zoWY#gJFCPUZrXbsH}sGH&_j70z- zNJwzffQxHTB8Y#G0UWUu0~cmdkJ<_j&!>#jx*!JZ5e@FPd%J#(&5a&ixGD}qPRdkb zqY)8{1V}1~h$9%W1ymJa#Rdv2QBe^EM1sh$L{&v#DHKIPR7HHgpMlFejq0xNlR6Ov z1?sf`-Oi3UdK;VJw#N9tS;1*hMrhjV@px;S>`{)?2~}wwgFw>OBq*a)NDz|YAQ4PP zB;DC+wLt9Ci*3Yo1Y}<3sIoRjq0oe7UNV%Fh#+jDK|3{K=n^3hdu|f6D1vkZ5KB&` z@f^JqaSfW@$9~koONH4;sv<=UBQ}K1i+efE?+`q`b21FP+Jgxxo#tVJ;Z9r_*3vIq zELLnds{Z{e8>582n+)`K$-T^qGPhej2q?hI`$mT{CRMv(ar>TeZQxh4a(_swYkwU>1sMiBmHh zZCcT{2moY@Agu9{B<(${PQz6g;0a|Vu_&;jOv{K=Ppwq8G%?v!p+I67MSeJ-8DIl^ z3YC+r!dDV^{e0!jm^U%D3FgfQuVNEkxrUO0~Mo3bYq_Gr> z3DQhVEuTJ7LFbYQ-!uV?kVQd=PF%A9u~bMUH9;OK8wK1~IpEz4(zVcA3^Ht^G*Yx< zS}xKM8iHi7tfML;D?|`*Y6}`*%Fd7oM4jS17B;a4t59DOvl*a%h#+ymK;yFKV8Ohl zr6{Qy1%VLCq68qt%j}(5N(={kJ)2 zTSTla0u_X*08&Ow2_ZRZ$)xl0%zQNAHK7#YrKKoFeyRx&+*f2qd%^jvaLDZ$E? ztt(pwii+a|uQ<-6wAS~k^xx;0-BiFykG2`aOakR5}bngAgH2=az@ zy*^%XA66ECgaD5FwSa^Gj{n-r=_@?-(PiCO_z6U1y{%$BJf7cg{5A9m@MW`5inw$5 zx=Qvj8+WlFZzJ32VUOMF^&DIung50fe}0#?omRwfdxA1(rmG+1fu2KO&+?6?NHR zx2|i`vh7RIX-aj@=`*#ML|BR?Mky;9?z_{H=pdyrUD+09iPkq^eZcx76s%Fnvh`-R z%v7x1Jv5@yh-lp8_ULO7OEjYu5kh_gEsm;da-~oiXD&r~^b~dnp@S*GQ4HS{45V|h z?HIu7jO!(hA;x0^8>)9F8-4Eqa#hlTh!(k=HB>i`e95ZPX-QFdBv0<8R+&mBAFqH!>I5G4w>Y-~AsIoL4-7namczB!W%=pf{5Ca1A9WaD2qw?d7SlJK#Lm^oYrU_vl+&z+(sJQ)_LEu@c3d;Bz8$N^&G{~3Jx_2IlW4& zD{9Ur`pSjGxvbH4M1ZU{QXyFlpDUZ7xq(ttmA5SeQrO*#IUFg9bLV@(Y1Mm1jWOsa z1T58>`=zu@)(KC`<(Y+YixHY&ub+{MspKoEBZ#c_7^1t;=#bYJuF0`cLM=HY?0LB| zuIB_(aSdf*O0qgOagnw?qeYT!vZR^~85rMZSjCC;oWx2g;fiM06wu;W(~6hd&3kLl zc6OG0^<+fjJu@Zu8fX{C6}nCrk_uSe4Y3H|t8YhNWdd zcwjoP>C%e9=49v-fkg!tvNcamrAdpZEv%)B(W1)cNwGE~UPM}W(N_GBm4!O1%Op1F znGk%K?8$Q}Uztd@#ZALxcp|}C2pO*JY8yqAZnl1#u;+}3QncrhPl&%gvuWk^!CX(a zHWlSOsA^b@TM8v`jby5mrCAil+bN<}lc*%pw#A~6VN}XaTFZl2`vLPHEL92|6gQ9j NUC9*TLO@}^_C&cj?4 #' ## gtsummary::tbl_summary() missings_logic_across <- function(data, exclude = NULL) { - # This function includes a approach way to preserve variable labels + # This function includes a way to preserve variable labels + with_labels(data,{ names(data) |> lapply(\(.x) { - # browser() - # Saving original labels - lab <- REDCapCAST::get_attr(data[[.x]], attr = "label") if (!.x %in% exclude) { - out <- is.na(data[[.x]]) + is.na(data[[.x]]) } else { - out <- data[[.x]] - } - if (!is.na(lab)) { - # Restoring original labels, if not NA - REDCapCAST::set_attr( - data = out, - label = lab, - attr = "label", - overwrite = TRUE - ) - } else { - out + data[[.x]] } }) |> dplyr::bind_cols(.name_repair = "unique_quiet") |> setNames(names(data)) + }) } @@ -11435,7 +11423,7 @@ update_factor_ui <- function(id) { class = "float-end", shinyWidgets::prettyCheckbox( inputId = ns("new_var"), - label = i18n$t("Create a new variable (otherwise replaces the one selected)"), + label = i18n$t("Create a new variable; otherwise replaces (Updating labels always creates new variable)"), value = FALSE, status = "primary", outline = TRUE, @@ -11566,15 +11554,18 @@ update_factor_server <- function(id, data_r = reactive(NULL)) { parameters <- list( variable = variable, new_variable = isTRUE(input$new_var) | - any(grid[["Var1_toset"]] == "New label"), + any(grid[["Var1_toset"]] != "New label"), new_levels = as.character(grid[["Var1"]]), new_labels = as.character(grid[["Var1_toset"]]), ignore = "New label" ) data <- tryCatch({ - rlang::exec(factor_new_levels_labels, - !!!modifyList(parameters, val = list(data = data))) + with_labels(data,{ + rlang::exec(factor_new_levels_labels, + !!!modifyList(parameters, val = list(data = data))) + }) + }, error = function(err) { showNotification(paste( "We encountered the following error creating the new factor:", @@ -12546,6 +12537,126 @@ clean_date <- function(data) { # +######## +#### Current file: /Users/au301842/FreesearchR/R//utils-labels.R +######## + +# ============================================================================= +# Column Label Utilities +# +# Coded with help from Claude to save time. +# Could be seperated for its own package. +# ============================================================================= + +#' Extract column labels from a data frame +#' +#' @param df A data frame. +#' @return A named character vector of label strings (only labelled columns included). +#' @export +extract_labels <- function(df) { + if (!is.data.frame(df)) stop("`df` must be a data frame.", call. = FALSE) + + labels <- vapply(df, function(col) { + lbl <- attr(col, "label") + if (is.null(lbl)) NA_character_ else as.character(lbl) + }, FUN.VALUE = character(1)) + + labels[!is.na(labels)] +} + + +#' Apply a named label vector to a data frame +#' +#' @param df A data frame. +#' @param labels A named character vector (names = column names, values = labels). +#' Typically the output of [extract_labels()]. Labels for absent columns are +#' silently ignored. +#' @return `df` with `"label"` attributes set on matching columns. +#' @export +apply_labels <- function(df, labels) { + if (!is.data.frame(df)) stop("`df` must be a data frame.", call. = FALSE) + if (!is.character(labels) || is.null(names(labels))) { + stop("`labels` must be a named character vector.", call. = FALSE) + } + + for (col in intersect(names(labels), names(df))) { + attr(df[[col]], "label") <- labels[[col]] + } + + df +} + + +#' Restore column labels using a reference data frame +#' +#' Convenience wrapper around [extract_labels()] + [apply_labels()]. Labels are +#' matched by column name; new columns in `df_modified` are left unchanged. +#' +#' @param df_modified A data frame whose columns should receive labels. +#' @param df_reference A data frame carrying the authoritative `"label"` attributes. +#' @return `df_modified` with labels restored on all columns present in `df_reference`. +#' @export +restore_labels <- function(df_modified, df_reference) { + if (!is.data.frame(df_modified)) stop("`df_modified` must be a data frame.", call. = FALSE) + if (!is.data.frame(df_reference)) stop("`df_reference` must be a data frame.", call. = FALSE) + + apply_labels(df_modified, extract_labels(df_reference)) +} + + +#' Evaluate an expression while preserving column labels +#' +#' Snapshots labels from `df` before evaluating `expr`, then reapplies them to +#' matching columns in the result. New columns created inside `expr` receive no +#' label automatically. +#' +#' @param df A data frame carrying `"label"` attributes. +#' @param expr An unquoted expression that transforms `df` and returns a data frame. +#' @return The data frame produced by `expr`, with original labels restored. +#' @export +with_labels <- function(df, expr) { + if (!is.data.frame(df)) stop("`df` must be a data frame.", call. = FALSE) + + labels <- extract_labels(df) + result <- eval(substitute(expr), parent.frame()) + + if (!is.data.frame(result)) { + stop("The expression passed to `with_labels()` must return a data frame.", call. = FALSE) + } + + apply_labels(result, labels) +} + + +#' Print a tidy summary of column labels +#' +#' @param df A data frame. +#' @param missing_marker String used when a column has no label. Default: `"(no label)"`. +#' @return A `column / class / label` data frame, printed and returned invisibly. +#' @export +label_report <- function(df, missing_marker = "(no label)") { + if (!is.data.frame(df)) stop("`df` must be a data frame.", call. = FALSE) + if (!is.character(missing_marker) || length(missing_marker) != 1L) { + stop("`missing_marker` must be a single character string.", call. = FALSE) + } + + labels <- vapply(df, function(col) { + lbl <- attr(col, "label") + if (is.null(lbl)) missing_marker else as.character(lbl) + }, FUN.VALUE = character(1)) + + report <- data.frame( + column = names(df), + class = vapply(df, function(x) paste(class(x), collapse = "/"), character(1)), + label = unname(labels), + stringsAsFactors = FALSE + ) + + print(report, row.names = FALSE) + invisible(report) +} + + ######## #### Current file: /Users/au301842/FreesearchR/R//validation.R ######## diff --git a/app_docker/translations/translation_da.csv b/app_docker/translations/translation_da.csv index fef64b5f..86a7f72b 100644 --- a/app_docker/translations/translation_da.csv +++ b/app_docker/translations/translation_da.csv @@ -61,7 +61,6 @@ "Factor variable to reorder:","Kategoriske variabel der skal ændres:" "Sort by levels","Sorter efter niveauer" "Sort by count","Sorter efter antal" -"Create a new variable (otherwise replaces the one selected)","Opret en ny variabel (ellers erstattes den oprindelige)" "Update factor variable","Updater faktor-variabel" "Levels","Niveauer" "Count","Antal" @@ -328,3 +327,4 @@ "You have provided a complete dataset with no missing values.","Data er uden manglende observationer." "Start by loading data.","Start med at vælge data." "Sample data","Træningsdata" +"Create a new variable; otherwise replaces (Updating labels always creates new variable)","Create a new variable; otherwise replaces (Updating labels always creates new variable)" diff --git a/app_docker/translations/translation_sw.csv b/app_docker/translations/translation_sw.csv index 300390ff..1193ea71 100644 --- a/app_docker/translations/translation_sw.csv +++ b/app_docker/translations/translation_sw.csv @@ -61,7 +61,6 @@ "Factor variable to reorder:","Kigezo cha vipengele ili kupanga upya:" "Sort by levels","Panga kwa viwango" "Sort by count","Panga kwa hesabu" -"Create a new variable (otherwise replaces the one selected)","Unda kigezo kipya (vinginevyo kinachukua nafasi ya kile kilichochaguliwa)" "Update factor variable","Sasisha kigezo cha kipengele" "Levels","Viwango" "Count","Hesabu" @@ -328,3 +327,4 @@ "You have provided a complete dataset with no missing values.","You have provided a complete dataset with no missing values." "Start by loading data.","Start by loading data." "Sample data","Sample data" +"Create a new variable; otherwise replaces (Updating labels always creates new variable)","Create a new variable; otherwise replaces (Updating labels always creates new variable)" diff --git a/inst/apps/FreesearchR/app.R b/inst/apps/FreesearchR/app.R index 9e885cb4..6007a903 100644 --- a/inst/apps/FreesearchR/app.R +++ b/inst/apps/FreesearchR/app.R @@ -1,7 +1,7 @@ ######## -#### Current file: /var/folders/9l/xbc19wxx0g79jdd2sf_0v291mhwh7f/T//RtmpxB1KWR/file173c92887da27.R +#### Current file: /var/folders/9l/xbc19wxx0g79jdd2sf_0v291mhwh7f/T//RtmpxB1KWR/file173c978fea931.R ######## i18n_path <- system.file("translations", package = "FreesearchR") @@ -75,7 +75,7 @@ if (!"global_freesearchR" %in% ls(name = globalenv())) { #### Current file: /Users/au301842/FreesearchR/R//app_version.R ######## -app_version <- function()'26.3.1' +app_version <- function()'26.3.2' ######## @@ -4527,7 +4527,7 @@ data_types <- function() { #### Current file: /Users/au301842/FreesearchR/R//hosted_version.R ######## -hosted_version <- function()'v26.3.1-260302' +hosted_version <- function()'v26.3.2-260311' ######## @@ -6367,31 +6367,19 @@ compare_missings <- function(data, #' ## missings_logic_across() |> #' ## gtsummary::tbl_summary() missings_logic_across <- function(data, exclude = NULL) { - # This function includes a approach way to preserve variable labels + # This function includes a way to preserve variable labels + with_labels(data,{ names(data) |> lapply(\(.x) { - # browser() - # Saving original labels - lab <- REDCapCAST::get_attr(data[[.x]], attr = "label") if (!.x %in% exclude) { - out <- is.na(data[[.x]]) + is.na(data[[.x]]) } else { - out <- data[[.x]] - } - if (!is.na(lab)) { - # Restoring original labels, if not NA - REDCapCAST::set_attr( - data = out, - label = lab, - attr = "label", - overwrite = TRUE - ) - } else { - out + data[[.x]] } }) |> dplyr::bind_cols(.name_repair = "unique_quiet") |> setNames(names(data)) + }) } @@ -11435,7 +11423,7 @@ update_factor_ui <- function(id) { class = "float-end", shinyWidgets::prettyCheckbox( inputId = ns("new_var"), - label = i18n$t("Create a new variable (otherwise replaces the one selected)"), + label = i18n$t("Create a new variable; otherwise replaces (Updating labels always creates new variable)"), value = FALSE, status = "primary", outline = TRUE, @@ -11566,15 +11554,18 @@ update_factor_server <- function(id, data_r = reactive(NULL)) { parameters <- list( variable = variable, new_variable = isTRUE(input$new_var) | - any(grid[["Var1_toset"]] == "New label"), + any(grid[["Var1_toset"]] != "New label"), new_levels = as.character(grid[["Var1"]]), new_labels = as.character(grid[["Var1_toset"]]), ignore = "New label" ) data <- tryCatch({ - rlang::exec(factor_new_levels_labels, - !!!modifyList(parameters, val = list(data = data))) + with_labels(data,{ + rlang::exec(factor_new_levels_labels, + !!!modifyList(parameters, val = list(data = data))) + }) + }, error = function(err) { showNotification(paste( "We encountered the following error creating the new factor:", @@ -12546,6 +12537,126 @@ clean_date <- function(data) { # +######## +#### Current file: /Users/au301842/FreesearchR/R//utils-labels.R +######## + +# ============================================================================= +# Column Label Utilities +# +# Coded with help from Claude to save time. +# Could be seperated for its own package. +# ============================================================================= + +#' Extract column labels from a data frame +#' +#' @param df A data frame. +#' @return A named character vector of label strings (only labelled columns included). +#' @export +extract_labels <- function(df) { + if (!is.data.frame(df)) stop("`df` must be a data frame.", call. = FALSE) + + labels <- vapply(df, function(col) { + lbl <- attr(col, "label") + if (is.null(lbl)) NA_character_ else as.character(lbl) + }, FUN.VALUE = character(1)) + + labels[!is.na(labels)] +} + + +#' Apply a named label vector to a data frame +#' +#' @param df A data frame. +#' @param labels A named character vector (names = column names, values = labels). +#' Typically the output of [extract_labels()]. Labels for absent columns are +#' silently ignored. +#' @return `df` with `"label"` attributes set on matching columns. +#' @export +apply_labels <- function(df, labels) { + if (!is.data.frame(df)) stop("`df` must be a data frame.", call. = FALSE) + if (!is.character(labels) || is.null(names(labels))) { + stop("`labels` must be a named character vector.", call. = FALSE) + } + + for (col in intersect(names(labels), names(df))) { + attr(df[[col]], "label") <- labels[[col]] + } + + df +} + + +#' Restore column labels using a reference data frame +#' +#' Convenience wrapper around [extract_labels()] + [apply_labels()]. Labels are +#' matched by column name; new columns in `df_modified` are left unchanged. +#' +#' @param df_modified A data frame whose columns should receive labels. +#' @param df_reference A data frame carrying the authoritative `"label"` attributes. +#' @return `df_modified` with labels restored on all columns present in `df_reference`. +#' @export +restore_labels <- function(df_modified, df_reference) { + if (!is.data.frame(df_modified)) stop("`df_modified` must be a data frame.", call. = FALSE) + if (!is.data.frame(df_reference)) stop("`df_reference` must be a data frame.", call. = FALSE) + + apply_labels(df_modified, extract_labels(df_reference)) +} + + +#' Evaluate an expression while preserving column labels +#' +#' Snapshots labels from `df` before evaluating `expr`, then reapplies them to +#' matching columns in the result. New columns created inside `expr` receive no +#' label automatically. +#' +#' @param df A data frame carrying `"label"` attributes. +#' @param expr An unquoted expression that transforms `df` and returns a data frame. +#' @return The data frame produced by `expr`, with original labels restored. +#' @export +with_labels <- function(df, expr) { + if (!is.data.frame(df)) stop("`df` must be a data frame.", call. = FALSE) + + labels <- extract_labels(df) + result <- eval(substitute(expr), parent.frame()) + + if (!is.data.frame(result)) { + stop("The expression passed to `with_labels()` must return a data frame.", call. = FALSE) + } + + apply_labels(result, labels) +} + + +#' Print a tidy summary of column labels +#' +#' @param df A data frame. +#' @param missing_marker String used when a column has no label. Default: `"(no label)"`. +#' @return A `column / class / label` data frame, printed and returned invisibly. +#' @export +label_report <- function(df, missing_marker = "(no label)") { + if (!is.data.frame(df)) stop("`df` must be a data frame.", call. = FALSE) + if (!is.character(missing_marker) || length(missing_marker) != 1L) { + stop("`missing_marker` must be a single character string.", call. = FALSE) + } + + labels <- vapply(df, function(col) { + lbl <- attr(col, "label") + if (is.null(lbl)) missing_marker else as.character(lbl) + }, FUN.VALUE = character(1)) + + report <- data.frame( + column = names(df), + class = vapply(df, function(x) paste(class(x), collapse = "/"), character(1)), + label = unname(labels), + stringsAsFactors = FALSE + ) + + print(report, row.names = FALSE) + invisible(report) +} + + ######## #### Current file: /Users/au301842/FreesearchR/R//validation.R ######## diff --git a/inst/translations/translation_da.csv b/inst/translations/translation_da.csv index fef64b5f..86a7f72b 100644 --- a/inst/translations/translation_da.csv +++ b/inst/translations/translation_da.csv @@ -61,7 +61,6 @@ "Factor variable to reorder:","Kategoriske variabel der skal ændres:" "Sort by levels","Sorter efter niveauer" "Sort by count","Sorter efter antal" -"Create a new variable (otherwise replaces the one selected)","Opret en ny variabel (ellers erstattes den oprindelige)" "Update factor variable","Updater faktor-variabel" "Levels","Niveauer" "Count","Antal" @@ -328,3 +327,4 @@ "You have provided a complete dataset with no missing values.","Data er uden manglende observationer." "Start by loading data.","Start med at vælge data." "Sample data","Træningsdata" +"Create a new variable; otherwise replaces (Updating labels always creates new variable)","Create a new variable; otherwise replaces (Updating labels always creates new variable)" diff --git a/inst/translations/translation_sw.csv b/inst/translations/translation_sw.csv index 300390ff..1193ea71 100644 --- a/inst/translations/translation_sw.csv +++ b/inst/translations/translation_sw.csv @@ -61,7 +61,6 @@ "Factor variable to reorder:","Kigezo cha vipengele ili kupanga upya:" "Sort by levels","Panga kwa viwango" "Sort by count","Panga kwa hesabu" -"Create a new variable (otherwise replaces the one selected)","Unda kigezo kipya (vinginevyo kinachukua nafasi ya kile kilichochaguliwa)" "Update factor variable","Sasisha kigezo cha kipengele" "Levels","Viwango" "Count","Hesabu" @@ -328,3 +327,4 @@ "You have provided a complete dataset with no missing values.","You have provided a complete dataset with no missing values." "Start by loading data.","Start by loading data." "Sample data","Sample data" +"Create a new variable; otherwise replaces (Updating labels always creates new variable)","Create a new variable; otherwise replaces (Updating labels always creates new variable)" diff --git a/man/apply_labels.Rd b/man/apply_labels.Rd new file mode 100644 index 00000000..fa7237ec --- /dev/null +++ b/man/apply_labels.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils-labels.R +\name{apply_labels} +\alias{apply_labels} +\title{Apply a named label vector to a data frame} +\usage{ +apply_labels(df, labels) +} +\arguments{ +\item{df}{A data frame.} + +\item{labels}{A named character vector (names = column names, values = labels). +Typically the output of \code{\link[=extract_labels]{extract_labels()}}. Labels for absent columns are +silently ignored.} +} +\value{ +\code{df} with \code{"label"} attributes set on matching columns. +} +\description{ +Apply a named label vector to a data frame +} diff --git a/man/extract_labels.Rd b/man/extract_labels.Rd new file mode 100644 index 00000000..b851352e --- /dev/null +++ b/man/extract_labels.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils-labels.R +\name{extract_labels} +\alias{extract_labels} +\title{Extract column labels from a data frame} +\usage{ +extract_labels(df) +} +\arguments{ +\item{df}{A data frame.} +} +\value{ +A named character vector of label strings (only labelled columns included). +} +\description{ +Extract column labels from a data frame +} diff --git a/man/label_report.Rd b/man/label_report.Rd new file mode 100644 index 00000000..03578d10 --- /dev/null +++ b/man/label_report.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils-labels.R +\name{label_report} +\alias{label_report} +\title{Print a tidy summary of column labels} +\usage{ +label_report(df, missing_marker = "(no label)") +} +\arguments{ +\item{df}{A data frame.} + +\item{missing_marker}{String used when a column has no label. Default: \code{"(no label)"}.} +} +\value{ +A \code{column / class / label} data frame, printed and returned invisibly. +} +\description{ +Print a tidy summary of column labels +} diff --git a/man/restore_labels.Rd b/man/restore_labels.Rd new file mode 100644 index 00000000..91fdbd1d --- /dev/null +++ b/man/restore_labels.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils-labels.R +\name{restore_labels} +\alias{restore_labels} +\title{Restore column labels using a reference data frame} +\usage{ +restore_labels(df_modified, df_reference) +} +\arguments{ +\item{df_modified}{A data frame whose columns should receive labels.} + +\item{df_reference}{A data frame carrying the authoritative \code{"label"} attributes.} +} +\value{ +\code{df_modified} with labels restored on all columns present in \code{df_reference}. +} +\description{ +Convenience wrapper around \code{\link[=extract_labels]{extract_labels()}} + \code{\link[=apply_labels]{apply_labels()}}. Labels are +matched by column name; new columns in \code{df_modified} are left unchanged. +} diff --git a/man/with_labels.Rd b/man/with_labels.Rd new file mode 100644 index 00000000..62b6a9e4 --- /dev/null +++ b/man/with_labels.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils-labels.R +\name{with_labels} +\alias{with_labels} +\title{Evaluate an expression while preserving column labels} +\usage{ +with_labels(df, expr) +} +\arguments{ +\item{df}{A data frame carrying \code{"label"} attributes.} + +\item{expr}{An unquoted expression that transforms \code{df} and returns a data frame.} +} +\value{ +The data frame produced by \code{expr}, with original labels restored. +} +\description{ +Snapshots labels from \code{df} before evaluating \code{expr}, then reapplies them to +matching columns in the result. New columns created inside \code{expr} receive no +label automatically. +} diff --git a/tests/testthat/test-utils-labels.R b/tests/testthat/test-utils-labels.R new file mode 100644 index 00000000..e2f467ce --- /dev/null +++ b/tests/testthat/test-utils-labels.R @@ -0,0 +1,143 @@ +# Tests for column label utilities (extract_labels, apply_labels, +# restore_labels, with_labels, label_report) + +# --- extract_labels ---------------------------------------------------------- + +test_that("extract_labels returns named character vector of present labels", { + df <- data.frame(a = 1:3, b = 4:6, c = 7:9) + attr(df$a, "label") <- "Column A" + attr(df$b, "label") <- "Column B" + + lbls <- extract_labels(df) + + expect_type(lbls, "character") + expect_named(lbls, c("a", "b")) + expect_equal(lbls[["a"]], "Column A") + expect_equal(lbls[["b"]], "Column B") + expect_false("c" %in% names(lbls)) +}) + +test_that("extract_labels returns zero-length vector when no labels present", { + expect_equal(length(extract_labels(data.frame(x = 1, y = 2))), 0L) +}) + +test_that("extract_labels errors on non-data-frame input", { + expect_error(extract_labels(list(a = 1)), "`df` must be a data frame") + expect_error(extract_labels(1:5), "`df` must be a data frame") +}) + + +# --- apply_labels ------------------------------------------------------------ + +test_that("apply_labels sets label attributes on matching columns", { + df <- data.frame(age = 1:3, income = c(10, 20, 30)) + df2 <- apply_labels(df, c(age = "Age (years)", income = "Income (USD)")) + + expect_equal(attr(df2$age, "label"), "Age (years)") + expect_equal(attr(df2$income, "label"), "Income (USD)") +}) + +test_that("apply_labels silently ignores labels for absent columns", { + df <- data.frame(age = 1:3) + expect_no_error(apply_labels(df, c(age = "Age", income = "Income"))) + expect_equal(attr(apply_labels(df, c(age = "Age", income = "Income"))$age, "label"), "Age") +}) + +test_that("apply_labels errors on bad inputs", { + expect_error(apply_labels(list(), c(a = "A")), "`df` must be a data frame") + expect_error(apply_labels(data.frame(), c("A")), "`labels` must be a named") + expect_error(apply_labels(data.frame(), 123), "`labels` must be a named") +}) + + +# --- restore_labels ---------------------------------------------------------- + +test_that("restore_labels copies labels from reference to modified df", { + df <- data.frame(a = 1:5, b = letters[1:5], stringsAsFactors = FALSE) + attr(df$a, "label") <- "Variable A" + attr(df$b, "label") <- "Variable B" + + df_mod <- df[df$a > 2, ] + attr(df_mod$a, "label") <- NULL + attr(df_mod$b, "label") <- NULL + + df_restored <- restore_labels(df_mod, df) + + expect_equal(attr(df_restored$a, "label"), "Variable A") + expect_equal(attr(df_restored$b, "label"), "Variable B") +}) + +test_that("restore_labels does not error when modified df has extra columns", { + df <- data.frame(x = 1:3) + attr(df$x, "label") <- "X" + + df_mod <- df + df_mod$y <- df$x * 2 + + result <- restore_labels(df_mod, df) + expect_equal(attr(result$x, "label"), "X") + expect_null(attr(result$y, "label")) +}) + +test_that("restore_labels errors on non-data-frame inputs", { + df <- data.frame(x = 1) + expect_error(restore_labels(list(), df), "`df_modified` must be a data frame") + expect_error(restore_labels(df, list()), "`df_reference` must be a data frame") +}) + + +# --- with_labels ------------------------------------------------------------- + +test_that("with_labels preserves labels through a subsetting expression", { + df <- data.frame(id = 1:5, age = c(25, 34, 45, 29, 52)) + attr(df$age, "label") <- "Age (years)" + + result <- with_labels(df, df[df$age > 30, ]) + expect_equal(attr(result$age, "label"), "Age (years)") +}) + +test_that("with_labels does not assign labels to new columns", { + df <- data.frame(x = 1:3, y = 4:6) + attr(df$x, "label") <- "X label" + + result <- with_labels(df, { df$z <- df$x + df$y; df }) + + expect_equal(attr(result$x, "label"), "X label") + expect_null(attr(result$z, "label")) +}) + +test_that("with_labels errors when expression does not return a data frame", { + df <- data.frame(x = 1:3) + expect_error(with_labels(df, sum(df$x)), "must return a data frame") +}) + +test_that("with_labels errors on non-data-frame df argument", { + expect_error(with_labels(list(x = 1), list()), "`df` must be a data frame") +}) + + +# --- label_report ------------------------------------------------------------ + +test_that("label_report returns correct structure", { + df <- data.frame(a = 1L, b = "x", stringsAsFactors = FALSE) + attr(df$a, "label") <- "Alpha" + + report <- label_report(df) + + expect_s3_class(report, "data.frame") + expect_named(report, c("column", "class", "label")) + expect_equal(nrow(report), 2L) + expect_equal(report$label[report$column == "a"], "Alpha") + expect_equal(report$label[report$column == "b"], "(no label)") +}) + +test_that("label_report respects custom missing_marker", { + df <- data.frame(x = 1) + report <- label_report(df, missing_marker = "N/A") + expect_equal(report$label[1], "N/A") +}) + +test_that("label_report errors on bad inputs", { + expect_error(label_report(list()), "`df` must be a data frame") + expect_error(label_report(data.frame(), c("a", "b")), "`missing_marker`") +}) From 8935b0b2a4c2a843361fd3a7f9f284c0261fb7c5 Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Wed, 11 Mar 2026 13:22:54 +0100 Subject: [PATCH 2/3] feat: allow passing of global settings launching from R or running docker container. --- NEWS.md | 2 ++ R/launch_FreesearchR.R | 28 +++++++++++++++++++++++----- R/sysdata.rda | Bin 2838 -> 2661 bytes R/ui_elements.R | 8 ++++---- SESSION.md | 19 ------------------- 5 files changed, 29 insertions(+), 28 deletions(-) diff --git a/NEWS.md b/NEWS.md index 6f50a612..7c44be1a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -6,6 +6,8 @@ *NEW* New with_labels() function (and helpers) added to allow easy preservation of labels. +*NEW* option to pass global settings when running as docker or launching from R. Support for INCLUDE_GLOBALENV, DATA_LIMIT_DEFAULT, DATA_LIMIT_UPPER and DATA_LIMIT_LOWER. Docs will follow. + # FreesearchR 26.3.1 *FIX* ~~Include font files for static loading without dependency on Google.~~ Kept webfonts from google as local fonts are not working for now. diff --git a/R/launch_FreesearchR.R b/R/launch_FreesearchR.R index 504de474..469c443b 100644 --- a/R/launch_FreesearchR.R +++ b/R/launch_FreesearchR.R @@ -23,11 +23,11 @@ launch_FreesearchR <- function(inlcude_globalenv = TRUE, data_limit_upper = 100000, data_limit_lower = 1, ...) { - global_freesearchR <- list( - include_globalenv = include_globalenv, - data_limit_default = data_limit_default, - data_limit_upper = data_limit_upper, - data_limit_lower = data_limit_lower + Sys.setenv( + INCLUDE_GLOBALENV = include_globalenv, + DATA_LIMIT_DEFAULT = data_limit_default, + DATA_LIMIT_UPPER = data_limit_upper, + DATA_LIMIT_LOWER = data_limit_lower ) appDir <- system.file("apps", "FreesearchR", package = "FreesearchR") @@ -39,3 +39,21 @@ launch_FreesearchR <- function(inlcude_globalenv = TRUE, a <- shiny::runApp(appDir = paste0(appDir, "/app.R"), ...) return(invisible(a)) } + + +## Helper to set env variables +get_config <- function(var_name, default = NULL) { + # First check environment variables (set by Docker) + val <- Sys.getenv(var_name, unset = NA) + + if (!is.na(val) && nzchar(val)) { + return(val) + } + + # Fall back to default (can be overridden when launching from R) + if (!is.null(default)) { + return(default) + } + + stop(paste("Required config variable not set:", var_name)) +} diff --git a/R/sysdata.rda b/R/sysdata.rda index e7ce41066e6125ce50acf9792d07bde50c433502..f20ba2552a749586b3c5f0ce62e1446fd82b4b4c 100644 GIT binary patch literal 2661 zcmV-r3YzsoT4*^jL0KkKSwF8mp8y$Bf5iX)Xaz!l|KNXb-@w2B|L{Nn06+)<;0xay zldLxn4g#q(peO-+@Bjc0svI>j01yOZGEE8OBSM==`bfs00MU~XiLnN%r~XDl8frAv zKOsk>K`{+5Ljo`WMvV2fB*mh00001CXzy$nrJ}NMt}oA00000 z000o84^YvgMutFW4FJ#vfM@^)ng9V3i8UHD$&imxh%#bi0iXZ_6G4+qfXQ-Iz)U3! zv@jWz0?R0%rLjd#Omsk3n~Kt?pw^@^yu3R2W3u)F%dwbUo@do_8Pr5U zg*l$R#DOUP&rersQS3`#+L^l8**o6cJ8-vK@CcA8nUypoZ*>Jye)V$YZ&Q`QwNlN% ztyMEc2(LIb0SB041DLbfZOg^(L048E>ycb9!X%boJP9i5s_~(i^pjN>EL%*K${x~j z5`R75CvXM47X8Z zixd55`%E~knsrPiRqqsqRhxvcsA(cz4_dmt#@9}@3E=fP*!aE^eP-ufPP?If^JeR* z%qTfCZQa|d7HaCK%197mFBVo})_tWL9NU3qlZ1fMJKVQRSn1(K~2inS-lJ!<;p;iHK87 zvM&&KgLQVfnP?tPa_x)V;$q1vj$PSfY^r-=>0%1Cg$Z~mslUHVV#8*@_!i%vIp&F0LNQkM?PH)?_z2zp|Y(rXCOHWPchs^(1Fn|%hN?U-XFu(@rO zm8CPx;~uv)abvGvV^O1XLJ=<;yS( zEfxiqgFRaeoBF#Ncx0*5d!#R8vCFKC(Mr*crP>4wP)wE;lx0Lp(F7bCg2tFKv!Dh+ zCv=V2h8qJFXcok!;`9$_pc~LYH>$ae7){G1kfm8dL=piyR0|}9?7n{6NftrpVQnQ& zt2nNeEwZe+=W9?@aib8cX;_+L(X2Ym3_%(7Qu7f*hOX}n#mfqv_jkEB-JwmkxT7Re z8EO)&>+@OA!0G`4A)PvXe5~oENmHMt&RQ1HD+^?SP?dlRNXdkRCpN5_PctmXz)lld z5l$LfQi&ufLBPdW$o4(nw;S)|+;UMV!Ocrj%FwG+R~RLE+18et-{H>P>b#BlTTxnY zWQL}ZHDzx1ZEQO#mbGFdDkw;B_LXcoM4E60G?51=*?P)8GqCzzlW~{fcN|4~qlA^Bg^ZXxD{moZrdr%JYKF@1ReQ;kwCYbpBo$X|)B`@py z1W;ZJWu78d-&2gB&j8O==U=8DoVdt+&J$B1wO@3ZEXRr5P%baBsfh(TPny(WFB;=v zG6pPe=ojF^u>&yjAJ@0ixe|rmyf8O<=bCcMi#M7gby4-V$-E>mRAC%a3u3MQ+gFhV zltnDsR3s@CYF)T2)Ujt{zfF-62< zLhY+&MEyfh!IYe|LpHqw7Dp=D_q6EgR7-TijK>2Vw?Chm-&6o)tID{nfptyejl;Zs zQ%klJin%}#X;a_amA?TAm-Q}98GjPk?X|ZRLN}8@==!nNI9M4lVDN! z&(*{(sg2c1y?stPy8^_0=g|jUyhI6K4rUr2?O)0ft&jUic6l2`IO$z-F%GW)sw@z& zOcK3N7>6yYhk0FK*$x!Bmi!jin_V89*fazehANvoZZfyKdLLpE#gnC}1srEijKNA= z-8d5Ub$4^YtcCO#N{B|dH?QU9$PDM?LQrCa^DOGHsnA zR#B6Vv^EltZ7fhlnuuss6X-{?UZiHNN6jcEOeiFBJ_a)oR;VM4=pt!GY=%*ec2e>| ziy^7E-J7r7mgg4j*I23z*3BDfrdPie+XV~B1lVeK99}?{9bLf5!&@6&btkf#Wh0BT z8A(R~N*f7+gahL3S{T#{W=e4YPeB_PjH6SE>uW9yb8Txk@51?^wJ=vzir9M9cYTqs z0;2E6wL2*p5QS}i)O&4bv1-|Z=i$m;3cy~X25ifzW3XXYZqFRJdE-$F7@Mk|qdnUv zr%!Yj*9>KOWK^!FBUP)TReMCQCES`XX-ILdafO7al4!dg$D`OOB7&DuYw4VU_JM-S T3k0y)KjQ94rwS4W_2;wTDyY|i literal 2838 zcmV+x3+ePiT4*^jL0KkKSq}>Kv;Z5Gf5QL&Xaz!l|KNXb-@w2B|L{Nn00;;H;0(VP zyxy2^4+E$Yk3a_^f%CqCi3i9UQ1H~m6A05mFp~+QV?{j*JkwOr*&qW!qee`{2C3j8 z36(vmlS#3uJfq4000001kN^Wy$)J>?4^g9K2198BAOVm8k%0ptkOZ1YNh#`&)b%us zpQQk39-slEBPM_V0iXcNh?_+8n9-r3GGGHyfCOYFnoS+%fZ05U-Y7DNxe_sid>n*HyLfA6<%vHyqL_xaW#XwC)n z&i6#kK2@MgN*Rl4f#Z@23V*!c9Gsi!}9 zX(V$r<&Fa7YrN{M|2M@L3-Knb*0OCI!_r@i-U|-7CSRSk&!VlYt6_&0%i|{ojSBoQ z>uhjYxLcz_$%cI#lXeDh>!?0wpT2Lc&~K#Eo>dayO>wcxT5p%f<9aF2Q z_2^}8sM%ASvs9;q5jRm1m^Fh#Q$;wNA0={RyN#s6-We~HE=-$QwLzB68J`Zv68#%$ zu)>S+)w%VoEf8Gs0Lu{q>2{tg_3-DK0BuACPJn_75kv?Q5*t*2D%oWUs)yc3_ zs49xVMnP0j5r`@>C<-hTMNwD_B8sXCqA2?QpT_N;JgU5YeDop<1s^p4<9!`;`Wu|X zM=JqmMWsa<(Yvd9&YJ5&a)sT6yWFpAZpU_YX~w(ShLUNCBm=5qU^a$b7M`a^4b;h5 z5h#E)iF)OmaW~q@wi`~l*I3)FZm|x{Q8`MGp&*dRjKdJgS`u_lv?Mq#lW#2>piL0Y z8O$9RPQ;b9Mgl5GZ890WPSz7l;=SeC2X(#Jwl6OdV#z8F_nC%8vk>i!fVNa?3<<0d z)Ys>wLU2*CUkQW4D`nY6qJP0V%7}|@AfHj~3hA4}KK)hI328fF_6;wpbD3-Qp zwRG4*_ibA=WwT0@uH10xn6b>v>hl7p5T2o4B!R8lXDCxv@}Sc)StXED zYYy(FVo{2=>Fr>kWeHb9iM?sI?V{U{Nv)iEyj_N->#K}c1gpNe)*ait>b%2QMwHM< z0|rR~*_5ud_jhF2oV;~h$(!xX2BPmU#U_wqG?0*tu^0_IK52G|-`&@nOZun*aRp#P zWB@`T=1E-4w5=;f+z9~5F|2~K*b*Rn&%KH9+Nj4MC54jMlu}V9WyCA&HGg0P*Ju=y z2tpAdsulJdl;fPmAZy&xOG*V{ORTnY=Mg6eDP=7|PTtvQ%Jq&iKNb zX0uENem7GBQkJB#6pBgUn3!8XPEkSc0w=`pxIkke5l~|Z-QAc57K%d4V9#cgCq13~ z26klP53OOZFD~yCO%$c5)U~7K$s`QK6H>ymjHrmUX+eX7P)0Pt3ZA#80)$EH+FOa9 zWIbG<^1`kzfp4Kf4cG!6JPUz~7ZE^GlvIrhz=ES~2|^8Ln>cWQNT)Kg!LraQ9x2+o zMJa5emp-<&1xFe&g;u3wG>?X`Jw^r~j9=GF*oqxBc%3sBDJ$|kxN!%Kg*Us3APW-8 zs0~Q!WT!?cdWtYC%SX3DlPoF?Cx4~hS{BhO3qTeUHo{gw765^g5RYvNZLPCEt-($j~^kp>I2qYc>#k9jK zt;^jnrwEDn8ZnbOW^(}~q*8K%$kcSAV1hwa1YLdPthi41oB%-}vb1nPAhWetN+7M5 z)?uHkfBqAQ$45D;`g=V7zsPa=1$_uzU?&iui82(R2!BNLr2LxMb zaJc(#%Atea-_mrg&~W7hkfY{T#;rH+r$b}7|2MyfUNXRiu+m;b%hO=Ega!bk=vfYp zQ=Zq5sn-dK6>&AHm78TcN?Xd=w;bp~&Iv}typpz}gHDZoJOfo&-^FDytAa;vu~P#6 z9@H8!;3h%K`>@0XjWXm-X|?6{km~a`iui7v;$i(g>Q!q5C?pA9w~Rv^!&CW{_Kfm? z-DT~&60f@u8cJP`lU{7&RPXI> zE^IHhLkg@yHbL5XcCq7H{K!S|YJ{{c7eca?G7ljQ5RBCa)PEMu{WpI4nU%`lQy6mkjR6SUD|bmS-kgmy`<28Q7=!lsqnb||GAsw83yyp)cTok; z=VnO1A->6-5(zP_S21gskumH*h~jM_(B$LeQ}WN$e3cH87m+>8tPau!36MoiK_)(e z6)U8ip4776Lp#53M!{egYI&EauYlU zqnW|9B-dBG7Va82ZQUOds40fLw9aoGVpTX!zVBsWrJBol%CNq^#;*60u)PN&$Lld= z`YX<3j9$zoy=4fv=7)n#NtKjY0JAy>Xe(xAi$4DYS%M?HH0ru-gzP4Ul+0^tGCKkV%H8aK@qput+@F67+2iX(*O2iibD olSR^xYtii%N(M??%dc?%fP3h8>qdxZ^dJ0P$rRy2Ks+nj&=-tQ!vFvP diff --git a/R/ui_elements.R b/R/ui_elements.R index 0aea99e8..cac844a0 100644 --- a/R/ui_elements.R +++ b/R/ui_elements.R @@ -83,9 +83,9 @@ ui_elements <- function(selection) { layout_params = "dropdown", # title = "Choose a datafile to upload", file_extensions = c(".csv", ".tsv", ".txt", ".xls", ".xlsx", ".rds", ".ods", ".dta"), - limit_default = global_freesearchR$data_limit_default, - limit_lower = global_freesearchR$data_limit_lower, - limit_upper = global_freesearchR$data_limit_upper + limit_default = DATA_LIMIT_DEFAULT, + limit_lower = DATA_LIMIT_LOWER, + limit_upper = DATA_LIMIT_UPPER ) ), @@ -107,7 +107,7 @@ ui_elements <- function(selection) { id = "env", title = NULL, packages = c("NHANES", "stRoke", "datasets", "MASS"), - globalenv = global_freesearchR$include_globalenv + globalenv = isTruthy(INCLUDE_GLOBALENV) ) ), # shiny::conditionalPanel( diff --git a/SESSION.md b/SESSION.md index 608dbe98..1193d865 100644 --- a/SESSION.md +++ b/SESSION.md @@ -26,8 +26,6 @@ |apexcharter |0.4.5 |2026-01-07 |CRAN (R 4.5.2) | |askpass |1.2.1 |2024-10-04 |CRAN (R 4.5.0) | |assertthat |0.2.1 |2019-03-21 |CRAN (R 4.5.0) | -|attachment |0.4.5 |2025-03-14 |CRAN (R 4.5.0) | -|attempt |0.3.1 |2020-05-03 |CRAN (R 4.5.0) | |backports |1.5.0 |2024-05-23 |CRAN (R 4.5.0) | |base64enc |0.1-6 |2026-02-02 |CRAN (R 4.5.2) | |bayestestR |0.17.0 |2025-08-29 |CRAN (R 4.5.0) | @@ -46,7 +44,6 @@ |cardx |0.3.2 |2026-02-05 |CRAN (R 4.5.2) | |caTools |1.18.3 |2024-09-04 |CRAN (R 4.5.0) | |cellranger |1.1.0 |2016-07-27 |CRAN (R 4.5.0) | -|cffr |1.2.1 |2026-01-12 |CRAN (R 4.5.2) | |checkmate |2.3.4 |2026-02-03 |CRAN (R 4.5.2) | |class |7.3-23 |2025-01-01 |CRAN (R 4.5.2) | |classInt |0.4-11 |2025-01-08 |CRAN (R 4.5.0) | @@ -56,8 +53,6 @@ |colorspace |2.1-2 |2025-09-22 |CRAN (R 4.5.0) | |commonmark |2.0.0 |2025-07-07 |CRAN (R 4.5.0) | |crayon |1.5.3 |2024-06-20 |CRAN (R 4.5.0) | -|credentials |2.0.3 |2025-09-12 |CRAN (R 4.5.0) | -|curl |7.0.0 |2025-08-19 |CRAN (R 4.5.0) | |data.table |1.18.2.1 |2026-01-27 |CRAN (R 4.5.2) | |datamods |1.5.3 |2024-10-02 |CRAN (R 4.5.0) | |datawizard |1.3.0 |2025-10-11 |CRAN (R 4.5.0) | @@ -66,7 +61,6 @@ |devtools |2.4.6 |2025-10-03 |CRAN (R 4.5.0) | |DHARMa |0.4.7 |2024-10-18 |CRAN (R 4.5.0) | |digest |0.6.39 |2025-11-19 |CRAN (R 4.5.2) | -|dockerfiler |0.2.5 |2025-05-07 |CRAN (R 4.5.0) | |doParallel |1.0.17 |2022-02-07 |CRAN (R 4.5.0) | |dplyr |1.2.0 |2026-02-03 |CRAN (R 4.5.2) | |DT |0.34.0 |2025-09-02 |CRAN (R 4.5.0) | @@ -93,15 +87,12 @@ |fs |1.6.6 |2025-04-12 |CRAN (R 4.5.0) | |gdtools |0.5.0 |2026-02-09 |CRAN (R 4.5.2) | |generics |0.1.4 |2025-05-09 |CRAN (R 4.5.0) | -|gert |2.3.1 |2026-01-11 |CRAN (R 4.5.2) | |ggalluvial |0.12.5 |2023-02-22 |CRAN (R 4.5.0) | |ggcorrplot |0.1.4.1 |2023-09-05 |CRAN (R 4.5.0) | |ggforce |0.5.0 |2025-06-18 |CRAN (R 4.5.0) | |ggplot2 |4.0.2 |2026-02-03 |CRAN (R 4.5.2) | |ggridges |0.5.7 |2025-08-27 |CRAN (R 4.5.0) | |ggstats |0.12.0 |2025-12-22 |CRAN (R 4.5.2) | -|gh |1.5.0 |2025-05-26 |CRAN (R 4.5.0) | -|gitcreds |0.1.2 |2022-09-08 |CRAN (R 4.5.0) | |glue |1.8.0 |2024-09-30 |CRAN (R 4.5.0) | |gridExtra |2.3 |2017-09-09 |CRAN (R 4.5.0) | |gt |1.3.0 |2026-01-22 |CRAN (R 4.5.2) | @@ -115,24 +106,20 @@ |htmltools |0.5.9 |2025-12-04 |CRAN (R 4.5.2) | |htmlwidgets |1.6.4 |2023-12-06 |CRAN (R 4.5.0) | |httpuv |1.6.16 |2025-04-16 |CRAN (R 4.5.0) | -|httr2 |1.2.2 |2025-12-08 |CRAN (R 4.5.2) | |IDEAFilter |0.2.1 |2025-07-29 |CRAN (R 4.5.0) | |insight |1.4.6 |2026-02-04 |CRAN (R 4.5.2) | |iterators |1.0.14 |2022-02-05 |CRAN (R 4.5.0) | |jquerylib |0.1.4 |2021-04-26 |CRAN (R 4.5.0) | |jsonlite |2.0.0 |2025-03-27 |CRAN (R 4.5.0) | -|jsonvalidate |1.5.0 |2025-02-07 |CRAN (R 4.5.0) | |KernSmooth |2.23-26 |2025-01-01 |CRAN (R 4.5.2) | |keyring |1.4.1 |2025-06-15 |CRAN (R 4.5.0) | |knitr |1.51 |2025-12-20 |CRAN (R 4.5.2) | |later |1.4.6 |2026-02-13 |CRAN (R 4.5.2) | |lattice |0.22-7 |2025-04-02 |CRAN (R 4.5.2) | |lifecycle |1.0.5 |2026-01-08 |CRAN (R 4.5.2) | -|litedown |0.9 |2025-12-18 |CRAN (R 4.5.2) | |lme4 |1.1-38 |2025-12-02 |CRAN (R 4.5.2) | |lubridate |1.9.5 |2026-02-04 |CRAN (R 4.5.2) | |magrittr |2.0.4 |2025-09-12 |CRAN (R 4.5.0) | -|markdown |2.0 |2025-03-23 |CRAN (R 4.5.0) | |MASS |7.3-65 |2025-02-28 |CRAN (R 4.5.0) | |Matrix |1.7-4 |2025-08-28 |CRAN (R 4.5.2) | |memoise |2.0.1 |2021-11-26 |CRAN (R 4.5.0) | @@ -148,7 +135,6 @@ |openssl |2.3.4 |2025-09-30 |CRAN (R 4.5.0) | |openxlsx2 |1.23.1 |2026-01-19 |CRAN (R 4.5.2) | |otel |0.2.0 |2025-08-29 |CRAN (R 4.5.0) | -|pak |0.9.2 |2025-12-22 |CRAN (R 4.5.2) | |parameters |0.28.3 |2025-11-25 |CRAN (R 4.5.2) | |patchwork |1.3.2 |2025-08-25 |CRAN (R 4.5.0) | |pbmcapply |1.5.1 |2022-04-28 |CRAN (R 4.5.0) | @@ -172,7 +158,6 @@ |R6 |2.6.1 |2025-02-15 |CRAN (R 4.5.0) | |ragg |1.5.0 |2025-09-02 |CRAN (R 4.5.0) | |rankinPlot |1.1.0 |2023-01-30 |CRAN (R 4.5.0) | -|rappdirs |0.3.4 |2026-01-17 |CRAN (R 4.5.2) | |rbibutils |2.4.1 |2026-01-21 |CRAN (R 4.5.2) | |RColorBrewer |1.1-3 |2022-04-03 |CRAN (R 4.5.0) | |Rcpp |1.1.1 |2026-01-10 |CRAN (R 4.5.2) | @@ -205,7 +190,6 @@ |sessioninfo |1.2.3 |2025-02-05 |CRAN (R 4.5.0) | |shiny |1.13.0 |2026-02-20 |CRAN (R 4.5.2) | |shiny.i18n |0.3.0 |2023-01-16 |CRAN (R 4.5.0) | -|shiny2docker |0.0.3 |2025-06-28 |CRAN (R 4.5.0) | |shinybusy |0.3.3 |2024-03-09 |CRAN (R 4.5.0) | |shinyjs |2.1.1 |2026-01-15 |CRAN (R 4.5.2) | |shinyTime |1.0.3 |2022-08-19 |CRAN (R 4.5.0) | @@ -214,7 +198,6 @@ |stringi |1.8.7 |2025-03-27 |CRAN (R 4.5.0) | |stringr |1.6.0 |2025-11-04 |CRAN (R 4.5.0) | |stRoke |25.9.2 |2025-09-30 |CRAN (R 4.5.0) | -|sys |3.4.3 |2024-10-04 |CRAN (R 4.5.0) | |systemfonts |1.3.1 |2025-10-01 |CRAN (R 4.5.0) | |testthat |3.3.2 |2026-01-11 |CRAN (R 4.5.2) | |textshaping |1.0.4 |2025-10-10 |CRAN (R 4.5.0) | @@ -229,7 +212,6 @@ |tzdb |0.5.0 |2025-03-15 |CRAN (R 4.5.0) | |usethis |3.2.1 |2025-09-06 |CRAN (R 4.5.0) | |uuid |1.2-2 |2026-01-23 |CRAN (R 4.5.2) | -|V8 |8.0.1 |2025-10-10 |CRAN (R 4.5.0) | |vctrs |0.7.1 |2026-01-23 |CRAN (R 4.5.2) | |viridis |0.6.5 |2024-01-29 |CRAN (R 4.5.0) | |viridisLite |0.4.3 |2026-02-04 |CRAN (R 4.5.2) | @@ -240,5 +222,4 @@ |xml2 |1.5.2 |2026-01-17 |CRAN (R 4.5.2) | |xtable |1.8-4 |2019-04-21 |CRAN (R 4.5.0) | |yaml |2.3.12 |2025-12-10 |CRAN (R 4.5.2) | -|yesno |0.1.3 |2024-07-26 |CRAN (R 4.5.0) | |zip |2.3.3 |2025-05-13 |CRAN (R 4.5.0) | From 01b48dccb5deb3f5df8696a6f7a7c56ced4651df Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Wed, 11 Mar 2026 13:24:21 +0100 Subject: [PATCH 3/3] moved to new release. --- DESCRIPTION | 2 +- NEWS.md | 6 ++++-- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 1c5d410d..e47380cb 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: FreesearchR Title: Easy data analysis for clinicians -Version: 26.3.2 +Version: 26.3.3 Authors@R: c( person("Andreas Gammelgaard", "Damsbo",email="agdamsbo@clin.au.dk", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-7559-1154")), diff --git a/NEWS.md b/NEWS.md index 7c44be1a..e5800992 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,7 @@ +# FreesearchR 26.3.3 + +*NEW* option to pass global settings when running as docker or launching from R. Support for INCLUDE_GLOBALENV, DATA_LIMIT_DEFAULT, DATA_LIMIT_UPPER and DATA_LIMIT_LOWER. Docs are missing... + # FreesearchR 26.3.2 *FIX* Updating factor levels always created new factor. @@ -6,8 +10,6 @@ *NEW* New with_labels() function (and helpers) added to allow easy preservation of labels. -*NEW* option to pass global settings when running as docker or launching from R. Support for INCLUDE_GLOBALENV, DATA_LIMIT_DEFAULT, DATA_LIMIT_UPPER and DATA_LIMIT_LOWER. Docs will follow. - # FreesearchR 26.3.1 *FIX* ~~Include font files for static loading without dependency on Google.~~ Kept webfonts from google as local fonts are not working for now.