diff --git a/CITATION.cff b/CITATION.cff
index 29f48145..f026dade 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.2
+version: 25.5.4
doi: 10.5281/zenodo.14527429
identifiers:
- type: url
diff --git a/DESCRIPTION b/DESCRIPTION
index 87cc929d..5a9123e7 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.2
+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/NAMESPACE b/NAMESPACE
index 186ab21a..cbc6d0ec 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -108,6 +108,7 @@ export(sankey_ready)
export(selectInputIcon)
export(set_column_label)
export(show_data)
+export(simple_snake)
export(sort_by)
export(specify_qmd_format)
export(subset_types)
@@ -130,7 +131,6 @@ export(write_quarto)
importFrom(classInt,classIntervals)
importFrom(data.table,as.data.table)
importFrom(data.table,data.table)
-importFrom(grDevices,col2rgb)
importFrom(graphics,abline)
importFrom(graphics,axis)
importFrom(graphics,hist)
@@ -141,7 +141,6 @@ importFrom(htmltools,css)
importFrom(htmltools,tagList)
importFrom(htmltools,tags)
importFrom(htmltools,validateCssUnit)
-importFrom(phosphoricons,ph)
importFrom(rlang,"%||%")
importFrom(rlang,call2)
importFrom(rlang,expr)
@@ -160,25 +159,20 @@ importFrom(shiny,isTruthy)
importFrom(shiny,modalDialog)
importFrom(shiny,moduleServer)
importFrom(shiny,numericInput)
-importFrom(shiny,observe)
importFrom(shiny,observeEvent)
importFrom(shiny,plotOutput)
importFrom(shiny,reactive)
importFrom(shiny,reactiveValues)
importFrom(shiny,renderPlot)
-importFrom(shiny,renderUI)
importFrom(shiny,req)
importFrom(shiny,restoreInput)
importFrom(shiny,selectizeInput)
importFrom(shiny,showModal)
importFrom(shiny,tagList)
-importFrom(shiny,textAreaInput)
importFrom(shiny,textInput)
importFrom(shiny,uiOutput)
importFrom(shiny,updateActionButton)
-importFrom(shiny,updateTextAreaInput)
importFrom(shinyWidgets,WinBox)
-importFrom(shinyWidgets,alert)
importFrom(shinyWidgets,noUiSliderInput)
importFrom(shinyWidgets,prettyCheckbox)
importFrom(shinyWidgets,updateVirtualSelect)
diff --git a/NEWS.md b/NEWS.md
index 07731215..5f097c19 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,3 +1,21 @@
+# 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
+
+- *FIX* polished REDCap import and new code to reference the `REDCapCAST::easy_redcap()` function.
+
+- *FIX* updated documentation to reflect new private hosting on a Hetzner server in Germany.
+
# FreesearchR 25.5.2
- *FIX*: correct export of plots. The solution in the last version broke more than it solved.
diff --git a/R/app_version.R b/R/app_version.R
index eca6bb3a..5e843a23 100644
--- a/R/app_version.R
+++ b/R/app_version.R
@@ -1 +1 @@
-app_version <- function()'25.5.2'
+app_version <- function()'25.5.4'
diff --git a/R/contrast_text.R b/R/contrast_text.R
index 9ea4c5ba..1db2e562 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 9bb71c49..0bc24026 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 d3f95eb5..9c78e73c 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 8401bf87..1b07f43b 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/datagrid-infos-mod.R b/R/datagrid-infos-mod.R
index 1a250d77..8d898f77 100644
--- a/R/datagrid-infos-mod.R
+++ b/R/datagrid-infos-mod.R
@@ -35,7 +35,7 @@ show_data <- function(data,
if (is.null(options))
options <- list()
- options$height <- 550
+ options$height <- 500
options$minBodyHeight <- 400
options$data <- data
options$theme <- "default"
diff --git a/R/helpers.R b/R/helpers.R
index 377badb5..73129194 100644
--- a/R/helpers.R
+++ b/R/helpers.R
@@ -652,3 +652,17 @@ is_identical_to_previous <- function(data, no.name = TRUE) {
}
}, FUN.VALUE = logical(1))
}
+
+
+#' Simplified version of the snakecase packages to_snake_case
+#'
+#' @param data character string vector
+#'
+#' @returns vector
+#' @export
+#'
+#' @examples
+#' c("foo bar", "fooBar21", "!!Foo'B'a-r", "foo_bar", "F OO bar") |> simple_snake()
+simple_snake <- function(data){
+ gsub("[\\s+]","_",gsub("[^\\w\\s:-]", "", tolower(data), perl=TRUE), perl=TRUE)
+}
diff --git a/R/hosted_version.R b/R/hosted_version.R
index 5feb2555..596d4e21 100644
--- a/R/hosted_version.R
+++ b/R/hosted_version.R
@@ -1 +1 @@
-hosted_version <- function()'v25.5.2-250508'
+hosted_version <- function()'v25.5.4-250510'
diff --git a/R/plot_euler.R b/R/plot_euler.R
index 4dff9de5..10156b74 100644
--- a/R/plot_euler.R
+++ b/R/plot_euler.R
@@ -87,10 +87,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")
}
diff --git a/R/plot_hbar.R b/R/plot_hbar.R
index 84ead0da..deac70c0 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 473e7b77..c45d46f2 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/redcap.R b/R/redcap.R
deleted file mode 100644
index e69de29b..00000000
diff --git a/R/redcap_read_shiny_module.R b/R/redcap_read_shiny_module.R
index 8857e5f0..9499e7d3 100644
--- a/R/redcap_read_shiny_module.R
+++ b/R/redcap_read_shiny_module.R
@@ -200,9 +200,12 @@ m_redcap_readServer <- function(id) {
)
# browser()
- shiny::withProgress({
- imported <- try(rlang::exec(REDCapR::redcap_metadata_read, !!!parameters), silent = TRUE)
- },message = paste("Connecting to",data_rv$uri))
+ shiny::withProgress(
+ {
+ imported <- try(rlang::exec(REDCapR::redcap_metadata_read, !!!parameters), silent = TRUE)
+ },
+ message = paste("Connecting to", data_rv$uri)
+ )
## TODO: Simplify error messages
if (inherits(imported, "try-error") || NROW(imported) < 1 || ifelse(is.list(imported), !isTRUE(imported$success), FALSE)) {
@@ -228,7 +231,7 @@ m_redcap_readServer <- function(id) {
status = "success",
include_data_alert(
see_data_text = "Click to see data dictionary",
- dataIdName = "see_data",
+ dataIdName = "see_dd",
extra = tags$p(
tags$b(phosphoricons::ph("check", weight = "bold"), "Connected to server!"),
glue::glue("The {data_rv$info$project_title} project is loaded.")
@@ -254,8 +257,8 @@ m_redcap_readServer <- function(id) {
output$connect_success <- shiny::reactive(identical(data_rv$dd_status, "success"))
shiny::outputOptions(output, "connect_success", suspendWhenHidden = FALSE)
- shiny::observeEvent(input$see_data, {
- datamods::show_data(
+ shiny::observeEvent(input$see_dd, {
+ show_data(
purrr::pluck(data_rv$dd_list, "data"),
title = "Data dictionary",
type = "modal",
@@ -264,6 +267,17 @@ m_redcap_readServer <- function(id) {
)
})
+ shiny::observeEvent(input$see_data, {
+ show_data(
+ # purrr::pluck(data_rv$dd_list, "data"),
+ data_rv$data,
+ title = "Imported data set",
+ type = "modal",
+ show_classes = FALSE,
+ tags$b("Preview:")
+ )
+ })
+
arms <- shiny::reactive({
shiny::req(input$api)
shiny::req(data_rv$uri)
@@ -378,13 +392,24 @@ m_redcap_readServer <- function(id) {
imported <- try(rlang::exec(REDCapCAST::read_redcap_tables, !!!parameters), silent = TRUE)
})
- code <- rlang::call2("read_redcap_tables",
- !!!utils::modifyList(parameters, list(token = "PERSONAL_API_TOKEN")), ,
+ parameters_code <- parameters[c("uri", "fields", "events", "raw_or_label", "filter_logic")]
+
+ code <- rlang::call2(
+ "easy_redcap",
+ !!!utils::modifyList(
+ parameters_code,
+ list(
+ data_format = ifelse(
+ input$data_type == "long" && !is.null(input$data_type),
+ "long",
+ "wide"
+ ),
+ project.name = simple_snake(data_rv$info$project_title)
+ )
+ ),
.ns = "REDCapCAST"
)
- # browser()
-
if (inherits(imported, "try-error") || NROW(imported) < 1) {
data_rv$data_status <- "error"
data_rv$data_list <- NULL
@@ -453,9 +478,17 @@ m_redcap_readServer <- function(id) {
datamods:::insert_alert(
selector = ns("retrieved"),
status = data_rv$data_status,
- tags$p(
- tags$b(phosphoricons::ph("check", weight = "bold"), "Success!"),
- data_rv$data_message
+ # tags$p(
+ # tags$b(phosphoricons::ph("check", weight = "bold"), "Success!"),
+ # data_rv$data_message
+ # ),
+ include_data_alert(
+ see_data_text = "Click to see the imported data",
+ dataIdName = "see_data",
+ extra = tags$p(
+ tags$b(phosphoricons::ph("check", weight = "bold"), data_rv$data_message)
+ ),
+ btn_show_data = TRUE
)
)
} else {
diff --git a/R/regression_model.R b/R/regression_model.R
index 252cbf16..df79cc16 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 57d54ffe..080cfc43 100644
Binary files a/R/sysdata.rda and b/R/sysdata.rda differ
diff --git a/R/update-factor-ext.R b/R/update-factor-ext.R
index a3943495..3fd4719e 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 eb20a11a..dbc64f8a 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/README.md b/README.md
index 99d8d012..66297f9b 100644
--- a/README.md
+++ b/README.md
@@ -7,9 +7,9 @@
[](https://agdamsbo.shinyapps.io/FreesearchR/)
-The [***FreesearchR***](https://agdamsbo.shinyapps.io/FreesearchR/) is a simple, clinical health data exploration and analysis tool to democratise clinical research by assisting any researcher to easily evaluate and analyse data and export publication ready results.
+The [***FreesearchR***](https://app.freesearchr.org) is a simple, clinical health data exploration and analysis tool to democratise clinical research by assisting any researcher to easily evaluate and analyse data and export publication ready results.
-[***FreesearchR***](https://agdamsbo.shinyapps.io/FreesearchR/) is free and open-source, and is directly accessible here: [link to the app freely hosted on shinyapps.io](https://agdamsbo.shinyapps.io/FreesearchR/). The app can also run locally, please see below.
+[***FreesearchR***](https://app.freesearchr.org) is free and open-source, and is [accessible in your web browser through this link](https://app.freesearchr.org). The app can also run locally, please [see below](#run-locally-on-your-own-machine-sec-run-locally).
All feedback is welcome and can be shared as a GitHub issue. Any suggestions on collaboration is much welcomed. Please reach out!
diff --git a/SESSION.md b/SESSION.md
index da151864..dc20f495 100644
--- a/SESSION.md
+++ b/SESSION.md
@@ -11,11 +11,11 @@
|collate |en_US.UTF-8 |
|ctype |en_US.UTF-8 |
|tz |Europe/Copenhagen |
-|date |2025-05-08 |
+|date |2025-05-10 |
|rstudio |2024.12.1+563 Kousa Dogwood (desktop) |
|pandoc |3.6.4 @ /opt/homebrew/bin/ (via rmarkdown) |
-|quarto |1.6.40 @ /usr/local/bin/quarto |
-|FreesearchR |25.5.2.250508 |
+|quarto |1.7.30 @ /usr/local/bin/quarto |
+|FreesearchR |25.5.4.250510 |
--------------------------------------------------------------------------------
@@ -44,7 +44,6 @@
|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) |
@@ -59,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) |
@@ -66,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) |
@@ -85,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) |
@@ -101,7 +105,6 @@
|nloptr |2.2.1 |2025-03-17 |CRAN (R 4.4.1) |
|openssl |2.3.2 |2025-02-03 |CRAN (R 4.4.1) |
|openxlsx2 |1.15 |2025-04-25 |CRAN (R 4.4.1) |
-|pak |0.8.0.2 |2025-04-08 |CRAN (R 4.4.1) |
|parameters |0.24.2 |2025-03-04 |CRAN (R 4.4.1) |
|patchwork |1.3.0 |2024-09-16 |CRAN (R 4.4.1) |
|performance |0.13.0 |2025-01-15 |CRAN (R 4.4.1) |
@@ -110,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) |
@@ -122,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) |
@@ -139,6 +146,7 @@
|rio |1.2.3 |2024-09-25 |CRAN (R 4.4.1) |
|rlang |1.1.6 |2025-04-11 |CRAN (R 4.4.1) |
|rmarkdown |2.29 |2024-11-04 |CRAN (R 4.4.1) |
+|roxygen2 |7.3.2 |2024-06-28 |CRAN (R 4.4.0) |
|rprojroot |2.0.4 |2023-11-05 |CRAN (R 4.4.1) |
|rsconnect |1.3.4 |2025-01-22 |CRAN (R 4.4.1) |
|rstudioapi |0.17.1 |2024-10-22 |CRAN (R 4.4.1) |
@@ -152,16 +160,23 @@
|shinyTime |1.0.3 |2022-08-19 |CRAN (R 4.4.0) |
|shinyWidgets |0.9.0 |2025-02-21 |CRAN (R 4.4.1) |
|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/_pkgdown.yml b/_pkgdown.yml
index 47ca9e1b..7391d304 100644
--- a/_pkgdown.yml
+++ b/_pkgdown.yml
@@ -11,7 +11,7 @@ template:
# Adding the switch destroys the theme colors
light-switch: false
includes:
- in_header:
+ in_header:
navbar:
bg: primary
diff --git a/inst/apps/FreesearchR/app.R b/inst/apps/FreesearchR/app.R
index e9886d65..7dff7246 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
@@ -2983,7 +3010,7 @@ show_data <- function(data,
if (is.null(options))
options <- list()
- options$height <- 550
+ options$height <- 500
options$minBodyHeight <- 400
options$data <- data
options$theme <- "default"
@@ -3951,11 +3978,25 @@ is_identical_to_previous <- function(data, no.name = TRUE) {
}
+#' Simplified version of the snakecase packages to_snake_case
+#'
+#' @param data character string vector
+#'
+#' @returns vector
+#' @export
+#'
+#' @examples
+#' c("foo bar", "fooBar21", "!!Foo'B'a-r", "foo_bar", "F OO bar") |> simple_snake()
+simple_snake <- function(data){
+ gsub("[\\s+]","_",gsub("[^\\w\\s:-]", "", tolower(data), perl=TRUE), perl=TRUE)
+}
+
+
########
#### Current file: /Users/au301842/FreesearchR/R//hosted_version.R
########
-hosted_version <- function()'v25.5.2-250508'
+hosted_version <- function()'v25.5.3-250510'
########
@@ -4793,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")
}
@@ -4908,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){
@@ -5100,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)
@@ -5113,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"
@@ -5178,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",
@@ -5566,9 +5606,12 @@ m_redcap_readServer <- function(id) {
)
# browser()
- shiny::withProgress({
- imported <- try(rlang::exec(REDCapR::redcap_metadata_read, !!!parameters), silent = TRUE)
- },message = paste("Connecting to",data_rv$uri))
+ shiny::withProgress(
+ {
+ imported <- try(rlang::exec(REDCapR::redcap_metadata_read, !!!parameters), silent = TRUE)
+ },
+ message = paste("Connecting to", data_rv$uri)
+ )
## TODO: Simplify error messages
if (inherits(imported, "try-error") || NROW(imported) < 1 || ifelse(is.list(imported), !isTRUE(imported$success), FALSE)) {
@@ -5594,7 +5637,7 @@ m_redcap_readServer <- function(id) {
status = "success",
include_data_alert(
see_data_text = "Click to see data dictionary",
- dataIdName = "see_data",
+ dataIdName = "see_dd",
extra = tags$p(
tags$b(phosphoricons::ph("check", weight = "bold"), "Connected to server!"),
glue::glue("The {data_rv$info$project_title} project is loaded.")
@@ -5620,8 +5663,8 @@ m_redcap_readServer <- function(id) {
output$connect_success <- shiny::reactive(identical(data_rv$dd_status, "success"))
shiny::outputOptions(output, "connect_success", suspendWhenHidden = FALSE)
- shiny::observeEvent(input$see_data, {
- datamods::show_data(
+ shiny::observeEvent(input$see_dd, {
+ show_data(
purrr::pluck(data_rv$dd_list, "data"),
title = "Data dictionary",
type = "modal",
@@ -5630,6 +5673,17 @@ m_redcap_readServer <- function(id) {
)
})
+ shiny::observeEvent(input$see_data, {
+ show_data(
+ # purrr::pluck(data_rv$dd_list, "data"),
+ data_rv$data,
+ title = "Imported data set",
+ type = "modal",
+ show_classes = FALSE,
+ tags$b("Preview:")
+ )
+ })
+
arms <- shiny::reactive({
shiny::req(input$api)
shiny::req(data_rv$uri)
@@ -5744,13 +5798,24 @@ m_redcap_readServer <- function(id) {
imported <- try(rlang::exec(REDCapCAST::read_redcap_tables, !!!parameters), silent = TRUE)
})
- code <- rlang::call2("read_redcap_tables",
- !!!utils::modifyList(parameters, list(token = "PERSONAL_API_TOKEN")), ,
+ parameters_code <- parameters[c("uri", "fields", "events", "raw_or_label", "filter_logic")]
+
+ code <- rlang::call2(
+ "easy_redcap",
+ !!!utils::modifyList(
+ parameters_code,
+ list(
+ data_format = ifelse(
+ input$data_type == "long" && !is.null(input$data_type),
+ "long",
+ "wide"
+ ),
+ project.name = simple_snake(data_rv$info$project_title)
+ )
+ ),
.ns = "REDCapCAST"
)
- # browser()
-
if (inherits(imported, "try-error") || NROW(imported) < 1) {
data_rv$data_status <- "error"
data_rv$data_list <- NULL
@@ -5819,9 +5884,17 @@ m_redcap_readServer <- function(id) {
datamods:::insert_alert(
selector = ns("retrieved"),
status = data_rv$data_status,
- tags$p(
- tags$b(phosphoricons::ph("check", weight = "bold"), "Success!"),
- data_rv$data_message
+ # tags$p(
+ # tags$b(phosphoricons::ph("check", weight = "bold"), "Success!"),
+ # data_rv$data_message
+ # ),
+ include_data_alert(
+ see_data_text = "Click to see the imported data",
+ dataIdName = "see_data",
+ extra = tags$p(
+ tags$b(phosphoricons::ph("check", weight = "bold"), data_rv$data_message)
+ ),
+ btn_show_data = TRUE
)
)
} else {
@@ -6022,13 +6095,6 @@ redcap_demo_app <- function() {
}
-########
-#### Current file: /Users/au301842/FreesearchR/R//redcap.R
-########
-
-
-
-
########
#### Current file: /Users/au301842/FreesearchR/R//regression_model.R
########
@@ -6306,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)) {
@@ -6324,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) &
@@ -7999,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,
@@ -8034,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,
@@ -8263,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()].
@@ -9317,10 +9380,10 @@ ui_elements <- list(
condition = "input.source=='env'",
import_globalenv_ui(id = "env", title = NULL)
),
- shiny::conditionalPanel(
- condition = "input.source=='redcap'",
- DT::DTOutput(outputId = "redcap_prev")
- ),
+ # shiny::conditionalPanel(
+ # condition = "input.source=='redcap'",
+ # DT::DTOutput(outputId = "redcap_prev")
+ # ),
shiny::conditionalPanel(
condition = "output.data_loaded == true",
shiny::br(),
@@ -9329,13 +9392,8 @@ ui_elements <- list(
shiny::fluidRow(
shiny::column(
width = 6,
+ shiny::p("Filter by completeness threshold:"),
shiny::br(),
- shiny::p("Filter by completeness threshold and manual selection:"),
- shiny::br(),
- shiny::br()
- ),
- shiny::column(
- width = 6,
shinyWidgets::noUiSliderInput(
inputId = "complete_cutoff",
label = NULL,
@@ -9348,12 +9406,17 @@ ui_elements <- list(
color = datamods:::get_primary_color()
),
shiny::helpText("Exclude variables with completeness below the specified percentage."),
- shiny::br(),
+ shiny::br()
+ ),
+ shiny::column(
+ width = 6,
+ shiny::p("Specify manually:"),
shiny::br(),
shiny::uiOutput(outputId = "import_var"),
- shiny::uiOutput(outputId = "data_info_import", inline = TRUE)
+ shiny::br()
)
- )
+ ),
+ shiny::uiOutput(outputId = "data_info_import", inline = TRUE)
),
shiny::br(),
shiny::br(),
@@ -9830,33 +9893,7 @@ ui <- bslib::page_fixed(
#### Current file: /Users/au301842/FreesearchR/app/server.R
########
-library(readr)
-library(MASS)
-library(stats)
-library(gt)
-# library(openxlsx2)
-library(haven)
-library(readODS)
-require(shiny)
-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(shinyjs)
+
data(starwars)
data(mtcars)
@@ -9864,8 +9901,8 @@ data(trial)
load_data <- function() {
Sys.sleep(1)
- hide("loading_page")
- show("main_content")
+ shinyjs::hide("loading_page")
+ shinyjs::show("main_content")
}
@@ -9946,14 +9983,14 @@ server <- function(input, output, session) {
})
## This is used to ensure the reactive data is retrieved
- output$redcap_prev <- DT::renderDT(
- {
- DT::datatable(head(from_redcap$data(), 5),
- caption = "First 5 observations"
- )
- },
- server = TRUE
- )
+ # output$redcap_prev <- DT::renderDT(
+ # {
+ # DT::datatable(head(from_redcap$data(), 5),
+ # caption = "First 5 observations"
+ # )
+ # },
+ # server = TRUE
+ # )
from_env <- datamods::import_globalenv_server(
id = "env",
diff --git a/man/cut-variable.Rd b/man/cut-variable.Rd
index 6403fa7f..67a125cd 100644
--- a/man/cut-variable.Rd
+++ b/man/cut-variable.Rd
@@ -13,7 +13,7 @@ cut_variable_server(id, data_r = reactive(NULL))
modal_cut_variable(
id,
- title = i18n("Convert Numeric to Factor"),
+ title = datamods:::i18n("Convert Numeric to Factor"),
easyClose = TRUE,
size = "l",
footer = NULL
diff --git a/man/get_label.Rd b/man/get_label.Rd
index 59643d65..c4484304 100644
--- a/man/get_label.Rd
+++ b/man/get_label.Rd
@@ -22,5 +22,6 @@ mtcars |> get_label(var = "mpg")
mtcars |> get_label()
mtcars$mpg |> get_label()
gtsummary::trial |> get_label(var = "trt")
+gtsummary::trial$trt |> get_label()
1:10 |> get_label()
}
diff --git a/man/plot_sankey_single.Rd b/man/plot_sankey_single.Rd
index 6b2e7888..83742a75 100644
--- a/man/plot_sankey_single.Rd
+++ b/man/plot_sankey_single.Rd
@@ -39,6 +39,5 @@ data.frame(
plot_sankey_single("first", "last", color.group = "pri")
mtcars |>
default_parsing() |>
- str()
plot_sankey_single("cyl", "vs", color.group = "pri")
}
diff --git a/man/simple_snake.Rd b/man/simple_snake.Rd
new file mode 100644
index 00000000..f79ba9a4
--- /dev/null
+++ b/man/simple_snake.Rd
@@ -0,0 +1,20 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/helpers.R
+\name{simple_snake}
+\alias{simple_snake}
+\title{Simplified version of the snakecase packages to_snake_case}
+\usage{
+simple_snake(data)
+}
+\arguments{
+\item{data}{character string vector}
+}
+\value{
+vector
+}
+\description{
+Simplified version of the snakecase packages to_snake_case
+}
+\examples{
+c("foo bar", "fooBar21", "!!Foo'B'a-r", "foo_bar", "F OO bar") |> simple_snake()
+}