mirror of
https://github.com/agdamsbo/FreesearchR.git
synced 2025-09-12 09:59:39 +02:00
83 lines
3.2 KiB
R
83 lines
3.2 KiB
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
|
||
|
|
#' @keywords internal
|
||
|
|
#'
|
||
|
|
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>';
|
||
|
|
}
|
||
|
|
}"))
|
||
|
|
)
|
||
|
|
)
|
||
|
|
}
|