renv and version

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: freesearcheR
 Title: Browser Based Data Analysis
-Version: 25.3.1
+Version: 25.3.2
 Authors@R: 
     person("Andreas Gammelgaard", "Damsbo", , "agdamsbo@clin.au.dk", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0002-7559-1154"))

NEWS.md

@@ -1,3 +1,8 @@
+# freesearcheR 25.3.2
+
+Focus is on polish and improved ui/ux.
+
+
 # freesearcheR 25.3.1
 
 First steps towards a more focused and simplified interface.

R/app_version.R

@@ -1 +1 @@
-app_version <- function()'250307_1438'
+app_version <- function()'250307_1453'

inst/apps/freesearcheR/app.R

@@ -10,7 +10,7 @@
 #### Current file: R//app_version.R 
 ########
 
-app_version <- function()'250307_1438'
+app_version <- function()'250307_1453'
 
 
 ########
@@ -41,94 +41,6 @@ baseline_table <- function(data, fun.args = NULL, fun = gtsummary::tbl_summary,
 
 
 
-########
-#### Current file: R//columnSelectInput.R 
-########
-
-#' A selectizeInput customized for data frames with column labels
-#'
-#' @description
-#' Copied and modified from the IDEAFilter package
-#' Adds the option to select "none" which is handled later
-#'
-#' @param inputId passed to \code{\link[shiny]{selectizeInput}}
-#' @param label passed to \code{\link[shiny]{selectizeInput}}
-#' @param data \code{data.frame} object from which fields should be populated
-#' @param selected default selection
-#' @param ... passed to \code{\link[shiny]{selectizeInput}}
-#' @param col_subset a \code{vector} containing the list of allowable columns to select
-#' @param placeholder passed to \code{\link[shiny]{selectizeInput}} options
-#' @param onInitialize passed to \code{\link[shiny]{selectizeInput}} options
-#' @param none_label label for "none" item
-#'
-#' @return a \code{\link[shiny]{selectizeInput}} dropdown element
-#'
-#' @importFrom shiny selectizeInput
-#' @export
-#'
-columnSelectInput <- function(inputId, label, data, selected = "", ...,
-                              col_subset = NULL, placeholder = "", onInitialize, none_label="No variable selected") {
-  datar <- if (is.reactive(data)) data else reactive(data)
-  col_subsetr <- if (is.reactive(col_subset)) col_subset else reactive(col_subset)
-
-  labels <- Map(function(col) {
-    json <- sprintf(
-      IDEAFilter:::strip_leading_ws('
-    {
-      "name": "%s",
-      "label": "%s",
-      "datatype": "%s"
-    }'),
-      col,
-      attr(datar()[[col]], "label") %||% "",
-      IDEAFilter:::get_dataFilter_class(datar()[[col]])
-    )
-  }, col = names(datar()))
-
-  if (!"none" %in% names(datar())){
-    labels <- c("none"=list(sprintf('\n    {\n      \"name\": \"none\",\n      \"label\": \"%s\",\n      \"datatype\": \"\"\n    }',none_label)),labels)
-    choices <- setNames(names(labels), labels)
-    choices <- choices[match(if (length(col_subsetr()) == 0 || isTRUE(col_subsetr() == "")) names(datar()) else col_subsetr(), choices)]
-  } else {
-    choices <- setNames(names(datar()), labels)
-    choices <- choices[match(if (length(col_subsetr()) == 0 || isTRUE(col_subsetr() == "")) choices else col_subsetr(), choices)]
-  }
-
-  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 '<div style=\"padding: 3px 12px\">' +
-                   '<div><strong>' +
-                      escape(item.data.name) + ' ' +
-                      '<span style=\"opacity: 0.3;\"><code style=\"color: black;\"> ' +
-                        item.data.datatype +
-                      '</code></span>' +
-                   '</strong></div>' +
-                   (item.data.label != '' ? '<div style=\"line-height: 1em;\"><small>' + escape(item.data.label) + '</small></div>' : '') +
-                 '</div>';
-        },
-
-        // avoid data vomit splashing on screen when an option is selected
-        item: function(item, escape) {
-        item.data = JSON.parse(item.label);
-        return '<div>' +
-                 escape(item.data.name) +
-               '</div>';
-        }
-      }"))
-    )
-  )
-}
-
-
 ########
 #### Current file: R//contrast_text.R 
 ########
@@ -328,6 +240,191 @@ cor_app <- function() {
 cor_app()
 
 
+########
+#### Current file: R//custom_SelectInput.R 
+########
+
+#' A selectizeInput customized for data frames with column labels
+#'
+#' @description
+#' Copied and modified from the IDEAFilter package
+#' Adds the option to select "none" which is handled later
+#'
+#' @param inputId passed to \code{\link[shiny]{selectizeInput}}
+#' @param label passed to \code{\link[shiny]{selectizeInput}}
+#' @param data \code{data.frame} object from which fields should be populated
+#' @param selected default selection
+#' @param ... passed to \code{\link[shiny]{selectizeInput}}
+#' @param col_subset a \code{vector} containing the list of allowable columns to select
+#' @param placeholder passed to \code{\link[shiny]{selectizeInput}} options
+#' @param onInitialize passed to \code{\link[shiny]{selectizeInput}} options
+#' @param none_label label for "none" item
+#'
+#' @return a \code{\link[shiny]{selectizeInput}} dropdown element
+#'
+#' @importFrom shiny selectizeInput
+#' @export
+#'
+columnSelectInput <- function(inputId, label, data, selected = "", ...,
+                              col_subset = NULL, placeholder = "", onInitialize, none_label="No variable selected") {
+  datar <- if (is.reactive(data)) data else reactive(data)
+  col_subsetr <- if (is.reactive(col_subset)) col_subset else reactive(col_subset)
+
+  labels <- Map(function(col) {
+    json <- sprintf(
+      IDEAFilter:::strip_leading_ws('
+    {
+      "name": "%s",
+      "label": "%s",
+      "datatype": "%s"
+    }'),
+      col,
+      attr(datar()[[col]], "label") %||% "",
+      IDEAFilter:::get_dataFilter_class(datar()[[col]])
+    )
+  }, col = names(datar()))
+
+  if (!"none" %in% names(datar())){
+    labels <- c("none"=list(sprintf('\n    {\n      \"name\": \"none\",\n      \"label\": \"%s\",\n      \"datatype\": \"\"\n    }',none_label)),labels)
+    choices <- setNames(names(labels), labels)
+    choices <- choices[match(if (length(col_subsetr()) == 0 || isTRUE(col_subsetr() == "")) names(datar()) else col_subsetr(), choices)]
+  } else {
+    choices <- setNames(names(datar()), labels)
+    choices <- choices[match(if (length(col_subsetr()) == 0 || isTRUE(col_subsetr() == "")) choices else col_subsetr(), choices)]
+  }
+
+  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 '<div style=\"padding: 3px 12px\">' +
+                   '<div><strong>' +
+                      escape(item.data.name) + ' ' +
+                      '<span style=\"opacity: 0.3;\"><code style=\"color: black;\"> ' +
+                        item.data.datatype +
+                      '</code></span>' +
+                   '</strong></div>' +
+                   (item.data.label != '' ? '<div style=\"line-height: 1em;\"><small>' + escape(item.data.label) + '</small></div>' : '') +
+                 '</div>';
+        },
+
+        // avoid data vomit splashing on screen when an option is selected
+        item: function(item, escape) {
+        item.data = JSON.parse(item.label);
+        return '<div>' +
+                 escape(item.data.name) +
+               '</div>';
+        }
+      }"))
+    )
+  )
+}
+
+
+
+#' 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 '<div style=\"padding: 3px 12px\">' +
+                   '<div><strong>' +
+                      escape(item.data.name) + ' ' +
+                   '</strong></div>' +
+                   (item.data.label != '' ? '<div style=\"line-height: 1em;\"><small>' + escape(item.data.label) + '</small></div>' : '') +
+                 '</div>';
+        },
+
+        // avoid data vomit splashing on screen when an option is selected
+        item: function(item, escape) {
+        item.data = JSON.parse(item.label);
+        return '<div>' +
+                 escape(item.data.name) +
+               '</div>';
+        }
+      }"))
+    )
+  )
+}
+
+
+
+
 ########
 #### Current file: R//cut-variable-dates.R 
 ########
@@ -5207,108 +5304,6 @@ 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 '<div style=\"padding: 3px 12px\">' +
-                   '<div><strong>' +
-                      escape(item.data.name) + ' ' +
-                   '</strong></div>' +
-                   (item.data.label != '' ? '<div style=\"line-height: 1em;\"><small>' + escape(item.data.label) + '</small></div>' : '') +
-                 '</div>';
-        },
-
-        // avoid data vomit splashing on screen when an option is selected
-        item: function(item, escape) {
-        item.data = JSON.parse(item.label);
-        return '<div>' +
-                 escape(item.data.name) +
-               '</div>';
-        }
-      }"))
-    )
-  )
-}
-
-
-
-
 ########
 #### Current file: /Users/au301842/freesearcheR/inst/apps/freesearcheR/ui.R 
 ########

renv/activate.R

@@ -2,7 +2,7 @@
 local({
 
   # the requested version of renv
-  version <- "1.1.0"
+  version <- "1.1.2"
   attr(version, "sha") <- NULL
 
   # the project directory
@@ -135,12 +135,12 @@ local({
   
     # R help links
     pattern <- "`\\?(renv::(?:[^`])+)`"
-    replacement <- "`\033]8;;ide:help:\\1\a?\\1\033]8;;\a`"
+    replacement <- "`\033]8;;x-r-help:\\1\a?\\1\033]8;;\a`"
     text <- gsub(pattern, replacement, text, perl = TRUE)
   
     # runnable code
     pattern <- "`(renv::(?:[^`])+)`"
-    replacement <- "`\033]8;;ide:run:\\1\a\\1\033]8;;\a`"
+    replacement <- "`\033]8;;x-r-run:\\1\a\\1\033]8;;\a`"
     text <- gsub(pattern, replacement, text, perl = TRUE)
   
     # return ansified text