inst/hbcdtlfb/www/R/outputs/calendar.R

In ucsd-dsm/hbcd-tlfb: HBCD TLFB shiny app

output$calendar <- renderCalendar({
  req(input$nature)
  req(timevis_data_cal())
  
  ifelse(
    input$display_holidays,
    data <- timevis_data_cal() |> 
      filter(calendarId != 1),
    data <- timevis_data_cal() |> 
      filter(calendarId != 1, calendarId != 3)
  )
  
  if(input$nature == "Routine")   defaultDate <- dates_study()$P1[1]
  if(input$nature == "Pre-LMP")   defaultDate <- dates_study()$P1[1]
  if(input$nature == "Post-LMP")  defaultDate <- dates_study()$P2[1]
  if(input$nature == "Last Week") defaultDate <- dates_study()$P3[1]
  if(input$nature == "Last Two Weeks Before Delivery") defaultDate <- dates_study()$P4[1]
  
  bg_colors_substances <- RColorBrewer::brewer.pal(6, "Set3")
  
  calendar(
    data = data, 
    view = "month",
    defaultDate = defaultDate,
    scheduleView = TRUE,
    navigation = TRUE,
    navOpts = navigation_options(
      today_label = "TODAY",
      class = "bttn-bordered bttn-sm bttn-primary black",
    )
  ) |> 
    cal_month_options(
      visibleWeeksCount = input$nb_weeks_display
    ) |>
    cal_theme(
      common.holiday.color = "#ff5964",
      common.saturday.color = "#ff5964"
    ) |> 
    # id:
    # 1 = periods of focus (pre-LMP...)
    # 2 = notable days: last day of LMP, date of delivery, today
    # 3 = holidays
    # 10-15 = substance
    cal_props(
      list(
        id = 1,
        name = "Periods of Focus",
        color = "white",
        bgColor = "steelblue",
        borderColor = "steelblue"
      ),
      list(
        id = 2,
        name = "Notable Days",
        color = "white",
        bgColor = "forestgreen",
        borderColor = "forestgreen"
      ),
      list(
        id = 3,
        name = "Holidays, Event",
        color = "white",
        bgColor = "forestgreen",
        borderColor = "forestgreen"
      ),
      list(
        id = 10,
        name = "Tobacco/Nicotine",
        color = "black",
        bgColor = bg_colors_substances[1],
        borderColor = bg_colors_substances[1]
      ),
      list(
        id = 11,
        name = "Alcohol",
        color = "black",
        bgColor = bg_colors_substances[2],
        borderColor = bg_colors_substances[2]
      ),
      list(
        id = 12,
        name = "Opioids",
        color = "black",
        bgColor = bg_colors_substances[3],
        borderColor = bg_colors_substances[3]
      ),
      list(
        id = 13,
        name = "Cannabis",
        color = "black",
        bgColor = bg_colors_substances[4],
        borderColor = bg_colors_substances[4]
      ),
      list(
        id = 14,
        name = "Simulants",
        color = "black",
        bgColor = bg_colors_substances[5],
        borderColor = bg_colors_substances[5]
      ),
      list(
        id = 15,
        name = "Other",
        color = "black",
        bgColor = bg_colors_substances[6],
        borderColor = bg_colors_substances[6]
      )
    )
})