This worked very well on it's own, but either a)I broke it while trying to adapt it to mine or b)this didn't resolve the issue. Here is my implementation of what you suggested:
library(plotly)
library(lubridate)
library(dplyr)
GroupDatesLimited <- function(temp, from, to, date_type = 'day') {
x <- temp %>%
group_by(Date = floor_date(Date, date_type)) %>%
filter(as.Date(Date) >= as.Date(from) & as.Date(Date) <= as.Date(to)) %>%
summarize(Cases=sum(Cases))
return(x)
}
GroupDates <- function(temp, date_type = 'day') {
x <- temp %>%
group_by(Date = floor_date(Date, date_type)) %>%
summarize(Cases=sum(Cases))
return(x)
}
MakePlotlyLine <- function(df, x, y) {
p <- plot_ly(
df,
x = ~x,
y = ~y,
type = 'scatter',
mode = 'lines'
)
}
MakePlotlyBar <- function(df, x, y) {
p <- plot_ly(
df,
x = ~x,
y = ~y,
type = 'bar',
text = ~format(y, big.mark = ','),
textposition = 'outside',
textfont = list(color = '#000000')
)
}
x <- as.Date(as.character(20200310), format = '%Y%m%d')
df <- data.frame('Date' = seq.Date(x, x + 100, by = 'day'), 'Cases' = sample(1:100, 101, replace = TRUE))
ui <- {
fluidPage(
fluidRow(
column(width = 12, selectInput('selectedView', 'View', c('Daily', 'Weekly', 'Monthly'), 'Daily')),
column(width = 1, align = 'center', uiOutput('startDate_Cases'), uiOutput('endDate_Cases')), column(width = 10, plotlyOutput('myPlotly', height = '500px'))
)
)
}
server <- function(input, output, session) {
# Update the start date input based on the selected view
output$startDate_Cases <- renderUI({
req(input$selectedView)
switch (
input$selectedView,
'Daily' = {
data <- GroupDates(df, 'day')
dateInput('startDate_Cases', 'Start Date', value = min(data$Date), min = min(data$Date), max = max(data$Date), format = 'mm/dd/yyyy', startview = 'month')
},
'Weekly' = {
data <- GroupDates(df, 'week')
dateInput('startDate_Cases', 'Start Date', value = min(data$Date), min = min(data$Date), max = max(data$Date), format = 'mm/dd/yyyy', startview = 'month', daysofweekdisabled = c(1, 2, 3, 4, 5, 6))
},
'Monthly' = {
data <- GroupDates(df, 'month')
min_date <- as.Date(min(floor_date(data$Date, 'month')))
max_date <- as.Date(max(ceiling_date(data$Date, 'month'))) - 1
dateInput('startDate_Cases', 'Start Date', value = min_date, min = min_date, max = max_date, format = 'M, yyyy', startview = 'month')
}
)
})
# Update the end date input based on the selected view
output$endDate_Cases <- renderUI({
req(input$selectedView)
switch (
input$selectedView,
'Daily' = {
data <- GroupDates(df, 'day')
dateInput('endDate_Cases', 'End Date', value = max(data$Date), min = min(data$Date), max = max(data$Date), format = 'mm/dd/yyyy', startview = 'month')
},
'Weekly' = {
data <- GroupDates(df, 'week')
dateInput('endDate_Cases', 'End Date', value = max(data$Date), min = min(data$Date), max = max(data$Date), format = 'mm/dd/yyyy', startview = 'month', daysofweekdisabled = c(1, 2, 3, 4, 5, 6))
},
'Monthly' = {
data <- GroupDates(df, 'month')
min_date <- as.Date(min(floor_date(data$Date, 'month')))
max_date <- as.Date(max(ceiling_date(data$Date, 'month'))) - 1
dateInput('endDate_Cases', 'End Date', value = max_date, min = min_date, max = max_date, format = 'M, yyyy', startview = 'month')
}
)
})
cases <- reactive({
req(input$selectedView, input$startDate_Cases, input$endDate_Cases)
cat('selectedView- ', input$selectedView, '\n')
switch (
input$selectedView,
'Daily' = cases <- GroupDatesLimited(df, input$startDate_Cases, input$endDate_Cases, 'day'),
'Weekly' = cases <- GroupDatesLimited(df, input$startDate_Cases, input$endDate_Cases, 'week'),
'Monthly' = cases <- GroupDatesLimited(df, input$startDate_Cases, input$endDate_Cases, 'month')
)
cases
})
cases_db <- debounce(cases, millis = 300)
# Render the plot for the data using the selected inputs
output$myPlotly <- renderPlotly({
data <- req(cases_db())
switch(
input$selectedView,
'Daily' = MakePlotlyLine(data, data$Date, data$Cases),
'Weekly' = MakePlotlyLine(data, data$Date, data$Cases),
'Monthly' = MakePlotlyBar(data, data$Date, data$Cases)
)
})
}
# Run the application
shinyApp(ui = ui, server = server)
I put a cat statement in the reactive to see how many times it was called and besides the first run, it gets called twice. Sorry if I'm just dumb and broke it, everything I'm doing with R and Shiny has been self taught over the past month or so.
P.S. I changed the data <- reactive() to cases <- reactive() because I have 3 graphs that I am doing this with that all rely on different data sources.
