-
Notifications
You must be signed in to change notification settings - Fork 97
/
Copy pathcalendar.R
136 lines (131 loc) · 4.1 KB
/
calendar.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
136
#' Create Semantic UI Calendar
#'
#' This creates a default calendar input using Semantic UI. The input is available
#' under \code{input[[input_id]]}.
#'
#' @param input_id Input name. Reactive value is available under \code{input[[input_id]]}.
#' @param value Initial value of the numeric input.
#' @param placeholder Text visible in the input when nothing is inputted.
#' @param type Select from \code{'year'}, \code{'month'}, \code{'date'} and \code{'time'}
#' @param min Minimum allowed value.
#' @param max Maximum allowed value.
#'
#' @examples
#' # Basic calendar
#' if (interactive()) {
#'
#' library(shiny)
#' library(shiny.semantic)
#'
#' ui <- shinyUI(
#' semanticPage(
#' title = "Calendar example",
#' calendar("date"),
#' p("Selected date:"),
#' textOutput("selected_date")
#' )
#' )
#'
#' server <- shinyServer(function(input, output, session) {
#' output$selected_date <- renderText(
#' as.character(input$date)
#' )
#' })
#'
#' shinyApp(ui = ui, server = server)
#' }
#'
#' \dontrun{
#' # Calendar with max and min
#' calendar(
#' name = "date_finish",
#' placeholder = "Select End Date",
#' min = "2019-01-01",
#' max = "2020-01-01"
#' )
#'
#' # Selecting month
#' calendar(
#' name = "month",
#' type = "month"
#' )
#' }
#'
#'
#' \dontrun{
#' # Calendar range
#' calendar(
#' input_id = "start_date",
#' type = "date",
#' value = "2020-02-20",
#' min = "2020-01-01",
#' max = "2020-03-01",
#' )
#'
#' calendar(
#' input_id = "end_date",
#' type = "date",
#' value = "2020-02-23",
#' min = "2020-01-01",
#' max = "2020-03-01",
#' )
#' }
#' @rdname calendar
#' @export
calendar <- function(input_id, value = NULL, placeholder = NULL, type = "date", min = NA, max = NA) {
if (!is.null(value)) value <- format(as.Date(value), "%Y/%m/%d")
if (!is.na(min)) min <- format(as.Date(min), "%Y/%m/%d")
if (!is.na(max)) max <- format(as.Date(max), "%Y/%m/%d")
cal_widget <-
div(
id = input_id, class = "ui calendar ss-input-date", `data-type` = type, `data-date` = value,
div(
class = "ui input left icon",
tags$i(class = "calendar icon"),
tags$input(type = "text", placeholder = placeholder)
)
)
if (!is.na(min)) cal_widget$attribs[["data-min-date"]] <- min
if (!is.na(max)) cal_widget$attribs[["data-max-date"]] <- max
cal_widget
}
#' Defines calendar ranges
#'
#'
#' @param input_id Input name. Reactive value is available under \code{input[[input_id]]}.
#' @param value Initial value of the numeric input.
#' @param placeholder Text visible in the input when nothing is inputted.
#' @param type Select from \code{'year'}, \code{'month'}, \code{'date'} and \code{'time'}
#' @param min Minimum allowed value.
#' @param max Maximum allowed value.
#' @param start_calendar_id id of the calendar that defines the range start.
#' @param end_calendar_id id of the calendar that defines the range end.
#'
#' @rdname calendar_range_single
#'
#' @export
calendar_range_single <- function(input_id, value = NULL, placeholder = NULL, type = "date", min = NA, max = NA,
start_calendar_id = NULL, end_calendar_id = NULL) {
cal_widget <- calendar(input_id, value, placeholder, type, min, max)
if (!is.null(start_calendar_id)) cal_widget$attribs[["data-start-calendar-id"]] <- start_calendar_id
if (!is.null(end_calendar_id)) cal_widget$attribs[["data-end-calendar-id"]] <- end_calendar_id
cal_widget
}
#' Update UI calendar
#'
#' This function updates the date on a calendar
#'
#' @param session The \code{session} object passed to function given to
#' \code{shinyServer}.
#' @param input_id ID of the calendar that will be updated
#'
#' @rdname calendar
#'
#' @export
update_calendar <- function(session, input_id, value = NULL, min = NULL, max = NULL) {
if (!is.null(value)) value <- format(as.Date(value), "%Y/%m/%d")
if (!is.null(min)) min <- format(as.Date(min), "%Y/%m/%d")
if (!is.null(max)) max <- format(as.Date(max), "%Y/%m/%d")
message <- list(value = value, min = min, max = max)
session$sendInputMessage(input_id, message = message)
}