R/Pharma Events

#| '!! shinylive warning !!': |
#|   shinylive does not work in self-contained HTML documents.
#|   Please set `embed-resources: false` in your metadata.
#| standalone: true
#| viewerHeight: 600

library(shiny)
library(dplyr)
library(bslib)
library(bsicons)

# Load the talks CSV dataset
talks <- read.csv("https://rinpharma.github.io/data-pipelines/output/processed_talks.csv") |>
  mutate(
    datetime_est = as.POSIXct(paste(Date, Start), tz = "America/New_York"),
    # Convert to user's timezone
    datetime_local = as.POSIXct(datetime_est, tz = Sys.timezone(location = TRUE)),
    # Get date in local timezone
    date_local =  format(datetime_local, "%Y-%m-%d"),
    # Format to show only the time portion, e.g. "8:00 EST"
    Local_Time = format(datetime_local, "%H:%M %Z")
  )

icon_types <- c(
  "Keynote" = "person-video", 
  "Talk" = "person-video3", 
  "Workshop" = "people", 
  "Coffee session" = "cup-hot", 
  "Schedule only" = "cup-hot", 
  "Remarks" = "person-video3",
  "Panel" = "people",
  "On-Demand" = "person-video3"
)

ui <- page_fluid(
  tags$head(
    tags$style(HTML("
    
    /* Constrain the entire Shiny app height */
    html, body {
      height: 100%;
    }
    
    /* scrollbar for main panel */
    #main-scroll {
      height: calc(100vh - 1rem);
      overflow-y: auto;
      padding-right: 0.5rem;
    }

    /* sidebar never scrolls */
    .bslib-sidebar {
      max-height: 100vh;
      overflow: hidden;
    }
    
    /* Prevent Quarto page scroll */
    .shiny-frame,
    .shiny-bound-output,
    .container-fluid {
      height: 100%;
      overflow: hidden;
    }

    /* schedule items outer container */
    #event-items .item-outer {
      padding: 0.5rem;
      border-bottom: 0.5px solid #444;
    }

    /* schedule top row */
    #event-items .item-inner {
      display: flex;
      justify-content: space-between;
      align-items: center;
      width: 100%;
    }
    
    /* talk title */
    #event-items .event-title {
      font-weight: bold;
      margin-bottom: 0.25rem;
    }

    /* speaker names and affiliations */
    #event-items .event-speaker {
      color: #444;
      font-size: 90%;
    }

    /* styling for APAC badge */
    .apac {
      font-size: 0.5rem;
      vertical-align: middle;
    }
  "))),
  
  layout_sidebar(
    sidebar = sidebar(
      selectInput(
        "event", "Select Event:",
        choices = sort(unique(talks$Event)),
        selected = unique(talks$Event)[1]
      ),
      uiOutput("day_buttons")
    ),
    div(
      id = "main-scroll",
      uiOutput("schedule_ui")
    )
  )
)

server <- function(input, output, session) {
  
  # Track selected day
  selected_day <- reactiveVal(NULL)
  
  # Reactive subset by event
  event_data <- reactive({
    talks %>% filter(Event == input$event)
  })
  
  # Available days in selected event
  days <- reactive({
    unique(event_data()$date_local)
  })
  
  # Set a default day when event changes
  observeEvent(days(), {
    req(days())
    isolate({
      selected_day(days()[1])
    })
  })

  # dynamically generate day filter buttons or dropdown
  output$day_buttons <- renderUI({
    req(days())
    ds <- days()
    
    if (length(ds) <= 6) {
      # buttons for small number of days
      div(
        class = "d-grid gap-1",
        lapply(ds, function(d) {
          actionButton(
            inputId = paste0("day_", d),
            label = d,
            class = "btn-primary rounded-3",
            onclick = sprintf(
              "Shiny.setInputValue('day', '%s', {priority: 'event'})",
              d
            )
          )
        })
      )
    } else {
      # switch to dropdown for many days
      selectInput(
        "day",
        "Select day:",
        choices = ds,
        selected = selected_day()
      )
    }
  })
  
  # Button click or dropdown selection
  observeEvent(input$day, {
    req(input$day)
    selected_day(input$day)
  }, ignoreInit = TRUE)
  
  # schedule table
  output$schedule_ui <- renderUI({
    req(selected_day())
    df <- event_data() %>% filter(date_local == selected_day())
    
    if (nrow(df) == 0) {
      return(HTML("<p>No sessions for this day.</p>"))
    }
    
    # Build rows with popovers
    rows <- lapply(seq_len(nrow(df)), function(i) {
      session <- df[i,]
      
      if (session$Type %in% names(icon_types)) {
        type_icon <- bs_icon(icon_types[session$Type]) |> tooltip(session$Type)
      } else {
        type_icon <- bs_icon("app") 
      }
      
      ## Abstract icon
      if (is.na(session$Abstract)) {
        abstract_icon <- bs_icon("file-earmark-text", color = "#ccc")
      } else {
        abstract_icon <- popover(
          trigger = bs_icon("file-earmark-text"),
          title = "Abstract",
          session$Abstract
        )
      }
      
      ## Slides icon
      if (is.na(session$Slides)) {
        slides_icon <- bs_icon("easel3-fill", color = "#ccc")
      } else {
        slides_icon <- shiny::a(href = session$Slides, target = "_blank", bs_icon("easel3-fill", color = "#000"))
      }
      
      ## YouTube icon
      if (is.na(session$Video)) {
        youtube_icon <- bs_icon("youtube", color = "#ccc")
      } else {
        youtube_icon <- shiny::a(href = session$Video, target = "_blank", bs_icon("youtube", color = "#f00"))
      }
      
      ## Presenters and affiliations
      if (is.na(session$Speaker)) {
        speakers <- NULL
      } else {
        speaker_count <- stringr::str_count(session$Speaker, "\\|") + 1
        affiliation_count <- if (is.na(session$Affiliation)) 0 else stringr::str_count(session$Affiliation, "\\|") + 1
        split_speakers <- unlist(strsplit(session$Speaker, " \\| "))
        if (speaker_count == affiliation_count) {
          split_affiliations <- unlist(strsplit(session$Affiliation, " \\| "))
          speakers <- glue::glue_collapse(glue::glue("{split_speakers} ({split_affiliations})"), sep = ", ", last = " and ")
        } else {
          speakers <- glue::glue_collapse(split_speakers, sep = ", ", last = " and ")
        }
      }
      
      ## APAC badge
      if (is.na(session$APAC)) {
        apac_badge <- NULL
      } else {
        apac_badge <- span(class = "badge bg-light text-dark apac", "APAC") |> 
          tooltip("session held in APAC region")
      }
      
      shiny::tags$div(
        class = "item-outer",
        div(class = "item-inner",
            span(
              span(class = "me-2", type_icon),
              session$Local_Time,
              apac_badge
            ),
            span(
              span(class = "me-2", slides_icon), 
              span(class = "me-2", youtube_icon), 
              abstract_icon
            )
        ),
        shiny::tags$div(class = "event-title", session$Title),
        shiny::tags$div(class = "event-speaker", speakers)
      )
    })
    
    card(
      card_header(paste("Schedule:", selected_day())),
      div(id = "event-items", class = "list-group", rows)
    )
    
  })
}

shinyApp(ui, server)