Merge branch 'Quickfix/EFvignette/logscale' of https://github.com/UCD…

…-SERG/serocalculator into Quickfix/EFvignette/logscale

.github/workflows/pkgdown.yaml

@@ -1,28 +1,54 @@
-# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
-# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
+# Deploys pkgdown for Pull Requests, tags, and pushes to main branch
+# PRs are deployed to /preview/pr<number>/
+# Tags are deployed to /<tag>/
+# copied from https://github.com/rstudio/education-workflows/blob/main/examples/pkgdown.yaml
+# referred from https://github.com/r-lib/actions/issues/865
 on:
-  push:
-    branches: [main, master]
   pull_request:
-    branches: [main, master]
-  release:
-    types: [published]
+    branches:
+      - main
+    types:
+      - opened
+      - reopened
+      - synchronize
+      - closed
+    paths:
+      - 'man/**'
+      - 'pkgdown/**'
+      - 'vignettes/**'
+  push:
+    tags:
+      - 'v[0-9]+.[0-9]+.[0-9]+'         # build on version tags
+      - '!v[0-9]+.[0-9]+.[0-9]+.[0-9]+' # but not if version involves a dev component
+    branches:
+      - main
   workflow_dispatch:
+    inputs:
+      tag:
+        description: Tag to deploy
+        required: true
+        default: ''
 
-name: pkgdown.yaml
+name: pkgdown
 
 jobs:
-  pkgdown:
+  pkgdown-build:
     runs-on: ubuntu-latest
-    # Only restrict concurrency for non-PR jobs
-    concurrency:
-      group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }}
+    if: ${{ !(github.event_name == 'pull_request' && github.event.action == 'closed') }}
     env:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
-    permissions:
-      contents: write
     steps:
-      - uses: actions/checkout@v4
+      - uses: actions/checkout@v2
+
+      - name: Configure git
+        run: |
+          git config --local user.name "$GITHUB_ACTOR"
+          git config --local user.email "$GITHUB_ACTOR@users.noreply.github.com"
+
+      - uses: r-lib/actions/pr-fetch@v2
+        if: ${{ github.event_name == 'pull_request' }}
+        with:
+          repo-token: ${{ github.token }}
 
       - uses: r-lib/actions/setup-pandoc@v2
 
@@ -32,17 +58,91 @@ jobs:
 
       - uses: r-lib/actions/setup-r-dependencies@v2
         with:
-          extra-packages: any::pkgdown, local::.
-          needs: website
+          needs: |
+            connect
+            website
+          extra-packages: |
+            local::.
+            any::pkgdown
+
+      # If events is a PR, set subdir to 'preview/pr<pr_number>'
+      - name: "[PR] Set documentation subdirectory"
+        if: github.event_name == 'pull_request'
+        run: |
+          echo "PKGDOWN_DEV_MODE=unreleased" >> $GITHUB_ENV
+          echo "subdir=preview/pr${{ github.event.number }}" >> $GITHUB_ENV
 
-      - name: Build site
-        run: pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE)
+      # If event is a tag, set subdir to '<tag_name>'
+      - name: "[tag] Set documentation subdirectory"
+        if: github.event_name == 'push' && startsWith(github.ref, 'refs/tags/v')
+        run: |
+          echo "PKGDOWN_DEV_MODE=release" >> $GITHUB_ENV
+          echo "subdir=${GITHUB_REF#refs/tags/}" >> $GITHUB_ENV
+
+      # If event is workflow_dispatch, set subdir to 'inputs.tag'
+      - name: '[dispatch] Set documentation subdirectory'
+        if: github.event_name == 'workflow_dispatch'
+        run: |
+          echo "subdir=${{ github.event.inputs.tag }}" >> $GITHUB_ENV
+
+      - name: Deploy pkgdown site
+        id: deploy
         shell: Rscript {0}
+        run: |
+          subdir <- "${{ env.subdir }}"
+          pkg <- pkgdown::as_pkgdown(".")
+
+          # Deploy pkgdown site to branch
+          pkgdown::deploy_to_branch(subdir = if (nzchar(subdir)) subdir, clean = nzchar(subdir))
+
+          # Report deployed site URL
+          deployed_url <- file.path(pkg$meta$url, subdir)
+          cat(sprintf('url=%s', deployed_url), file = Sys.getenv("GITHUB_OUTPUT"), append = TRUE)
+
+      - name: Notify pkgdown deployment
+        if: github.event_name == 'pull_request'
+        uses: hasura/comment-progress@v2.2.0
+        with:
+          github-token: ${{ secrets.GITHUB_TOKEN }}
+          repository: ${{ github.repository }}
+          number: ${{ github.event.number }}
+          id: pkgdown-deploy
+          append: false
+          message: >
+            :book: ${{ steps.deploy.outputs.url }}
+
+            Preview documentation for this PR (at commit ${{ github.event.pull_request.head.sha }})
+
+  pkgdown-clean:
+    if: ${{ github.event_name == 'pull_request' && github.event.action == 'closed' }}
+    runs-on: ubuntu-latest
+    env:
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+    steps:
+      - uses: actions/checkout@v2
+        with:
+          ref: "gh-pages"
+
+      - name: Clean up PR Preview
+        run: |
+          git config --local user.name "$GITHUB_ACTOR"
+          git config --local user.email "$GITHUB_ACTOR@users.noreply.github.com"
+
+          preview_dir="preview/pr${{ github.event.pull_request.number }}"
+          if [ -d "$preview_dir" ]; then
+            git rm -r $preview_dir
+            git commit -m "Remove $preview_dir (GitHub Actions)" || echo 'No preview to remove'
+            git push origin || echo 'No preview to remove'
+          else
+            echo 'No preview to remove'
+          fi
 
-      - name: Deploy to GitHub pages 🚀
-        if: github.event_name != 'pull_request'
-        uses: JamesIves/github-pages-deploy-action@v4.5.0
+      - name: Notify pkgdown cleanup
+        uses: hasura/comment-progress@v2.2.0
         with:
-          clean: false
-          branch: gh-pages
-          folder: docs
+          github-token: ${{ secrets.GITHUB_TOKEN }}
+          repository: ${{ github.repository }}
+          number: ${{ github.event.number }}
+          id: pkgdown-deploy
+          message: |
+            _:closed_book: Preview documentation for this PR has been cleaned up._

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: serocalculator
 Title: Estimating Infection Rates from Serological Data
-Version: 1.2.0.9017
+Version: 1.2.0.9018
 Authors@R: c(
     person("Peter", "Teunis", , "p.teunis@emory.edu", role = c("aut", "cph"),
            comment = "Author of the method and original code."),
@@ -38,7 +38,8 @@ Imports:
     tibble,
     tidyr,
     tidyselect,
-    utils
+    utils,
+    purrr
 Suggests:
     bookdown,
     devtag (>= 0.0.0.9000),
@@ -55,7 +56,9 @@ Suggests:
     ssdtools (>= 1.0.6.9016),
     testthat (>= 3.0.0),
     tidyverse,
-    qrcode
+    qrcode,
+    svglite,
+    vdiffr
 LinkingTo: 
     Rcpp
 Config/testthat/edition: 3

NEWS.md

@@ -1,6 +1,9 @@
 # serocalculator (development version)
 
 ## New features
+* Improved error messaging for `autoplot.pop_data()` (#234).
+
+* Clarified package installation instructions in scrub typhus vignette (#234).
 
 * Add `as_noise_params` (#228) 
 
@@ -19,7 +22,11 @@
 * Added template for pull requests 
 (from <https://github.com/bcgov/ssdtools>) (#265)
 
-## Developer-facing changes
+## Internal changes
+
+* Added online preview builds for PRs that change the `pkgdown` website (#309)
+
+* Added `test-autoplot.pop_data` test (#234)
 
 * initialized [`lintr`](https://lintr.r-lib.org/) with `lintr::use_lint()` (#278)
 
@@ -28,6 +35,7 @@
 * fixed `dplyr::select()` deprecation warning in `df_to_array()` (#276)
 
 * Added `devtag` to package (using `devtag::use_devtag()`) (#292)
+
 * Added `@dev` tag to `?df_to_array()` (#292)
 
 * Generalized `get_()` and `set_()` methods to be general-purpose
@@ -47,6 +55,7 @@ including:
   - lint changed files (#256)
 
 # serocalculator 1.2.0
+
 * Added `test-summary.pop_data` test
 
 * Modified `test-est.incidence` test

R/autoplot.pop_data.R

@@ -4,9 +4,11 @@
 #'
 #' @param object A `pop_data` object (from [load_pop_data()])
 #' @param log whether to show antibody responses on logarithmic scale
-#' @param strata the name of a variable in `pop_data` to stratify by (or `NULL` for no stratification)
+#' @param strata the name of a variable in `pop_data`
+#' to stratify by (or `NULL` for no stratification)
 #' @param ... unused
-#' @param type an option to choose type of chart: the current options are `"density"` or `"age-scatter"`
+#' @param type an option to choose type of chart:
+#' the current options are `"density"` or `"age-scatter"`
 #'
 #' @return a [ggplot2::ggplot] object
 #'
@@ -31,40 +33,58 @@ autoplot.pop_data <- function(
     type = "density",
     strata = NULL,
     ...) {
+
+  if (!is.null(strata) && !is.element(strata, names(object))) {
+    cli::cli_abort(
+      class = "unavailable_strata",
+      message = c(
+        x = "The variable {.var {strata}} specified by argument {.arg strata}
+        does not exist in {.arg object}.",
+        i = "Please choose a column that exists in {.arg object}."
+      )
+    )
+  }
+
   if (type == "age-scatter") {
     age_scatter(object, strata)
   } else if (type == "density") {
     density_plot(object, strata, log)
   } else {
     cli::cli_abort(
-      '`type = "{type}"` is not a valid input;
-      the currently available options for `type` are "density" or "age-scatter"'
+      class = "unavailable_type",
+      message = c(
+        x = "{.fn autoplot.pop_data} does not currently have an option for
+         {.arg type} = {.str {type}}.",
+        i = "The {.arg type} argument accepts options
+        {.str density} or {.str age-scatter}."
+      )
     )
   }
 }
 
 age_scatter <- function(
     object,
-    strata = NULL) {
+    strata = NULL,
+    age_var = object %>% get_age_var(),
+    value_var = object %>% get_value_var()) {
   # create default plotting
 
   if (is.null(strata)) {
     plot1 <-
       object %>%
-      ggplot2::ggplot(ggplot2::aes(x = .data[[object %>% get_age_var()]],
-                                   y = .data[[object %>% get_value_var()]],
-                                   col = get(strata)
-                                   )
-                      )
+      ggplot2::ggplot() +
+      ggplot2::aes(
+        x = .data[[age_var]],
+        y = .data[[value_var]]
+      )
   } else {
     plot1 <-
       object %>%
-      ggplot2::ggplot(
-        ggplot2::aes(
-          x = .data[[object %>% get_age_var()]],
-          y = .data[[object %>% get_value_var()]]
-        ),
-        col = get(strata)
+      ggplot2::ggplot() +
+      ggplot2::aes(
+        col = .data[[strata]],
+        x = .data[[age_var]],
+        y = .data[[value_var]]
       ) +
       ggplot2::labs(colour = strata)
   }
@@ -73,7 +93,7 @@ age_scatter <- function(
     ggplot2::theme_linedraw() +
     # ggplot2::scale_y_log10() +
 
-    # avoid log 0 (https://forum.posit.co/t/using-log-transformation-but-need-to-preserve-0/129197/4)
+    # avoid log 0 (https://bit.ly/4eqDkT4)
     ggplot2::scale_y_continuous(
       trans = scales::pseudo_log_trans(sigma = 0.01),
       breaks = c(-1, -0.1, 0, 0.1, 1, 10),
@@ -99,10 +119,12 @@ age_scatter <- function(
 density_plot <- function(
     object,
     strata = NULL,
-    log = FALSE) {
+    log = FALSE,
+    value_var = object %>% get_value_var()) {
   plot1 <-
     object %>%
-    ggplot2::ggplot(ggplot2::aes(x = .data[[object %>% get_value_var()]])) +
+    ggplot2::ggplot() +
+    ggplot2::aes(x = .data[[value_var]]) +
     ggplot2::theme_linedraw() +
     ggplot2::facet_wrap(~antigen_iso, nrow = 3)
 
@@ -122,10 +144,11 @@ density_plot <- function(
       ggplot2::labs(fill = strata)
   }
   if (log) {
+
     min_nonzero_val <-
       object %>%
-      filter(object %>% get_value() > 0) %>%
       get_value() %>%
+      purrr::keep(~ . > 0) %>%
       min()
 
     max_val <-

_pkgdown.yml

@@ -4,3 +4,6 @@ template:
   light-switch: true
 
 bibliography: vignettes/references.bib
+
+search:
+  exclude: ['preview/']