Вот рабочий пример:
PS: Вы должны быть осторожны, используя сокращения названий месяцев, поскольку они зависят от региона.
library(shiny)
library(plotly)
ui <- fluidPage(
titlePanel("Plotly - dateRangeInput"),
sidebarLayout(
sidebarPanel(
dateRangeInput(inputId="myDateRange", label="", start = NULL, end = NULL, min = NULL, max = NULL)
),
mainPanel(
plotlyOutput("age")
)
)
)
server <- function(input, output, session) {
data_ <- data.frame(stringsAsFactors=FALSE,
dates = c("NOV-17", "DEC-17", "JAN-18", "FEB-18", "MAR-18"),
ex = c(77L, 98L, 65L, 77L, 44L),
act = c(90L, 78L, 87L, 54L, 34L))
data_$helperDates <- as.Date(paste0(data_$dates, "-01"), format="%b-%y-%d")
data_ <- data_[order(data_$helperDates, decreasing = FALSE), ]
data_$dates <- factor(data_$dates, levels = c(as.character(data_$dates)))
minDate <- min(data_$helperDates, na.rm = TRUE)
maxDate <- max(data_$helperDates, na.rm = TRUE)
updateDateRangeInput(session, inputId="myDateRange", start = minDate, end = maxDate, min = minDate, max = maxDate)
filteredData <- reactive({
req(input$myDateRange)
na.omit(data_[data_$helperDates >= input$myDateRange[1] & data_$helperDates <= input$myDateRange[2], ])
})
output$age <- renderPlotly({
req({nrow(filteredData()) > 0})
age <- plot_ly(filteredData(), x = ~dates, y = ~ex, name = 'Expect', type = 'scatter', mode = 'lines+markers',
line = list(color = 'rgb(205, 12, 24)', width = 4)) %>%
add_trace(y =~act, name = 'Actual', mode = 'lines+markers', line = list(color = 'rgb(170, 255, 102)', width = 4)) %>%
layout(title = "Mon vs KM",
xaxis = list(title = "Mon"),
yaxis = list (title = "KM"),
legend = list(orientation = 'h'))
})
}
shinyApp(ui = ui, server = server)