Publish verified ratings on GitHub Pages with readable history charts

.github/workflows/ci.yml

@@ -21,3 +21,23 @@ jobs:
           use-public-rspm: true
       - uses: r-lib/actions/setup-renv@f9a764fea8d5c63df6ef9a5c7795bf7deb5d7e05 # v2
       - run: make check
+      - uses: quarto-dev/quarto-actions/setup@8a96df13519ee81fd526f2dfca5962811136661b # v2.2.0
+        with:
+          version: '1.10.19'
+      - run: make site
+      - name: Capture website previews
+        run: |
+          mkdir -p out/previews
+          for page in index docs/test docs/odi docs/t20i; do
+            for size in 1440,1800 480,2000; do
+              google-chrome --headless --no-sandbox --disable-gpu --hide-scrollbars \
+                --timeout=15000 --window-size="$size" \
+                --screenshot="out/previews/${page##*/}-${size%,*}.png" \
+                "file://$PWD/out/site/$page.html"
+            done
+          done
+      - uses: actions/upload-artifact@cf430e030ddbb5b0abf93d22962f4752f3646cd9 # v7.0.2
+        with:
+          name: site-previews
+          path: out/previews
+          retention-days: 7

.github/workflows/pages.yml

@@ -0,0 +1,61 @@
+name: Publish site
+
+on:
+  push:
+    branches: [main]
+  workflow_dispatch:
+  workflow_call:
+    inputs:
+      ref:
+        description: Commit containing the validated publication
+        type: string
+        required: true
+
+permissions:
+  contents: read
+
+concurrency:
+  group: pages
+  cancel-in-progress: false
+
+jobs:
+  build:
+    if: github.ref == 'refs/heads/main'
+    runs-on: ubuntu-latest
+    timeout-minutes: 30
+    permissions:
+      contents: read
+      pages: read
+    steps:
+      - uses: actions/checkout@3d3c42e5aac5ba805825da76410c181273ba90b1 # v7.0.1
+        with:
+          ref: ${{ inputs.ref || github.sha }}
+          persist-credentials: false
+      - uses: r-lib/actions/setup-r@f9a764fea8d5c63df6ef9a5c7795bf7deb5d7e05 # v2
+        with:
+          r-version: '4.6.0'
+          use-public-rspm: true
+      - uses: r-lib/actions/setup-renv@f9a764fea8d5c63df6ef9a5c7795bf7deb5d7e05 # v2
+      - uses: quarto-dev/quarto-actions/setup@8a96df13519ee81fd526f2dfca5962811136661b # v2.2.0
+        with:
+          version: '1.10.19'
+      - run: make site
+      - uses: actions/configure-pages@45bfe0192ca1faeb007ade9deae92b16b8254a0d # v6.0.0
+      - uses: actions/upload-pages-artifact@fc324d3547104276b827a68afc52ff2a11cc49c9 # v5.0.0
+        with:
+          path: out/site
+
+  deploy:
+    needs: build
+    runs-on: ubuntu-latest
+    timeout-minutes: 10
+    permissions:
+      pages: write
+      id-token: write
+    environment:
+      name: github-pages
+      url: ${{ steps.deployment.outputs.page_url }}
+    steps:
+      - name: Deploy verified site
+        id: deployment
+        uses: actions/deploy-pages@368f82528645a54fb793d4d04e342629a3f51346 # v5.0.1

.github/workflows/ratings.yml

@@ -19,10 +19,13 @@ concurrency:
 
 jobs:
   update:
+    if: github.ref == 'refs/heads/main'
     runs-on: ubuntu-latest
     timeout-minutes: 120
     permissions:
       contents: write
+    outputs:
+      commit: ${{ steps.publication.outputs.commit }}
     steps:
       - uses: actions/checkout@3d3c42e5aac5ba805825da76410c181273ba90b1 # v7.0.1
         with:
@@ -32,6 +35,9 @@ jobs:
           r-version: '4.6.0'
           use-public-rspm: true
       - uses: r-lib/actions/setup-renv@f9a764fea8d5c63df6ef9a5c7795bf7deb5d7e05 # v2
+      - uses: quarto-dev/quarto-actions/setup@8a96df13519ee81fd526f2dfca5962811136661b # v2.2.0
+        with:
+          version: '1.10.19'
       - run: make check
       - name: Fetch, prepare, fit, and render
         env:
@@ -42,7 +48,10 @@ jobs:
             args+=(--refresh)
           fi
           Rscript scripts/pipeline.R "${args[@]}"
+      - name: Validate website before publishing data
+        run: make site
       - name: Publish validated results
+        id: publication
         run: |
           git config user.name 'github-actions[bot]'
           git config user.email '41898282+github-actions[bot]@users.noreply.github.com'
@@ -51,3 +60,14 @@ jobs:
             git commit -m 'Update cricket ratings'
             git push origin HEAD:main
           fi
+          echo "commit=$(git rev-parse HEAD)" >> "$GITHUB_OUTPUT"
+
+  site:
+    needs: update
+    permissions:
+      contents: read
+      pages: write
+      id-token: write
+    uses: ./.github/workflows/pages.yml
+    with:
+      ref: ${{ needs.update.outputs.commit }}

.gitignore

@@ -18,3 +18,7 @@ out/**/stage-*/
 out/**/*.previous/
 figs/stage-*/
 figs/*.previous/
+out/site/
+
+/.quarto/
+**/*.quarto_ipynb

DESCRIPTION

@@ -6,10 +6,13 @@ Imports:
     digest,
     EloRating,
     ggplot2,
+    ggrepel,
     httr2,
     jsonlite,
+    knitr,
     readr,
     rlang,
+    rmarkdown,
     rvest,
     xml2,
     lintr,

Makefile

@@ -1,4 +1,6 @@
-.PHONY: sync fetch prepare analyze visualize publish update lint test check ci-docker
+.PHONY: sync fetch prepare analyze visualize publish update site lint test check ci-docker
+
+QUARTO ?= quarto
 
 sync:
 	Rscript -e 'renv::restore(prompt = FALSE)'
@@ -14,5 +16,9 @@ test:
 
 check: lint test
 
+site:
+	$(QUARTO) render
+	Rscript scripts/check_site.R
+
 ci-docker:
 	docker run --rm -v "$(CURDIR):/app" -w /app -e RENV_PATHS_LIBRARY=/tmp/library -e RENV_PATHS_CACHE=/tmp/cache rocker/r-ver:4.6.0 sh -c 'apt-get update && apt-get install -y libcurl4-openssl-dev libssl-dev libxml2-dev && make sync check'

R/pipeline.R

@@ -5,7 +5,8 @@ write_json <- function(value, path) {
 }
 
 code_fingerprint <- function() {
-  paths <- sort(c(list.files("R", pattern = "\\.R$", full.names = TRUE), "scripts/pipeline.R", "renv.lock"))
+  modules <- setdiff(list.files("R", pattern = "\\.R$", full.names = TRUE), "R/site.R")
+  paths <- sort(c(modules, "scripts/pipeline.R", "renv.lock"))
   if (length(paths) < 3L || !all(file.exists(paths))) stop("Run from the repository root to record code provenance")
   as.list(setNames(vapply(paths, sha256, character(1)), paths))
 }
@@ -101,30 +102,22 @@ read_analysis <- function(directory) {
   list(manifest = manifest, latest = read("latest"), monthly = read("monthly"), updates = read("updates"))
 }
 
-chart_data <- function(latest, monthly, format_name) {
-  leaders <- head(latest[latest$format == format_name & latest$is_active, ], 10)
-  history <- monthly[monthly$format == format_name & monthly$team_id %in% leaders$team_id, ]
-  history$team <- leaders$team[match(history$team_id, leaders$team_id)]
-  history
-}
-
 visualize_data <- function(input, output) {
   data <- read_analysis(input)
-  .data <- rlang::.data
+  styles <- chart_styles(data$latest)
   replace_directory(output, function(directory) {
     for (format in unique(data$latest$format)) {
-      history <- chart_data(data$latest, data$monthly, format)
-      chart <- ggplot2::ggplot(history, ggplot2::aes(x = .data$date, y = .data$rating, colour = .data$team)) +
-        ggplot2::geom_line(linewidth = 0.45) +
-        ggplot2::theme_minimal(base_size = 11) +
-        ggplot2::labs(
-          title = paste(format, toupper(data$manifest$model), "ratings"),
-          subtitle = paste("Month-end history of the current top ten active teams · through", data$manifest$as_of),
-          x = NULL, y = "Rating", colour = NULL,
-          caption = "Completed matches only; no smoothing or interpolation. Independent of ICC rankings."
-        ) +
-        ggplot2::theme(panel.grid.minor = ggplot2::element_blank())
-      ggplot2::ggsave(file.path(directory, paste0(tolower(format), ".png")), chart, width = 11, height = 6, dpi = 150)
+      charts <- ratings_charts(data, format, styles)
+      for (view in names(charts)) {
+        stem <- paste0(tolower(format), if (view == "history") "_history" else "")
+        height <- if (view == "history") 12 else 7
+        ggplot2::ggsave(file.path(directory, paste0(stem, ".png")), charts[[view]],
+          width = 12, height = height, dpi = 180, bg = "white"
+        )
+        ggplot2::ggsave(file.path(directory, paste0(stem, ".svg")), charts[[view]],
+          device = grDevices::svg, width = 12, height = height, bg = "white"
+        )
+      }
     }
     manifest <- list(
       analysis_sha256 = sha256(file.path(input, "manifest.json")),
@@ -152,10 +145,16 @@ write_report <- function(data, path) {
     lines <- c(
       lines, paste0("## ", format), "",
       paste("Most recent recorded result:", data$manifest$last_result[[format]]), "",
+      paste0("![", format, " recent rating history](", tolower(format), ".png)"), "",
+      paste0("[Download recent-history SVG](", tolower(format), ".svg)"), "",
+      "<details>", "<summary>Full history by team</summary>", "",
+      paste0("![", format, " full rating histories](", tolower(format), "_history.png)"), "",
+      paste0("[Download full-history SVG](", tolower(format), "_history.svg)"), "",
+      "</details>", "", "### Current ratings", "",
       "| Rank | Team | Rating | Rated matches | Last rated match |",
       "| ---: | --- | ---: | ---: | --- |",
       sprintf("| %s | %s | %s | %s | %s |", rows$rank, label, rows$rating, rows$rated_matches, rows$last_rated_match),
-      "", paste0("![", format, " rating history](", tolower(format), ".png)"), ""
+      ""
     )
   }
   writeLines(head(lines, -1L), path, useBytes = TRUE)

R/site.R

@@ -0,0 +1,66 @@
+read_publication <- function(directory) {
+  manifest <- jsonlite::read_json(file.path(directory, "manifest.json"))
+  files <- names(manifest$files)
+  required <- c("latest.csv", "monthly.csv", "updates.csv")
+  if (!all(required %in% files) || any(basename(files) != files) || anyDuplicated(files)) {
+    stop("Invalid publication file manifest")
+  }
+  for (name in files) {
+    path <- file.path(directory, name)
+    if (!file.exists(path) || !identical(digest::digest(file = path, algo = "sha256"), manifest$files[[name]])) {
+      stop("Publication checksum mismatch: ", name)
+    }
+  }
+  latest <- readr::read_csv(
+    file.path(directory, "latest.csv"), show_col_types = FALSE,
+    col_types = readr::cols(date = readr::col_date(), last_rated_match = readr::col_date())
+  )
+  if (
+    !nrow(latest) || anyNA(latest$date) ||
+      !identical(unique(as.character(latest$date)), manifest$analysis$as_of) ||
+      !identical(manifest$source$as_of, manifest$analysis$as_of)
+  ) {
+    stop("Inconsistent publication cutoff")
+  }
+  list(manifest = manifest, latest = latest)
+}
+
+site_ratings <- function(publication, format) {
+  rows <- publication$latest
+  if (!format %in% rows$format) stop("Missing publication format: ", format)
+  rows <- rows[rows$format == format & rows$is_active, ]
+  rows <- rows[order(-rows$rating, rows$team_id), ]
+  data.frame(
+    Rank = rows$rank, Team = paste0(rows$team, ifelse(rows$is_provisional, " (provisional)", "")),
+    Elo = rows$rating, `Rated matches` = rows$rated_matches,
+    `Last rated match` = rows$last_rated_match, check.names = FALSE
+  )
+}
+
+check_site <- function(directory, base_path = "/elo_cricket/") {
+  directory <- normalizePath(directory, mustWork = TRUE)
+  pages <- list.files(directory, pattern = "[.]html$", recursive = TRUE, full.names = TRUE)
+  if (!file.exists(file.path(directory, "index.html"))) stop("Missing site index")
+  for (page in pages) {
+    html <- xml2::read_html(page)
+    nodes <- xml2::xml_find_all(html, "//*[@href or @src]")
+    urls <- unique(c(xml2::xml_attr(nodes, "href"), xml2::xml_attr(nodes, "src")))
+    urls <- urls[!is.na(urls) & nzchar(urls)]
+    urls <- urls[!grepl("^([a-zA-Z][a-zA-Z0-9+.-]*:|//)", urls)]
+    for (url in urls) {
+      path <- utils::URLdecode(sub("[?#].*$", "", url))
+      if (!nzchar(path)) next
+      if (startsWith(path, "/")) {
+        if (!startsWith(path, base_path)) stop("Link outside site base path: ", url)
+        target <- file.path(directory, substring(path, nchar(base_path) + 1L))
+      } else {
+        target <- file.path(dirname(page), path)
+      }
+      if (dir.exists(target)) target <- file.path(target, "index.html")
+      if (!file.exists(target)) stop("Broken site link in ", basename(page), ": ", url)
+      target <- normalizePath(target, mustWork = TRUE)
+      if (!startsWith(target, paste0(directory, "/"))) stop("Link escapes site: ", url)
+    }
+  }
+  invisible(length(pages))
+}