Merge branch 'main' into lint-on-push

.github/workflows/check-spelling.yaml

@@ -0,0 +1,23 @@
+---
+name: Spellcheck
+
+on:
+  push:
+    branches:
+      - main
+  pull_request:
+    branches:
+      - main
+
+jobs:
+  check:
+    runs-on: ubuntu-latest
+    name: Spellcheck
+    container:
+      image: rocker/tidyverse:4.1.2
+    steps:
+      - name: Checkout repo
+        uses: actions/checkout@v3
+
+      - name: Run Spelling Check test
+        uses: insightsengineering/[email protected]

.github/workflows/lint-changed-files.yaml

@@ -0,0 +1,45 @@
+# 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
+on:
+  pull_request:
+
+name: lint-changed-files.yaml
+
+permissions: read-all
+
+jobs:
+  lint-changed-files:
+    runs-on: ubuntu-latest
+    env:
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+    steps:
+      - uses: actions/checkout@v4
+
+      - uses: r-lib/actions/setup-r@v2
+
+      - uses: r-lib/actions/setup-r-dependencies@v2
+        with:
+          extra-packages: |
+            any::gh
+            any::lintr
+            any::purrr
+          needs: check
+
+      - name: Add lintr options
+        run: |
+          cat('\noptions(lintr.linter_file = ".lintr")\n', file = "~/.Rprofile", append = TRUE)
+        shell: Rscript {0}
+
+      - name: Install package
+        run: R CMD INSTALL .
+
+      - name: Extract and lint files changed by this PR
+        run: |
+          files <- gh::gh("GET https://api.github.com/repos/${{ github.repository }}/pulls/${{ github.event.pull_request.number }}/files")
+          changed_files <- purrr::map_chr(files, "filename")
+          all_files <- list.files(recursive = TRUE)
+          exclusions_list <- as.list(setdiff(all_files, changed_files))
+          lintr::lint_package(exclusions = exclusions_list)
+        shell: Rscript {0}
+        env:
+          LINTR_ERROR_ON_LINT: true

.github/workflows/news.yaml

@@ -0,0 +1,14 @@
+name: Check NEWS.md Changelog
+on:
+  pull_request:
+    types: [assigned, opened, synchronize, reopened, labeled, unlabeled]
+    branches:
+      - main
+jobs:
+  Check-Changelog:
+    name: Check Changelog Action
+    runs-on: ubuntu-20.04
+    steps:
+      - uses: UCD-SERG/changelog-check-action@v2
+        with:
+          changelog: NEWS.md

.github/workflows/version-check.yaml

@@ -0,0 +1,58 @@
+---
+on:
+  pull_request:
+    branches:
+      - main
+
+name: Version increment check
+
+jobs:
+  version-check:
+    if: ${{ github.event_name == 'pull_request' }}
+    runs-on: ubuntu-latest
+    env:
+      GITHUB_PAT: ${{ github.token }}
+    permissions:
+      pull-requests: read
+
+    steps:
+
+      - name: checkout working HEAD
+        uses: actions/checkout@v4
+        with:
+          ref: ${{ github.event.pull_request.head.ref }}
+          sparse-checkout: |
+            DESCRIPTION
+          path: working
+
+      - name: checkout base HEAD
+        uses: actions/checkout@v4
+        with:
+          ref: ${{ github.event.pull_request.base.ref }}
+          sparse-checkout: |
+            DESCRIPTION
+          path: compare
+
+      - name: show files
+        run: |
+          ls -lR working compare
+          echo "\nWORKING:\n"
+          cat working/DESCRIPTION
+          echo "\nCOMPARE:\n"
+          cat compare/DESCRIPTION
+
+      - name: Setup R
+        uses: r-lib/actions/setup-r@v2
+        with:
+          use-public-rspm: true
+
+      - name: compare versions
+        run: |
+          Rscript -e " \
+            install.packages('desc'); \
+            working_version <- desc::desc_get_version('working/DESCRIPTION'); \
+            message('PR branch version: ', working_version); \
+            compare_version <- desc::desc_get_version('compare/DESCRIPTION'); \
+            message('main branch version: ', compare_version); \
+            stopifnot(working_version > compare_version); \
+          "

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: serocalculator
 Type: Package
 Title: Estimating Infection Rates from Serological Data
-Version: 1.2.0
+Version: 1.2.0.9004
 Authors@R: c(
   person(given = "Peter", family = "Teunis", email = "[email protected]", role = c("aut", "cph"), comment = "Author of the method and original code."),
   person(given = "Kristina", family = "Lai", email = "[email protected]", role = c("aut", "cre")), 

NAMESPACE

@@ -8,6 +8,9 @@ S3method(autoplot,seroincidence.by)
 S3method(autoplot,summary.seroincidence.by)
 S3method(get_age,pop_data)
 S3method(get_age_var,pop_data)
+S3method(get_biomarker_levels,pop_data)
+S3method(get_biomarker_names,pop_data)
+S3method(get_biomarker_names_var,pop_data)
 S3method(get_id,pop_data)
 S3method(get_id_var,pop_data)
 S3method(get_value,pop_data)
@@ -17,17 +20,20 @@ S3method(print,seroincidence.by)
 S3method(print,summary.pop_data)
 S3method(print,summary.seroincidence.by)
 S3method(set_age,pop_data)
+S3method(set_biomarker_var,pop_data)
 S3method(set_id,pop_data)
 S3method(set_value,pop_data)
 S3method(strata,seroincidence.by)
 S3method(summary,pop_data)
 S3method(summary,seroincidence)
 S3method(summary,seroincidence.by)
+export(as_curve_params)
 export(as_pop_data)
 export(check_pop_data)
 export(est.incidence)
 export(est.incidence.by)
 export(f_dev)
+export(f_dev0)
 export(fdev)
 export(getAdditionalData)
 export(get_additional_data)
@@ -52,6 +58,8 @@ importFrom(dplyr,distinct)
 importFrom(dplyr,everything)
 importFrom(dplyr,filter)
 importFrom(dplyr,group_by)
+importFrom(dplyr,if_all)
+importFrom(dplyr,if_any)
 importFrom(dplyr,inner_join)
 importFrom(dplyr,is.grouped_df)
 importFrom(dplyr,mutate)

NEWS.md

@@ -1,3 +1,17 @@
+# serocalculator (development version)
+
+## New features
+
+(to be added by future PRs)
+
+## Developer-facing changes
+
+* Added additional automated checks through 
+[GitHub actions](https://docs.github.com/en/actions), 
+including:
+  - check `NEWS.md` for updated change log (#257)
+  - lint changed files (#256)
+
 # serocalculator 1.2.0
 * Added `test-summary.pop_data` test
 

R/as_curve_params.R

@@ -0,0 +1,71 @@
+#' Load antibody decay curve parameter
+#'
+#' @param data a [data.frame()] or [tibble::tbl_df]
+#' @param antigen_isos [character()] vector of antigen isotypes to be used in analyses
+#' @returns a `curve_data` object (a [tibble::tbl_df] with extra attribute `antigen_isos`)
+#' @export
+#' @examples
+#' library(magrittr)
+#' curve_data <-
+#'   "https://osf.io/download/rtw5k/" %>%
+#'   readr::read_rds() %>%
+#'   as_curve_params()
+#'
+#' print(curve_data)
+as_curve_params <- function(data, antigen_isos = NULL) {
+
+  if(!is.data.frame(data))
+  {
+    cli::cli_abort(
+      class = "not data.frame",
+      message = c(
+        "Can't convert {.arg data} to {.cls curve_params}.",
+        "x" = "{.arg data} must be a {.cls data.frame}
+        (or a subclass of {.cls data.frame}).",
+        "i" = "You have supplied a {.cls {class(data)}}."
+      )
+    )
+  }
+
+  curve_data <-
+    data %>%
+    tibble::as_tibble()
+
+  # define curve columns
+  curve_cols <- c("antigen_iso", "y0", "y1", "t1", "alpha", "r")
+
+  # check if object is curve (with columns)
+  if (!all(is.element(curve_cols, curve_data %>% names()))) {
+    # get columns from provided data
+    data_cols <- data %>% names()
+
+    # get any missing column(s)
+    missing_cols <- setdiff(x = curve_cols, y = data_cols)
+
+    cli::cli_abort(
+      class = "not curve_params",
+      message = c(
+        "Can't convert {.arg data} to {.cls curve_params}.",
+        "x" = "The column{?s}: {.strong {.var {missing_cols}}} are missing."
+      )
+    )
+  }
+
+  # assign curve class
+  class(curve_data) <-
+    c("curve_params", class(curve_data))
+
+
+  if (is.null(antigen_isos)) {
+    antigen_isos <- unique(curve_data$antigen_iso)
+  } else {
+    stopifnot(all(
+      is.element(antigen_isos, curve_data$antigen_iso)
+    ))
+  }
+
+  # assign antigen attribute
+  attr(curve_data, "antigen_isos") <- antigen_isos
+
+  return(curve_data)
+}

R/as_pop_data.R

@@ -9,15 +9,19 @@
 #' @returns a `pop_data` object (a [tibble::tbl_df] with extra attribute `antigen_isos`)
 #' @export
 #' @examples
-#' xs_data <- load_pop_data("https://osf.io/download//n6cp3/")
+#' library(magrittr)
+#' xs_data <-
+#'   "https://osf.io/download//n6cp3/" %>%
+#'   readr::read_rds() %>%
+#'   as_pop_data()
 #'
 #' print(xs_data)
 as_pop_data <- function(data,
-                          antigen_isos = NULL,
-                          age = "Age",
-                          value = "result",
-                          id = "index_id",
-                          standardize = TRUE) {
+                        antigen_isos = NULL,
+                        age = "Age",
+                        value = "result",
+                        id = "index_id",
+                        standardize = TRUE) {
 
 
   pop_data <-
@@ -38,8 +42,8 @@ as_pop_data <- function(data,
   pop_data <- pop_data %>%
     set_age(age = age, standardize = standardize) %>%
     set_value(value = value, standardize = standardize) %>%
-    set_id(id = id, standardize = standardize)
+    set_id(id = id, standardize = standardize)  %>%
+    set_biomarker_var(biomarker = "antigen_iso", standardize = standardize)
 
   return(pop_data)
 }
-