home_schedule.qmd

---
title: Schedule
subtitle: |
    The schedule is intended for when following a live workshop. If you
    are following this at your own pace, see **Contents**.
pagetitle: Schedule | Tools for Reproducible Research
toc: false
number-sections: false
sidebar: false
format: html
freeze: false
---

```{r}
#| echo: false
#| include: false

library(lubridate)
library(dplyr)
library(fontawesome)
library(htmlTable)
library(yaml)
library(readxl)
library(here)

schedule_message <- yaml::read_yaml(here("_quarto.yml"))$schedule_message
asst <- yaml::read_yaml("_quarto.yml")$assistant

#' @description Add hover classes to assistants
#' @param a vector of assistants
#' @param ids named vector of assistant ids
create_tooltip <- function(a, asst) {
    asst <- lapply(strsplit(asst, ":"), trimws)
    ids <- sapply(asst, "[[", 1)
    names(ids) <- sapply(asst, "[[", 2)

    for (i in seq_along(a)) {
        if (!is.na(a[i])) {
            x <- sapply(unlist(strsplit(a[i], ",")), trimws)
            y <- sapply(x, function(x) {
                if (x %in% ids) {
                    names(ids)[match(x, ids)]
                } else {
                    x
                }
            })
            a[i] <- paste(mapply(function(abbr, name) paste0('<span class="hover-text">', abbr, '<span class="tooltip-text top">', name, "</span></span>"), abbr = x, name = y), collapse = "<span>,</span>")
        }
    }
    return(a)
}
```

```{r}
#| echo: false
#| eval: true

s <- readxl::read_xlsx("schedule.xlsx") %>%
  # remove rows that are all NA
  filter(if_any(everything(), ~ !is.na(.))) %>%
  # missing values in date and room are filled
  tidyr::fill(date, room, link_room, .direction = "down") %>%
  # convert date characters to date objects
  dplyr::mutate(date = format(as_datetime(date, format = "%d/%m/%Y"), "%d-%b-%Y")) %>%
  dplyr::mutate(day = format(as_datetime(date, format = "%d-%b-%Y"), "%a")) %>%
  dplyr::group_by(date) %>%
  dplyr::mutate(time = format(time, "%H:%M")) %>%
  as.data.frame() %>%
  dplyr::mutate(room = ifelse(is.na(link_room), room, paste0("<a href='", link_room, "'>", room, "</a>"))) %>%
  # create day label (with date, day, room)
  dplyr::mutate(date = paste0("<p style='font-size:110%;padding-top:10px;padding-bottom:5px;'><span style='font-weight:bold;'><span class='marker'>", fa("fas fa-calendar"), "</span>", date, "</span>", "<span style='color:white;border-radius:4px;padding-right:4px;padding-left:4px;background:#95b540;margin-left:9px;margin-right:7px;'>", day, "</span>", "<span class='marker'>", fa("fas fa-location-dot"), "</span>", room, "</p>")) %>%
  # style topic
  dplyr::mutate(topic = ifelse(tolower(topic) == "break" | tolower(topic) == "lunch", paste0("<span class='topic'>", topic, "</span>"), topic)) %>%
  dplyr::mutate(topic = ifelse(grepl("dinner", tolower(topic)), paste0("<span class='topic-dinner'>", topic, "</span>"), topic)) %>%
  dplyr::mutate(topic = ifelse(!startsWith(topic, "<span"), paste0("<span style='margin-right:5px;'>", topic, "</span>"), topic)) %>%
  # add links to topic
  dplyr::mutate(topic = ifelse(is.na(link_slide), topic, paste0("<span>", topic, "<a class='marker' href='", link_slide, "'>", fa("fas fa-file-powerpoint"), "</a></span>"))) %>%
  dplyr::mutate(topic = ifelse(is.na(link_lab), topic, paste0("<span>", topic, "<a class='marker' href='", link_lab, "'>", fa("fas fa-file-lines"), "</a></span>"))) %>%
  dplyr::mutate(topic = ifelse(is.na(link_youtube), topic, paste0("<span>", topic, "<a class='marker' href='", link_youtube, "' target=”_blank”>", fa("fab fa-youtube"), "</a></span>"))) %>%
  dplyr::mutate(instructor = ifelse(is.na(instructor), "", instructor)) %>%
  dplyr::mutate(assistant = ifelse(is.na(assistant), "", assistant)) %>%
  dplyr::select(date, room, time, topic, instructor, assistant)

if (all(is.na(s$assistant)) | all(s$assistant == "")) {
  s$assistant <- NULL
  cnames <- c("Time", "Topic", "Instructor")
} else {
  s$assistant <- create_tooltip(s$assistant, asst)
  cnames <- c("Time", "Topic", "Instructor", "Assistant")
}
```

```{r}
#| echo: false
#| results: asis
if (!is.null(schedule_message)) {
  if (nchar(schedule_message) != 0) {
    cat(paste0("::: {.callout-note}\n", schedule_message, "\n:::\n"))
  }
}
```

::: {.table-schedule}

```{r}
#| echo: false
#| eval: true
#| html-table-processing: none

# grouping vector
r <- rle(s$date)
row.names(s) <- NULL

s %>%
    dplyr::select(-date, -room) %>%
    setNames(cnames) %>%
    addHtmlTableStyle(align = "clll", align.header = "clll", css.cell = "padding-right:1em;") %>%
    htmlTable(rnames = FALSE, rgroup = r$values, n.rgroup = r$lengths)
```

```{r}
#| echo: false
#| eval: false

library(gt)

s %>%
  select(-room) %>%
  #group_by(date) %>%
  gt(groupname_col = "date", process_md = TRUE) %>%
  fmt_markdown() %>%
  cols_align(align = "left")
```

```{r}
#| echo: false
#| eval: false

library(kableExtra)

r <- rle(s$date)
packs <- r$lengths
names(packs) <- r$values

s %>%
    kbl(format = "html", escape = FALSE) %>%
    kable_styling(bootstrap_options = c("striped", "hover", "condensed", full_width = FALSE)) %>%
    pack_rows(index = packs, escape = FALSE)
```

<!-- marker legend -->
<p class="small" style="margin-top:20px;text-align:center;">
<span>
<span style="margin-left:6px; margin-right:6px;">
{{< fa calendar >}} Date
</span>
<span style="margin-left:6px; margin-right:6px;">
{{< fa map-marker-alt >}}  Venue
</span>
<span style="margin-left:6px; margin-right:6px;">
{{< fa file-powerpoint >}}  Slides
</span>
<span style="margin-left:6px; margin-right:6px;">
{{< fa file-lines >}}  Lab
</span>
<span style="margin-left:6px; margin-right:6px;">
{{< fa brands youtube >}}  Video
</span>
</span>
</p>

:::