From d76c75bd93dd3773eb6ec850c3a12b9751f82708 Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Sat, 10 May 2025 13:02:04 +0200 Subject: [PATCH] quick additional update --- CITATION.cff | 2 +- DESCRIPTION | 2 +- NEWS.md | 10 +++ R/app_version.R | 2 +- R/contrast_text.R | 1 - R/create-column-mod.R | 14 +--- R/cut-variable-dates.R | 36 ++++----- R/data_plots.R | 1 + R/hosted_version.R | 2 +- R/plot_hbar.R | 5 +- R/plot_sankey.R | 5 +- R/regression_model.R | 9 ++- R/sysdata.rda | Bin 2152 -> 2271 bytes R/update-factor-ext.R | 6 +- R/update-variables-ext.R | 4 - SESSION.md | 20 ++++- inst/apps/FreesearchR/app.R | 157 +++++++++++++++++------------------- 17 files changed, 138 insertions(+), 138 deletions(-) diff --git a/CITATION.cff b/CITATION.cff index 25ca71c..f026dad 100644 --- a/CITATION.cff +++ b/CITATION.cff @@ -9,7 +9,7 @@ type: software license: AGPL-3.0-or-later title: 'FreesearchR: A free and open-source browser based data analysis tool for researchers with publication ready output' -version: 25.5.3 +version: 25.5.4 doi: 10.5281/zenodo.14527429 identifiers: - type: url diff --git a/DESCRIPTION b/DESCRIPTION index be82a04..5a9123e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: FreesearchR Title: A free and open-source browser based data analysis tool for researchers with publication ready output -Version: 25.5.3 +Version: 25.5.4 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 9c02423..5f097c1 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,13 @@ +# FreesearchR 25.5.4 + +- *FIX* correctly omit NAs in `data_type()` call + +- *FIX* omit NAs when plotting Euler diagrams. + +- *FIX* print correct labels in horizontal stacked bars. + +- *FIX* initial app load should feel faster. + # FreesearchR 25.5.3 - *FIX* a little polish on the data import diff --git a/R/app_version.R b/R/app_version.R index ba85500..5e843a2 100644 --- a/R/app_version.R +++ b/R/app_version.R @@ -1 +1 @@ -app_version <- function()'25.5.3' +app_version <- function()'25.5.4' diff --git a/R/contrast_text.R b/R/contrast_text.R index 9ea4c5b..1db2e56 100644 --- a/R/contrast_text.R +++ b/R/contrast_text.R @@ -25,7 +25,6 @@ #' contrast_text(c("#F2F2F2", "blue"), method="relative") #' @export #' -#' @importFrom grDevices col2rgb #' contrast_text <- function(background, light_text = 'white', diff --git a/R/create-column-mod.R b/R/create-column-mod.R index 9bb71c4..0bc2402 100644 --- a/R/create-column-mod.R +++ b/R/create-column-mod.R @@ -17,20 +17,17 @@ #' @export #' #' @importFrom htmltools tagList tags css -#' @importFrom shiny NS textInput textAreaInput uiOutput actionButton -#' @importFrom phosphoricons ph -#' @importFrom shinyWidgets virtualSelectInput #' #' @name create-column #' #' @example examples/create_column_module_demo.R create_column_ui <- function(id) { ns <- NS(id) - tagList( + htmltools::tagList( # datamods:::html_dependency_datamods(), # html_dependency_FreesearchR(), - tags$head( - tags$link(rel = "stylesheet", type = "text/css", href = "FreesearchR/inst/assets/css/FreesearchR.css") + shiny::tags$head( + shiny::tags$link(rel = "stylesheet", type = "text/css", href = "FreesearchR/inst/assets/css/FreesearchR.css") ), # tags$head( # # Note the wrapping of the string in HTML() @@ -84,7 +81,7 @@ create_column_ui <- function(id) { ) ) ), - textAreaInput( + shiny::textAreaInput( inputId = ns("expression"), label = i18n("Enter an expression to define new column:"), value = "", @@ -132,9 +129,6 @@ create_column_ui <- function(id) { #' #' @rdname create-column #' -#' @importFrom shiny moduleServer reactiveValues observeEvent renderUI req -#' updateTextAreaInput reactive bindEvent observe -#' @importFrom shinyWidgets alert updateVirtualSelect create_column_server <- function(id, data_r = reactive(NULL), allowed_operations = list_allowed_operations()) { diff --git a/R/cut-variable-dates.R b/R/cut-variable-dates.R index d3f95eb..9c78e73 100644 --- a/R/cut-variable-dates.R +++ b/R/cut-variable-dates.R @@ -1,9 +1,3 @@ -library(datamods) -library(toastui) -library(phosphoricons) -library(rlang) -library(shiny) - #' Extended cutting function with fall-back to the native base::cut #' #' @param x an object inheriting from class "hms" @@ -212,9 +206,9 @@ cut_variable_ui <- function(id) { shiny::fluidRow( column( width = 3, - virtualSelectInput( + shinyWidgets::virtualSelectInput( inputId = ns("variable"), - label = i18n("Variable to cut:"), + label = datamods:::i18n("Variable to cut:"), choices = NULL, width = "100%" ) @@ -227,7 +221,7 @@ cut_variable_ui <- function(id) { width = 3, numericInput( inputId = ns("n_breaks"), - label = i18n("Number of breaks:"), + label = datamods:::i18n("Number of breaks:"), value = 3, min = 2, max = 12, @@ -238,12 +232,12 @@ cut_variable_ui <- function(id) { width = 3, checkboxInput( inputId = ns("right"), - label = i18n("Close intervals on the right"), + label = datamods:::i18n("Close intervals on the right"), value = TRUE ), checkboxInput( inputId = ns("include_lowest"), - label = i18n("Include lowest value"), + label = datamods:::i18n("Include lowest value"), value = TRUE ) ) @@ -254,10 +248,10 @@ cut_variable_ui <- function(id) { uiOutput(outputId = ns("slider_fixed")) ), plotOutput(outputId = ns("plot"), width = "100%", height = "270px"), - datagridOutput2(outputId = ns("count")), + toastui::datagridOutput2(outputId = ns("count")), actionButton( inputId = ns("create"), - label = tagList(ph("scissors"), i18n("Create factor variable")), + label = tagList(phosphoricons::ph("scissors"), datamods:::i18n("Create factor variable")), class = "btn-outline-primary float-end" ), tags$div(class = "clearfix") @@ -288,7 +282,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { is.numeric(.x) || is_datetime(.x) }, logical(1)) vars_num <- names(vars_num)[vars_num] - updateVirtualSelect( + shinyWidgets::updateVirtualSelect( inputId = "variable", choices = vars_num, selected = if (isTruthy(input$variable)) input$variable else vars_num[1] @@ -325,9 +319,9 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { } - noUiSliderInput( + shinyWidgets::noUiSliderInput( inputId = session$ns("fixed_brks"), - label = i18n("Fixed breaks:"), + label = datamods:::i18n("Fixed breaks:"), min = lower, max = upper, value = brks, @@ -382,7 +376,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { shinyWidgets::virtualSelectInput( inputId = session$ns("method"), - label = i18n("Method:"), + label = datamods:::i18n("Method:"), choices = choices, selected = NULL, width = "100%" @@ -525,7 +519,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { data }) - output$count <- renderDatagrid2({ + output$count <- toastui::renderDatagrid2({ # shiny::req(rv$new_var_name) data <- req(data_cutted_r()) # variable <- req(input$variable) @@ -541,14 +535,14 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { datamods:::apply_grid_theme() } on.exit(toastui::reset_grid_theme()) - grid <- datagrid( + grid <- toastui::datagrid( data = count_data, colwidths = "guess", theme = "default", bodyHeight = "auto" ) grid <- toastui::grid_columns(grid, className = "font-monospace") - grid_colorbar( + toastui::grid_colorbar( grid, column = "count", label_outside = TRUE, @@ -576,7 +570,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { #' #' @rdname cut-variable modal_cut_variable <- function(id, - title = i18n("Convert Numeric to Factor"), + title = datamods:::i18n("Convert Numeric to Factor"), easyClose = TRUE, size = "l", footer = NULL) { diff --git a/R/data_plots.R b/R/data_plots.R index 8401bf8..1b07f43 100644 --- a/R/data_plots.R +++ b/R/data_plots.R @@ -681,6 +681,7 @@ create_plot <- function(data, type, pri, sec, ter = NULL, ...) { #' mtcars |> get_label() #' mtcars$mpg |> get_label() #' gtsummary::trial |> get_label(var = "trt") +#' gtsummary::trial$trt |> get_label() #' 1:10 |> get_label() get_label <- function(data, var = NULL) { # data <- if (is.reactive(data)) data() else data diff --git a/R/hosted_version.R b/R/hosted_version.R index 9f191af..596d4e2 100644 --- a/R/hosted_version.R +++ b/R/hosted_version.R @@ -1 +1 @@ -hosted_version <- function()'v25.5.3-250510' +hosted_version <- function()'v25.5.4-250510' diff --git a/R/plot_hbar.R b/R/plot_hbar.R index 84ead0d..deac70c 100644 --- a/R/plot_hbar.R +++ b/R/plot_hbar.R @@ -62,9 +62,8 @@ vertical_stacked_bars <- function(data, contrast_cut <- sum(contrast_text(colors, threshold = .3) == "white") - score_label <- ifelse(is.na(REDCapCAST::get_attr(data$score, "label")), score, REDCapCAST::get_attr(data$score, "label")) - group_label <- ifelse(is.na(REDCapCAST::get_attr(data$group, "label")), group, REDCapCAST::get_attr(data$group, "label")) - + score_label <- data |> get_label(var = score) + group_label <- data |> get_label(var = group) p |> (\(.x){ diff --git a/R/plot_sankey.R b/R/plot_sankey.R index 473e7b7..c45d46f 100644 --- a/R/plot_sankey.R +++ b/R/plot_sankey.R @@ -119,7 +119,6 @@ plot_sankey <- function(data, pri, sec, ter = NULL, color.group = "pri", colors #' plot_sankey_single("first", "last", color.group = "pri") #' mtcars |> #' default_parsing() |> -#' str() #' plot_sankey_single("cyl", "vs", color.group = "pri") plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), colors = NULL, ...) { color.group <- match.arg(color.group) @@ -132,8 +131,6 @@ plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), co data <- data |> sankey_ready(pri = pri, sec = sec, ...) - library(ggalluvial) - na.color <- "#2986cc" box.color <- "#1E4B66" @@ -197,6 +194,8 @@ plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), co ) } + ## Will fail to use stat="stratum" if library is not loaded. + library(ggalluvial) p + ggplot2::geom_text( stat = "stratum", diff --git a/R/regression_model.R b/R/regression_model.R index 252cbf1..df79cc1 100644 --- a/R/regression_model.R +++ b/R/regression_model.R @@ -271,12 +271,13 @@ data_type <- function(data) { sapply(data, data_type) } else { cl_d <- class(data) + l_unique <- length(unique(na.omit(data))) if (all(is.na(data))) { out <- "empty" - } else if (length(unique(data)) < 2) { + } else if (l_unique < 2) { out <- "monotone" - } else if (any(c("factor", "logical") %in% cl_d) | length(unique(data)) == 2) { - if (identical("logical", cl_d) | length(unique(data)) == 2) { + } else if (any(c("factor", "logical") %in% cl_d) | l_unique == 2) { + if (identical("logical", cl_d) | l_unique == 2) { out <- "dichotomous" } else { # if (is.ordered(data)) { @@ -289,7 +290,7 @@ data_type <- function(data) { out <- "text" } else if (any(c("hms", "Date", "POSIXct", "POSIXt") %in% cl_d)) { out <- "datetime" - } else if (!length(unique(data)) == 2) { + } else if (l_unique > 2) { ## Previously had all thinkable classes ## Now just assumes the class has not been defined above ## any(c("numeric", "integer", "hms", "Date", "timediff") %in% cl_d) & diff --git a/R/sysdata.rda b/R/sysdata.rda index 17176937b55b3e75ccefe450178e95d5e9a5a271..080cfc43cf6072f5714be37febe3ba7c56feec78 100644 GIT binary patch literal 2271 zcmV<52q5=DT4*^jL0KkKSyGRqIsg>O|Iq*cXaz!l|KNXb-@(8C|L{Nn5C8}P;0fOw zmm=fC)#;T^fF~2AAL2`(eFsxXf>gaP^n^mL%}f%4$Q# z!*irE(2v+%#nN=GrJ>Omc$8$wl2dWFBezp#676_WPAO`=wQt2tjAfk=}>Sx8o(CRK_e z18JBPH5A}GN`V!;(z1%yP3u|Z(4SS*OZQB$A5&Nm1M_G=5M_&rr21k0Zq+=Ct5-&ULY?SwE#kuM3JsV z5k-O|ycvnda`521a%sdJw#?H(1x#(Vw#bI5nVZQQQbU??tb!E{@fs63%}gB(#JD12 zc?^#9Qzv6YD1{18=;2h7L90>~<5)Q$OBSz>eVi2~vszNJsjE4l>0yiJ8aY^%F)d&L z$b=JXoKvJoHo6&7GISS(qkcdDW#uYe@iI2+RMI%jIPq(=y2@>=mwYO_aopc5)?=I) zTzAaK@DiHd)+B2rq#LqMnuZZ$T;g1^R&rwQxpc00}9e#{P(B}k;5w`^rZY_+zf$pEo& zB~V%K2fsV#7@Bo3vl)S_G-O~Ni)zT*ABv`OKu7>21xunP2$1e~4rT_KuD)>GLdvfB zO~?Rfp@LANwOpkJCA4XbuM%=(SrF!OVG2>Cv4Et@nHT6u&!e6I!?&PH!Z8LgQaud= zp3p5UEVHPSbd#&p=;+{3r7eA2#|EQHGK(n|UDJdxZKn-|8oGGPOV^s0;8uPS&-Ea= zBCbfH7LBQXmVl~C1gct4YJ!wQmz%8wSPC8gK1gCtn|rj)97Szc%<$~SDlAx$V90FB z$yZ@IQ>$zR7wfg=B}7w;19lnK>k z+g#Owfb}kCE{ZSnKN_ZHAZunIfCL;HsRQM|bO-=L*Wa##yJ$cG1J~)bbrWNMyR#94 zg_t$0N9E}Dj+}*ys!!r%WyhEO8WxRwz`*nMjpOt3`Ur@3dU?|%?;fvF1&YC62SSyR zCy?h=3~$*V)NYk>HBH znJ-S6s{CKeqLoS+)fK^G>wSfJ2$dt*O{HA*)llEk#Lg$w=&b7{#>Xeg;H4H5!#K6d z@wI{+5MwUETxFD0Z5-q+d0TD;nGj$sjjB;wA*ozvIF_y}a2I#d+ULYSS$)*pL07Mr z8m6-==YB(=7J3sAVzUG{XIantRCu#rCL!5##IQk@FV#jR9R2EMF`&$!s|~cm(R>>R z&gb$Sy!XtC3F48x7h1Mj8qL)OvQ1i^r%`%UMVEx)Y2ISOnP>~5(OcYkI=gQd^J>EjOi16?V8uvcFa>8C48$q8=eH65&2?g6?d7Kq z9}ejRK(o@y^wo=39tdu^}^&VsdI zT!qPaxzWVVh-5bHUHBN9i>pI3+O~FGpI+#EupF!5YGLo6PPnlo#`H7DAqFtIu&B+N z08l`X)4r#cMj6Z*{HX>+lq0aKQ44}kRKa!%)9@tvylfeQMy_Kf)Q}99B2hq1_);WC z5^_$B+;zUeII3erD;^ct(kL8zX}l1%<*}p}8h7VrE(60$;n;63GE98vIy8mqZD+#^ zD?)SOP|v#sz%x1HTEJmuwB3u@jV#t+=V5*>;!H%U#_PNu);T&Mlg^5WSSV?%i9Nl)yS+cC>eL42irGjR0 z4hO3K8Y@)nf&h?L70RsmYIfHF^`_o=8B)27EYqV`8-+00Xs*K6EuTcBow3Q&VV!7E-wH8 literal 2152 zcmV-u2$%OlT4*^jL0KkKS$(5h9Ni{ZrHp8fKtvKmY&$ z27mwqN`oUtng9bpXaF=cXfyx-GynuiO+>_-Ab`*`Jt3n&Gyni;pwYBI$$DJmCXq&Z z84U_sT7f{n0RcF_HZBoD>xf|S?&Zms0O1TgKOQa<7@r8HGD}j_FKkZb?7wSYMb3hN zCoTiOpx)m9R&7pK>eD-ag8tE}c(gn*OZ9&j1gG~L17E^0hR=29<;1`wK0KSq4jFJo zV>2>IP7-G>LJSsNp<5*N;AJQA`)~TN-3%{uhyV z?MoP0p8H+yl9_23y}H>w8H^Tr>t;Qqj)vw=)SqxDD))?X#nc@UQp{%4US3`DbbUp->f3{lOG9VhA^NB^YxGA(!X4Z1X@3Xehe+Jsf*=dqdx+08q)36*!16 zgn&pw42&Sb7L;053KUQUr2#={RHQ{vPF~LV&rvJN3rb#Q8_Fvf!JGs^xkO_3AQ*IK zT9XD_5mW^<(S^nmPcslRoi%hM)V1z4c!n65Ln*#ZX?D$FqVt=)Fc4DVB#f0467c73 zXE{|o>h36Pg+T@o#1Nr~qQM~tpd~q$Mp`NoDWVg))eIOS5=dC2JTw^ql0e+!?NXXe zQW5KUBU23YD&g3ua7QvzEC2wUK@kB6Xh_t}o6O?}2M-5^xK&YAbAb|S(&>{Jm`2kL zyRpqhGcL6Yb-dB133qokfh;0RNu7hCAqokc0Le_~q=7^P@+sXNWW+YT35JsuR8UAG zvr_n8YVn*_t{XVGy5X&jYfPB77|4>bjLSA~-6u)MzdKX@ZR6X=UteE`rIs|>0wN(56AVPb8V>_h zav)(0b}wxRN{Z^?stT&X0>ps@Vz(lVGDcfb-i{4Yl-DD5Xi-F=rXe8RS6s=r2R_Dn zur(+KqA-CNk}Stn7e1&6Mw)b@Ux4Z9W9HgaAkSXyv53MAL23e%RCkm$SdKfW)6v(l zdh!*E8e;aKJCIj$0ELFhev*KyNDe(4@cA|ji#8bbU{@xn4luq9^oW&xyVLCiX!@GjL|h+T9dGd^EIh&ilpF zP-?^^zJlzzzG!7&+N*R91VDgvwz-KxcnE<3a+H8 zBWgUn%A$PFQBqr7T~xp!uyrayqh>Qpj7E6}dfQ@`=O0e|UP$bczKS&`_|00fe;(B; zz|Ge#D<50udE!Dqtscv8opZY3)!TekSg%8j&Sbe>exEg{yr>lMYnAA01)LGHtWM}a zT67LH7Kh6F^_M^*Xf1}6mE}Ts)NE?s6+j4QO2wNyq4x@N5JctMOUlU6fYJ*Pq+ayG zkV7?dj}fz?IMyDuTY*-QY+1sEl7yXbt=DJ29hOG%iztH~#CP)C`bx367)eWziKVI9nQTAt7 z9gE%_w%NqDFvmwXDbt+nU`FNiym-S1$02YG(`X7vHVYTdH<5nSj`4im$`ds?L|ijd z4B{s!sW@X1LNq5N>d#IXNL6hni0>WCreV=LyVr;zd-k+~?z5{o>u?>`K0M9*Xr%eq z(_SlNkA|!6LUZ8}pZAL53Y#rb0*h?(Q?ZJI^Y(DANuu}wS0+TzfKh$ztOfv%xYIw@`tTHx7I?u?zSlOe=7 z9cSs$n5-}aC6_KXGpb<0Z%n#!3~63LZBpGHbc)_|2h6MxG|4Hdg6?n)>*=H5L~20; zHSOO=4RFWRHDlQP$$4fq?Hclb9)9)BbVyOD>q^GGwC9L^(v6AS@zr#_PFb#W(F%Ck euvLY$i+4!i1GYe3suTqu@pmLsg$W1cPriVyzRTYL diff --git a/R/update-factor-ext.R b/R/update-factor-ext.R index a394349..3fd4719 100644 --- a/R/update-factor-ext.R +++ b/R/update-factor-ext.R @@ -31,7 +31,7 @@ update_factor_ui <- function(id) { fluidRow( column( width = 6, - virtualSelectInput( + shinyWidgets::virtualSelectInput( inputId = ns("variable"), label = i18n("Factor variable to reorder:"), choices = NULL, @@ -66,10 +66,10 @@ update_factor_ui <- function(id) { ) ) ), - datagridOutput(ns("grid")), + toastui::datagridOutput(ns("grid")), tags$div( class = "float-end", - prettyCheckbox( + shinyWidgets::prettyCheckbox( inputId = ns("new_var"), label = i18n("Create a new variable (otherwise replaces the one selected)"), value = FALSE, diff --git a/R/update-variables-ext.R b/R/update-variables-ext.R index eb20a11..dbc64f8 100644 --- a/R/update-variables-ext.R +++ b/R/update-variables-ext.R @@ -1,7 +1,3 @@ -library(data.table) -library(rlang) - - #' Select, rename and convert variables #' #' @param id Module id. See [shiny::moduleServer()]. diff --git a/SESSION.md b/SESSION.md index 583ed1c..dc20f49 100644 --- a/SESSION.md +++ b/SESSION.md @@ -15,7 +15,7 @@ |rstudio |2024.12.1+563 Kousa Dogwood (desktop) | |pandoc |3.6.4 @ /opt/homebrew/bin/ (via rmarkdown) | |quarto |1.7.30 @ /usr/local/bin/quarto | -|FreesearchR |25.5.3.250510 | +|FreesearchR |25.5.4.250510 | -------------------------------------------------------------------------------- @@ -38,14 +38,12 @@ |cachem |1.1.0 |2024-05-16 |CRAN (R 4.4.1) | |cellranger |1.1.0 |2016-07-27 |CRAN (R 4.4.0) | |cffr |1.2.0 |2025-01-25 |CRAN (R 4.4.1) | -|checkmate |2.3.2 |2024-07-29 |CRAN (R 4.4.0) | |class |7.3-23 |2025-01-01 |CRAN (R 4.4.1) | |classInt |0.4-11 |2025-01-08 |CRAN (R 4.4.1) | |cli |3.6.5 |2025-04-23 |CRAN (R 4.4.1) | |commonmark |1.9.5 |2025-03-17 |CRAN (R 4.4.1) | |correlation |0.8.7 |2025-03-03 |CRAN (R 4.4.1) | |crayon |1.5.3 |2024-06-20 |CRAN (R 4.4.1) | -|crosstalk |1.2.1 |2023-11-23 |CRAN (R 4.4.0) | |curl |6.2.2 |2025-03-24 |CRAN (R 4.4.1) | |data.table |1.17.0 |2025-02-22 |CRAN (R 4.4.1) | |datamods |1.5.3 |2024-10-02 |CRAN (R 4.4.1) | @@ -60,6 +58,7 @@ |easystats |0.7.4 |2025-02-06 |CRAN (R 4.4.1) | |effectsize |1.0.0 |2024-12-10 |CRAN (R 4.4.1) | |ellipsis |0.3.2 |2021-04-29 |CRAN (R 4.4.1) | +|eulerr |7.0.2 |2024-03-28 |CRAN (R 4.4.0) | |evaluate |1.0.3 |2025-01-10 |CRAN (R 4.4.1) | |farver |2.1.2 |2024-05-13 |CRAN (R 4.4.1) | |fastmap |1.2.0 |2024-05-15 |CRAN (R 4.4.1) | @@ -67,8 +66,11 @@ |forcats |1.0.0 |2023-01-29 |CRAN (R 4.4.0) | |fs |1.6.6 |2025-04-12 |CRAN (R 4.4.1) | |generics |0.1.3 |2022-07-05 |CRAN (R 4.4.1) | +|ggalluvial |0.12.5 |2023-02-22 |CRAN (R 4.4.0) | +|ggforce |0.4.2 |2024-02-19 |CRAN (R 4.4.0) | |ggplot2 |3.5.2 |2025-04-09 |CRAN (R 4.4.1) | |glue |1.8.0 |2024-09-30 |CRAN (R 4.4.1) | +|gridExtra |2.3 |2017-09-09 |CRAN (R 4.4.1) | |gt |1.0.0 |2025-04-05 |CRAN (R 4.4.1) | |gtable |0.3.6 |2024-10-25 |CRAN (R 4.4.1) | |gtsummary |2.2.0 |2025-04-14 |CRAN (R 4.4.1) | @@ -78,7 +80,6 @@ |htmltools |0.5.8.1 |2024-04-04 |CRAN (R 4.4.1) | |htmlwidgets |1.6.4 |2023-12-06 |CRAN (R 4.4.0) | |httpuv |1.6.16 |2025-04-16 |CRAN (R 4.4.1) | -|httr |1.4.7 |2023-08-15 |CRAN (R 4.4.0) | |IDEAFilter |0.2.0 |2024-04-15 |CRAN (R 4.4.0) | |insight |1.2.0 |2025-04-22 |CRAN (R 4.4.1) | |jquerylib |0.1.4 |2021-04-26 |CRAN (R 4.4.0) | @@ -87,6 +88,7 @@ |KernSmooth |2.23-26 |2025-01-01 |CRAN (R 4.4.1) | |keyring |1.3.2 |2023-12-11 |CRAN (R 4.4.0) | |knitr |1.50 |2025-03-16 |CRAN (R 4.4.1) | +|labeling |0.4.3 |2023-08-29 |CRAN (R 4.4.1) | |later |1.4.2 |2025-04-08 |CRAN (R 4.4.1) | |lattice |0.22-7 |2025-04-02 |CRAN (R 4.4.1) | |lifecycle |1.0.4 |2023-11-07 |CRAN (R 4.4.1) | @@ -111,6 +113,8 @@ |pkgbuild |1.4.7 |2025-03-24 |CRAN (R 4.4.1) | |pkgconfig |2.0.3 |2019-09-22 |CRAN (R 4.4.1) | |pkgload |1.4.0 |2024-06-28 |CRAN (R 4.4.0) | +|polyclip |1.10-7 |2024-07-23 |CRAN (R 4.4.1) | +|polylabelr |0.3.0 |2024-11-19 |CRAN (R 4.4.1) | |processx |3.8.6 |2025-02-21 |CRAN (R 4.4.1) | |profvis |0.4.0 |2024-09-20 |CRAN (R 4.4.1) | |promises |1.3.2 |2024-11-28 |CRAN (R 4.4.1) | @@ -123,6 +127,8 @@ |R.oo |1.27.0 |2024-11-01 |CRAN (R 4.4.1) | |R.utils |2.13.0 |2025-02-24 |CRAN (R 4.4.1) | |R6 |2.6.1 |2025-02-15 |CRAN (R 4.4.1) | +|ragg |1.4.0 |2025-04-10 |CRAN (R 4.4.1) | +|rankinPlot |1.1.0 |2023-01-30 |CRAN (R 4.4.0) | |rbibutils |2.3 |2024-10-04 |CRAN (R 4.4.1) | |RColorBrewer |1.1-3 |2022-04-03 |CRAN (R 4.4.1) | |Rcpp |1.0.14 |2025-01-12 |CRAN (R 4.4.1) | @@ -156,15 +162,21 @@ |stringi |1.8.7 |2025-03-27 |CRAN (R 4.4.1) | |stringr |1.5.1 |2023-11-14 |CRAN (R 4.4.0) | |styler |1.10.3 |2024-04-07 |CRAN (R 4.4.0) | +|systemfonts |1.2.2 |2025-04-04 |CRAN (R 4.4.1) | +|textshaping |1.0.0 |2025-01-20 |CRAN (R 4.4.1) | |tibble |3.2.1 |2023-03-20 |CRAN (R 4.4.0) | |tidyr |1.3.1 |2024-01-24 |CRAN (R 4.4.1) | |tidyselect |1.2.1 |2024-03-11 |CRAN (R 4.4.0) | |toastui |0.4.0 |2025-04-03 |CRAN (R 4.4.1) | +|tweenr |2.0.3 |2024-02-26 |CRAN (R 4.4.0) | |tzdb |0.5.0 |2025-03-15 |CRAN (R 4.4.1) | |urlchecker |1.0.1 |2021-11-30 |CRAN (R 4.4.1) | |usethis |3.1.0 |2024-11-26 |CRAN (R 4.4.1) | +|utf8 |1.2.4 |2023-10-22 |CRAN (R 4.4.1) | |V8 |6.0.3 |2025-03-26 |CRAN (R 4.4.1) | |vctrs |0.6.5 |2023-12-01 |CRAN (R 4.4.0) | +|viridis |0.6.5 |2024-01-29 |CRAN (R 4.4.0) | +|viridisLite |0.4.2 |2023-05-02 |CRAN (R 4.4.1) | |vroom |1.6.5 |2023-12-05 |CRAN (R 4.4.0) | |withr |3.0.2 |2024-10-28 |CRAN (R 4.4.1) | |writexl |1.5.4 |2025-04-15 |CRAN (R 4.4.1) | diff --git a/inst/apps/FreesearchR/app.R b/inst/apps/FreesearchR/app.R index 34302d2..7dff724 100644 --- a/inst/apps/FreesearchR/app.R +++ b/inst/apps/FreesearchR/app.R @@ -1,5 +1,44 @@ +######## +#### Current file: /Users/au301842/FreesearchR/app/libs.R +######## + +library(shiny) +# library(shinyjs) +# library(methods) +# library(readr) +# library(MASS) +# library(stats) +# library(gt) +# library(openxlsx2) +# library(haven) +# library(readODS) +# library(bslib) +# library(assertthat) +# library(dplyr) +# library(quarto) +# library(here) +# library(broom) +# library(broom.helpers) +# library(easystats) +# library(patchwork) +# library(DHARMa) +# library(apexcharter) +library(toastui) +# library(datamods) +# library(IDEAFilter) +library(shinyWidgets) +# library(DT) +# library(data.table) +# library(gtsummary) +library(bsicons) +library(rlang) +# library(datamods) +# library(toastui) +# library(phosphoricons) + + ######## #### Current file: /Users/au301842/FreesearchR/app/functions.R ######## @@ -10,7 +49,7 @@ #### Current file: /Users/au301842/FreesearchR/R//app_version.R ######## -app_version <- function()'25.5.2' +app_version <- function()'25.5.3' ######## @@ -129,7 +168,6 @@ create_baseline <- function(data, ..., by.var, add.p = FALSE, add.overall = FALS #' contrast_text(c("#F2F2F2", "blue"), method="relative") #' @export #' -#' @importFrom grDevices col2rgb #' contrast_text <- function(background, light_text = 'white', @@ -323,20 +361,17 @@ sentence_paste <- function(data, and.str = "and") { #' @export #' #' @importFrom htmltools tagList tags css -#' @importFrom shiny NS textInput textAreaInput uiOutput actionButton -#' @importFrom phosphoricons ph -#' @importFrom shinyWidgets virtualSelectInput #' #' @name create-column #' #' @example examples/create_column_module_demo.R create_column_ui <- function(id) { ns <- NS(id) - tagList( + htmltools::tagList( # datamods:::html_dependency_datamods(), # html_dependency_FreesearchR(), - tags$head( - tags$link(rel = "stylesheet", type = "text/css", href = "FreesearchR/inst/assets/css/FreesearchR.css") + shiny::tags$head( + shiny::tags$link(rel = "stylesheet", type = "text/css", href = "FreesearchR/inst/assets/css/FreesearchR.css") ), # tags$head( # # Note the wrapping of the string in HTML() @@ -390,7 +425,7 @@ create_column_ui <- function(id) { ) ) ), - textAreaInput( + shiny::textAreaInput( inputId = ns("expression"), label = i18n("Enter an expression to define new column:"), value = "", @@ -438,9 +473,6 @@ create_column_ui <- function(id) { #' #' @rdname create-column #' -#' @importFrom shiny moduleServer reactiveValues observeEvent renderUI req -#' updateTextAreaInput reactive bindEvent observe -#' @importFrom shinyWidgets alert updateVirtualSelect create_column_server <- function(id, data_r = reactive(NULL), allowed_operations = list_allowed_operations()) { @@ -947,12 +979,6 @@ vectorSelectInput <- function(inputId, #### Current file: /Users/au301842/FreesearchR/R//cut-variable-dates.R ######## -library(datamods) -library(toastui) -library(phosphoricons) -library(rlang) -library(shiny) - #' Extended cutting function with fall-back to the native base::cut #' #' @param x an object inheriting from class "hms" @@ -1161,9 +1187,9 @@ cut_variable_ui <- function(id) { shiny::fluidRow( column( width = 3, - virtualSelectInput( + shinyWidgets::virtualSelectInput( inputId = ns("variable"), - label = i18n("Variable to cut:"), + label = datamods:::i18n("Variable to cut:"), choices = NULL, width = "100%" ) @@ -1176,7 +1202,7 @@ cut_variable_ui <- function(id) { width = 3, numericInput( inputId = ns("n_breaks"), - label = i18n("Number of breaks:"), + label = datamods:::i18n("Number of breaks:"), value = 3, min = 2, max = 12, @@ -1187,12 +1213,12 @@ cut_variable_ui <- function(id) { width = 3, checkboxInput( inputId = ns("right"), - label = i18n("Close intervals on the right"), + label = datamods:::i18n("Close intervals on the right"), value = TRUE ), checkboxInput( inputId = ns("include_lowest"), - label = i18n("Include lowest value"), + label = datamods:::i18n("Include lowest value"), value = TRUE ) ) @@ -1203,10 +1229,10 @@ cut_variable_ui <- function(id) { uiOutput(outputId = ns("slider_fixed")) ), plotOutput(outputId = ns("plot"), width = "100%", height = "270px"), - datagridOutput2(outputId = ns("count")), + toastui::datagridOutput2(outputId = ns("count")), actionButton( inputId = ns("create"), - label = tagList(ph("scissors"), i18n("Create factor variable")), + label = tagList(phosphoricons::ph("scissors"), datamods:::i18n("Create factor variable")), class = "btn-outline-primary float-end" ), tags$div(class = "clearfix") @@ -1237,7 +1263,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { is.numeric(.x) || is_datetime(.x) }, logical(1)) vars_num <- names(vars_num)[vars_num] - updateVirtualSelect( + shinyWidgets::updateVirtualSelect( inputId = "variable", choices = vars_num, selected = if (isTruthy(input$variable)) input$variable else vars_num[1] @@ -1274,9 +1300,9 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { } - noUiSliderInput( + shinyWidgets::noUiSliderInput( inputId = session$ns("fixed_brks"), - label = i18n("Fixed breaks:"), + label = datamods:::i18n("Fixed breaks:"), min = lower, max = upper, value = brks, @@ -1331,7 +1357,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { shinyWidgets::virtualSelectInput( inputId = session$ns("method"), - label = i18n("Method:"), + label = datamods:::i18n("Method:"), choices = choices, selected = NULL, width = "100%" @@ -1474,7 +1500,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { data }) - output$count <- renderDatagrid2({ + output$count <- toastui::renderDatagrid2({ # shiny::req(rv$new_var_name) data <- req(data_cutted_r()) # variable <- req(input$variable) @@ -1490,14 +1516,14 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { datamods:::apply_grid_theme() } on.exit(toastui::reset_grid_theme()) - grid <- datagrid( + grid <- toastui::datagrid( data = count_data, colwidths = "guess", theme = "default", bodyHeight = "auto" ) grid <- toastui::grid_columns(grid, className = "font-monospace") - grid_colorbar( + toastui::grid_colorbar( grid, column = "count", label_outside = TRUE, @@ -1525,7 +1551,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { #' #' @rdname cut-variable modal_cut_variable <- function(id, - title = i18n("Convert Numeric to Factor"), + title = datamods:::i18n("Convert Numeric to Factor"), easyClose = TRUE, size = "l", footer = NULL) { @@ -2255,6 +2281,7 @@ create_plot <- function(data, type, pri, sec, ter = NULL, ...) { #' mtcars |> get_label() #' mtcars$mpg |> get_label() #' gtsummary::trial |> get_label(var = "trt") +#' gtsummary::trial$trt |> get_label() #' 1:10 |> get_label() get_label <- function(data, var = NULL) { # data <- if (is.reactive(data)) data() else data @@ -3969,7 +3996,7 @@ simple_snake <- function(data){ #### Current file: /Users/au301842/FreesearchR/R//hosted_version.R ######## -hosted_version <- function()'v25.5.2-250510' +hosted_version <- function()'v25.5.3-250510' ######## @@ -4807,10 +4834,11 @@ plot_euler <- function(data, pri, sec, ter = NULL, seed = 2103) { out <- lapply(ds, \(.x){ .x[c(pri, sec)] |> as.data.frame() |> + na.omit() |> plot_euler_single() }) -# names(out) + # names(out) wrap_plot_list(out) # patchwork::wrap_plots(out, guides = "collect") } @@ -4922,9 +4950,8 @@ vertical_stacked_bars <- function(data, contrast_cut <- sum(contrast_text(colors, threshold = .3) == "white") - score_label <- ifelse(is.na(REDCapCAST::get_attr(data$score, "label")), score, REDCapCAST::get_attr(data$score, "label")) - group_label <- ifelse(is.na(REDCapCAST::get_attr(data$group, "label")), group, REDCapCAST::get_attr(data$group, "label")) - + score_label <- data |> get_label(var = score) + group_label <- data |> get_label(var = group) p |> (\(.x){ @@ -5114,7 +5141,6 @@ plot_sankey <- function(data, pri, sec, ter = NULL, color.group = "pri", colors #' plot_sankey_single("first", "last", color.group = "pri") #' mtcars |> #' default_parsing() |> -#' str() #' plot_sankey_single("cyl", "vs", color.group = "pri") plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), colors = NULL, ...) { color.group <- match.arg(color.group) @@ -5127,8 +5153,6 @@ plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), co data <- data |> sankey_ready(pri = pri, sec = sec, ...) - library(ggalluvial) - na.color <- "#2986cc" box.color <- "#1E4B66" @@ -5192,6 +5216,8 @@ plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), co ) } + ## Will fail to use stat="stratum" if library is not loaded. + library(ggalluvial) p + ggplot2::geom_text( stat = "stratum", @@ -6346,12 +6372,13 @@ data_type <- function(data) { sapply(data, data_type) } else { cl_d <- class(data) + l_unique <- length(unique(na.omit(data))) if (all(is.na(data))) { out <- "empty" - } else if (length(unique(data)) < 2) { + } else if (l_unique < 2) { out <- "monotone" - } else if (any(c("factor", "logical") %in% cl_d) | length(unique(data)) == 2) { - if (identical("logical", cl_d) | length(unique(data)) == 2) { + } else if (any(c("factor", "logical") %in% cl_d) | l_unique == 2) { + if (identical("logical", cl_d) | l_unique == 2) { out <- "dichotomous" } else { # if (is.ordered(data)) { @@ -6364,7 +6391,7 @@ data_type <- function(data) { out <- "text" } else if (any(c("hms", "Date", "POSIXct", "POSIXt") %in% cl_d)) { out <- "datetime" - } else if (!length(unique(data)) == 2) { + } else if (l_unique > 2) { ## Previously had all thinkable classes ## Now just assumes the class has not been defined above ## any(c("numeric", "integer", "hms", "Date", "timediff") %in% cl_d) & @@ -8039,7 +8066,7 @@ update_factor_ui <- function(id) { fluidRow( column( width = 6, - virtualSelectInput( + shinyWidgets::virtualSelectInput( inputId = ns("variable"), label = i18n("Factor variable to reorder:"), choices = NULL, @@ -8074,10 +8101,10 @@ update_factor_ui <- function(id) { ) ) ), - datagridOutput(ns("grid")), + toastui::datagridOutput(ns("grid")), tags$div( class = "float-end", - prettyCheckbox( + shinyWidgets::prettyCheckbox( inputId = ns("new_var"), label = i18n("Create a new variable (otherwise replaces the one selected)"), value = FALSE, @@ -8303,10 +8330,6 @@ winbox_update_factor <- function(id, #### Current file: /Users/au301842/FreesearchR/R//update-variables-ext.R ######## -library(data.table) -library(rlang) - - #' Select, rename and convert variables #' #' @param id Module id. See [shiny::moduleServer()]. @@ -9870,35 +9893,7 @@ ui <- bslib::page_fixed( #### Current file: /Users/au301842/FreesearchR/app/server.R ######## -library(shiny) -# library(shinyjs) -# library(methods) -library(readr) -library(MASS) -library(stats) -library(gt) -# library(openxlsx2) -library(haven) -library(readODS) -library(bslib) -library(assertthat) -library(dplyr) -library(quarto) -library(here) -library(broom) -library(broom.helpers) -library(easystats) -library(patchwork) -library(DHARMa) -library(apexcharter) -library(toastui) -library(datamods) -library(IDEAFilter) -library(shinyWidgets) -library(DT) -library(data.table) -library(gtsummary) -library(bsicons) + data(starwars) data(mtcars)