diff --git a/R/app_version.R b/R/app_version.R
index be55055..a6af51d 100644
--- a/R/app_version.R
+++ b/R/app_version.R
@@ -1 +1 @@
-app_version <- function()'250306_0759'
+app_version <- function()'250307_1438'
diff --git a/R/columnSelectInput.R b/R/custom_SelectInput.R
similarity index 53%
rename from R/columnSelectInput.R
rename to R/custom_SelectInput.R
index a761392..2ca1bf8 100644
--- a/R/columnSelectInput.R
+++ b/R/custom_SelectInput.R
@@ -17,7 +17,7 @@
#' @return a \code{\link[shiny]{selectizeInput}} dropdown element
#'
#' @importFrom shiny selectizeInput
-#' @keywords internal
+#' @export
#'
columnSelectInput <- function(inputId, label, data, selected = "", ...,
col_subset = NULL, placeholder = "", onInitialize, none_label="No variable selected") {
@@ -80,3 +80,100 @@ columnSelectInput <- function(inputId, label, data, selected = "", ...,
)
)
}
+
+
+
+#' A selectizeInput customized for named vectors
+#'
+#' @param inputId passed to \code{\link[shiny]{selectizeInput}}
+#' @param label passed to \code{\link[shiny]{selectizeInput}}
+#' @param data A named \code{vector} object from which fields should be populated
+#' @param selected default selection
+#' @param ... passed to \code{\link[shiny]{selectizeInput}}
+#' @param placeholder passed to \code{\link[shiny]{selectizeInput}} options
+#' @param onInitialize passed to \code{\link[shiny]{selectizeInput}} options
+#'
+#' @returns a \code{\link[shiny]{selectizeInput}} dropdown element
+#' @export
+#'
+#' @examples
+#' if (shiny::interactive()) {
+#' shinyApp(
+#' ui = fluidPage(
+#' shiny::uiOutput("select"),
+#' tableOutput("data")
+#' ),
+#' server = function(input, output) {
+#' output$select <- shiny::renderUI({
+#' vectorSelectInput(
+#' inputId = "variable", label = "Variable:",
+#' data = c(
+#' "Cylinders" = "cyl",
+#' "Transmission" = "am",
+#' "Gears" = "gear"
+#' )
+#' )
+#' })
+#'
+#' output$data <- renderTable(
+#' {
+#' mtcars[, c("mpg", input$variable), drop = FALSE]
+#' },
+#' rownames = TRUE
+#' )
+#' }
+#' )
+#' }
+vectorSelectInput <- function(inputId,
+ label,
+ data,
+ selected = "",
+ ...,
+ placeholder = "",
+ onInitialize) {
+ datar <- if (shiny::is.reactive(data)) data else shiny::reactive(data)
+
+ labels <- sprintf(
+ IDEAFilter:::strip_leading_ws('
+ {
+ "name": "%s",
+ "label": "%s"
+ }'),
+ datar(),
+ names(datar()) %||% ""
+ )
+
+ choices <- stats::setNames(datar(), labels)
+
+ shiny::selectizeInput(
+ inputId = inputId,
+ label = label,
+ choices = choices,
+ selected = selected,
+ ...,
+ options = c(
+ list(render = I("{
+ // format the way that options are rendered
+ option: function(item, escape) {
+ item.data = JSON.parse(item.label);
+ return '
' +
+ '
' +
+ escape(item.data.name) + ' ' +
+ '
' +
+ (item.data.label != '' ? '
' + escape(item.data.label) + '
' : '') +
+ '
';
+ },
+
+ // avoid data vomit splashing on screen when an option is selected
+ item: function(item, escape) {
+ item.data = JSON.parse(item.label);
+ return '' +
+ escape(item.data.name) +
+ '
';
+ }
+ }"))
+ )
+ )
+}
+
+
diff --git a/R/redcap_read_shiny_module.R b/R/redcap_read_shiny_module.R
index 9da0289..6a0ed2b 100644
--- a/R/redcap_read_shiny_module.R
+++ b/R/redcap_read_shiny_module.R
@@ -254,11 +254,11 @@ m_redcap_readServer <- function(id) {
})
output$arms <- shiny::renderUI({
- shiny::selectizeInput(
+ vectorSelectInput(
inputId = ns("arms"),
selected = NULL,
label = "Filter by events/arms",
- choices = arms()[[3]],
+ data = stats::setNames(arms()[[3]],arms()[[1]]),
multiple = TRUE
)
})
diff --git a/inst/apps/freesearcheR/app.R b/inst/apps/freesearcheR/app.R
index 0a85dab..79061e0 100644
--- a/inst/apps/freesearcheR/app.R
+++ b/inst/apps/freesearcheR/app.R
@@ -10,7 +10,7 @@
#### Current file: R//app_version.R
########
-app_version <- function()'250306_0759'
+app_version <- function()'250307_1438'
########
@@ -64,7 +64,7 @@ baseline_table <- function(data, fun.args = NULL, fun = gtsummary::tbl_summary,
#' @return a \code{\link[shiny]{selectizeInput}} dropdown element
#'
#' @importFrom shiny selectizeInput
-#' @keywords internal
+#' @export
#'
columnSelectInput <- function(inputId, label, data, selected = "", ...,
col_subset = NULL, placeholder = "", onInitialize, none_label="No variable selected") {
@@ -2828,11 +2828,11 @@ m_redcap_readServer <- function(id) {
})
output$arms <- shiny::renderUI({
- shiny::selectizeInput(
+ vectorSelectInput(
inputId = ns("arms"),
selected = NULL,
label = "Filter by events/arms",
- choices = arms()[[3]],
+ data = stats::setNames(arms()[[3]],arms()[[1]]),
multiple = TRUE
)
})
@@ -5207,6 +5207,108 @@ clean_date <- function(data){
}
+########
+#### Current file: R//vectorSelectInput.R
+########
+
+library(shiny)
+
+#' A selectizeInput customized for named vectors
+#'
+#' @param inputId passed to \code{\link[shiny]{selectizeInput}}
+#' @param label passed to \code{\link[shiny]{selectizeInput}}
+#' @param data A named \code{vector} object from which fields should be populated
+#' @param selected default selection
+#' @param ... passed to \code{\link[shiny]{selectizeInput}}
+#' @param placeholder passed to \code{\link[shiny]{selectizeInput}} options
+#' @param onInitialize passed to \code{\link[shiny]{selectizeInput}} options
+#'
+#' @returns a \code{\link[shiny]{selectizeInput}} dropdown element
+#' @export
+#'
+#' @examples
+#' if (shiny::interactive()) {
+#' shinyApp(
+#' ui = fluidPage(
+#' shiny::uiOutput("select"),
+#' tableOutput("data")
+#' ),
+#' server = function(input, output) {
+#' output$select <- shiny::renderUI({
+#' vectorSelectInput(
+#' inputId = "variable", label = "Variable:",
+#' data = c(
+#' "Cylinders" = "cyl",
+#' "Transmission" = "am",
+#' "Gears" = "gear"
+#' )
+#' )
+#' })
+#'
+#' output$data <- renderTable(
+#' {
+#' mtcars[, c("mpg", input$variable), drop = FALSE]
+#' },
+#' rownames = TRUE
+#' )
+#' }
+#' )
+#' }
+vectorSelectInput <- function(inputId,
+ label,
+ data,
+ selected = "",
+ ...,
+ placeholder = "",
+ onInitialize) {
+ datar <- if (shiny::is.reactive(data)) data else shiny::reactive(data)
+
+ labels <- sprintf(
+ IDEAFilter:::strip_leading_ws('
+ {
+ "name": "%s",
+ "label": "%s"
+ }'),
+ datar(),
+ names(datar()) %||% ""
+ )
+
+ choices <- stats::setNames(datar(), labels)
+
+ shiny::selectizeInput(
+ inputId = inputId,
+ label = label,
+ choices = choices,
+ selected = selected,
+ ...,
+ options = c(
+ list(render = I("{
+ // format the way that options are rendered
+ option: function(item, escape) {
+ item.data = JSON.parse(item.label);
+ return '' +
+ '
' +
+ escape(item.data.name) + ' ' +
+ '
' +
+ (item.data.label != '' ? '
' + escape(item.data.label) + '
' : '') +
+ '
';
+ },
+
+ // avoid data vomit splashing on screen when an option is selected
+ item: function(item, escape) {
+ item.data = JSON.parse(item.label);
+ return '' +
+ escape(item.data.name) +
+ '
';
+ }
+ }"))
+ )
+ )
+}
+
+
+
+
########
#### Current file: /Users/au301842/freesearcheR/inst/apps/freesearcheR/ui.R
########
diff --git a/inst/apps/freesearcheR/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf b/inst/apps/freesearcheR/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf
index 601efea..48a5d11 100644
--- a/inst/apps/freesearcheR/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf
+++ b/inst/apps/freesearcheR/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf
@@ -5,6 +5,6 @@ account: agdamsbo
server: shinyapps.io
hostUrl: https://api.shinyapps.io/v1
appId: 13611288
-bundleId: 9881752
+bundleId: 9899914
url: https://agdamsbo.shinyapps.io/freesearcheR/
version: 1
diff --git a/renv.lock b/renv.lock
index a4543d5..8e89df4 100644
--- a/renv.lock
+++ b/renv.lock
@@ -3529,6 +3529,53 @@
"Maintainer": "Hadley Wickham ",
"Repository": "CRAN"
},
+ "ggalluvial": {
+ "Package": "ggalluvial",
+ "Version": "0.12.5",
+ "Source": "Repository",
+ "Type": "Package",
+ "Title": "Alluvial Plots in 'ggplot2'",
+ "Authors@R": "c( person(given = \"Jason Cory\", family = \"Brunson\", role = c(\"aut\", \"cre\"), email = \"cornelioid@gmail.com\"), person(given = \"Quentin D.\", family = \"Read\", role = 'aut'))",
+ "Maintainer": "Jason Cory Brunson ",
+ "Description": "Alluvial plots use variable-width ribbons and stacked bar plots to represent multi-dimensional or repeated-measures data with categorical or ordinal variables; see Riehmann, Hanfler, and Froehlich (2005) and Rosvall and Bergstrom (2010) . Alluvial plots are statistical graphics in the sense of Wilkinson (2006) ; they share elements with Sankey diagrams and parallel sets plots but are uniquely determined from the data and a small set of parameters. This package extends Wickham's (2010) layered grammar of graphics to generate alluvial plots from tidy data.",
+ "Depends": [
+ "R (>= 3.6)",
+ "ggplot2 (>= 2.2)"
+ ],
+ "Imports": [
+ "stats",
+ "dplyr (>= 0.7)",
+ "tidyr (>= 0.7)",
+ "lazyeval",
+ "rlang",
+ "tidyselect"
+ ],
+ "Suggests": [
+ "grid",
+ "alluvial",
+ "testthat",
+ "knitr",
+ "rmarkdown",
+ "babynames",
+ "sessioninfo",
+ "ggrepel",
+ "shiny (>= 1.4.0.2)",
+ "htmltools",
+ "sp (>= 1.4-0)",
+ "ggfittext (>= 0.6)",
+ "vdiffr (>= 0.2)"
+ ],
+ "License": "GPL-3",
+ "LazyData": "true",
+ "URL": "http://corybrunson.github.io/ggalluvial/",
+ "BugReports": "https://github.com/corybrunson/ggalluvial/issues",
+ "VignetteBuilder": "knitr",
+ "RoxygenNote": "7.2.3",
+ "Encoding": "UTF-8",
+ "NeedsCompilation": "no",
+ "Author": "Jason Cory Brunson [aut, cre], Quentin D. Read [aut]",
+ "Repository": "CRAN"
+ },
"ggeffects": {
"Package": "ggeffects",
"Version": "2.2.0",