mirror of
https://github.com/agdamsbo/FreesearchR.git
synced 2025-09-12 09:59:39 +02:00
renv and version
This commit is contained in:
parent
12db7a6025
commit
6c44be558d
6 changed files with 292 additions and 287 deletions
|
|
@ -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"))
|
||||
|
|
|
|||
5
NEWS.md
5
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.
|
||||
|
|
|
|||
|
|
@ -1 +1 @@
|
|||
app_version <- function()'250307_1438'
|
||||
app_version <- function()'250307_1453'
|
||||
|
|
|
|||
|
|
@ -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
|
||||
########
|
||||
|
|
|
|||
187
renv.lock
187
renv.lock
File diff suppressed because one or more lines are too long
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue