Is there a way to imitate the daysofweekdisabled found in dateInput?
I want people to select only mondays.
Unfortunately, there is no built-in feature of function dateRangeInput. However, one can create a hook to evaluate if a given input is valid or not i.e. both start and end date is on a Monday:
library(shiny)
library(lubridate)
ui <- fluidPage(
dateRangeInput("daterange1", "Date range:",
start = "2001-01-01",
end = "2010-12-31"
),
textOutput("daterange1_valid")
)
server <- function(input, output, session) {
output$daterange1_valid <- renderText({
is_valid <- all(input$daterange1 %>% map_lgl(~ wday(.x, label = TRUE) == "Mon"))
ifelse(is_valid, "valid", "not valid. Start and end must be on a Monday!")
})
}
shinyApp(ui, server)
Another way is to just use two dateInput elements instead. This will allow you to also color days other than Monday grey in the picker.
Related
I'm trying to create a slider. None of the base values I'm working with have decimals in them, so I have no idea why this continues to happen. I also have set the round parameter within the function as round = TRUE.
library(shiny)
test_df <- 19:45
ui <- fluidPage(
sliderInput("range1", label = h3("Select Range"), min(test_df),
max(test_df), value = c(min(test_df), max(test_df)), round = TRUE)
)
server <- function(input, output, session){
}
shinyApp(ui, server)
But as you can see, when you run it, it keeps showing numbers with decimals in the slider range.
I'm clearly missing something but have no idea as to what it is.
It looks like inputSlider made 10 ticks on your slider, regardless of whether or not that makes sense. 45-19=26, 26/10=2.6, and we are seeing steps of 2.6 on the slider. We can add a step argument to fix the slider so it moves in increments of 1 or whatever you choose.
library(shiny)
test_df <- 19:45
ui <- fluidPage(
sliderInput("range1", label = h3("Select Range"), min(test_df),
max(test_df), value = c(min(test_df), max(test_df)), round = TRUE,
step = 1)
)
server <- function(input, output, session){
}
shinyApp(ui, server)
I have the following code that should ask for a date and a time and then merge them together to get a date-time variable, if possible POSIXct.
library(shiny)
library(shinyTime)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
dateInput(inputId='dateRange1',
label = 'Enter initial date: yyyy-mm-dd'),
timeInput("time_input1", "Enter time of the initial day", value = strptime("00:00:00", "%T"))
),
mainPanel(
textOutput("time_output1")
)))
################
server <- function(input, output) {
vals <- reactiveValues()
observe({
vals$initial_date <-paste(as.character(input$dateRange1),strftime(input$time_input1, "%T") , collapse = " - ")
})
output$time_output1 <- renderText(vals$initial_date)
}
shinyApp(ui, server)
I would like the class of vals$initial_date to be "POSIXct" "POSIXt", but I do not manage. I need to make operations with the dates and times. I have tried many things, among other ones I have used:
vals$initial_date<- strptime(vals$initial_date, "%d-%m-%Y %H:%M:%S")
and
vals$initial_date<- as.POSIXct(vals$initial_date, "%d-%m-%Y %H:%M:%S")
inside the 'observe', but it did not work.
Can someone please tell me where my problem is?
thanks!
The time input already has the date component, we can get rid of it if you like. Note that I have added the inherits test to see if the object in the reactiveValues() is of type POSIXct. Also I added some renderText conditional so it displays full datetime oppose to just date when rendering 00:00:00
library(shiny)
library(shinyTime)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
dateInput(inputId='dateRange1',label = 'Enter initial date: yyyy-mm-dd ', value = Sys.Date()),
timeInput("time_input1", "Enter time of the initial day", value = strptime("00:00:00", "%T"))
),
mainPanel(
textOutput("time_output1")
)))
################
server <- function(input, output) {
vals <- reactiveValues()
observe({
testdatetime <- paste(input$dateRange1,strftime(input$time_input1, format="%H:%M:%S"))
testdatetime <- as.POSIXct(testdatetime, format="%Y-%m-%d %H:%M:%S",tz= "UTC")
vals$initial_date <- testdatetime
# Check if the Time is a POSIXct object
test <- inherits(testdatetime, "POSIXct")
print(test)
})
output$time_output1 <- renderText({
value <- as.character(vals$initial_date)
if(nchar(value) == nchar(as.character(Sys.Date()))){
value <- paste(value,"00:00:00 ")
}
value
})
}
shinyApp(ui, server)
I would like to know if there was a trick to prevent users from setting the end date before the beginning date using dateRangeInput in Shiny (say the first date is "01-01-2016", the second date cannont go lower than that).
I tried by redefining the min and the max each time, but then I get stuck and cannot get my min back to its original value.
Here is an example. Basically it observes changes in start date and then update the dateRangeInput object dynamically. If the previously selected end date is earlier than the new start date, then the end date is updated. The minimum possible date is also updated so that user cannot select an end date earlier than start date.
library(shiny)
ui <- shinyUI(fluidPage(
titlePanel("Dynamically change dateRangeInput"),
sidebarLayout(
sidebarPanel(
dateRangeInput("date_range", "Range of dates")
),
mainPanel(
textOutput("text")
)
)
))
server <- shinyServer(function(input, output, session) {
# Update the dateRangeInput if start date changes
observeEvent(input$date_range[1], {
end_date = input$date_range[2]
# If end date is earlier than start date, update the end date to be the same as the new start date
if (input$date_range[2] < input$date_range[1]) {
end_date = input$date_range[1]
}
updateDateRangeInput(session,"date_range", start=input$date_range[1], end=end_date, min=input$date_range[1] )
})
output$text <- renderText({
validate(
need(input$date_range[2] >= input$date_range[1], "End date cannot be earlier than start date!")
)
input$date_range[2] >= input$date_range[1]
})
})
shinyApp(ui = ui, server = server)
I am currently building a shiny app and trying to get a set of dates to render as character strings to the end user, while still keeping their date format when invoked in the server side code.
There might be a simple solution here, but unsure how to get the dates to format in the selectInput dropdown. In my actual use case, using a date slider isn't ideal as the dates do not follow a common interval.
Reproducible example below:
# setup
require(lubridate)
test.dates <- as.Date(c('2014-06-01', '2014-07-01', '2014-08-01',
'2014-09-01', '2014-10-01', '2014-11-01',
'2014-12-01', '2015-01-01','2015-02-01',
'2015-03-01', '2015-04-01'))
test.names <- as.character(paste0(month(test.dates, label = T), ' ',
year(test.dates)))
test.df <- data.frame(date = test.dates)
row.names(test.df) <- test.names
# shiny
server <- function(input, output) {
output$table <- renderTable(test.df)
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("test", label = "DATE FORMAT TEST:", choices =
test.df, selected = test.df[1,])
),
mainPanel(tableOutput('table'))
)
)
shinyApp(ui = ui, server = server)
I believe you will find it much easier to pass around character objects than date objects in Shiny. I would simply use the direct character values of your dates and whenever you need them to be date objects in your subsequent analysis explicitly convert to a date object. The following provides an example where both the dropdown and table have the character formatted dates.
require(lubridate)
myDates <- c('2014-06-01', '2014-07-01', '2014-08-01',
'2014-09-01', '2014-10-01', '2014-11-01',
'2014-12-01', '2015-01-01','2015-02-01',
'2015-03-01', '2015-04-01')
test.names <- as.character(paste0(lubridate::month(test.dates, label=TRUE), ' ',
year(test.dates)))
test.df <- data.frame(date = myDates)
row.names(test.df) <- test.names
# shiny
server <- function(input, output) {
output$table <- renderTable(test.df)
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("test", label = "DATE FORMAT TEST:", choices =
myDates, selected = myDates[1])
),
mainPanel(tableOutput('table'))
)
)
shinyApp(ui = ui, server = server)
I have a date range input function as follows in my ui for my shiny app.
dateRangeInput("dates",
"Date range",
start = "2015-01-01",
end = as.character(Sys.Date()))
However I want a pop up message to correct the user if the user chooses a start date that is later than the end date, instead of an error in the app. How do i do this?
Also is it possible to only allow the user to choose a date range which is more than, say x, days.
You can provide custom error messages with a validate statement. Here is a simple example.
library(shiny)
runApp(
list(
ui = fluidPage(
dateRangeInput("dates",
"Date range",
start = "2015-01-01",
end = as.character(Sys.Date())),
textOutput("DateRange")
),
server = function(input, output){
output$DateRange <- renderText({
# make sure end date later than start date
validate(
need(input$dates[2] > input$dates[1], "end date is earlier than start date"
)
)
# make sure greater than 2 week difference
validate(
need(difftime(input$dates[2], input$dates[1], "days") > 14, "date range less the 14 days"
)
)
paste("Your date range is",
difftime(input$dates[2], input$dates[1], units="days"),
"days")
})
}
))