diff --git a/CITATION.cff b/CITATION.cff
index f026dade..29f48145 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.4
+version: 25.5.2
doi: 10.5281/zenodo.14527429
identifiers:
- type: url
diff --git a/DESCRIPTION b/DESCRIPTION
index 5a9123e7..87cc929d 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.4
+Version: 25.5.2
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 cbc6d0ec..186ab21a 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -108,7 +108,6 @@ 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)
@@ -131,6 +130,7 @@ 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,6 +141,7 @@ importFrom(htmltools,css)
importFrom(htmltools,tagList)
importFrom(htmltools,tags)
importFrom(htmltools,validateCssUnit)
+importFrom(phosphoricons,ph)
importFrom(rlang,"%||%")
importFrom(rlang,call2)
importFrom(rlang,expr)
@@ -159,20 +160,25 @@ 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 5f097c19..07731215 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,21 +1,3 @@
-# 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 5e843a23..eca6bb3a 100644
--- a/R/app_version.R
+++ b/R/app_version.R
@@ -1 +1 @@
-app_version <- function()'25.5.4'
+app_version <- function()'25.5.2'
diff --git a/R/contrast_text.R b/R/contrast_text.R
index 1db2e562..9ea4c5ba 100644
--- a/R/contrast_text.R
+++ b/R/contrast_text.R
@@ -25,6 +25,7 @@
#' 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 0bc24026..9bb71c49 100644
--- a/R/create-column-mod.R
+++ b/R/create-column-mod.R
@@ -17,17 +17,20 @@
#' @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)
- htmltools::tagList(
+ tagList(
# datamods:::html_dependency_datamods(),
# html_dependency_FreesearchR(),
- shiny::tags$head(
- shiny::tags$link(rel = "stylesheet", type = "text/css", href = "FreesearchR/inst/assets/css/FreesearchR.css")
+ tags$head(
+ tags$link(rel = "stylesheet", type = "text/css", href = "FreesearchR/inst/assets/css/FreesearchR.css")
),
# tags$head(
# # Note the wrapping of the string in HTML()
@@ -81,7 +84,7 @@ create_column_ui <- function(id) {
)
)
),
- shiny::textAreaInput(
+ textAreaInput(
inputId = ns("expression"),
label = i18n("Enter an expression to define new column:"),
value = "",
@@ -129,6 +132,9 @@ 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 9c78e73c..d3f95eb5 100644
--- a/R/cut-variable-dates.R
+++ b/R/cut-variable-dates.R
@@ -1,3 +1,9 @@
+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"
@@ -206,9 +212,9 @@ cut_variable_ui <- function(id) {
shiny::fluidRow(
column(
width = 3,
- shinyWidgets::virtualSelectInput(
+ virtualSelectInput(
inputId = ns("variable"),
- label = datamods:::i18n("Variable to cut:"),
+ label = i18n("Variable to cut:"),
choices = NULL,
width = "100%"
)
@@ -221,7 +227,7 @@ cut_variable_ui <- function(id) {
width = 3,
numericInput(
inputId = ns("n_breaks"),
- label = datamods:::i18n("Number of breaks:"),
+ label = i18n("Number of breaks:"),
value = 3,
min = 2,
max = 12,
@@ -232,12 +238,12 @@ cut_variable_ui <- function(id) {
width = 3,
checkboxInput(
inputId = ns("right"),
- label = datamods:::i18n("Close intervals on the right"),
+ label = i18n("Close intervals on the right"),
value = TRUE
),
checkboxInput(
inputId = ns("include_lowest"),
- label = datamods:::i18n("Include lowest value"),
+ label = i18n("Include lowest value"),
value = TRUE
)
)
@@ -248,10 +254,10 @@ cut_variable_ui <- function(id) {
uiOutput(outputId = ns("slider_fixed"))
),
plotOutput(outputId = ns("plot"), width = "100%", height = "270px"),
- toastui::datagridOutput2(outputId = ns("count")),
+ datagridOutput2(outputId = ns("count")),
actionButton(
inputId = ns("create"),
- label = tagList(phosphoricons::ph("scissors"), datamods:::i18n("Create factor variable")),
+ label = tagList(ph("scissors"), i18n("Create factor variable")),
class = "btn-outline-primary float-end"
),
tags$div(class = "clearfix")
@@ -282,7 +288,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]
- shinyWidgets::updateVirtualSelect(
+ updateVirtualSelect(
inputId = "variable",
choices = vars_num,
selected = if (isTruthy(input$variable)) input$variable else vars_num[1]
@@ -319,9 +325,9 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
}
- shinyWidgets::noUiSliderInput(
+ noUiSliderInput(
inputId = session$ns("fixed_brks"),
- label = datamods:::i18n("Fixed breaks:"),
+ label = i18n("Fixed breaks:"),
min = lower,
max = upper,
value = brks,
@@ -376,7 +382,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
shinyWidgets::virtualSelectInput(
inputId = session$ns("method"),
- label = datamods:::i18n("Method:"),
+ label = i18n("Method:"),
choices = choices,
selected = NULL,
width = "100%"
@@ -519,7 +525,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
data
})
- output$count <- toastui::renderDatagrid2({
+ output$count <- renderDatagrid2({
# shiny::req(rv$new_var_name)
data <- req(data_cutted_r())
# variable <- req(input$variable)
@@ -535,14 +541,14 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
datamods:::apply_grid_theme()
}
on.exit(toastui::reset_grid_theme())
- grid <- toastui::datagrid(
+ grid <- datagrid(
data = count_data,
colwidths = "guess",
theme = "default",
bodyHeight = "auto"
)
grid <- toastui::grid_columns(grid, className = "font-monospace")
- toastui::grid_colorbar(
+ grid_colorbar(
grid,
column = "count",
label_outside = TRUE,
@@ -570,7 +576,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
#'
#' @rdname cut-variable
modal_cut_variable <- function(id,
- title = datamods:::i18n("Convert Numeric to Factor"),
+ title = i18n("Convert Numeric to Factor"),
easyClose = TRUE,
size = "l",
footer = NULL) {
diff --git a/R/data_plots.R b/R/data_plots.R
index 1b07f43b..8401bf87 100644
--- a/R/data_plots.R
+++ b/R/data_plots.R
@@ -681,7 +681,6 @@ 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 8d898f77..1a250d77 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 <- 500
+ options$height <- 550
options$minBodyHeight <- 400
options$data <- data
options$theme <- "default"
diff --git a/R/helpers.R b/R/helpers.R
index 73129194..377badb5 100644
--- a/R/helpers.R
+++ b/R/helpers.R
@@ -652,17 +652,3 @@ 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 596d4e21..5feb2555 100644
--- a/R/hosted_version.R
+++ b/R/hosted_version.R
@@ -1 +1 @@
-hosted_version <- function()'v25.5.4-250510'
+hosted_version <- function()'v25.5.2-250508'
diff --git a/R/plot_euler.R b/R/plot_euler.R
index 10156b74..4dff9de5 100644
--- a/R/plot_euler.R
+++ b/R/plot_euler.R
@@ -87,11 +87,10 @@ 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 deac70c0..84ead0da 100644
--- a/R/plot_hbar.R
+++ b/R/plot_hbar.R
@@ -62,8 +62,9 @@ vertical_stacked_bars <- function(data,
contrast_cut <-
sum(contrast_text(colors, threshold = .3) == "white")
- score_label <- data |> get_label(var = score)
- group_label <- data |> get_label(var = group)
+ 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"))
+
p |>
(\(.x){
diff --git a/R/plot_sankey.R b/R/plot_sankey.R
index c45d46f2..473e7b77 100644
--- a/R/plot_sankey.R
+++ b/R/plot_sankey.R
@@ -119,6 +119,7 @@ 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)
@@ -131,6 +132,8 @@ 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"
@@ -194,8 +197,6 @@ 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
new file mode 100644
index 00000000..e69de29b
diff --git a/R/redcap_read_shiny_module.R b/R/redcap_read_shiny_module.R
index 9499e7d3..8857e5f0 100644
--- a/R/redcap_read_shiny_module.R
+++ b/R/redcap_read_shiny_module.R
@@ -200,12 +200,9 @@ 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)) {
@@ -231,7 +228,7 @@ m_redcap_readServer <- function(id) {
status = "success",
include_data_alert(
see_data_text = "Click to see data dictionary",
- dataIdName = "see_dd",
+ dataIdName = "see_data",
extra = tags$p(
tags$b(phosphoricons::ph("check", weight = "bold"), "Connected to server!"),
glue::glue("The {data_rv$info$project_title} project is loaded.")
@@ -257,8 +254,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_dd, {
- show_data(
+ shiny::observeEvent(input$see_data, {
+ datamods::show_data(
purrr::pluck(data_rv$dd_list, "data"),
title = "Data dictionary",
type = "modal",
@@ -267,17 +264,6 @@ 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)
@@ -392,24 +378,13 @@ m_redcap_readServer <- function(id) {
imported <- try(rlang::exec(REDCapCAST::read_redcap_tables, !!!parameters), silent = TRUE)
})
- 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)
- )
- ),
+ code <- rlang::call2("read_redcap_tables",
+ !!!utils::modifyList(parameters, list(token = "PERSONAL_API_TOKEN")), ,
.ns = "REDCapCAST"
)
+ # browser()
+
if (inherits(imported, "try-error") || NROW(imported) < 1) {
data_rv$data_status <- "error"
data_rv$data_list <- NULL
@@ -478,17 +453,9 @@ 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
- # ),
- 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
+ tags$p(
+ tags$b(phosphoricons::ph("check", weight = "bold"), "Success!"),
+ data_rv$data_message
)
)
} else {
diff --git a/R/regression_model.R b/R/regression_model.R
index df79cc16..252cbf16 100644
--- a/R/regression_model.R
+++ b/R/regression_model.R
@@ -271,13 +271,12 @@ 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 (l_unique < 2) {
+ } else if (length(unique(data)) < 2) {
out <- "monotone"
- } else if (any(c("factor", "logical") %in% cl_d) | l_unique == 2) {
- if (identical("logical", cl_d) | l_unique == 2) {
+ } else if (any(c("factor", "logical") %in% cl_d) | length(unique(data)) == 2) {
+ if (identical("logical", cl_d) | length(unique(data)) == 2) {
out <- "dichotomous"
} else {
# if (is.ordered(data)) {
@@ -290,7 +289,7 @@ data_type <- function(data) {
out <- "text"
} else if (any(c("hms", "Date", "POSIXct", "POSIXt") %in% cl_d)) {
out <- "datetime"
- } else if (l_unique > 2) {
+ } else if (!length(unique(data)) == 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 080cfc43..57d54ffe 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 3fd4719e..a3943495 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,
- shinyWidgets::virtualSelectInput(
+ virtualSelectInput(
inputId = ns("variable"),
label = i18n("Factor variable to reorder:"),
choices = NULL,
@@ -66,10 +66,10 @@ update_factor_ui <- function(id) {
)
)
),
- toastui::datagridOutput(ns("grid")),
+ datagridOutput(ns("grid")),
tags$div(
class = "float-end",
- shinyWidgets::prettyCheckbox(
+ 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 dbc64f8a..eb20a11a 100644
--- a/R/update-variables-ext.R
+++ b/R/update-variables-ext.R
@@ -1,3 +1,7 @@
+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 66297f9b..99d8d012 100644
--- a/README.md
+++ b/README.md
@@ -7,9 +7,9 @@
[](https://agdamsbo.shinyapps.io/FreesearchR/)
-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.
+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.
-[***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).
+[***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.
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 dc20f495..da151864 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-10 |
+|date |2025-05-08 |
|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.4.250510 |
+|quarto |1.6.40 @ /usr/local/bin/quarto |
+|FreesearchR |25.5.2.250508 |
--------------------------------------------------------------------------------
@@ -44,6 +44,7 @@
|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) |
@@ -58,7 +59,6 @@
|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,11 +66,8 @@
|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) |
@@ -88,7 +85,6 @@
|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) |
@@ -105,6 +101,7 @@
|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) |
@@ -113,8 +110,6 @@
|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) |
@@ -127,8 +122,6 @@
|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) |
@@ -146,7 +139,6 @@
|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) |
@@ -160,23 +152,16 @@
|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 7391d304..47ca9e1b 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 7dff7246..e9886d65 100644
--- a/inst/apps/FreesearchR/app.R
+++ b/inst/apps/FreesearchR/app.R
@@ -1,44 +1,5 @@
-########
-#### 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
########
@@ -49,7 +10,7 @@ library(rlang)
#### Current file: /Users/au301842/FreesearchR/R//app_version.R
########
-app_version <- function()'25.5.3'
+app_version <- function()'25.5.2'
########
@@ -168,6 +129,7 @@ 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',
@@ -361,17 +323,20 @@ 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)
- htmltools::tagList(
+ tagList(
# datamods:::html_dependency_datamods(),
# html_dependency_FreesearchR(),
- shiny::tags$head(
- shiny::tags$link(rel = "stylesheet", type = "text/css", href = "FreesearchR/inst/assets/css/FreesearchR.css")
+ tags$head(
+ tags$link(rel = "stylesheet", type = "text/css", href = "FreesearchR/inst/assets/css/FreesearchR.css")
),
# tags$head(
# # Note the wrapping of the string in HTML()
@@ -425,7 +390,7 @@ create_column_ui <- function(id) {
)
)
),
- shiny::textAreaInput(
+ textAreaInput(
inputId = ns("expression"),
label = i18n("Enter an expression to define new column:"),
value = "",
@@ -473,6 +438,9 @@ 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()) {
@@ -979,6 +947,12 @@ 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"
@@ -1187,9 +1161,9 @@ cut_variable_ui <- function(id) {
shiny::fluidRow(
column(
width = 3,
- shinyWidgets::virtualSelectInput(
+ virtualSelectInput(
inputId = ns("variable"),
- label = datamods:::i18n("Variable to cut:"),
+ label = i18n("Variable to cut:"),
choices = NULL,
width = "100%"
)
@@ -1202,7 +1176,7 @@ cut_variable_ui <- function(id) {
width = 3,
numericInput(
inputId = ns("n_breaks"),
- label = datamods:::i18n("Number of breaks:"),
+ label = i18n("Number of breaks:"),
value = 3,
min = 2,
max = 12,
@@ -1213,12 +1187,12 @@ cut_variable_ui <- function(id) {
width = 3,
checkboxInput(
inputId = ns("right"),
- label = datamods:::i18n("Close intervals on the right"),
+ label = i18n("Close intervals on the right"),
value = TRUE
),
checkboxInput(
inputId = ns("include_lowest"),
- label = datamods:::i18n("Include lowest value"),
+ label = i18n("Include lowest value"),
value = TRUE
)
)
@@ -1229,10 +1203,10 @@ cut_variable_ui <- function(id) {
uiOutput(outputId = ns("slider_fixed"))
),
plotOutput(outputId = ns("plot"), width = "100%", height = "270px"),
- toastui::datagridOutput2(outputId = ns("count")),
+ datagridOutput2(outputId = ns("count")),
actionButton(
inputId = ns("create"),
- label = tagList(phosphoricons::ph("scissors"), datamods:::i18n("Create factor variable")),
+ label = tagList(ph("scissors"), i18n("Create factor variable")),
class = "btn-outline-primary float-end"
),
tags$div(class = "clearfix")
@@ -1263,7 +1237,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]
- shinyWidgets::updateVirtualSelect(
+ updateVirtualSelect(
inputId = "variable",
choices = vars_num,
selected = if (isTruthy(input$variable)) input$variable else vars_num[1]
@@ -1300,9 +1274,9 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
}
- shinyWidgets::noUiSliderInput(
+ noUiSliderInput(
inputId = session$ns("fixed_brks"),
- label = datamods:::i18n("Fixed breaks:"),
+ label = i18n("Fixed breaks:"),
min = lower,
max = upper,
value = brks,
@@ -1357,7 +1331,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
shinyWidgets::virtualSelectInput(
inputId = session$ns("method"),
- label = datamods:::i18n("Method:"),
+ label = i18n("Method:"),
choices = choices,
selected = NULL,
width = "100%"
@@ -1500,7 +1474,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
data
})
- output$count <- toastui::renderDatagrid2({
+ output$count <- renderDatagrid2({
# shiny::req(rv$new_var_name)
data <- req(data_cutted_r())
# variable <- req(input$variable)
@@ -1516,14 +1490,14 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
datamods:::apply_grid_theme()
}
on.exit(toastui::reset_grid_theme())
- grid <- toastui::datagrid(
+ grid <- datagrid(
data = count_data,
colwidths = "guess",
theme = "default",
bodyHeight = "auto"
)
grid <- toastui::grid_columns(grid, className = "font-monospace")
- toastui::grid_colorbar(
+ grid_colorbar(
grid,
column = "count",
label_outside = TRUE,
@@ -1551,7 +1525,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
#'
#' @rdname cut-variable
modal_cut_variable <- function(id,
- title = datamods:::i18n("Convert Numeric to Factor"),
+ title = i18n("Convert Numeric to Factor"),
easyClose = TRUE,
size = "l",
footer = NULL) {
@@ -2281,7 +2255,6 @@ 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
@@ -3010,7 +2983,7 @@ show_data <- function(data,
if (is.null(options))
options <- list()
- options$height <- 500
+ options$height <- 550
options$minBodyHeight <- 400
options$data <- data
options$theme <- "default"
@@ -3978,25 +3951,11 @@ 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.3-250510'
+hosted_version <- function()'v25.5.2-250508'
########
@@ -4834,11 +4793,10 @@ 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")
}
@@ -4950,8 +4908,9 @@ vertical_stacked_bars <- function(data,
contrast_cut <-
sum(contrast_text(colors, threshold = .3) == "white")
- score_label <- data |> get_label(var = score)
- group_label <- data |> get_label(var = group)
+ 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"))
+
p |>
(\(.x){
@@ -5141,6 +5100,7 @@ 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)
@@ -5153,6 +5113,8 @@ 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"
@@ -5216,8 +5178,6 @@ 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",
@@ -5606,12 +5566,9 @@ 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)) {
@@ -5637,7 +5594,7 @@ m_redcap_readServer <- function(id) {
status = "success",
include_data_alert(
see_data_text = "Click to see data dictionary",
- dataIdName = "see_dd",
+ dataIdName = "see_data",
extra = tags$p(
tags$b(phosphoricons::ph("check", weight = "bold"), "Connected to server!"),
glue::glue("The {data_rv$info$project_title} project is loaded.")
@@ -5663,8 +5620,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_dd, {
- show_data(
+ shiny::observeEvent(input$see_data, {
+ datamods::show_data(
purrr::pluck(data_rv$dd_list, "data"),
title = "Data dictionary",
type = "modal",
@@ -5673,17 +5630,6 @@ 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)
@@ -5798,24 +5744,13 @@ m_redcap_readServer <- function(id) {
imported <- try(rlang::exec(REDCapCAST::read_redcap_tables, !!!parameters), silent = TRUE)
})
- 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)
- )
- ),
+ code <- rlang::call2("read_redcap_tables",
+ !!!utils::modifyList(parameters, list(token = "PERSONAL_API_TOKEN")), ,
.ns = "REDCapCAST"
)
+ # browser()
+
if (inherits(imported, "try-error") || NROW(imported) < 1) {
data_rv$data_status <- "error"
data_rv$data_list <- NULL
@@ -5884,17 +5819,9 @@ 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
- # ),
- 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
+ tags$p(
+ tags$b(phosphoricons::ph("check", weight = "bold"), "Success!"),
+ data_rv$data_message
)
)
} else {
@@ -6095,6 +6022,13 @@ redcap_demo_app <- function() {
}
+########
+#### Current file: /Users/au301842/FreesearchR/R//redcap.R
+########
+
+
+
+
########
#### Current file: /Users/au301842/FreesearchR/R//regression_model.R
########
@@ -6372,13 +6306,12 @@ 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 (l_unique < 2) {
+ } else if (length(unique(data)) < 2) {
out <- "monotone"
- } else if (any(c("factor", "logical") %in% cl_d) | l_unique == 2) {
- if (identical("logical", cl_d) | l_unique == 2) {
+ } else if (any(c("factor", "logical") %in% cl_d) | length(unique(data)) == 2) {
+ if (identical("logical", cl_d) | length(unique(data)) == 2) {
out <- "dichotomous"
} else {
# if (is.ordered(data)) {
@@ -6391,7 +6324,7 @@ data_type <- function(data) {
out <- "text"
} else if (any(c("hms", "Date", "POSIXct", "POSIXt") %in% cl_d)) {
out <- "datetime"
- } else if (l_unique > 2) {
+ } else if (!length(unique(data)) == 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) &
@@ -8066,7 +7999,7 @@ update_factor_ui <- function(id) {
fluidRow(
column(
width = 6,
- shinyWidgets::virtualSelectInput(
+ virtualSelectInput(
inputId = ns("variable"),
label = i18n("Factor variable to reorder:"),
choices = NULL,
@@ -8101,10 +8034,10 @@ update_factor_ui <- function(id) {
)
)
),
- toastui::datagridOutput(ns("grid")),
+ datagridOutput(ns("grid")),
tags$div(
class = "float-end",
- shinyWidgets::prettyCheckbox(
+ prettyCheckbox(
inputId = ns("new_var"),
label = i18n("Create a new variable (otherwise replaces the one selected)"),
value = FALSE,
@@ -8330,6 +8263,10 @@ 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()].
@@ -9380,10 +9317,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(),
@@ -9392,8 +9329,13 @@ 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,
@@ -9406,17 +9348,12 @@ ui_elements <- list(
color = datamods:::get_primary_color()
),
shiny::helpText("Exclude variables with completeness below the specified percentage."),
- shiny::br()
- ),
- shiny::column(
- width = 6,
- shiny::p("Specify manually:"),
+ shiny::br(),
shiny::br(),
shiny::uiOutput(outputId = "import_var"),
- shiny::br()
+ shiny::uiOutput(outputId = "data_info_import", inline = TRUE)
)
- ),
- shiny::uiOutput(outputId = "data_info_import", inline = TRUE)
+ )
),
shiny::br(),
shiny::br(),
@@ -9893,7 +9830,33 @@ 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)
@@ -9901,8 +9864,8 @@ data(trial)
load_data <- function() {
Sys.sleep(1)
- shinyjs::hide("loading_page")
- shinyjs::show("main_content")
+ hide("loading_page")
+ show("main_content")
}
@@ -9983,14 +9946,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 67a125cd..6403fa7f 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 = datamods:::i18n("Convert Numeric to Factor"),
+ title = i18n("Convert Numeric to Factor"),
easyClose = TRUE,
size = "l",
footer = NULL
diff --git a/man/get_label.Rd b/man/get_label.Rd
index c4484304..59643d65 100644
--- a/man/get_label.Rd
+++ b/man/get_label.Rd
@@ -22,6 +22,5 @@ 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 83742a75..6b2e7888 100644
--- a/man/plot_sankey_single.Rd
+++ b/man/plot_sankey_single.Rd
@@ -39,5 +39,6 @@ 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
deleted file mode 100644
index f79ba9a4..00000000
--- a/man/simple_snake.Rd
+++ /dev/null
@@ -1,20 +0,0 @@
-% 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()
-}