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", 
  "On-Demand" = "person-video3"
)

ui <- page_fluid(
tags$head(
  tags$style(HTML("
    #event-items .item-outer {
      padding: 0.5rem;
      border-bottom: 0.5px solid #444;
    }
    #event-items .item-inner {
      display: flex;
      justify-content: space-between;
      align-items: center;
      width: 100%;
    }
    #event-items .event-title {
      font-weight: bold;
      margin-bottom: 0.25rem;
    }
    #event-items .event-speaker {
      color: #444;
      font-size: 90%;
    }
  "))),

  layout_sidebar(
    sidebar = sidebar(
      selectInput(
        "event", "Select Event:",
        choices = sort(unique(talks$Event)),
        selected = unique(talks$Event)[1]
      ),
      uiOutput("day_buttons")
    ),
    uiOutput("schedule_ui")
  )
)

server <- function(input, output, session) {
  
  # Reactive subset by event
  event_data <- reactive({
    talks %>% filter(Event == input$event)
  })
  
  # Available days in selected event
  days <- reactive({
    unique(event_data()$date_local)
  })
  
  # dynamically generate day filter buttons
  output$day_buttons <- renderUI({
    lapply(days(), function(d) {
      actionButton(inputId = paste0("day_", d), label = d, class = "btn-primary m-0 rounded-3")
    })
  })
  
  # track selected day
  selected_day <- reactiveVal(NULL)
  
  # default day
  observeEvent(days(), {
    if (length(days()) > 0) selected_day(days()[1])
  })
  
  # update when button clicked
  observe({
    lapply(days(), function(d) {
      observeEvent(input[[paste0("day_", d)]], {
        selected_day(d)
      })
    })
  })
  
  # 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% c("Keynote", "Talk", "Workshop", "Coffee session", "Schedule only", "On-Demand")) {
        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
        )
      }

      ## 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"))
      }

      ## Presenter
      if (is.na(session$Affiliation)) {
        if (is.na(session$Speaker)) {
          speaker <- ""
        } else {
          speaker <- session$Speaker
        }
      } else {
      speaker <- paste0(session$Speaker, " (", session$Affiliation, ")")
      }

      shiny::tags$div(
        class = "item-outer",
        div(class = "item-inner",
          span(
            span(class = "me-2", type_icon),
            session$Local_Time
          ),
          span(
            span(class = "me-2", youtube_icon), 
            abstract_icon
          )
        ),
        shiny::tags$div(class = "event-title", session$Title),
        shiny::tags$div(class = "event-speaker", speaker)
      )
    })
    
    card(
      card_header(paste("Schedule:", selected_day())),
      div(id = "event-items", class = "list-group", rows)
    )
    
  })
}

shinyApp(ui, server)