-
Notifications
You must be signed in to change notification settings - Fork 153
/
input-numericRange.R
135 lines (126 loc) · 3.43 KB
/
input-numericRange.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
#' @title Numeric Range Input
#'
#' @description Create an input group of numeric inputs that function as a range
#' input.
#'
#' @param value The initial value(s) for the range. A
#' numeric vector of length one will be duplicated to represent the minimum and
#' maximum of the range; a numeric vector of two or more will have its minimum
#' and maximum set the minimum and maximum of the range.
#' @inheritParams shiny::numericInput
#' @inheritParams shiny::sliderInput
#' @inheritParams shiny::dateRangeInput
#'
#' @importFrom htmltools tags tagList singleton findDependencies attachDependencies validateCssUnit
#' @importFrom shiny sliderInput restoreInput
#' @importFrom utils packageVersion
#'
#' @seealso [updateNumericRangeInput()]
#'
#' @export
#'
#' @examples
#' if (interactive()) {
#'
#' ### examples ----
#'
#' # see ?demoNumericRange
#' demoNumericRange()
#'
#'
#' ### basic usage ----
#'
#' library( shiny )
#' library( shinyWidgets )
#'
#'
#' ui <- fluidPage(
#'
#' tags$br(),
#'
#' numericRangeInput(
#' inputId = "my_id", label = "Numeric Range Input:",
#' value = c(100, 400)
#' ),
#' verbatimTextOutput(outputId = "res1")
#'
#' )
#'
#' server <- function(input, output, session) {
#'
#' output$res1 <- renderPrint(input$my_id)
#'
#' }
#'
#' shinyApp(ui, server)
#'
#'
#' }
numericRangeInput <- function(inputId,
label,
value,
width = NULL,
separator = " to ",
min = NA,
max = NA,
step = NA) {
value <- shiny::restoreInput(id = inputId, default = value)
value <- c(min(value), max(value))
if (!is.na(min) && length(min) == 1)
min <- rep(min, 2)
if (!is.na(max) && length(max) == 1)
max <- rep(max, 2)
if (!is.na(step) && length(step) == 1)
step <- rep(step, 2)
input_tag <- function(value, min, max, step) {
inputTag <- tags$input(
type = "number",
class = "form-control",
value = formatNoSci(value)
)
if (!is.na(min))
inputTag$attribs$min <- min
if (!is.na(max))
inputTag$attribs$max <- max
if (!is.na(step))
inputTag$attribs$step <- step
inputTag
}
fromTag <- input_tag(value[1], min[1], max[1], step[1])
toTag <- input_tag(value[2], min[2], max[2], step[2])
rangeTag <- tags$div(
id = inputId,
class = "shiny-numeric-range-input form-group shiny-input-container",
style = css(width = validateCssUnit(width)),
label_input(inputId, label),
tags$div(
class = "input-numeric-range input-group",
fromTag,
tags$span(class = "input-group-addon input-group-text rounded-0", separator),
toTag
)
)
attachShinyWidgetsDep(rangeTag)
}
#' Change the value of a numeric range input
#'
#' @param session The session object passed to function given to shinyServer.
#' @inheritParams numericRangeInput
#'
#' @seealso [numericRangeInput()]
#'
#' @export
#'
#' @example examples/updateNumericRangeInput.R
updateNumericRangeInput <- function(session = getDefaultReactiveDomain(),
inputId,
label = NULL,
value = NULL) {
if (!is.null(value))
value <- c(min(value), max(value))
message <- list(
label = label,
value = value
)
session$sendInputMessage(inputId, dropNulls(message))
}